l4/pkg/ocaml/contrib/otherlibs/labltk/compiler/lexer.mll

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                 MLTk, Tcl/Tk interface of Objective Caml            *)
   4 (*                                                                     *)
   5 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
   6 (*               projet Cristal, INRIA Rocquencourt                    *)
   7 (*            Jacques Garrigue, Kyoto University RIMS                  *)
   8 (*                                                                     *)
   9 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
  10 (*  en Automatique and Kyoto University.  All rights reserved.         *)
  11 (*  This file is distributed under the terms of the GNU Library        *)
  12 (*  General Public License, with the special exception on linking      *)
  13 (*  described in file ../LICENSE.                                      *)
  14 (*                                                                     *)
  15 (***********************************************************************)
  16
  17 (* $Id: lexer.mll 5029 2002-07-23 14:12:03Z doligez $ *)
  18
  19 {
  20 open StdLabels
  21 open Lexing
  22 open Parser
  23 open Support
  24
  25 exception Lexical_error of string
  26 let current_line = ref 1
  27
  28
  29 (* The table of keywords *)
  30
  31 let keyword_table = (Hashtbl.create 149 : (string, token) Hashtbl.t)
  32
  33 let _ = List.iter
  34   ~f:(fun (str,tok) -> Hashtbl.add keyword_table str tok)
  35   [
  36   "int", TYINT;
  37   "float", TYFLOAT;
  38   "bool", TYBOOL;
  39   "char", TYCHAR;
  40   "string", TYSTRING;
  41   "list", LIST;
  42   "as", AS;
  43   "variant", VARIANT;
  44   "widget", WIDGET;
  45   "option", OPTION;
  46   "type", TYPE;
  47   "subtype", SUBTYPE;
  48   "function", FUNCTION;
  49   "module", MODULE;
  50   "external", EXTERNAL;
  51   "sequence", SEQUENCE;
  52   "unsafe", UNSAFE
  53 ]
  54
  55
  56 (* To buffer string literals *)
  57
  58 let initial_string_buffer = String.create 256
  59 let string_buff = ref initial_string_buffer
  60 let string_index = ref 0
  61
  62 let reset_string_buffer () =
  63   string_buff := initial_string_buffer;
  64   string_index := 0;
  65   ()
  66
  67 let store_string_char c =
  68   if !string_index >= String.length (!string_buff) then begin
  69     let new_buff = String.create (String.length (!string_buff) * 2) in
  70       String.blit ~src:(!string_buff) ~src_pos:0 ~dst:new_buff ~dst_pos:0
  71                   ~len:(String.length (!string_buff));
  72       string_buff := new_buff
  73   end;
  74   String.set (!string_buff) (!string_index) c;
  75   incr string_index
  76
  77 let get_stored_string () =
  78   let s = String.sub (!string_buff) ~pos:0 ~len:(!string_index) in
  79     string_buff := initial_string_buffer;
  80     s
  81 (* To translate escape sequences *)
  82
  83 let char_for_backslash = function
  84     'n' -> '\010'
  85   | 'r' -> '\013'
  86   | 'b' -> '\008'
  87   | 't' -> '\009'
  88   | c   -> c
  89
  90 let char_for_decimal_code lexbuf i =
  91   Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
  92                10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
  93                     (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))
  94
  95 let saved_string_start = ref 0
  96
  97 }
  98
  99 rule main = parse
 100     '\010' { incr current_line; main lexbuf }
 101   | [' ' '\013' '\009' '\026' '\012'] +
 102       { main lexbuf }
 103   | ['A'-'Z' 'a'-'z' '\192'-'\214' '\216'-'\246' '\248'-'\255' ]
 104     ( '_' ? ['A'-'Z' 'a'-'z' '\192'-'\214' '\216'-'\246' '\248'-'\255' (*'*) '0'-'9' ] ) *
 105       { let s = Lexing.lexeme lexbuf in
 106           try
 107             Hashtbl.find keyword_table s
 108           with Not_found ->
 109             IDENT s }
 110
 111   | "\""
 112       { reset_string_buffer();
 113         (* Start of token is start of string. *)
 114         saved_string_start := lexbuf.lex_start_pos;
 115         string lexbuf;
 116         lexbuf.lex_start_pos <- !saved_string_start;
 117         STRING (get_stored_string()) }
 118   | "(" { LPAREN }
 119   | ")" { RPAREN }
 120   | "[" { LBRACKET }
 121   | "]" { RBRACKET }
 122   | "{" { LBRACE }
 123   | "}" { RBRACE }
 124   | "," { COMMA }
 125   | ";" { SEMICOLON }
 126   | ":" {COLON}
 127   | "?" {QUESTION}
 128   | "/" {SLASH}
 129   | "%" { comment lexbuf; main lexbuf }
 130   | "##line" { line lexbuf; main lexbuf }
 131   | eof { EOF }
 132   | _
 133       { raise (Lexical_error("illegal character")) }
 134
 135
 136 and string = parse
 137     '"'
 138       { () }
 139   | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
 140       { string lexbuf }
 141   | '\\' ['\\' '"' 'n' 't' 'b' 'r']
 142       { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
 143         string lexbuf }
 144   | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
 145       { store_string_char(char_for_decimal_code lexbuf 1);
 146          string lexbuf }
 147   | eof
 148       { raise (Lexical_error("string not terminated")) }
 149   | '\010'
 150       { incr current_line;
 151         store_string_char(Lexing.lexeme_char lexbuf 0);
 152         string lexbuf }
 153   | _
 154       { store_string_char(Lexing.lexeme_char lexbuf 0);
 155         string lexbuf }
 156
 157 and comment = parse
 158    '\010' { incr current_line }
 159  | eof  { () }
 160  | _ { comment lexbuf }
 161
 162 and linenum = parse
 163  | ['0'-'9']+ {
 164             let next_line = int_of_string (Lexing.lexeme lexbuf) in
 165             current_line := next_line - 1
 166           }
 167  | _ { raise (Lexical_error("illegal ##line directive: no line number"))}
 168
 169 and line = parse
 170  | [' ' '\t']* { linenum lexbuf }