[r2002-11-07 01:13:10 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-07 01:13:10+00:00

parser/wlexer.ml

+let eof = 0
+let encoding_error = 1
+let xml_char = 2
+let blank = 3
+let lowercase = 4
+let uppercase = 5
+let ascii_digit = 6
+let char_5f = 7
+let char_3c = 8
+let char_3e = 9
+let char_3d = 10
+let char_2e = 11
+let char_2c = 12
+let char_3a = 13
+let char_3b = 14
+let char_2b = 15
+let char_2d = 16
+let char_2a = 17
+let char_2f = 18
+let char_40 = 19
+let char_26 = 20
+let char_7b = 21
+let char_7d = 22
+let char_5b = 23
+let char_5d = 24
+let char_28 = 25
+let char_29 = 26
+let char_7c = 27
+let char_3f = 28
+let char_60 = 29
+let char_22 = 30
+let char_5c = 31
+let char_27 = 32
+let char_21 = 33
+
+let one_char_classes = [
+  (0x5f, 07);
+  (0x3c, 08);
+  (0x3e, 09);
+  (0x3d, 10);
+  (0x2e, 11);
+  (0x2c, 12);
+  (0x3a, 13);
+  (0x3b, 14);
+  (0x2b, 15);
+  (0x2d, 16);
+  (0x2a, 17);
+  (0x2f, 18);
+  (0x40, 19);
+  (0x26, 20);
+  (0x7b, 21);
+  (0x7d, 22);
+  (0x5b, 23);
+  (0x5d, 24);
+  (0x28, 25);
+  (0x29, 26);
+  (0x7c, 27);
+  (0x3f, 28);
+  (0x60, 29);
+  (0x22, 30);
+  (0x5c, 31);
+  (0x27, 32);
+  (0x21, 33);
+ ]
+
+let nb_classes = 34
+
+# 12 "parser/wlexer.mll"
+ 
+  let keywords = Hashtbl.create 17
+
+  let error i j exn = raise (Location.Location ((i,j),exn))
+  exception Illegal_character of char
+  exception Unterminated_comment
+  exception Unterminated_string
+  exception Unterminated_string_in_comment
+
+  (* Buffer for string literals *)
+    
+  let string_buff = Buffer.create 1024
+  let store_char = Buffer.add_char string_buff
+  let get_stored_string () =
+    let s = Buffer.contents string_buff in
+    Buffer.clear string_buff;
+    s
+
+  let string_start_pos = ref 0;;
+  let comment_start_pos : int list ref = ref [];;
+
+  let char_for_decimal_code s =
+    let s = String.sub s 1 (String.length s - 1) in
+    let c = int_of_string s in
+    assert ( c < 256 ); (* TODO: handle Unicode *)
+    Char.chr c
+let lex_tables = {
+  Lexing.lex_base = 
+   "\000\000\009\000\012\000\018\000\252\255\251\255\004\000\255\255\
+    \005\000\254\255\014\000\013\000\001\000\004\000\253\255\255\255\
+    \247\255\246\255\019\000\047\000\051\000\017\000\043\000\250\255\
+    \027\000\010\000\001\000\050\000\016\000\249\255\248\255\250\255\
+    \057\000\063\000\032\000\067\000\071\000\060\000";
+  Lexing.lex_backtrk = 
+   "\255\255\255\255\255\255\255\255\255\255\255\255\004\000\255\255\
+    \002\000\255\255\004\000\002\000\004\000\004\000\255\255\255\255\
+    \255\255\255\255\000\000\001\000\002\000\003\000\005\000\255\255\
+    \005\000\005\000\005\000\005\000\005\000\255\255\255\255\255\255\
+    \255\255\004\000\003\000\002\000\001\000\000\000";
+  Lexing.lex_default = 
+   "\023\000\005\000\005\000\005\000\000\000\000\000\255\255\000\000\
+    \255\255\000\000\255\255\255\255\255\255\255\255\000\000\000\000\
+    \000\000\000\000\255\255\255\255\255\255\255\255\255\255\000\000\
+    \255\255\255\255\255\255\255\255\255\255\000\000\000\000\000\000\
+    \255\255\255\255\255\255\255\255\255\255\255\255";
+  Lexing.lex_trans = 
+   "\016\000\017\000\017\000\018\000\019\000\020\000\021\000\019\000\
+    \022\000\004\000\008\000\008\000\004\000\024\000\025\000\026\000\
+    \027\000\026\000\004\000\011\000\011\000\015\000\037\000\034\000\
+    \031\000\028\000\012\000\009\000\026\000\031\000\029\000\017\000\
+    \029\000\030\000\013\000\009\000\009\000\031\000\034\000\014\000\
+    \031\000\014\000\007\000\010\000\009\000\009\000\032\000\033\000\
+    \033\000\006\000\007\000\036\000\036\000\036\000\036\000\035\000\
+    \035\000\035\000\035\000\031\000\032\000\033\000\033\000\037\000\
+    \000\000\000\000\031\000\033\000\033\000\033\000\033\000\035\000\
+    \035\000\035\000\035\000\036\000\036\000\036\000\036\000\000\000\
+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+    \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+    \000\000";
+  Lexing.lex_check = 
+   "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
+    \000\000\001\000\006\000\008\000\002\000\000\000\000\000\000\000\
+    \000\000\000\000\003\000\011\000\010\000\013\000\018\000\021\000\
+    \025\000\000\000\001\000\012\000\000\000\026\000\000\000\000\000\
+    \000\000\028\000\001\000\006\000\006\000\024\000\034\000\001\000\
+    \024\000\001\000\002\000\002\000\010\000\010\000\022\000\022\000\
+    \022\000\003\000\003\000\019\000\019\000\019\000\019\000\020\000\
+    \020\000\020\000\020\000\027\000\032\000\032\000\032\000\037\000\
+    \255\255\255\255\027\000\033\000\033\000\033\000\033\000\035\000\
+    \035\000\035\000\035\000\036\000\036\000\036\000\036\000\255\255\
+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
+    \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
+    \255\255"
+}
+
+let rec token engine lexbuf = 
+  match engine lex_tables 0 lexbuf with
+    0 -> (
+# 44 "parser/wlexer.mll"
+                token engine lexbuf )
+  | 1 -> (
+# 45 "parser/wlexer.mll"
+                                   
+      let s = Lexing.lexeme lexbuf in
+      if Hashtbl.mem keywords s then "",s else "LIDENT",s
+    )
+  | 2 -> (
+# 49 "parser/wlexer.mll"
+                           "UIDENT",Lexing.lexeme lexbuf )
+  | 3 -> (
+# 50 "parser/wlexer.mll"
+                   "INT",Lexing.lexeme lexbuf )
+  | 4 -> (
+# 51 "parser/wlexer.mll"
+                                                   
+      let s = Lexing.lexeme lexbuf in
+      "TAG", String.sub s 1 (String.length s - 1)
+    )
+  | 5 -> (
+# 58 "parser/wlexer.mll"
+   "",Lexing.lexeme lexbuf )
+  | 6 -> (
+# 61 "parser/wlexer.mll"
+        let string_start = Lexing.lexeme_start lexbuf in
+        string_start_pos := string_start;
+	let double_quote = Lexing.lexeme_char lexbuf 0 = '"' in
+        if double_quote then string2 engine lexbuf else string1 engine lexbuf;
+        lexbuf.Lexing.lex_start_pos <-
+          string_start - lexbuf.Lexing.lex_abs_pos;
+        (if double_quote then "STRING2" else "STRING1"), 
+	(get_stored_string()) )
+  | 7 -> (
+# 71 "parser/wlexer.mll"
+        comment_start_pos := [Lexing.lexeme_start lexbuf];
+        comment engine lexbuf;
+        token engine lexbuf )
+  | 8 -> (
+# 76 "parser/wlexer.mll"
+        "EOI","" )
+  | 9 -> (
+# 78 "parser/wlexer.mll"
+        error 
+	  (Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
+	  (Illegal_character ((Lexing.lexeme lexbuf).[0])) )
+  | _ -> failwith "lexing: empty token [token]"
+
+and comment engine lexbuf = 
+  match engine lex_tables 1 lexbuf with
+    0 -> (
+# 84 "parser/wlexer.mll"
+        comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
+        comment engine lexbuf;
+      )
+  | 1 -> (
+# 88 "parser/wlexer.mll"
+        comment_start_pos := List.tl !comment_start_pos;
+	if !comment_start_pos <> [] then comment engine lexbuf;
+      )
+  | 2 -> (
+# 92 "parser/wlexer.mll"
+        string_start_pos := Lexing.lexeme_start lexbuf;
+	let string = 
+	  if Lexing.lexeme_char lexbuf 0 = '"' then string2 else string1 in
+        (try string engine lexbuf
+         with Location.Location (_,Unterminated_string) ->
+           let st = List.hd !comment_start_pos in
+          error st (st+2) Unterminated_string_in_comment);
+	Buffer.clear string_buff;
+        comment engine lexbuf )
+  | 3 -> (
+# 102 "parser/wlexer.mll"
+        let st = List.hd !comment_start_pos in
+        error st (st+2) Unterminated_comment
+      )
+  | 4 -> (
+# 106 "parser/wlexer.mll"
+        comment engine lexbuf )
+  | _ -> failwith "lexing: empty token [comment]"
+
+and string2 engine lexbuf = 
+  match engine lex_tables 2 lexbuf with
+    0 -> (
+# 110 "parser/wlexer.mll"
+        () )
+  | 1 -> (
+# 112 "parser/wlexer.mll"
+        store_char (Lexing.lexeme_char lexbuf 1);
+        string2 engine lexbuf )
+  | 2 -> (
+# 115 "parser/wlexer.mll"
+        store_char (char_for_decimal_code (Lexing.lexeme lexbuf));
+        string2 engine lexbuf )
+  | 3 -> (
+# 118 "parser/wlexer.mll"
+        error !string_start_pos (!string_start_pos+1) Unterminated_string )
+  | 4 -> (
+# 120 "parser/wlexer.mll"
+        store_char (Lexing.lexeme_char lexbuf 0);
+	(* TODO: Unicode *)
+        string2 engine lexbuf )
+  | _ -> failwith "lexing: empty token [string2]"
+
+and string1 engine lexbuf = 
+  match engine lex_tables 3 lexbuf with
+    0 -> (
+# 126 "parser/wlexer.mll"
+        () )
+  | 1 -> (
+# 128 "parser/wlexer.mll"
+        store_char (Lexing.lexeme_char lexbuf 1);
+        string1 engine lexbuf )
+  | 2 -> (
+# 131 "parser/wlexer.mll"
+        store_char (char_for_decimal_code (Lexing.lexeme lexbuf));
+        string1 engine lexbuf )
+  | 3 -> (
+# 134 "parser/wlexer.mll"
+        error !string_start_pos (!string_start_pos+1) Unterminated_string )
+  | 4 -> (
+# 136 "parser/wlexer.mll"
+        store_char (Lexing.lexeme_char lexbuf 0);
+        string1 engine lexbuf )
+  | _ -> failwith "lexing: empty token [string1]"
+
+;;
+
+# 139 "parser/wlexer.mll"
+ 
+
+let lexer_func_of_wlex lexfun lexengine cs =
+  let lb =
+    Lexing.from_function
+      (fun s n ->
+         try s.[0] <- Stream.next cs; 1 with Stream.Failure -> 0)
+  in
+  let next () =
+    let tok = lexfun lexengine lb in
+    let loc = (Lexing.lexeme_start lb, Lexing.lexeme_end lb) in
+    (tok, loc) 
+  in
+  Token.make_stream_and_location next
+
+let register_kw (s1,s2) =
+  if s1 = "" then 
+    match s2.[0] with 
+      | 'a' .. 'z' when not (Hashtbl.mem keywords s2) -> 
+	  Hashtbl.add keywords s2 ()      
+      | _ -> ()
+
+
+let lexer lexfun lexengine =
+  { 
+    Token.tok_func = lexer_func_of_wlex lexfun lexengine; 
+    Token.tok_using = register_kw;
+    Token.tok_removing = (fun _ -> ()); 
+    Token.tok_match = Token.default_match;
+    Token.tok_text = Token.lexer_text 
+  }
+
+  let classes = 
+    let c i = (i,i) in
+    let i ch1 ch2 = (Char.code ch1, Char.code ch2) in
+    [ (ascii_digit, [i '0' '9']);
+      (lowercase, [i 'a' 'z']);
+      (uppercase, [i 'A' 'Z']);
+      (blank, [c 8; c 9; c 10; c 13; c 32]);
+    ]
+
+  let table =
+    assert(nb_classes <= 256);
+    let v = String.make 256 (Char.chr encoding_error) in
+    let fill_int c (i, j) = String.fill v i (j-i+1) c in
+    let fill_class (c, l) = List.iter (fill_int (Char.chr c)) l in
+    let fill_char  (ch, cl) = v.[ch] <- Char.chr cl in
+    List.iter fill_class classes;
+    List.iter fill_char one_char_classes;
+    v
+
+  let utf8_engine = Lex_engines.engine_tiny_utf8 table
+                      (fun c -> 
+                         if c>=0x10000 && c < 0x11000 then xml_char
+                         else encoding_error)
+
+  let latin1_engine = Lex_engines.engine_tiny_8bit table