{
open Parser
open Support.Error

let reservedWords = [
  ("int", fun i -> INTTY i);
  ("this", fun i -> THIS i);
  ("short", fun i -> SHORTTY i);
  ("long", fun i -> LONGTY i);
  ("float", fun i -> FLOATTY i);
  ("double", fun i -> DOUBLETY i);
  ("bool", fun i -> BOOLTY i);
  ("string", fun i -> STRINGTY i);
  ("char", fun i -> CHARTY i);
  ("wchar_t", fun i -> WCHARTY i);
  ("unsigned", fun i -> UNSIGNED i);
  ("signed", fun i -> SIGNED i);
  ("const", fun i -> CONST i);
  ("true", fun i -> TRUE i);
  ("false", fun i -> FALSE i);
  ("fun", fun i -> FUN i);
  ("primitive", fun i -> PRIMITIVE i);
  ("try", fun i -> TRY i);
  ("catch", fun i -> CATCH i);
  ("throw", fun i -> THROW i);
  ("exists", fun i -> EXISTS i);
  ("unpack", fun i -> UNPACK i);
  ("mutable", fun i -> MUTABLE i);
  ("void", fun i -> VOIDTY i);
  ("nullptr", fun i -> NULLPTR i);
  ("let", fun i -> LET i);
  ("and", fun i -> AND i);
  ("or", fun i -> OR i);
  ("not", fun i -> NOT i);
  ("negate", fun i -> NEG i);
  ("cast", fun i -> CAST i);
  ("switch", fun i -> SWITCH i);
  ("case", fun i -> CASE i);
  ("default", fun i -> DEFAULT i);
  ("operator", fun i -> OPERATOR i);

  ("if", fun i -> IF i);
  ("else", fun i -> ELSE i);
  ("while", fun i -> WHILE i);
  ("do", fun i -> DO i);
  ("for", fun i -> FOR i);
  ("return", fun i -> RETURN i);

  ("struct", fun i -> STRUCT i);
  ("union", fun i -> UNION i);
  ("class", fun i -> CLASS i);
  ("concept", fun i -> CONCEPT i);
  ("model", fun i -> MODEL i);
  ("refines", fun i -> REFINES i);
  ("require", fun i -> REQUIRE i);
  ("where", fun i -> WHERE i);
  ("module", fun i -> MODULE i);
  ("private", fun i -> PRIVATE i);
  ("public", fun i -> PUBLIC i);
  ("import", fun i -> IMPORT i);
  ("include_c", fun i -> INCLUDE i);
  ("use", fun i -> USE i);
  ("open", fun i -> OPEN i);
  ("from", fun i -> FROM i);
  ("as", fun i -> AS i);
  ("type", fun i -> TYPE i);
  ("sizeof", fun i -> SIZEOF i);

  ("new", fun i -> NEW i);
  ("placement_new", fun i -> PLACEMENT_NEW i);
  ("GC", fun i -> GC i);
  ("array", fun i -> ARRAY i);
  ("delete", fun i -> DELETE i);
  ("destroy", fun i -> DESTROY i);
  ("extern", fun i -> EXTERN i);

  ("|", fun i -> BAR i);  
  ("(", fun i -> LPAREN i);  
  (")", fun i -> RPAREN i);  
  ("{", fun i -> LBRACE i);  
  ("}", fun i -> RBRACE i);  
  ("[", fun i -> LBRACK i);  
  ("]", fun i -> RBRACK i);  
  (";", fun i -> SEMICOLON i);  
  (":", fun i -> COLON i);  
  ("=", fun i -> ASSIGN i);  
  ("...", fun i -> ELIPSES i);  
  (".", fun i -> DOT i);  
  (",", fun i -> COMMA i);  
  ("->", fun i -> ARROW i);
  ("/\\", fun i -> INTER i);
  ("*", fun i -> STAR i);
  ("<<", fun i -> OUTPUT i);
  (">>", fun i -> INPUT i);
  ("<", fun i -> LT i);
  (">", fun i -> GT i);
  ("<=", fun i -> LEQ i);
  (">=", fun i -> GEQ i);
  ("==", fun i -> EQ i);
  ("!=", fun i -> NEQ i);
  ("!", fun i -> BANG i);
  ("++", fun i -> INC i);
  ("+=", fun i -> PLUSASSIGN i);
  ("+", fun i -> PLUS i);
  ("--", fun i -> DEC i);
  ("-", fun i -> SUB i);
  ("/", fun i -> DIV i);
  ("@", fun i -> AT i);
  ("%", fun i -> PERCENT i);
  ("?", fun i -> QMARK i);
  ("~", fun i -> TILDE i);
  ("&", fun i -> AMP i)
]

(* Support functions *)

type buildfun = info -> Parser.token

let (symbolTable : (string,buildfun) Hashtbl.t) = Hashtbl.create 1024
let _ =
  List.iter (fun (str,f) -> Hashtbl.add symbolTable str f) reservedWords

let createID i str =
  try (Hashtbl.find symbolTable str) i
  with _ ->
     NAME {i=i;v=str}

let lineno   = ref 1
and depth    = ref 0
and start    = ref 0

and filename = ref ""
and startLex = ref dummyinfo

(* Wrong! *)
let create inFile stream =
  if not (Filename.is_implicit inFile) then filename := inFile
  else filename := inFile;
  lineno := 1; start := 0; Lexing.from_channel stream

let newline lexbuf = incr lineno; start := (Lexing.lexeme_start lexbuf)

let info lexbuf =
  createInfo (!filename) (!lineno) (Lexing.lexeme_start lexbuf - !start)

let text = Lexing.lexeme

let stringBuffer = ref (String.create 2048)
let stringEnd = ref 0

let resetStr () = stringEnd := 0

let addStr ch =
  let x = !stringEnd in
  let buffer = !stringBuffer
in
  if x = String.length buffer then
    begin
      let newBuffer = String.create (x*2) in
      String.blit buffer 0 newBuffer 0 x;
      String.set newBuffer x ch;
      stringBuffer := newBuffer;
      stringEnd := x+1
    end
  else
    begin
      String.set buffer x ch;
      stringEnd := x+1
    end

let getStr () = String.sub (!stringBuffer) 0 (!stringEnd)

let extractLineno yytext offset =
  int_of_string (String.sub yytext offset (String.length yytext - offset))

}


