Commit 5869d4b6 authored by Pietro Abate's avatar Pietro Abate

[r2003-05-25 11:46:41 by cvscast] Menage

Original author: cvscast
Date: 2003-05-25 11:46:41+00:00
parent 417256a7
......@@ -21,8 +21,9 @@ else
SYNTAX_PARSER = -pp '$(SYNTAX)'
endif
CAMLC = ocamlfind $(CAMLC_P) $(PACKAGES)
CAMLOPT = ocamlfind $(CAMLOPT_P) $(PACKAGES)
OPT = -warn-error A
CAMLC = ocamlfind $(CAMLC_P) $(OPT) $(PACKAGES)
CAMLOPT = ocamlfind $(CAMLOPT_P) $(OPT) $(PACKAGES)
ifeq ($(NATIVE), true)
EXTENSION = cmx
......
......@@ -13,13 +13,6 @@ let enter_global x v =
global_env := Env.add x v !global_env
let exn_load_file_utf8 = CDuceExn (Pair (
Atom (Atoms.mk_ascii "load_file_utf8"),
string_latin1 "File is not a valid UTF-8 stream"))
(* Evaluation of expressions *)
let rec eval env e0 =
......
......@@ -201,7 +201,8 @@ let rec compare x y =
| 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 (_,_) ->
| Abstraction (_,_), _
| _, Abstraction (_,_) ->
raise (CDuceExn (string_latin1 "comparing functional values"))
| Absent,_ | _,Absent -> assert false
| String_latin1 (ix,jx,sx,qx), String_latin1 (iy,jy,sy,qy) ->
......@@ -242,7 +243,13 @@ let rec compare x y =
| _, String_latin1 (i,j,s,q) -> compare x (normalize_string_latin1 i j s q)
| String_utf8 (i,j,s,q), _ -> compare (normalize_string_utf8 i j s q) y
| _, String_utf8 (i,j,s,q) -> compare x (normalize_string_utf8 i j s q)
| _,_ -> Obj.tag (Obj.repr x) - Obj.tag (Obj.repr y)
(* TODO: rewrite this case *)
| Pair (_,_), _ -> -1 | _, Pair(_,_) -> 1
| Xml (_,_,_),_ -> -1 | _, Xml(_,_,_) -> 1
| Record _,_ -> -1 | _, Record _ -> 1
| Atom _,_ -> -1 | _, Atom _ -> 1
| Integer _,_ -> -1 | _, Integer _ -> 1
......@@ -249,15 +249,15 @@ module Map = struct
let rec assoc_remove_aux v r = function
| ((x,y) as a)::l ->
let c = X.compare x v in
if c = 0 then (r := y; l)
if c = 0 then (r := Some y; l)
else if c < 0 then a :: (assoc_remove_aux v r l)
else raise Not_found
| [] -> raise Not_found
let assoc_remove v l =
let r = ref (Obj.magic 0) in
let r = ref None in
let l = assoc_remove_aux v r l in
(!r, l)
match !r with Some x -> (x,l) | _ -> assert false
(* TODO: is is faster to raise exception Not_found and return
original list ? *)
......
......@@ -666,28 +666,6 @@ struct
List.iter add d;
List.map (!) !res
(*
This version explodes when dealing with
Any - [ t1? t2? t3? ... tn? ]
==> need partitioning
*)
let get_aux any_right d =
let line accu (left,right) =
let rec aux accu d1 d2 = function
| (t1,t2)::right ->
let accu =
let d1 = diff_t d1 t1 in
if is_empty d1 then accu else aux accu d1 d2 right in
let accu =
let d2 = diff_t d2 t2 in
if is_empty d2 then accu else aux accu d1 d2 right in
accu
| [] -> (d1,d2) :: accu
in
let (d1,d2) = cap_product any any_right left in
if (is_empty d1) || (is_empty d2) then accu else aux accu d1 d2 right
in
List.fold_left line [] d
(* Partitioning:
......
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