[r2005-03-29 15:15:50 by afrisch] Pb with ocamlopt -pack

Original author: afrisch
Date: 2005-03-29 15:15:50+00:00

ocamliface/mlstub.ml

@@ -41,7 +41,7 @@ and typ_descr = function
   | Variant (_,l,_) -> bigcup variant l
   | Record (_,l,_) ->
       let l = List.map (fun (lab,t) -> label lab, typ t) l in
-      Types.record' (false,(LabelMap.from_list_disj l))
+      Types.record_fields (false,(LabelMap.from_list_disj l))
   | Abstract "int" -> Builtin_defs.caml_int
   | Abstract "char" -> Builtin_defs.char_latin1
   | Abstract "string" -> Builtin_defs.string_latin1

runtime/system.ml

@@ -13,7 +13,7 @@ let variant_type_ascii l =
     l
 
 let record_type_ascii l =
-  Types.record' (false,
+  Types.record_fields (false,
     (LabelMap.from_list_disj 
        (List.map (fun (l,t) -> Value.label_ascii l, Types.cons t) l)))
 

schema/schema_converter.ml

@@ -44,7 +44,7 @@ let mk_seq_derecurs base facets =
 let xsi_nil_type =
   let m = LabelMap.singleton xsi_nil_label (Types.cons Builtin_defs.true_type)
   in
-  Types.record' (false,m)
+  Types.record_fields (false,m)
     
     
     

types/builtin_defs.ml

@@ -63,7 +63,7 @@ let mk_ref ~get ~set =
 let ref_type t =
   let get = Types.cons (Types.arrow Sequence.nil_node t)
   and set = Types.cons (Types.arrow t Sequence.nil_node) in
-  Types.record' (false , mk_ref ~get ~set)
+  Types.record_fields (false , mk_ref ~get ~set)
 
 let float_abs =
   "float"
@@ -71,7 +71,7 @@ let float_abs =
 let float =
   Types.abstract (Types.Abstract.atom float_abs)
 
-let any_attr_node = Types.cons (Types.record' (true,LabelMap.empty)) 
+let any_attr_node = Types.cons (Types.record_fields (true,LabelMap.empty)) 
 let any_xml,any_xml_seq,any_xml_content = 
   let elt = Types.make () in
   let seq = Types.make () in

types/sample.ml

@@ -21,7 +21,7 @@ let rec get memo t =
     | (false,t) -> cons t in
   let record (r,some,none) = 
     let r = LabelMap.filter (fun l (o,t) -> not o) r in
-    Types.record' (not none, LabelMap.map fields r) in
+    Types.record_fields (not none, LabelMap.map fields r) in
   let typ u = 
     let u = Types.cap t u in 
     if Types.is_empty u then raise Not_found else u in

types/types.ml

@@ -542,7 +542,7 @@ let arrow x y = { empty with hash = 0; arrow = BoolPair.atom (x,y) }
 let record label t = 
   { empty with hash = 0; 
       record = BoolRec.atom (true,LabelMap.singleton label t) }
-let record' (x : bool * node Ident.label_map) =
+let record_fields (x : bool * node Ident.label_map) =
   { empty with hash = 0; record = BoolRec.atom x }
 let atom a = { empty with hash = 0; atoms = a }
 let char c = { empty with hash = 0; chars = c }
@@ -620,7 +620,7 @@ let rec constant = function
   | Char c -> char (Chars.atom c)
   | Pair (x,y) -> times (const_node x) (const_node y)
   | Xml (x,y) -> xml (const_node x) (const_node y)
-  | Record x -> record' (false ,LabelMap.map const_node x)
+  | Record x -> record_fields (false ,LabelMap.map const_node x)
   | String (i,j,s,c) ->
       if U.equal_index i j then constant c
       else 
@@ -1304,7 +1304,7 @@ struct
 	let none = none1 && none2 and some = some1 || some2 in
 	let accu = LabelMap.from_list (fun _ _ -> assert false) accu in
 	(* approx for the case (some && not none) ... *)
-	res := cup !res (record' (some, accu))
+	res := cup !res (record_fields (some, accu))
       else
 	let l1 = split d1 l and l2 = split d2 l in
 	let loop (t1,d1) (t2,d2) =
@@ -1944,7 +1944,7 @@ let rec_of_list o l =
 	    cons (if opt then Record.or_absent typ else typ))
 	 l)
   in
-  record' (o,map)
+  record_fields (o,map)
 
 let empty_closed_record = rec_of_list false []
 let empty_open_record = rec_of_list true []

types/types.mli

@@ -89,7 +89,7 @@ val xml      : Node.t -> Node.t -> t
 val arrow    : Node.t -> Node.t -> t
 val record   : label -> Node.t -> t
   (* bool = true -> open record; bool = false -> closed record *)
-val record'  : bool * Node.t label_map -> t
+val record_fields : bool * Node.t label_map -> t
 val char     : Chars.t -> t
 val constant : const -> t
 val abstract : Abstract.t -> t

typing/typer.ml

@@ -519,7 +519,7 @@ module IType = struct
     | IXml (s1,s2) -> Types.xml (typ_node s1) (typ_node s2)
     | IArrow (s1,s2) -> Types.arrow (typ_node s1) (typ_node s2)
     | IOptional s -> Types.Record.or_absent (typ s)
-    | IRecord (o,r) ->  Types.record' (o, LabelMap.map compute_typ_field r)
+    | IRecord (o,r) ->  Types.record_fields (o, LabelMap.map compute_typ_field r)
     | ILink _ -> assert false
     | ICapture _ | IConstant (_,_) -> assert false
     | IConcat _ | IMerge _ -> assert false
@@ -575,7 +575,7 @@ module IType = struct
 		    (pat e) :: !pats;
 		  Types.Record.any_or_absent_node )
 	in
-	let constr = Types.record' (o,LabelMap.mapi aux r) in
+	let constr = Types.record_fields (o,LabelMap.mapi aux r) in
 	List.fold_left Patterns.cap (Patterns.constr constr) !pats
 	  (* TODO: can avoid constr when o=true, and all fields have fv *)
     | ICapture x -> Patterns.capture x
@@ -1643,7 +1643,7 @@ and type_record loc env r constr precise =
   if not (Types.Record.has_empty_record rconstr) then
     should_have loc constr "More fields should be present";
   let t = 
-    Types.record' (false, LabelMap.from_list (fun _ _ -> assert false) res)
+    Types.record_fields (false, LabelMap.from_list (fun _ _ -> assert false) res)
   in
   verify loc t constr