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

Original author: cvscast
Date: 2003-03-14 16:15:14+00:00

depend

@@ -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 

parser/parser.ml

@@ -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]))
     ]

parser/wlexer.ml

@@ -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 =

parser/wlexer.mll

@@ -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 }

runtime/eval.ml

@@ -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)
+

runtime/run_dispatch.ml

@@ -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

runtime/value.ml

@@ -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)
+	  (* TODO: rewrite this case *)
+
+

runtime/value.mli

@@ -27,6 +27,11 @@ val normalize: t -> t
 val const : Types.const -> t
 val string : string -> t
 val nil : t
+val vtrue : t
+val vfalse : t