/[svn]/cduce/trunk/runtime/serial.ml
ViewVC logotype

Diff of /cduce/trunk/runtime/serial.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1613 by abate, Tue Jul 10 19:07:37 2007 UTC revision 1616 by abate, Tue Jul 10 19:07:52 2007 UTC
# Line 39  Line 39 
39  module T = Mk(Types)  module T = Mk(Types)
40  module LABA = Mk(Custom.Array(Ident.LabelPool))  module LABA = Mk(Custom.Array(Ident.LabelPool))
41  module TAG = Mk(Atoms.V)  module TAG = Mk(Atoms.V)
42    module TAGA = Mk(Custom.Array(Custom.Pair(Atoms.V)(Custom.Int)))
43    
44  module P = struct  module P = struct
45    type chunk =    type chunk =
# Line 48  Line 49 
49          typ : T.pchunk;          typ : T.pchunk;
50          laba : LABA.pchunk;          laba : LABA.pchunk;
51          tag : TAG.pchunk;          tag : TAG.pchunk;
52            taga : TAGA.pchunk;
53       }       }
54    
55    let init () =    let init () =
# Line 57  Line 59 
59        typ = T.init ();        typ = T.init ();
60        laba = LABA.init ();        laba = LABA.init ();
61        tag = TAG.init ();        tag = TAG.init ();
62          taga = TAGA.init ();
63      }      }
64    
65    let serialize s c =    let serialize s c =
# Line 65  Line 68 
68      LAB.serialize s c.lab;      LAB.serialize s c.lab;
69      T.serialize s c.typ;      T.serialize s c.typ;
70      LABA.serialize s c.laba;      LABA.serialize s c.laba;
71      TAG.serialize s c.tag      TAG.serialize s c.tag;
72        TAGA.serialize s c.taga;
73        ()
74    
75    let pm c = PM.put c.pm    let pm c = PM.put c.pm
76    let const c = CONST.put c.cst    let const c = CONST.put c.cst
# Line 73  Line 78 
78    let typ c = T.put c.typ    let typ c = T.put c.typ
79    let label_array c = LABA.put c.laba    let label_array c = LABA.put c.laba
80    let tag c = TAG.put c.tag    let tag c = TAG.put c.tag
81      let tag_array c = TAGA.put c.taga
82    
83    let mk c =    let mk c =
84      let s = Serialize.Put.run serialize c in      let s = Serialize.Put.run serialize c in
# Line 91  Line 97 
97          typ : Types.t T.chunk;          typ : Types.t T.chunk;
98          laba : Ident.label array LABA.chunk;          laba : Ident.label array LABA.chunk;
99          tag : Value.t TAG.chunk;          tag : Value.t TAG.chunk;
100            taga : int Atoms.map TAGA.chunk;
101        }        }
102    
103    let deserialize s =    let deserialize s =
# Line 100  Line 107 
107      let typ = T.deserialize s in      let typ = T.deserialize s in
108      let laba = LABA.deserialize s in      let laba = LABA.deserialize s in
109      let tag = TAG.deserialize s in      let tag = TAG.deserialize s in
110      { pm = pm; cst = cst; lab = lab; typ = typ; laba = laba; tag = tag }      let taga = TAGA.deserialize s in
111        { pm = pm; cst = cst; lab = lab; typ = typ; laba = laba; tag = tag;
112          taga = taga }
113    
114    let mk s =    let mk s =
115      Types.clear_deserialize_table ();      Types.clear_deserialize_table ();
# Line 137  Line 146 
146    
147    let constr chunk i vs =    let constr chunk i vs =
148      Value.ocaml2cduce_constr (TAG.get (fun x -> Value.Atom x) chunk.tag i) vs      Value.ocaml2cduce_constr (TAG.get (fun x -> Value.Atom x) chunk.tag i) vs
149    
150      let dconstr chunk i v =
151        Value.cduce2ocaml_constr (TAGA.get
152                          (fun x ->
153                             let x = Array.map (fun (t,i) ->
154                                                  Atoms.atom t, i) x in
155                             Atoms.mk_map (Array.to_list x))
156                          chunk.taga i) v
157  end  end
158    
Legend:
Removed from v.1613  
changed lines
  Added in v.1616
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5