Commit 082b52f6 authored by Pietro Abate's avatar Pietro Abate
Browse files

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

Original author: cvscast
Date: 2002-11-07 01:13:10+00:00
parent 2b21d637
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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment