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

Original author: cvscast
Date: 2003-05-25 11:46:41+00:00

Makefile

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

runtime/eval.ml

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

runtime/value.ml

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

types/sortedList.ml

@@ -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 ? *)

types/types.ml

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