rule main = parse
  [' ' '\009' '\012']+     { main lexbuf }

| [' ' '\009' '\012']*"\n" { newline lexbuf; main lexbuf }

| "*/" { error (info lexbuf) "Unmatched end of comment" }

| "/*" { depth := 1; startLex := info lexbuf; comment lexbuf; main lexbuf }

| "//" { startLex := info lexbuf; cpp_comment lexbuf; main lexbuf }

| "# " ['0'-'9']+
    { lineno := extractLineno (text lexbuf) 2 - 1; getFile lexbuf }

| "# line " ['0'-'9']+
    { lineno := extractLineno (text lexbuf) 7 - 1; getFile lexbuf }

| "#line " ['0'-'9']+
    { lineno := extractLineno (text lexbuf) 6 - 1; getFile lexbuf }

| ['0'-'9']+
    { INT{i=info lexbuf; v=int_of_string (text lexbuf)} }

| ['0'-'9']+ '.' ['0'-'9']*
    { DOUBLE{i=info lexbuf; v=float_of_string (text lexbuf)} }

| '\'' _ '\''
  { CHAR{i=info lexbuf; v= String.get (text lexbuf) 1} }

| "\'\\0\'"
  { CHAR{i=info lexbuf; v= '\000'} }

| ['A'-'Z' 'a'-'z' '_']
  ['A'-'Z' 'a'-'z' '_' '0'-'9' '\'']*
    { createID (info lexbuf) (text lexbuf) }

| "->"
| "'"
| "&"
| "?"
| "~"
| "_"
| "@"
| "++" | "--" 
| "+="
| "+" | "-" | "*" | "/" | "%" | "!" | "==" | "!=" | "=" 
| "<<" | "<" | "<=" | ">>" | ">" | ">="
| "|" | "(" | ")" | "{" | "}" | "[" | "]" | ";" | ":" | "," | "..." | "." | "&"
    { createID (info lexbuf) (text lexbuf) }

| "\"" { resetStr(); startLex := info lexbuf; string lexbuf }

| eof { EOF(info lexbuf) }

| _  { error (info lexbuf) "Illegal character" }

and comment = parse
  "/*"
    { depth := succ !depth; comment lexbuf }
| "*/"
    { depth := pred !depth; if !depth > 0 then comment lexbuf }
| eof
    { error (!startLex) "Comment not terminated" }
| [^ '\n']
    { comment lexbuf }
| "\n"
    { newline lexbuf; comment lexbuf }

and cpp_comment = parse
| [^ '\n']
    { cpp_comment lexbuf }
| "\n"
    { newline lexbuf }

and getFile = parse
  " "* "\"" { getName lexbuf }
| '\n' { main lexbuf }

and getName = parse
  [^ '"' '\n']+ { filename := (text lexbuf); finishName lexbuf }

and finishName = parse
  '"' [^ '\n']* { main lexbuf }

and string = parse
  '"'  { STRING {i = !startLex; v=getStr()} }
| '\\' { addStr(escaped lexbuf); string lexbuf }
| '\n' { addStr '\n'; newline lexbuf; string lexbuf }
| eof  { error (!startLex) "String not terminated" }
| _    { addStr (Lexing.lexeme_char lexbuf 0); string lexbuf }

and escaped = parse
  'n'	 { '\n' }
| 't'	 { '\t' }
| '\\'	 { '\\' }
| '"'    { '\034'  }
| '\''	 { '\'' }
| ['0'-'9']['0'-'9']['0'-'9']
    {
      let x = int_of_string(text lexbuf) in
      if x > 255 then
	error (info lexbuf) "Illegal character constant"
      else
	Char.chr x
    }
| [^ '"' '\\' 't' 'n' '\'']
    { error (info lexbuf) "Illegal character constant" }