(***********************************************************************)
(*                                                                     *)
(*                 MLTk, Tcl/Tk interface of OCaml                     *)
(*                                                                     *)
(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
(*               projet Cristal, INRIA Rocquencourt                    *)
(*            Jacques Garrigue, Kyoto University RIMS                  *)
(*                                                                     *)
(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
(*  en Automatique and Kyoto University.  All rights reserved.         *)
(*  This file is distributed under the terms of the GNU Library        *)
(*  General Public License, with the special exception on linking      *)
(*  described in file ../LICENSE.                                      *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

{
open StdLabels
open Lexing
open Parser

exception Lexical_error of string
let current_line = ref 1


(* The table of keywords *)

let keyword_table = (Hashtbl.create 149 : (string, token) Hashtbl.t)

let _ = List.iter
  ~f:(fun (str,tok) -> Hashtbl.add keyword_table str tok)
  [
  "int", TYINT;
  "float", TYFLOAT;
  "bool", TYBOOL;
  "char", TYCHAR;
  "string", TYSTRING;
  "list", LIST;
  "as", AS;
  "variant", VARIANT;
  "widget", WIDGET;
  "option", OPTION;
  "type", TYPE;
  "subtype", SUBTYPE;
  "function", FUNCTION;
  "module", MODULE;
  "external", EXTERNAL;
  "sequence", SEQUENCE;
  "unsafe", UNSAFE
]


(* To buffer string literals *)

let initial_string_buffer = Bytes.create 256
let string_buff = ref initial_string_buffer
let string_index = ref 0

let reset_string_buffer () =
  string_buff := initial_string_buffer;
  string_index := 0;
  ()

let store_string_char c =
  if !string_index >= Bytes.length (!string_buff) then begin
    let new_buff = Bytes.create (Bytes.length (!string_buff) * 2) in
      Bytes.blit ~src:(!string_buff) ~src_pos:0 ~dst:new_buff ~dst_pos:0
                  ~len:(Bytes.length (!string_buff));
      string_buff := new_buff
  end;
  Bytes.set (!string_buff) (!string_index) c;
  incr string_index

let get_stored_string () =
  let s = Bytes.sub_string (!string_buff) 0 (!string_index) in
    string_buff := initial_string_buffer;
    s
(* To translate escape sequences *)

let char_for_backslash = function
    'n' -> '\010'
  | 'r' -> '\013'
  | 'b' -> '\008'
  | 't' -> '\009'
  | c   -> c

let char_for_decimal_code lexbuf i =
  Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
               10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
                    (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))

let saved_string_start = ref 0

}

rule main = parse
    '\010' { incr current_line; main lexbuf }
  | [' ' '\013' '\009' '\026' '\012'] +
      { main lexbuf }
  | ['A'-'Z' 'a'-'z' '\192'-'\214' '\216'-'\246' '\248'-'\255' ]
    ( '_' ? ['A'-'Z' 'a'-'z' '\192'-'\214' '\216'-'\246' '\248'-'\255' (*'*) '0'-'9' ] ) *
      { let s = Lexing.lexeme lexbuf in
          try
            Hashtbl.find keyword_table s
          with Not_found ->
            IDENT s }

  | "\""
      { reset_string_buffer();
        (* Start of token is start of string. *)
        saved_string_start := lexbuf.lex_start_pos;
        string lexbuf;
        lexbuf.lex_start_pos <- !saved_string_start;
        STRING (get_stored_string()) }
  | "(" { LPAREN }
  | ")" { RPAREN }
  | "[" { LBRACKET }
  | "]" { RBRACKET }
  | "{" { LBRACE }
  | "}" { RBRACE }
  | "," { COMMA }
  | ";" { SEMICOLON }
  | ":" {COLON}
  | "?" {QUESTION}
  | "/" {SLASH}
  | "%" { comment lexbuf; main lexbuf }
  | "##line" { line lexbuf; main lexbuf }
  | eof { EOF }
  | _
      { raise (Lexical_error("illegal character")) }


and string = parse
    '"'
      { () }
  | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
      { string lexbuf }
  | '\\' ['\\' '"' 'n' 't' 'b' 'r']
      { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
        string lexbuf }
  | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
      { store_string_char(char_for_decimal_code lexbuf 1);
         string lexbuf }
  | eof
      { raise (Lexical_error("string not terminated")) }
  | '\010'
      { incr current_line;
        store_string_char(Lexing.lexeme_char lexbuf 0);
        string lexbuf }
  | _
      { store_string_char(Lexing.lexeme_char lexbuf 0);
        string lexbuf }

and comment = parse
   '\010' { incr current_line }
 | eof  { () }
 | _ { comment lexbuf }

and linenum = parse
 | ['0'-'9']+ {
            let next_line = int_of_string (Lexing.lexeme lexbuf) in
            current_line := next_line - 1
          }
 | _ { raise (Lexical_error("illegal ##line directive: no line number"))}

and line = parse
 | [' ' '\t']* { linenum lexbuf }