Commit a8c712ec authored by Pietro Abate's avatar Pietro Abate

[r2005-06-17 14:55:43 by afrisch] New representation for integer maps (used...

[r2005-06-17 14:55:43 by afrisch] New representation for integer maps (used for dispatcher on atoms and
for record values

Original author: afrisch
Date: 2005-06-17 14:55:44+00:00
parent 1d4ae7d9
......@@ -73,7 +73,10 @@ and compile_aux env tail = function
| Typed.Xml (e1, { Typed.exp_descr = Typed.Pair (e2,e3) }, Some t) ->
XmlNs (compile env false e1, compile env false e2, compile env tail e3,t)
| Typed.Xml _ -> assert false
| Typed.RecordLitt r -> Record (LabelMap.map (compile env false) r)
| Typed.RecordLitt r ->
let r = List.map (fun (l,e) -> (l, compile env false e)) (LabelMap.get r)
in
Record (Imap.create (Array.of_list r))
| Typed.String (i,j,s,q) -> String (i,j,s,compile env tail q)
| Typed.Match (e,brs) -> Match (compile env false e, compile_branches env tail brs)
| Typed.Map (e,brs) -> Map (compile env false e, compile_branches env false brs)
......
......@@ -51,7 +51,7 @@ type expr =
| Pair of expr * expr
| Xml of expr * expr * expr
| XmlNs of expr * expr * expr * Ns.table
| Record of expr label_map
| Record of expr Imap.t
| String of U.uindex * U.uindex * U.t * expr
| Match of expr * branches
......@@ -174,7 +174,8 @@ module Put = struct
Ns.serialize_table s ns
| Record r ->
bits nbits s 6;
LabelMap.serialize expr s r
Serialize.Put.list (Serialize.Put.pair LabelPool.serialize expr) s
(Imap.elements r)
| String (i,j,st,q) ->
bits nbits s 7;
U.serialize_sub s st i j;
......@@ -305,7 +306,10 @@ module Get = struct
XmlNs (e1,e2,e3,ns)
else
Xml (e1,e2,e3)
| 6 -> Record (LabelMap.deserialize expr s)
| 6 ->
let r = Serialize.Get.list
(Serialize.Get.pair LabelPool.deserialize expr) s in
Record (Imap.create (Array.of_list r))
| 7 ->
let st = U.deserialize s in
let e = expr s in
......
......@@ -23,7 +23,7 @@ type expr =
| Pair of expr * expr
| Xml of expr * expr * expr
| XmlNs of expr * expr * expr * Ns.table
| Record of expr label_map
| Record of expr Imap.t
| String of U.uindex * U.uindex * U.t * expr
| Match of expr * branches
......
......@@ -87,11 +87,11 @@ compile/lambda.cmo: types/types.cmi misc/serialize.cmi types/patterns.cmi \
compile/lambda.cmx: types/types.cmx misc/serialize.cmx types/patterns.cmx \
misc/ns.cmx types/ident.cmx compile/lambda.cmi
runtime/value.cmo: types/types.cmi types/sequence.cmi misc/ns.cmi \
compile/lambda.cmi types/intervals.cmi types/ident.cmo misc/encodings.cmi \
types/chars.cmi types/atoms.cmi runtime/value.cmi
compile/lambda.cmi types/intervals.cmi misc/imap.cmi types/ident.cmo \
misc/encodings.cmi types/chars.cmi types/atoms.cmi runtime/value.cmi
runtime/value.cmx: types/types.cmx types/sequence.cmx misc/ns.cmx \
compile/lambda.cmx types/intervals.cmx types/ident.cmx misc/encodings.cmx \
types/chars.cmx types/atoms.cmx runtime/value.cmi
compile/lambda.cmx types/intervals.cmx misc/imap.cmx types/ident.cmx \
misc/encodings.cmx types/chars.cmx types/atoms.cmx runtime/value.cmi
parser/location.cmo: misc/html.cmi parser/location.cmi
parser/location.cmx: misc/html.cmx parser/location.cmi
parser/url.cmo: parser/location.cmi parser/url.cmi
......@@ -202,12 +202,10 @@ runtime/run_dispatch.cmx: runtime/value.cmx types/types.cmx \
types/atoms.cmx runtime/run_dispatch.cmi
runtime/explain.cmo: runtime/value.cmi types/types.cmi \
runtime/run_dispatch.cmi types/patterns.cmi types/ident.cmo \
misc/encodings.cmi types/chars.cmi compile/auto_opt.cmi types/atoms.cmi \
runtime/explain.cmi
misc/encodings.cmi types/chars.cmi types/atoms.cmi runtime/explain.cmi
runtime/explain.cmx: runtime/value.cmx types/types.cmx \
runtime/run_dispatch.cmx types/patterns.cmx types/ident.cmx \
misc/encodings.cmx types/chars.cmx compile/auto_opt.cmx types/atoms.cmx \
runtime/explain.cmi
misc/encodings.cmx types/chars.cmx types/atoms.cmx runtime/explain.cmi
runtime/print_xml.cmo: runtime/value.cmi types/sequence.cmi \
schema/schema_builtin.cmi misc/ns.cmi types/intervals.cmi types/ident.cmo \
misc/encodings.cmi types/atoms.cmi runtime/print_xml.cmi
......@@ -217,11 +215,11 @@ runtime/print_xml.cmx: runtime/value.cmx types/sequence.cmx \
runtime/eval.cmo: runtime/value.cmi types/types.cmi typing/typer.cmi \
schema/schema_common.cmi runtime/run_dispatch.cmi types/patterns.cmi \
misc/ns.cmi compile/lambda.cmi types/ident.cmo runtime/explain.cmi \
compile/auto_opt.cmi runtime/eval.cmi
runtime/eval.cmi
runtime/eval.cmx: runtime/value.cmx types/types.cmx typing/typer.cmx \
schema/schema_common.cmx runtime/run_dispatch.cmx types/patterns.cmx \
misc/ns.cmx compile/lambda.cmx types/ident.cmx runtime/explain.cmx \
compile/auto_opt.cmx runtime/eval.cmi
runtime/eval.cmi
compile/compile.cmo: types/types.cmi typing/typer.cmi typing/typed.cmo \
misc/serialize.cmi types/patterns.cmi parser/location.cmi \
compile/lambda.cmi types/ident.cmo runtime/eval.cmi parser/ast.cmo \
......@@ -374,8 +372,8 @@ types/builtin_defs.cmi: types/types.cmi types/ident.cmo types/atoms.cmi
compile/lambda.cmi: types/types.cmi misc/serialize.cmi types/patterns.cmi \
misc/ns.cmi types/ident.cmo
runtime/value.cmi: types/types.cmi misc/ns.cmi compile/lambda.cmi \
types/intervals.cmi types/ident.cmo misc/encodings.cmi types/chars.cmi \
types/atoms.cmi
types/intervals.cmi misc/imap.cmi types/ident.cmo misc/encodings.cmi \
types/chars.cmi types/atoms.cmi
parser/location.cmi: misc/html.cmi
parser/parser.cmi: parser/ast.cmo
types/externals.cmi: types/types.cmi
......
(* Patricia trees; code adapted from http://www.lri.fr/~filliatr/ftp/ocaml/misc/ptmap.ml *)
type 'a t =
| Empty
| Leaf of int * 'a
| Branch of int * int * 'a t * 'a t
type 'a s =
| DError
| DReturn of 'a
| DLeaf of int * 'a * 'a
| DBranch of int * int * 'a s * 'a s
let empty = Empty
let return x = DReturn x
let zero_bit k m = (k land m) == 0
let lowest_bit x = x land (-x)
let branching_bit p0 p1 = lowest_bit (p0 lxor p1)
let mask p m = p land (m-1)
let match_prefix k p m = (mask k m) == p
let rec prepare_def y = function
| Empty -> DReturn y
| Leaf (k,x) -> DLeaf (k,x,y)
| Branch (p,m,t0,t1) ->
DBranch (p,m,prepare_def y t0, prepare_def y t1)
let rec prepare_nodef = function
| Empty -> DError
| Leaf (k,x) -> DReturn x
| Branch (p,m,t0,t1) ->
match (prepare_nodef t0, prepare_nodef t1) with
| (DReturn x0, DReturn x1) when x0 == x1 -> DReturn x0
| (t0,t1) -> DBranch (p,m,t0,t1)
let prepare def y =
match def with
| None -> prepare_nodef y
| Some def -> prepare_def def y
let rec find k = function
| DError -> assert false
| DReturn y -> y
| DLeaf (j,x,y) -> if k == j then x else y
| DBranch (_, m, l, r) -> find k (if zero_bit k m then l else r)
let join p0 t0 p1 t1 =
let m = branching_bit p0 p1 in
if zero_bit p0 m
then Branch (mask p0 m, m, t0, t1)
else Branch (mask p0 m, m, t1, t0)
let rec add k x = function
| Empty -> Leaf (k,x)
| Leaf (j,_) as t ->
if j == k then Leaf (k,x) else join k (Leaf (k,x)) j t
| Branch (p,m,t0,t1) as t ->
if match_prefix k p m
then
if zero_bit k m
then Branch (p, m, add k x t0, t1)
else Branch (p, m, t0, add k x t1)
type 'a t = int array
let get = Array.unsafe_get
let set = Array.unsafe_set
let empty = [| |]
let elements (t : 'a t) : (int * 'a) list =
if t == empty then [] else
let rec aux accu i =
if (i > 0)
then aux ((get t i, Obj.magic (get t (succ i)))::accu) (i - 2)
else accu
in
aux [] (get t 0 - 2)
let map_elements f t =
if t == empty then [] else
let rec aux accu i =
if (i > 0)
then aux (f (get t i) (Obj.magic (get t (succ i)))::accu) (i - 2)
else accu
in
aux [] (get t 0 - 2)
let sort a =
Array.sort (fun (i,_) (j,_) -> assert (i != j); if i < j then (-1) else 1) a
let real_create a =
let n = Array.length a in
let m = (n lsl 1) + 1 in
let t = Array.create m m in
for i = 1 to n do
let j = i lsl 1 in
let (idx,v) = get a (pred i) in
set t (pred j) idx;
set t j (Obj.magic v);
done;
t
let create a =
if Array.length a = 0 then empty else (sort a; real_create a)
let create_default def a =
sort a;
let l = Array.to_list a in
let rec aux i = function
| [] ->
if (i == max_int) then []
else [(succ i, def)]
| ((i1,_) as c)::rest ->
if (succ i == i1) then c :: (aux i1 rest)
else (succ i, def) :: c :: (aux i1 rest)
in
let l =
match l with
| ((i1,_) as c)::rest ->
if (i1 == min_int) then c :: (aux i1 rest)
else (min_int,def) :: c :: (aux i1 rest)
| [] -> [(min_int,def)] in
let a = Array.of_list l in
real_create a
let rec find_aux t (i : int) low high =
if (low >= high) then low
else
let m = ((low + high) lsr 1) lor 1 in
if i < get t m then find_aux t i low (m-2)
else find_aux t i m high
let find (t : 'a t) i : 'a =
if t == empty then raise Not_found;
let j = find_aux t i 1 (get t 0) in
if (get t j == i) then (Obj.magic get t (succ j))
else raise Not_found
let find_default t def i =
if t == empty then def
else
let j = find_aux t i 1 (get t 0) in
if (get t j == i) then (Obj.magic get t (succ j))
else def
let find_lower (t : 'a t) i : 'a =
assert (t != empty);
Obj.magic get t (succ (find_aux t i 1 (get t 0)))
let merge (t1 : 'a t) (t2 : 'a t) =
if t1 == empty then t2 else if t2 == empty then t1
else
let n1 = get t1 0 and n2 = get t2 0 in
let m = pred (n1 + n2) in
let t = Array.create m m in
let rec aux i i1 (l1:int) i2 l2 =
if l1 == l2 then
(set t i l1;
set t (succ i) (get t2 (pred i2));
let i = i + 2 in
if (i1 = n1) then (
let l = n2 - i2 in
let i2 = i2 - 2 in
Array.blit t2 i2 t i l;
i + l
) else if (i2 = n2) then (
let l = n1 - i1 in
let i1 = i1 - 2 in
Array.blit t1 i1 t i l;
i + l
) else
let l1 = get t1 i1 and l2 = get t2 i2 in
let i1 = i1 + 2 and i2 = i2 + 2 in
aux i i1 l1 i2 l2)
else if l1 < l2 then
(set t i l1;
set t (succ i) (get t1 (pred i1));
let i = i + 2 in
if (i1 = n1) then (
let i2 = i2 - 2 in
let l = n2 - i2 in
Array.blit t2 i2 t i l;
i + l
) else
let l1 = get t1 i1 in
let i1 = i1 + 2 in
aux i i1 l1 i2 l2)
else
(set t i l2;
set t (succ i) (get t2 (pred i2));
let i = i + 2 in
if (i2 = n2) then (
let l = n1 - i1 in
let i1 = i1 - 2 in
Array.blit t1 i1 t i l;
i + l
) else
let l2 = get t2 i2 in
let i2 = i2 + 2 in
aux i i1 l1 i2 l2)
in
set t 0 (aux 1 3 (get t1 1) 3 (get t2 1));
t
let cardinal t =
if t == empty then 0
else (pred (get t 0)) lsr 1
let map f t =
if t == empty then empty
else
let n = get t 0 in
let t' = Array.create n 0 in
Array.blit t 0 t' 0 n;
let rec aux i =
if (i = 0) then t'
else (set t' i (Obj.magic (f (Obj.magic (get t i)))); aux (i - 2))
in
aux (pred n)
let compare f t1 t2 =
if (t1 == t2) then 0
else if t1 == empty then (-1)
else if t2 == empty then 1
else
let n1 = get t1 0 and n2 = get t2 0 in
if (n1 < n2) then (-1) else if (n1 > n2) then 1
else
let rec aux i =
if (i < 0) then 0
else
let l1 = get t1 i and l2 = get t2 i in
if (l1 < l2) then (-1) else if (l1 > l2) then 1
else let x1 = Obj.magic (get t1 (succ i))
and x2 = Obj.magic (get t2 (succ i))
in let c = f x1 x2 in
if c != 0 then c else aux (i - 2)
in
aux (n1 - 2)
let hash f t =
if t == empty then 1
else
let rec aux accu i =
if (i < 0) then accu
else aux (accu * 65537
+ 257 * (f (Obj.magic (get t (succ i))))
+ (get t i)) (i - 2) in
aux 1 (get t 0 - 2)
let remove t i =
if t == empty then t
else
let j = find_aux t i 1 (get t 0) in
if (get t j != i) then t
else
let n = get t 0 - 2 in
if (n = 1) then empty
else
join k (Leaf (k,x)) p t
let rec dump f ppf = function
| DError -> Format.fprintf ppf "Error"
| DReturn x -> Format.fprintf ppf "Return %a" f x
| DLeaf(j,x,y) -> Format.fprintf ppf "Leaf(%i,%a,%a)" j f x f y
| DBranch (p,m,t0,t1) ->
Format.fprintf ppf "B(%i,%i,%a,%a)" p m (dump f) t0 (dump f) t1
let t' = Array.create n n in
Array.blit t 1 t' 1 (j - 1);
Array.blit t (j + 2) t' j (n - j);
t'
let iter f t =
if t == empty then ()
else
let rec aux i =
if (i < 0) then ()
else f (get t i) (Obj.magic (get t (succ i))) in
aux (get t 0 - 2)
(** Compact maps from integers to values. **)
type 'a t
type 'a s
val add: int -> 'a -> 'a t -> 'a t
val empty: 'a t
val return: 'a -> 'a s
val prepare: 'a option -> 'a t -> 'a s
val find: int -> 'a s -> 'a
val dump : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a s -> unit
val create: (int * 'a) array -> 'a t
(** The integer keys must be pairwise disjoint. *)
val create_default: 'a -> (int * 'a) array -> 'a t
(** Same as [create] but add necessary bindings so that
[find_lower] returns a default value when the key is not
in the set of the bindings which are provided. *)
val merge: 'a t -> 'a t -> 'a t
(** Merge two maps, with a priority to the second one in case of conflict.
Complexity linear in the size of the result. *)
val find: 'a t -> int -> 'a
(** Find the value associated to a key, or raise [Not_found]. *)
val find_default: 'a t -> 'a -> int -> 'a
(** Find the value associated to a key, or return a default value. *)
val find_lower: 'a t -> int -> 'a
(** Find the value associated to the largest key smaller than
or equal to the integer. It is assumed that such a key exists. *)
val find: 'a t -> int -> 'a
(** Find the value associated to a key, or raise [Not_found]. *)
val cardinal: 'a t -> int
(** Number of keys in the map. *)
val elements: 'a t -> (int * 'a) list
val map: ('a -> 'b) -> 'a t -> 'b t
val map_elements: (int -> 'a -> 'b) -> 'a t -> 'b list
val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
val hash: ('a -> int) -> 'a t -> int
val remove: 'a t -> int -> 'a t
val iter: (int -> 'a -> unit) -> 'a t -> unit
......@@ -132,7 +132,8 @@ let rec eval env = function
let v2 = eval env e2 in
let v3 = eval env e3 in
Value.XmlNs (v1,v2,v3,ns)
| Record r -> Value.Record (LabelMap.map (eval env) r)
| Record r ->
Value.Record (Imap.map (eval env) r)
| String (i,j,s,q) -> Value.substring_utf8 i j s (eval env q)
| Match (e,brs) -> eval_branches env brs (eval env e)
......@@ -306,13 +307,13 @@ and eval_xtrans_aux env brs acc = function
and eval_dot l = function
| Value.Record r
| Value.Xml (_,Value.Record r,_)
| Value.XmlNs (_,Value.Record r,_,_) -> LabelMap.assoc l r
| Value.XmlNs (_,Value.Record r,_,_) -> Imap.find_lower r l
| v ->
Value.print Format.std_formatter v;
failwith ("Cannot find field " ^ (Label.to_string (LabelPool.value l)))
and eval_remove_field l = function
| Value.Record r -> Value.Record (LabelMap.remove l r)
| Value.Record r -> Value.Record (Imap.remove r l)
| _ -> assert false
......
......@@ -67,7 +67,7 @@ and run_disp pt fail d v =
and run_disp_kind pt d fail actions = function
| Pair (v1,v2) -> run_disp_prod pt d fail v1 v2 actions.prod
| Xml (v1,v2,v3) -> run_disp_prod pt d fail v1 (Pair(v2,v3)) actions.xml
| Record r -> run_disp_record pt d fail false (LabelMap.get r) actions.record
| Record r -> run_disp_record pt d fail false (Imap.elements r) actions.record
| Atom a -> make_result pt fail (Atoms.get_map a actions.atoms)
| Char c -> make_result pt fail (Chars.get_map c actions.chars)
| Integer i ->
......
......@@ -42,7 +42,7 @@ let string s q =
let attrib att =
(* TODO: better error message *)
let att = List.map (fun (n,v) -> LabelPool.mk n, string_utf8 v) att in
LabelMap.from_list (fun _ _ -> failwith "Invalid XML document: uniqueness of attributes") att
Imap.create (Array.of_list att)
let elem ns (tag_ns,tag) att child =
if !keep_ns then
......
......@@ -131,9 +131,9 @@ let string_of_xml ~utf8 ns_table v =
let rec register_elt = function
| Xml (Atom tag, Record attrs, content)
| XmlNs (Atom tag, Record attrs, content, _) ->
List.iter
(fun (n,_) -> Ns.Printer.register_attr printer (LabelPool.value n))
(LabelMap.get attrs);
Imap.iter
(fun n _ -> Ns.Printer.register_attr printer (LabelPool.value n))
attrs;
Ns.Printer.register_tag printer (Atoms.V.value tag);
register_content content
| _ -> ()
......@@ -150,7 +150,7 @@ let string_of_xml ~utf8 ns_table v =
| Xml (Atom tag, Record attrs, content)
| XmlNs (Atom tag, Record attrs, content, _) ->
let tag = Atoms.V.value tag in
let attrs = LabelMap.mapi_to_list
let attrs = Imap.map_elements
(fun n v ->
if is_str v then begin
let (s,q) = get_string_utf8 v in
......
......@@ -190,7 +190,7 @@ and run_disp_kind actions v =
| Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
| Xml (v1,v2,v3)
| XmlNs (v1,v2,v3,_) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
| Record r -> run_disp_record false v (LabelMap.get r) actions.record
| Record r -> run_disp_record false v (Imap.elements r) actions.record
| String_latin1 (i,j,s,q) ->
(* run_disp_kind actions (Value.normalize v) *)
run_disp_string_latin1 i j s q actions
......
......@@ -5,7 +5,7 @@ type t =
| Pair of t * t
| Xml of t * t * t
| XmlNs of t * t * t * Ns.table
| Record of t label_map
| Record of t Imap.t
| Atom of Atoms.V.t
| Integer of Intervals.V.t
| Char of Chars.V.t
......@@ -42,10 +42,10 @@ let vbool x = if x then vtrue else vfalse
let vrecord l =
let l = List.map (fun (qname,v) -> LabelPool.mk qname, v) l in
Record (LabelMap.from_list_disj l)
Record (Imap.create (Array.of_list l))
let get_fields = function
| Record map -> LabelMap.mapi_to_list (fun k v -> LabelPool.value k, v) map
| Record map -> List.map (fun (k,v) -> LabelPool.value k, v) (Imap.elements map)
| _ -> raise (Invalid_argument "Value.get_fields")
let rec sequence = function
......@@ -90,14 +90,19 @@ let rec const = function
| Types.Pair (x,y) -> Pair (const x, const y)
| Types.Xml (x, Types.Pair (y, z)) -> Xml (const x, const y, const z)
| Types.Xml (_,_) -> assert false
| Types.Record x -> Record (LabelMap.map const x)
| Types.Record x ->
let x = LabelMap.mapi_to_list (fun l c -> (l,const c)) x in
Record (Imap.create (Array.of_list x))
| Types.String (i,j,s,c) -> String_utf8 (i,j,s, const c)
let rec inv_const = function
| Pair (x, y) -> Types.Pair (inv_const x, inv_const y)
| Xml (x, y, z) | XmlNs (x,y,z,_) ->
Types.Pair (inv_const x, Types.Pair (inv_const y, inv_const z))
| Record x -> Types.Record (LabelMap.map inv_const x)
| Record x ->
let x = Imap.elements x in
let x = List.map (fun (l,c) -> (l,inv_const c)) x in
Types.Record (LabelMap.from_list_disj x)
| Atom a -> Types.Atom a
| Integer i -> Types.Integer i
| Char c -> Types.Char c
......@@ -266,7 +271,7 @@ let rec print ppf v =
else match v with
| Pair (x,y) -> Format.fprintf ppf "(%a,%a)" print x print y
| Xml (x,y,z) | XmlNs (x,y,z,_) -> print_xml ppf x y z
| Record l -> Format.fprintf ppf "{%a }" print_record (LabelMap.get l)
| Record l -> Format.fprintf ppf "{%a }" print_record (Imap.elements l)
| Atom a -> Atoms.V.print_quote ppf a
| Integer i -> Intervals.V.print ppf i
| Char c -> Chars.V.print ppf c
......@@ -333,7 +338,7 @@ and print_tag ppf = function
| Atom tag -> Atoms.V.print ppf tag
| tag -> Format.fprintf ppf "(%a)" print tag
and print_attr ppf = function
| Record attr -> print_record ppf (LabelMap.get attr)
| Record attr -> print_record ppf (Imap.elements attr)
| attr -> Format.fprintf ppf "(%a)" print attr
and print_record ppf = function
......@@ -354,7 +359,7 @@ let dump_xml ppf v =
| Record x ->
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<record>@,%a@,</record>@]"
(fun ppf x -> print_record ppf (LabelMap.get x)) x
(fun ppf x -> print_record ppf (Imap.elements x)) x
| Atom a ->
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<atom>@,%a@,</atom>@]"
......@@ -408,7 +413,7 @@ let rec compare x y =
let c = compare x1 y1 in if c <> 0 then c
else let c = compare x2 y2 in if c <> 0 then c
else compare x3 y3
| Record rx, Record ry -> LabelMap.compare compare rx ry
| Record rx, Record ry -> Imap.compare compare rx ry
| Atom x, Atom y -> Atoms.V.compare x y
| Integer x, Integer y -> Intervals.V.compare x y
| Char x, Char y -> Chars.V.compare x y
......@@ -480,7 +485,7 @@ let rec hash = function
| (Xml (x1,x2,x3) | XmlNs (x1,x2,x3,_)) ->
2 + hash x1 * 65537 + hash x2 * 257 + hash x3 * 17
| Record rx ->
3 + 17 * LabelMap.hash hash rx
3 + 17 * Imap.hash hash rx
| Atom x ->
4 + 17 * Atoms.V.hash x
| Integer x ->
......@@ -541,7 +546,7 @@ let map_xml map_pcdata map_other =
let tagged_tuple tag vl =
let ct = sequence vl in
let at = Record LabelMap.empty in
let at = Record Imap.empty in
let tag = Atom (Atoms.V.mk_ascii tag) in
Xml (tag, at, ct)
......@@ -616,7 +621,7 @@ let label_ascii s =
LabelPool.mk (Ns.empty, U.mk s)
let record l =
Record (LabelMap.from_list_disj l)
Record (Imap.create (Array