[r2005-03-25 14:05:49 by afrisch] Empty log message

Original author: afrisch
Date: 2005-03-25 14:05:49+00:00

runtime/serial.ml

@@ -6,12 +6,16 @@ let serialize = ref []
 module Mk(X : Custom.T) = struct
   module A = Custom.Array(X)
   
-  let lst = ref [] and nb = ref (-1)
-  let put x = lst := x :: !lst; incr nb; !nb
+  type pchunk = { mutable nb : int; mutable lst : X.t list }
+  let put c x = 
+    let i = c.nb in
+    c.nb <- succ i;
+    c.lst <- x::c.lst;
+    i
     
-  let init () = lst := []; nb := (-1)
-  let serialize s = Serialize.Put.array X.serialize s 
-		      (Array.of_list (List.rev !lst))
+  let init () = { nb = 0; lst = [] }
+  let serialize s c = Serialize.Put.array X.serialize s 
+		      (Array.of_list (List.rev c.lst))
 
   type 'a entry = Serialized of X.t | Computed of 'a
   type 'a chunk = 'a entry array
@@ -32,24 +36,35 @@ end
 module PM = Mk(Custom.Pair(Types)(Custom.List(Patterns.Node)))
 module CONST = Mk(Types.Const)
 module LAB = Mk(Ident.LabelPool)
+module T = Mk(Types)
 
 module P = struct
-  let init () = 
-    PM.init ();
-    CONST.init ();
-    LAB.init ()
-
-  let serialize s () =
-    PM.serialize s;
-    CONST.serialize s;
-    LAB.serialize s
-
-  let pm = PM.put
-  let const = CONST.put
-  let label = LAB.put
+  type chunk =
+      { pm : PM.pchunk;
+	cst : CONST.pchunk;
+	lab : LAB.pchunk;
+	typ : T.pchunk;
+      }
 
-  let mk () =
-    let s = Serialize.Put.run serialize () in
+  let init () = 
+    { pm = PM.init ();
+      cst = CONST.init ();
+      lab = LAB.init ();
+      typ = T.init () }
+
+  let serialize s c =
+    PM.serialize s c.pm;
+    CONST.serialize s c.cst;
+    LAB.serialize s c.lab;
+    T.serialize s c.typ
+
+  let pm c = PM.put c.pm
+  let const c = CONST.put c.cst
+  let label c = LAB.put c.lab
+  let typ c = T.put c.typ
+
+  let mk c =
+    let s = Serialize.Put.run serialize c in
     ignore (Types.CompUnit.close_serialize ());
     s
 
@@ -62,13 +77,15 @@ module G = struct
 	  PM.chunk;
 	cst : Value.t CONST.chunk;
 	lab : Ident.label LAB.chunk;
+	typ : Types.t T.chunk;
       }
 
   let deserialize s =
     let pm = PM.deserialize s in
     let cst = CONST.deserialize s in
     let lab = LAB.deserialize s in
-    { pm = pm; cst = cst; lab = lab }
+    let typ = T.deserialize s in
+    { pm = pm; cst = cst; lab = lab; typ = typ }
 
   let mk s = 
     Types.clear_deserialize_table ();
@@ -96,5 +113,8 @@ module G = struct
 	  
   let remove_label chunk i v =
     Value.remove_field (LAB.get (fun x -> x) chunk.lab i) v
+
+  let typ chunk i =
+    T.get (fun x -> x) chunk.typ i
 end
 

runtime/serial.mli

 module P : sig
-  val init: unit -> unit
-  val mk: unit -> string
+  type chunk
+  val init: unit -> chunk
+  val mk: chunk -> string
 
-  val pm: Types.t * Patterns.Node.t list -> int
-  val const: Types.const -> int
-  val label: Ident.label -> int
+  val pm: chunk -> Types.t * Patterns.Node.t list -> int
+  val const: chunk -> Types.const -> int
+  val label: chunk -> Ident.label -> int
+  val typ: chunk -> Types.t -> int
 end
 
 module G : sig
@@ -14,6 +16,7 @@ module G : sig
   val pm: chunk -> int -> Value.t -> int * Value.t array
   val const: chunk -> int -> Value.t
   val remove_label: chunk -> int -> Value.t -> Value.t
+  val typ: chunk -> int -> Types.t
 end