Commit 6f69556d authored by Pietro Abate's avatar Pietro Abate

[r2005-03-24 19:33:55 by afrisch] Empty log message

Original author: afrisch
Date: 2005-03-24 19:33:56+00:00
parent 3d508dcb
......@@ -57,22 +57,33 @@ ML_SRC=$(filter %.ml,$(SRC))
CDUCE_OBJECTS=$(ML_SRC:.ml=.cmo)
$(CDUCE_OBJECTS) $(CDUCE_OBJECTS:.cmo=.cmi): $(COMPILER)
$(CDUCE_OBJECTS:.cmo=.cmx): $(OPTCOMPILER)
cduce_types.cmo: $(CDUCE_OBJECTS)
$(CAMLC) $(COMPFLAGS) -pack -o cduce_types.cmo $(CDUCE_INCLUDES) $^
cduce_types.cmx: $(CDUCE_OBJECTS:.cmo=.cmx)
$(CAMLOPT) $(OPTCOMPFLAGS) -pack -o cduce_types.cmx $(CDUCE_INCLUDES) $^
cduce_types.p.cmx: cduce_types.cmx
cp cduce_types.cmx cduce_types.p.cmx
cp cduce_types.o cduce_types.p.o
CDUCE_INCLUDES = $(DIRS:%=-I %)
cduce/types/intervals.cmo: cduce/types/intervals.ml cduce/cat1 cduce/types/intervals_int.ml
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) -pp 'cduce/cat1 cduce/types/intervals_int.ml' $<
cduce/types/intervals.cmx: cduce/types/intervals.ml cduce/cat1 cduce/types/intervals_int.ml
$(CAMLOPT) $(OPTCOMPFLAGS) -c $(CDUCE_INCLUDES) -pp 'cduce/cat1 cduce/types/intervals_int.ml' $<
cduce/types/intervals.cmi: cduce/types/intervals.mli cduce/cat1 cduce/types/intervals_int.mli
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) -pp 'cduce/cat1 cduce/types/intervals_int.mli' $<
cduce/misc/stats.cmo: cduce/misc/stats.ml
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) -pp 'sed s/Unix\\.gettimeofday\(\)/0./' $<
cduce/misc/stats.cmx: cduce/misc/stats.ml
$(CAMLOPT) $(OPTCOMPFLAGS) -c $(CDUCE_INCLUDES) -pp 'sed s/Unix\\.gettimeofday\(\)/0./' $<
cduce/cat1:
echo "cat \$$1" > cduce/cat1
......@@ -84,7 +95,7 @@ cduce/cat1:
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) $<
.ml.cmx:
$(CAMLOPT) -c $(CDUCE_INCLUDES) $<
$(CAMLOPT) $(OPTCOMPFLAGS) -c $(CDUCE_INCLUDES) $<
.mli.cmi:
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) $<
......
......@@ -95,10 +95,6 @@ and branches = (ppat * pexpr) list
and ppat = ppat' located
and ppat' =
| PatVar of (U.t option) * U.t (* optional compilation unit *)
(*
| SchemaVar of (* type/pattern schema variable *)
Schema_types.component_kind * U.t * U.t (* kind, schema, name *)
*)
| Cst of pexpr
| NsT of U.t
| Recurs of ppat * (Location.loc * U.t * ppat) list
......
......@@ -31,18 +31,22 @@ end
module PM = Mk(Custom.Pair(Types)(Custom.List(Patterns.Node)))
module CONST = Mk(Types.Const)
module LAB = Mk(Ident.LabelPool)
module P = struct
let init () =
PM.init ();
CONST.init ()
CONST.init ();
LAB.init ()
let serialize s () =
PM.serialize s;
CONST.serialize s
CONST.serialize s;
LAB.serialize s
let pm = PM.put
let const = CONST.put
let label = LAB.put
let mk () =
let s = Serialize.Put.run serialize () in
......@@ -57,12 +61,14 @@ module G = struct
(Patterns.Compile.dispatcher * int Patterns.Compile.rhs array)
PM.chunk;
cst : Value.t CONST.chunk;
lab : Ident.label LAB.chunk;
}
let deserialize s =
let pm = PM.deserialize s in
let cst = CONST.deserialize s in
{ pm = pm; cst = cst }
let lab = LAB.deserialize s in
{ pm = pm; cst = cst; lab = lab }
let mk s =
Types.clear_deserialize_table ();
......@@ -88,5 +94,7 @@ module G = struct
let const chunk i =
CONST.get Value.const chunk.cst i
let remove_label chunk i v =
Value.remove_field (LAB.get (fun x -> x) chunk.lab i) v
end
......@@ -4,6 +4,7 @@ module P : sig
val pm: Types.t * Patterns.Node.t list -> int
val const: Types.const -> int
val label: Ident.label -> int
end
module G : sig
......@@ -12,6 +13,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
end
......@@ -732,3 +732,6 @@ let rec xtransform_aux f accu = function
let xtransform f v = xtransform_aux f nil v
let remove_field l = function
| Record r -> Record (LabelMap.remove l r)
| _ -> assert false
......@@ -137,3 +137,4 @@ val mk_record: (U.t * U.t) array -> t array -> t
val transform: (t -> t) -> t -> t
val xtransform: (t -> t) -> t -> t
val remove_field: label -> t -> t
......@@ -1542,7 +1542,7 @@ and type_check' loc env e constr precise = match e with
| Dot (e,l) ->
let t = type_check env e Types.Record.any true in
let t =
try (Types.Record.project t l)
try Types.Record.project t l
with Not_found -> raise_loc loc (WrongLabel(t,l))
in
verify loc t constr
......
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