Commit 320cb519 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-03-14 16:14:17 by cvscast] Empty log message

Original author: cvscast
Date: 2003-03-14 16:15:14+00:00
parent 88300a9b
......@@ -8,18 +8,18 @@ parser/ast.cmo: types/ident.cmo parser/location.cmi types/types.cmi
parser/ast.cmx: types/ident.cmx parser/location.cmx types/types.cmx
parser/location.cmo: parser/location.cmi
parser/location.cmx: parser/location.cmi
parser/parser.cmo: parser/ast.cmo types/atoms.cmi types/chars.cmi \
types/ident.cmo types/intervals.cmi parser/location.cmi \
parser/parser.cmo: parser/ast.cmo types/atoms.cmi types/builtin.cmo \
types/chars.cmi types/ident.cmo types/intervals.cmi parser/location.cmi \
types/sequence.cmi types/types.cmi parser/wlexer.cmo parser/parser.cmi
parser/parser.cmx: parser/ast.cmx types/atoms.cmx types/chars.cmx \
types/ident.cmx types/intervals.cmx parser/location.cmx \
parser/parser.cmx: parser/ast.cmx types/atoms.cmx types/builtin.cmx \
types/chars.cmx types/ident.cmx types/intervals.cmx parser/location.cmx \
types/sequence.cmx types/types.cmx parser/wlexer.cmx parser/parser.cmi
parser/wlexer.cmo: parser/location.cmi
parser/wlexer.cmx: parser/location.cmx
typing/typed.cmo: types/ident.cmo parser/location.cmi types/patterns.cmi \
types/sortedMap.cmi types/types.cmi
types/types.cmi
typing/typed.cmx: types/ident.cmx parser/location.cmx types/patterns.cmx \
types/sortedMap.cmx types/types.cmx
types/types.cmx
typing/typer.cmo: parser/ast.cmo types/builtin.cmo types/ident.cmo \
types/intervals.cmi parser/location.cmi types/patterns.cmi \
types/sequence.cmi typing/typed.cmo types/types.cmi typing/typer.cmi
......@@ -59,11 +59,11 @@ types/sortedMap.cmx: types/sortedMap.cmi
types/type_bool.cmo: types/boolean.cmi types/recursive.cmo
types/type_bool.cmx: types/boolean.cmx types/recursive.cmx
types/types.cmo: types/atoms.cmi types/boolean.cmi types/chars.cmi \
types/intervals.cmi types/normal.cmi misc/pool.cmi types/recursive.cmo \
types/sortedList.cmi types/sortedMap.cmi misc/state.cmi types/types.cmi
types/ident.cmo types/intervals.cmi types/normal.cmi types/recursive.cmo \
types/sortedList.cmi misc/state.cmi types/types.cmi
types/types.cmx: types/atoms.cmx types/boolean.cmx types/chars.cmx \
types/intervals.cmx types/normal.cmx misc/pool.cmx types/recursive.cmx \
types/sortedList.cmx types/sortedMap.cmx misc/state.cmx types/types.cmi
types/ident.cmx types/intervals.cmx types/normal.cmx types/recursive.cmx \
types/sortedList.cmx misc/state.cmx types/types.cmi
runtime/eval.cmo: types/atoms.cmi types/ident.cmo types/intervals.cmi \
runtime/load_xml.cmi parser/location.cmi runtime/print_xml.cmo \
runtime/run_dispatch.cmi misc/state.cmi typing/typed.cmo \
......@@ -72,22 +72,24 @@ runtime/eval.cmx: types/atoms.cmx types/ident.cmx types/intervals.cmx \
runtime/load_xml.cmx parser/location.cmx runtime/print_xml.cmx \
runtime/run_dispatch.cmx misc/state.cmx typing/typed.cmx \
runtime/value.cmx runtime/eval.cmi
runtime/load_xml.cmo: types/atoms.cmi parser/location.cmi types/sortedMap.cmi \
types/types.cmi runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: types/atoms.cmx parser/location.cmx types/sortedMap.cmx \
types/types.cmx runtime/value.cmx runtime/load_xml.cmi
runtime/print_xml.cmo: types/atoms.cmi types/chars.cmi types/sequence.cmi \
types/types.cmi runtime/value.cmi
runtime/print_xml.cmx: types/atoms.cmx types/chars.cmx types/sequence.cmx \
types/types.cmx runtime/value.cmx
runtime/run_dispatch.cmo: types/patterns.cmi types/types.cmi \
runtime/value.cmi runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/patterns.cmx types/types.cmx \
runtime/value.cmx runtime/run_dispatch.cmi
runtime/value.cmo: types/atoms.cmi types/chars.cmi types/intervals.cmi \
types/sequence.cmi types/sortedMap.cmi types/types.cmi runtime/value.cmi
runtime/value.cmx: types/atoms.cmx types/chars.cmx types/intervals.cmx \
types/sequence.cmx types/sortedMap.cmx types/types.cmx runtime/value.cmi
runtime/load_xml.cmo: types/atoms.cmi types/ident.cmo parser/location.cmi \
runtime/value.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: types/atoms.cmx types/ident.cmx parser/location.cmx \
runtime/value.cmx runtime/load_xml.cmi
runtime/print_xml.cmo: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/sequence.cmi runtime/value.cmi
runtime/print_xml.cmx: types/atoms.cmx types/chars.cmx types/ident.cmx \
types/sequence.cmx runtime/value.cmx
runtime/run_dispatch.cmo: types/chars.cmi types/ident.cmo types/patterns.cmi \
types/types.cmi runtime/value.cmi runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/chars.cmx types/ident.cmx types/patterns.cmx \
types/types.cmx runtime/value.cmx runtime/run_dispatch.cmi
runtime/value.cmo: types/atoms.cmi types/builtin.cmo types/chars.cmi \
types/ident.cmo types/intervals.cmi types/sequence.cmi types/types.cmi \
runtime/value.cmi
runtime/value.cmx: types/atoms.cmx types/builtin.cmx types/chars.cmx \
types/ident.cmx types/intervals.cmx types/sequence.cmx types/types.cmx \
runtime/value.cmi
driver/cduce.cmo: parser/ast.cmo types/builtin.cmo runtime/eval.cmi \
types/ident.cmo parser/location.cmi parser/parser.cmi types/patterns.cmi \
misc/state.cmi typing/typed.cmo typing/typer.cmi types/types.cmi \
......@@ -110,16 +112,15 @@ parser/parser.cmi: parser/ast.cmo
typing/typer.cmi: parser/ast.cmo types/ident.cmo typing/typed.cmo \
types/types.cmi
types/boolean.cmi: types/sortedList.cmi
types/normal.cmi: types/boolean.cmi
types/patterns.cmi: types/ident.cmo types/types.cmi
types/sequence.cmi: types/atoms.cmi types/types.cmi
types/sortedMap.cmi: types/sortedList.cmi
types/syntax.cmi: types/patterns.cmi types/types.cmi
types/types.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \
misc/pool.cmi types/sortedMap.cmi
types/types.cmi: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/intervals.cmi
runtime/eval.cmi: types/ident.cmo typing/typed.cmo runtime/value.cmi
runtime/load_xml.cmi: runtime/value.cmi
runtime/run_dispatch.cmi: types/patterns.cmi runtime/value.cmi
runtime/value.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \
types/sortedMap.cmi types/types.cmi
runtime/value.cmi: types/atoms.cmi types/chars.cmi types/ident.cmo \
types/intervals.cmi types/types.cmi
driver/cduce.cmi: runtime/eval.cmi typing/typer.cmi
......@@ -97,6 +97,10 @@ EXTEND
mk noloc (Op ("raise",[mk noloc (Var (ident "x"))]))) in
mk loc (Try (e,b@[default]))
| "map"; e = SELF; "with"; b = branches -> mk loc (Map (e,b))
| "if"; e = SELF; "then"; e1 = SELF; "else"; e2 = SELF ->
let p1 = mk loc (Internal (Builtin.true_type))
and p2 = mk loc (Internal (Builtin.false_type)) in
mk loc (Match (e, [p1,e1; p2,e2]))
| "transform"; e = SELF; "with"; b = branches ->
let default = mk noloc (Capture (ident "x")), cst_nil in
mk loc (Op ("flatten", [mk loc (Map (e,b@[default]))]))
......@@ -109,6 +113,15 @@ EXTEND
]
|
[ e1 = expr; op = ["=" | "<=" | "<<" | ">>" | ">=" ]; e2 = expr ->
let op = match op with
| "<<" -> "<"
| ">>" -> ">"
| s -> s in
mk loc (Op (op,[e1;e2]))
]
|
[ e1 = expr; op = ["+" | "-" | "@"]; e2 = expr -> mk loc (Op (op,[e1;e2]))
]
......
......@@ -75,6 +75,7 @@ let nb_classes = 34
exception Unterminated_string
exception Unterminated_string_in_comment
(* Buffer for string literals *)
let string_buff = Buffer.create 1024
......@@ -83,6 +84,11 @@ let nb_classes = 34
let s = Buffer.contents string_buff in
Buffer.clear string_buff;
s
let store_special = function
| 'n' -> store_char '\n'
| 'r' -> store_char '\r'
| 't' -> store_char '\t'
| c -> raise (Illegal_character '\\')
let string_start_pos = ref 0;;
let comment_start_pos : int list ref = ref [];;
......@@ -100,102 +106,107 @@ let nb_classes = 34
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\003\000\005\000\253\255\255\255\
\247\255\246\255\020\000\047\000\051\000\018\000\043\000\250\255\
\027\000\017\000\044\000\052\000\005\000\011\000\045\000\043\000\
\249\255\250\255\248\255\066\000\069\000\082\000\086\000\060\000\
\090\000\103\000\120\000\124\000\137\000\141\000\074\000";
"\000\000\012\000\010\000\018\000\251\255\250\255\016\000\255\255\
\253\255\005\000\254\255\027\000\013\000\252\255\251\255\000\000\
\006\000\253\255\255\255\247\255\246\255\021\000\047\000\060\000\
\028\000\067\000\026\000\250\255\033\000\024\000\040\000\053\000\
\011\000\018\000\039\000\037\000\249\255\248\255\077\000\080\000\
\084\000\097\000\055\000\101\000\114\000\118\000\131\000\135\000\
\148\000\071\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\005\000\005\000\005\000\
\255\255\255\255\255\255\255\255\004\000\255\255\004\000\003\000\
\002\000\255\255\002\000\001\000\255\255\001\000\000\000";
"\255\255\255\255\255\255\255\255\255\255\255\255\005\000\255\255\
\255\255\003\000\255\255\005\000\003\000\255\255\255\255\004\000\
\004\000\255\255\255\255\255\255\255\255\000\000\001\000\002\000\
\003\000\005\000\005\000\255\255\005\000\005\000\005\000\005\000\
\005\000\005\000\005\000\005\000\255\255\255\255\255\255\004\000\
\255\255\004\000\003\000\002\000\255\255\002\000\001\000\255\255\
\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\
"\027\000\014\000\005\000\005\000\000\000\000\000\255\255\000\000\
\000\000\255\255\000\000\255\255\255\255\000\000\000\000\255\255\
\255\255\000\000\000\000\000\000\000\000\255\255\255\255\255\255\
\255\255\255\255\255\255\000\000\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\000\000\000\000\255\255\255\255\
\255\255\255\255\255\255\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\255\255\255\255\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\028\000\004\000\011\000\011\000\029\000\015\000\046\000\
\039\000\030\000\012\000\031\000\028\000\009\000\032\000\033\000\
\032\000\033\000\013\000\009\000\009\000\033\000\033\000\014\000\
\033\000\014\000\007\000\010\000\009\000\009\000\035\000\036\000\
\036\000\006\000\007\000\043\000\043\000\043\000\043\000\040\000\
\040\000\040\000\040\000\033\000\044\000\033\000\034\000\043\000\
\041\000\033\000\039\000\040\000\033\000\035\000\036\000\036\000\
\033\000\036\000\036\000\036\000\036\000\046\000\000\000\043\000\
\000\000\000\000\037\000\040\000\000\000\036\000\038\000\038\000\
\038\000\038\000\038\000\038\000\038\000\038\000\040\000\040\000\
\040\000\040\000\038\000\037\000\000\000\036\000\038\000\041\000\
\000\000\000\000\040\000\042\000\042\000\042\000\042\000\000\000\
\000\000\000\000\038\000\000\000\000\000\000\000\038\000\042\000\
\000\000\000\000\040\000\000\000\042\000\042\000\042\000\042\000\
\043\000\043\000\043\000\043\000\000\000\041\000\000\000\042\000\
\042\000\044\000\000\000\000\000\043\000\045\000\045\000\045\000\
\045\000\045\000\045\000\045\000\045\000\000\000\000\000\000\000\
\042\000\045\000\044\000\000\000\043\000\045\000\000\000\000\000\
"\019\000\020\000\020\000\021\000\022\000\023\000\024\000\022\000\
\025\000\026\000\004\000\009\000\013\000\028\000\029\000\030\000\
\031\000\032\000\004\000\012\000\008\000\033\000\009\000\018\000\
\049\000\034\000\010\000\035\000\032\000\015\000\036\000\008\000\
\036\000\012\000\042\000\005\000\005\000\016\000\005\000\005\000\
\007\000\011\000\017\000\005\000\017\000\005\000\005\000\010\000\
\010\000\006\000\007\000\046\000\046\000\046\000\046\000\005\000\
\037\000\010\000\010\000\005\000\047\000\042\000\005\000\046\000\
\043\000\043\000\043\000\043\000\005\000\005\000\038\000\039\000\
\039\000\044\000\049\000\005\000\043\000\005\000\000\000\046\000\
\038\000\039\000\039\000\000\000\039\000\039\000\039\000\039\000\
\041\000\041\000\041\000\041\000\043\000\040\000\000\000\000\000\
\039\000\000\000\000\000\000\000\041\000\041\000\041\000\041\000\
\041\000\043\000\043\000\043\000\043\000\000\000\040\000\000\000\
\039\000\041\000\044\000\000\000\041\000\043\000\045\000\045\000\
\045\000\045\000\045\000\045\000\045\000\045\000\000\000\000\000\
\000\000\041\000\045\000\044\000\000\000\043\000\045\000\046\000\
\046\000\046\000\046\000\048\000\048\000\048\000\048\000\000\000\
\047\000\000\000\045\000\046\000\000\000\000\000\045\000\048\000\
\048\000\048\000\048\000\048\000\000\000\000\000\000\000\000\000\
\000\000\047\000\000\000\046\000\048\000\000\000\000\000\048\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\045\000\000\000\000\000\000\000\045\000\000\000";
\000\000\000\000\000\000\000\000\048\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\000\000\013\000\018\000\
\021\000\000\000\001\000\000\000\000\000\012\000\000\000\025\000\
\000\000\028\000\001\000\006\000\006\000\024\000\029\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\026\000\019\000\027\000\030\000\019\000\
\020\000\031\000\039\000\020\000\027\000\035\000\035\000\035\000\
\026\000\036\000\036\000\036\000\036\000\046\000\255\255\019\000\
\255\255\255\255\036\000\020\000\255\255\036\000\037\000\037\000\
\037\000\037\000\038\000\038\000\038\000\038\000\040\000\040\000\
\040\000\040\000\037\000\038\000\255\255\036\000\038\000\040\000\
\255\255\255\255\040\000\041\000\041\000\041\000\041\000\255\255\
\255\255\255\255\037\000\255\255\255\255\255\255\038\000\041\000\
\255\255\255\255\040\000\255\255\042\000\042\000\042\000\042\000\
\043\000\043\000\043\000\043\000\255\255\042\000\255\255\041\000\
\042\000\043\000\255\255\255\255\043\000\044\000\044\000\044\000\
\044\000\045\000\045\000\045\000\045\000\255\255\255\255\255\255\
\042\000\044\000\045\000\255\255\043\000\045\000\255\255\255\255\
\000\000\000\000\002\000\009\000\001\000\000\000\000\000\000\000\
\000\000\000\000\003\000\012\000\006\000\000\000\006\000\016\000\
\021\000\000\000\015\000\000\000\000\000\001\000\000\000\011\000\
\000\000\011\000\024\000\026\000\026\000\001\000\029\000\032\000\
\002\000\002\000\001\000\028\000\001\000\033\000\028\000\006\000\
\006\000\003\000\003\000\022\000\022\000\022\000\022\000\030\000\
\034\000\011\000\011\000\035\000\022\000\042\000\031\000\022\000\
\023\000\023\000\023\000\023\000\030\000\031\000\025\000\025\000\
\025\000\023\000\049\000\025\000\023\000\025\000\255\255\022\000\
\038\000\038\000\038\000\255\255\039\000\039\000\039\000\039\000\
\040\000\040\000\040\000\040\000\023\000\039\000\255\255\255\255\
\039\000\255\255\255\255\255\255\040\000\041\000\041\000\041\000\
\041\000\043\000\043\000\043\000\043\000\255\255\041\000\255\255\
\039\000\041\000\043\000\255\255\040\000\043\000\044\000\044\000\
\044\000\044\000\045\000\045\000\045\000\045\000\255\255\255\255\
\255\255\041\000\044\000\045\000\255\255\043\000\045\000\046\000\
\046\000\046\000\046\000\047\000\047\000\047\000\047\000\255\255\
\046\000\255\255\044\000\046\000\255\255\255\255\045\000\047\000\
\048\000\048\000\048\000\048\000\255\255\255\255\255\255\255\255\
\255\255\048\000\255\255\046\000\048\000\255\255\255\255\047\000\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\044\000\255\255\255\255\255\255\045\000\255\255"
\255\255\255\255\255\255\255\255\048\000\255\255"
}
let rec token engine lexbuf =
match engine lex_tables 0 lexbuf with
0 -> (
# 51 "parser/wlexer.mll"
# 57 "parser/wlexer.mll"
token engine lexbuf )
| 1 -> (
# 52 "parser/wlexer.mll"
# 58 "parser/wlexer.mll"
let s = Lexing.lexeme lexbuf in
if Hashtbl.mem keywords s then "",s else "LIDENT",s
)
| 2 -> (
# 56 "parser/wlexer.mll"
# 62 "parser/wlexer.mll"
"UIDENT",Lexing.lexeme lexbuf )
| 3 -> (
# 57 "parser/wlexer.mll"
# 63 "parser/wlexer.mll"
"INT",Lexing.lexeme lexbuf )
| 4 -> (
# 58 "parser/wlexer.mll"
# 64 "parser/wlexer.mll"
let s = Lexing.lexeme lexbuf in
"TAG", tag_of_tag s 1
)
| 5 -> (
# 66 "parser/wlexer.mll"
# 72 "parser/wlexer.mll"
"",Lexing.lexeme lexbuf )
| 6 -> (
# 69 "parser/wlexer.mll"
# 75 "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
......@@ -205,15 +216,15 @@ let rec token engine lexbuf =
(if double_quote then "STRING2" else "STRING1"),
(get_stored_string()) )
| 7 -> (
# 79 "parser/wlexer.mll"
# 85 "parser/wlexer.mll"
comment_start_pos := [Lexing.lexeme_start lexbuf];
comment engine lexbuf;
token engine lexbuf )
| 8 -> (
# 84 "parser/wlexer.mll"
# 90 "parser/wlexer.mll"
"EOI","" )
| 9 -> (
# 86 "parser/wlexer.mll"
# 92 "parser/wlexer.mll"
error
(Lexing.lexeme_start lexbuf) (Lexing.lexeme_end lexbuf)
(Illegal_character ((Lexing.lexeme lexbuf).[0])) )
......@@ -222,17 +233,17 @@ let rec token engine lexbuf =
and comment engine lexbuf =
match engine lex_tables 1 lexbuf with
0 -> (
# 92 "parser/wlexer.mll"
# 98 "parser/wlexer.mll"
comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos;
comment engine lexbuf;
)
| 1 -> (
# 96 "parser/wlexer.mll"
# 102 "parser/wlexer.mll"
comment_start_pos := List.tl !comment_start_pos;
if !comment_start_pos <> [] then comment engine lexbuf;
)
| 2 -> (
# 100 "parser/wlexer.mll"
# 106 "parser/wlexer.mll"
string_start_pos := Lexing.lexeme_start lexbuf;
let string =
if Lexing.lexeme_char lexbuf 0 = '"' then string2 else string1 in
......@@ -243,33 +254,38 @@ and comment engine lexbuf =
Buffer.clear string_buff;
comment engine lexbuf )
| 3 -> (
# 110 "parser/wlexer.mll"
# 116 "parser/wlexer.mll"
let st = List.hd !comment_start_pos in
error st (st+2) Unterminated_comment
)
| 4 -> (
# 114 "parser/wlexer.mll"
# 120 "parser/wlexer.mll"
comment engine lexbuf )
| _ -> failwith "lexing: empty token [comment]"
and string2 engine lexbuf =
match engine lex_tables 2 lexbuf with
0 -> (
# 118 "parser/wlexer.mll"
# 124 "parser/wlexer.mll"
() )
| 1 -> (
# 120 "parser/wlexer.mll"
# 126 "parser/wlexer.mll"
store_char (Lexing.lexeme_char lexbuf 1);
string2 engine lexbuf )
| 2 -> (
# 123 "parser/wlexer.mll"
# 128 "parser/wlexer.mll"
store_special (Lexing.lexeme_char lexbuf 1);
string1 engine lexbuf )
| 3 -> (
# 132 "parser/wlexer.mll"
store_char (char_for_decimal_code (Lexing.lexeme lexbuf));
string2 engine lexbuf )
| 3 -> (
# 126 "parser/wlexer.mll"
error !string_start_pos (!string_start_pos+1) Unterminated_string )
| 4 -> (
# 128 "parser/wlexer.mll"
# 135 "parser/wlexer.mll"
error !string_start_pos (!string_start_pos+1) Unterminated_string )
| 5 -> (
# 137 "parser/wlexer.mll"
store_char (Lexing.lexeme_char lexbuf 0);
(* TODO: Unicode *)
string2 engine lexbuf )
......@@ -278,28 +294,33 @@ and string2 engine lexbuf =
and string1 engine lexbuf =
match engine lex_tables 3 lexbuf with
0 -> (
# 134 "parser/wlexer.mll"
# 143 "parser/wlexer.mll"
() )
| 1 -> (
# 136 "parser/wlexer.mll"
# 145 "parser/wlexer.mll"
store_char (Lexing.lexeme_char lexbuf 1);
string1 engine lexbuf )
| 2 -> (
# 139 "parser/wlexer.mll"
# 147 "parser/wlexer.mll"
store_special (Lexing.lexeme_char lexbuf 1);
string1 engine lexbuf )
| 3 -> (
# 151 "parser/wlexer.mll"
store_char (char_for_decimal_code (Lexing.lexeme lexbuf));
string1 engine lexbuf )
| 3 -> (
# 142 "parser/wlexer.mll"
error !string_start_pos (!string_start_pos+1) Unterminated_string )
| 4 -> (
# 144 "parser/wlexer.mll"
# 154 "parser/wlexer.mll"
error !string_start_pos (!string_start_pos+1) Unterminated_string )
| 5 -> (
# 156 "parser/wlexer.mll"
store_char (Lexing.lexeme_char lexbuf 0);
string1 engine lexbuf )
| _ -> failwith "lexing: empty token [string1]"
;;
# 147 "parser/wlexer.mll"
# 159 "parser/wlexer.mll"
let lexer_func_of_wlex lexfun lexengine cs =
......
......@@ -18,6 +18,7 @@ classes
exception Unterminated_string
exception Unterminated_string_in_comment
(* Buffer for string literals *)
let string_buff = Buffer.create 1024
......@@ -26,6 +27,11 @@ classes
let s = Buffer.contents string_buff in
Buffer.clear string_buff;
s
let store_special = function
| 'n' -> store_char '\n'
| 'r' -> store_char '\r'
| 't' -> store_char '\t'
| c -> raise (Illegal_character '\\')
let string_start_pos = ref 0;;
let comment_start_pos : int list ref = ref [];;
......@@ -61,7 +67,7 @@ rule token = parse
}
| [ "<>=.,:;+-*/@&{}[]()|?`!" ]
| "->" | "::" | ";;" | "--" | ":=" | "\\" | "++"
| "{|" | "|}"
| "{|" | "|}" | "<=" | ">=" | "<<" | ">>"
| ["?+*"] "?"
{ "",Lexing.lexeme lexbuf }
......@@ -119,6 +125,9 @@ and string2 = parse
| '\\' ['\\' '"']
{ store_char (Lexing.lexeme_char lexbuf 1);
string2 engine lexbuf }
| '\\' lowercase {
store_special (Lexing.lexeme_char lexbuf 1);
string1 engine lexbuf }
| '\\' ascii_digit+
{ store_char (char_for_decimal_code (Lexing.lexeme lexbuf));
string2 engine lexbuf }
......@@ -135,6 +144,9 @@ and string1 = parse
| '\\' ['\\' '\'']
{ store_char (Lexing.lexeme_char lexbuf 1);
string1 engine lexbuf }
| '\\' lowercase {
store_special (Lexing.lexeme_char lexbuf 1);
string1 engine lexbuf }
| '\\' ascii_digit+
{ store_char (char_for_decimal_code (Lexing.lexeme lexbuf));
string1 engine lexbuf }
......
......@@ -70,6 +70,11 @@ let rec eval env e0 =
| Typed.Op ("string_of", [e]) -> eval_string_of (eval env e)
| Typed.Op ("dump_to_file", [e1; e2]) ->
eval_dump_to_file (eval env e1) (eval env e2)
| Typed.Op ("=",[e1; e2]) -> eval_equal (eval env e1) (eval env e2)
| Typed.Op ("<",[e1; e2]) -> eval_lt (eval env e1) (eval env e2)
| Typed.Op ("<=",[e1; e2]) -> eval_lte (eval env e1) (eval env e2)
| Typed.Op (">",[e1; e2]) -> eval_gt (eval env e1) (eval env e2)
| Typed.Op (">=",[e1; e2]) -> eval_gte (eval env e1) (eval env e2)
| Typed.Dot (e, l) -> eval_dot l (eval env e)
| Typed.Op (o,_) -> failwith ("Unknown operator " ^ o)
......@@ -170,3 +175,23 @@ and eval_string_of v =
Format.pp_print_flush ppf ();
string (Buffer.contents b)
and eval_equal v1 v2 =
let c = Value.compare v1 v2 in
Value.vbool (Value.compare v1 v2 = 0)
and eval_lt v1 v2 =
let c = Value.compare v1 v2 in
Value.vbool (Value.compare v1 v2 < 0)
and eval_lte v1 v2 =
let c = Value.compare v1 v2 in
Value.vbool (Value.compare v1 v2 <= 0)
and eval_gt v1 v2 =
let c = Value.compare v1 v2 in
Value.vbool (Value.compare v1 v2 > 0)
and eval_gte v1 v2 =
let c = Value.compare v1 v2 in
Value.vbool (Value.compare v1 v2 >= 0)
......@@ -4,6 +4,13 @@ open Value
open Ident
open Patterns.Compile
(*
module Array = struct
include Array
let get = unsafe_get
end
*)
let make_result_prod v1 r1 v2 r2 v (code,r) =
let ret = Array.map
(function
......
......@@ -16,6 +16,10 @@ exception CDuceExn of t
let nil = Atom Sequence.nil_atom
let string s = String (0,String.length s, s, nil)
let vtrue = Atom Builtin.true_atom
let vfalse = Atom Builtin.false_atom
let vbool x = if x then vtrue else vfalse
let const = function
| Types.Integer i -> Integer i
......@@ -109,8 +113,49 @@ and print_field ppf (l,v) =
Format.fprintf ppf "%s=%a" (LabelPool.value l) print v
let normalize_string i j s q =
if i = j then q else
Pair (Char (Chars.mk_char (String.unsafe_get s i)), String (succ i,j,s,q))
let normalize = function
| String (i,j,s,q) ->
if i = j then q else
Pair (Char (Chars.mk_char s.[i]), String (succ i,j,s,q))
| String (i,j,s,q) -> normalize_string i j s q
| v -> assert false
let rec compare x y =
if (x == y) then 0
else
match (x,y) with
| Pair (x1,x2), Pair (y1,y2) | Xml (x1,x2), Xml (y1,y2) ->
let c = compare x1 y1 in if c <> 0 then c
else compare x2 y2
| Record rx, Record ry -> LabelMap.compare compare rx ry
| Atom x, Atom y -> Atoms.vcompare x y
| Integer x, Integer y -> Intervals.vcompare x y
| Char x, Char y -> Chars.vcompare x y
| Abstraction (_,_), Abstraction (_,_) ->
raise (CDuceExn (string "comparing functional values"))
| Absent,_ | _,Absent -> assert false
| String (ix,jx,sx,qx), String (iy,jy,sy,qy) ->
if (sx == sy) && (ix = iy) && (jx = jy) then compare qx qy
else
(* Note: we would like to compare first jx-ix and jy-iy,
but this is not compatible with the equivalence of values *)
let rec aux ix iy =
if (ix = jx) then
if (iy = jy) then compare qx qy
else compare qx (normalize_string iy jy sy qy)
else
if (iy = jy) then compare (normalize_string ix jx sx qx) qy
else
let c1 = String.unsafe_get sx ix
and c2 = String.unsafe_get sy iy in
if c1 < c2 then -1 else
if c1 > c2 then 1 else aux (ix + 1) (iy + 1)
in
aux ix iy
| String (i,j,s,q), _ -> compare (normalize_string i j s q) y
| _, String (i,j,s,q) -> compare x (normalize_string i j s q)
| _,_ -> Obj.tag (Obj.repr x) - Obj.tag (Obj.repr y)