Commit d1c56c6e authored by Pietro Abate's avatar Pietro Abate

[r2005-03-31 14:54:09 by afrisch] Empty log message

Original author: afrisch
Date: 2005-03-31 14:54:10+00:00
parent 44ea696a
......@@ -102,8 +102,8 @@ cduce/cat1:
.PHONY: compute_depend
cduce/compute_depend:
ocamldep $(INCLUDES) $(SRC) > cduce/types_depend
compute_depend:
ocamldep $(CDUCE_INCLUDES) $(SRC) > cduce/types_depend
include cduce/types_depend
......
......@@ -38,6 +38,7 @@ module CONST = Mk(Types.Const)
module LAB = Mk(Ident.LabelPool)
module T = Mk(Types)
module LABA = Mk(Custom.Array(Ident.LabelPool))
module TAG = Mk(Atoms.V)
module P = struct
type chunk =
......@@ -46,6 +47,7 @@ module P = struct
lab : LAB.pchunk;
typ : T.pchunk;
laba : LABA.pchunk;
tag : TAG.pchunk;
}
let init () =
......@@ -54,6 +56,7 @@ module P = struct
lab = LAB.init ();
typ = T.init ();
laba = LABA.init ();
tag = TAG.init ();
}
let serialize s c =
......@@ -61,13 +64,15 @@ module P = struct
CONST.serialize s c.cst;
LAB.serialize s c.lab;
T.serialize s c.typ;
LABA.serialize s c.laba
LABA.serialize s c.laba;
TAG.serialize s c.tag
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 label_array c = LABA.put c.laba
let tag c = TAG.put c.tag
let mk c =
let s = Serialize.Put.run serialize c in
......@@ -85,6 +90,7 @@ module G = struct
lab : Ident.label LAB.chunk;
typ : Types.t T.chunk;
laba : Ident.label array LABA.chunk;
tag : Value.t TAG.chunk;
}
let deserialize s =
......@@ -93,7 +99,8 @@ module G = struct
let lab = LAB.deserialize s in
let typ = T.deserialize s in
let laba = LABA.deserialize s in
{ pm = pm; cst = cst; lab = lab; typ = typ; laba = laba }
let tag = TAG.deserialize s in
{ pm = pm; cst = cst; lab = lab; typ = typ; laba = laba; tag = tag }
let mk s =
Types.clear_deserialize_table ();
......@@ -127,5 +134,8 @@ module G = struct
let record chunk i vs =
Value.mk_record (LABA.get (fun x -> x) chunk.laba i) vs
let constr chunk i vs =
Value.ocaml2cduce_constr (TAG.get (fun x -> Value.Atom x) chunk.tag i) vs
end
......@@ -8,6 +8,7 @@ module P : sig
val label: chunk -> Ident.label -> int
val typ: chunk -> Types.t -> int
val label_array: chunk -> Ident.label array -> int
val tag: chunk -> Atoms.V.t -> int
end
module G : sig
......@@ -19,6 +20,7 @@ module G : sig
val remove_label: chunk -> int -> Value.t -> Value.t
val typ: chunk -> int -> Types.t
val record: chunk -> int -> Value.t array -> Value.t
val constr: chunk -> int -> Value.t array -> Value.t
end
......@@ -58,6 +58,12 @@ let rec sequence_rev accu = function
let sequence_rev l = sequence_rev nil l
let sequence_of_array a =
let rec aux accu i =
if (i = 0) then accu
else let i = pred i in aux (Pair (a.(i), accu)) i in
aux nil (Array.length a)
let concat v1 v2 =
match (v1,v2) with
| (Atom _, v) | (v, Atom _) -> v
......@@ -698,6 +704,10 @@ let div v1 v2 = match (v1,v2) with
| (Integer x, Integer y) -> Integer (Intervals.V.div x y)
| _ -> assert false
let modulo v1 v2 = match (v1,v2) with
| (Integer x, Integer y) -> Integer (Intervals.V.modulo x y)
| _ -> assert false
let pair v1 v2 = Pair (v1,v2)
let xml v1 v2 v3 = Xml (v1,v2,v3)
......@@ -747,3 +757,11 @@ let xtransform f v = xtransform_aux f nil v
let remove_field l = function
| Record r -> Record (LabelMap.remove l r)
| _ -> assert false
let rec ocaml2cduce_list f = function
| [] -> nil
| hd::tl -> Pair (f hd, ocaml2cduce_list f tl)
let no_attr = Record LabelMap.empty
let ocaml2cduce_constr tag va = Xml (tag, no_attr, sequence_of_array va)
......@@ -126,6 +126,8 @@ val ocaml2cduce_option: ('a -> t) -> 'a option -> t
val cduce2ocaml_option: (t -> 'a) -> t -> 'a option
val ocaml2cduce_wchar : int -> t
val ocaml2cduce_atom : U.t -> U.t -> t
val ocaml2cduce_list : ('a -> t) -> 'a list -> t
val ocaml2cduce_constr: t -> t array -> t
val print_utf8: U.t -> unit
......@@ -134,6 +136,7 @@ val add: t -> t -> t
val sub: t -> t -> t
val mul: t -> t -> t
val div: t -> t -> t
val modulo: t -> t -> t
val pair: t -> t -> t
val xml: t -> t -> t -> t
val mk_record: label array -> t array -> t
......@@ -141,3 +144,5 @@ val mk_record: label array -> t array -> t
val transform: (t -> t) -> t -> t
val xtransform: (t -> t) -> t -> t
val remove_field: label -> t -> t
......@@ -34,6 +34,7 @@ let div = div_big_int
let modulo = mod_big_int
let succ = succ_big_int
let pred = pred_big_int
let negat t = sub_big_int zero_big_int t
let lt = lt_big_int
let gt = gt_big_int
......@@ -383,6 +384,9 @@ let mul l1 l2 =
) empty l1
let div i1 i2 = any
let modulo i1 i2 = any
let dmp s i =
let ppf = Format.std_formatter in
Format.fprintf ppf "%s = [ " s;
......
......@@ -18,6 +18,7 @@ module V : sig
val modulo: t -> t -> t
val succ: t -> t
val pred: t -> t
val negat: t -> t
val lt: t -> t -> bool
val gt: t -> t -> bool
......@@ -60,4 +61,6 @@ val single : t -> V.t
val add : t -> t -> t
val mul : t -> t -> t
val sub : t -> t -> t
val div : t -> t -> t
val modulo : t -> t -> t
val negat : t -> t
This diff is collapsed.
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