Commit 2aec8404 authored by Pietro Abate's avatar Pietro Abate

[r2005-04-01 13:14:42 by afrisch] Empty log message

Original author: afrisch
Date: 2005-04-01 13:14:42+00:00
parent ac724046
......@@ -39,6 +39,7 @@ module LAB = Mk(Ident.LabelPool)
module T = Mk(Types)
module LABA = Mk(Custom.Array(Ident.LabelPool))
module TAG = Mk(Atoms.V)
module TAGA = Mk(Custom.Array(Custom.Pair(Atoms.V)(Custom.Int)))
module P = struct
type chunk =
......@@ -48,6 +49,7 @@ module P = struct
typ : T.pchunk;
laba : LABA.pchunk;
tag : TAG.pchunk;
taga : TAGA.pchunk;
}
let init () =
......@@ -57,6 +59,7 @@ module P = struct
typ = T.init ();
laba = LABA.init ();
tag = TAG.init ();
taga = TAGA.init ();
}
let serialize s c =
......@@ -65,7 +68,9 @@ module P = struct
LAB.serialize s c.lab;
T.serialize s c.typ;
LABA.serialize s c.laba;
TAG.serialize s c.tag
TAG.serialize s c.tag;
TAGA.serialize s c.taga;
()
let pm c = PM.put c.pm
let const c = CONST.put c.cst
......@@ -73,6 +78,7 @@ module P = struct
let typ c = T.put c.typ
let label_array c = LABA.put c.laba
let tag c = TAG.put c.tag
let tag_array c = TAGA.put c.taga
let mk c =
let s = Serialize.Put.run serialize c in
......@@ -91,6 +97,7 @@ module G = struct
typ : Types.t T.chunk;
laba : Ident.label array LABA.chunk;
tag : Value.t TAG.chunk;
taga : int Atoms.map TAGA.chunk;
}
let deserialize s =
......@@ -100,7 +107,9 @@ module G = struct
let typ = T.deserialize s in
let laba = LABA.deserialize s in
let tag = TAG.deserialize s in
{ pm = pm; cst = cst; lab = lab; typ = typ; laba = laba; tag = tag }
let taga = TAGA.deserialize s in
{ pm = pm; cst = cst; lab = lab; typ = typ; laba = laba; tag = tag;
taga = taga }
let mk s =
Types.clear_deserialize_table ();
......@@ -137,5 +146,13 @@ module G = struct
let constr chunk i vs =
Value.ocaml2cduce_constr (TAG.get (fun x -> Value.Atom x) chunk.tag i) vs
let dconstr chunk i v =
Value.cduce2ocaml_constr (TAGA.get
(fun x ->
let x = Array.map (fun (t,i) ->
Atoms.atom t, i) x in
Atoms.mk_map (Array.to_list x))
chunk.taga i) v
end
......@@ -9,6 +9,7 @@ module P : sig
val typ: chunk -> Types.t -> int
val label_array: chunk -> Ident.label array -> int
val tag: chunk -> Atoms.V.t -> int
val tag_array: chunk -> (Atoms.V.t * int) array -> int
end
module G : sig
......@@ -21,6 +22,7 @@ module G : sig
val typ: chunk -> int -> Types.t
val record: chunk -> int -> Value.t array -> Value.t
val constr: chunk -> int -> Value.t array -> Value.t
val dconstr: chunk -> int -> Value.t -> Obj.t
end
......@@ -770,3 +770,17 @@ let rec cduce2ocaml_list f v =
let no_attr = Record LabelMap.empty
let ocaml2cduce_constr tag va = Xml (tag, no_attr, sequence_of_array va)
let cduce2ocaml_constr m = function
| Xml (Atom v,_,f) | XmlNs (Atom v,_,f,_) ->
let tag = Atoms.get_map v m in
(match get_sequence f with
| [] ->
Obj.repr tag
| f ->
let x = Obj.repr (Array.of_list f) in
Obj.set_tag x tag;
x)
| _ -> assert false
......@@ -129,6 +129,7 @@ val ocaml2cduce_atom : U.t -> U.t -> t
val ocaml2cduce_list : ('a -> t) -> 'a list -> t
val cduce2ocaml_list : (t -> 'a) -> t -> 'a list
val ocaml2cduce_constr: t -> t array -> t
val cduce2ocaml_constr: int Atoms.map -> t -> Obj.t
val print_utf8: U.t -> unit
......
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