binannot: replace Lazy by EnvLazy for serializationocaml-binannot

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/ocaml-binannot@12367 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

39 files changed, 99 insertions, 28 deletions

diff --git a/asmcomp/alpha/.gitignore b/asmcomp/alpha/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/asmcomp/alpha/.gitignore
diff --git a/asmcomp/hppa/.gitignore b/asmcomp/hppa/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/asmcomp/hppa/.gitignore
diff --git a/asmcomp/m68k/.gitignore b/asmcomp/m68k/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/asmcomp/m68k/.gitignore
diff --git a/asmcomp/mips/.gitignore b/asmcomp/mips/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/asmcomp/mips/.gitignore
diff --git a/binary-compat/compat/3.11.2/.gitignore b/binary-compat/compat/3.11.2/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/binary-compat/compat/3.11.2/.gitignore
diff --git a/binary-compat/compat/3.12.0/.gitignore b/binary-compat/compat/3.12.0/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/binary-compat/compat/3.12.0/.gitignore
diff --git a/boot/ocamlc b/boot/ocamlc
index b956cb8c4f..6b66aa8e4c 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamldep b/boot/ocamldep
index 59091f53a2..9824da3693 100755
--- a/boot/ocamldep
+++ b/boot/ocamldep
diff --git a/boot/ocamllex b/boot/ocamllex
index 3ffaaf5a05..937cc75f33 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex
diff --git a/camlp4/camlp4/.gitignore b/camlp4/camlp4/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/camlp4/.gitignore
diff --git a/camlp4/etc/.gitignore b/camlp4/etc/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/etc/.gitignore
diff --git a/camlp4/lib/.gitignore b/camlp4/lib/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/lib/.gitignore
diff --git a/camlp4/meta/.gitignore b/camlp4/meta/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/meta/.gitignore
diff --git a/camlp4/ocaml_src/.gitignore b/camlp4/ocaml_src/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/ocaml_src/.gitignore
diff --git a/camlp4/ocaml_src/camlp4/.gitignore b/camlp4/ocaml_src/camlp4/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/ocaml_src/camlp4/.gitignore
diff --git a/camlp4/ocaml_src/lib/.gitignore b/camlp4/ocaml_src/lib/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/ocaml_src/lib/.gitignore
diff --git a/camlp4/ocaml_src/meta/.gitignore b/camlp4/ocaml_src/meta/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/ocaml_src/meta/.gitignore
diff --git a/camlp4/ocaml_src/odyl/.gitignore b/camlp4/ocaml_src/odyl/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/ocaml_src/odyl/.gitignore
diff --git a/camlp4/ocpp/.gitignore b/camlp4/ocpp/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/ocpp/.gitignore
diff --git a/camlp4/odyl/.gitignore b/camlp4/odyl/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/odyl/.gitignore
diff --git a/camlp4/top/.gitignore b/camlp4/top/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/camlp4/top/.gitignore
diff --git a/jocparsing/.gitignore b/jocparsing/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/jocparsing/.gitignore
diff --git a/maccaml/.gitignore b/maccaml/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/maccaml/.gitignore
diff --git a/otherlibs/db/.gitignore b/otherlibs/db/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/otherlibs/db/.gitignore
diff --git a/otherlibs/dbm/.gitignore b/otherlibs/dbm/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/otherlibs/dbm/.gitignore
diff --git a/otherlibs/join/.gitignore b/otherlibs/join/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/otherlibs/join/.gitignore
diff --git a/otherlibs/labltk/example/.gitignore b/otherlibs/labltk/example/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/otherlibs/labltk/example/.gitignore
diff --git a/otherlibs/num/bignum/.gitignore b/otherlibs/num/bignum/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/otherlibs/num/bignum/.gitignore
diff --git a/otherlibs/num/test/.gitignore b/otherlibs/num/test/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/otherlibs/num/test/.gitignore
diff --git a/otherlibs/threads/Tests/.gitignore b/otherlibs/threads/Tests/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/otherlibs/threads/Tests/.gitignore
diff --git a/test/.gitignore b/test/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/test/.gitignore
diff --git a/test/Moretest/.gitignore b/test/Moretest/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/test/Moretest/.gitignore
diff --git a/test/Results/.gitignore b/test/Results/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/test/Results/.gitignore
diff --git a/test/testinterp/.gitignore b/test/testinterp/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/test/testinterp/.gitignore
diff --git a/testasmcomp/.gitignore b/testasmcomp/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testasmcomp/.gitignore
diff --git a/testlabl/.gitignore b/testlabl/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testlabl/.gitignore
diff --git a/testsuite/tests/regression-camlp4-class-type-plus/.gitignore b/testsuite/tests/regression-camlp4-class-type-plus/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/regression-camlp4-class-type-plus/.gitignore
diff --git a/testsuite/tests/regression-pr5080-notes/.gitignore b/testsuite/tests/regression-pr5080-notes/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/regression-pr5080-notes/.gitignore
diff --git a/typing/env.ml b/typing/env.ml
index 33a19152f8..fe50f7a98b 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -44,6 +44,66 @@ type error =
 
 exception Error of error
 
+module EnvLazy : sig
+  type 'a t
+  type ('a,'b) maker
+
+  val force : 'a t -> 'a
+  val create : ('a,'b) maker -> 'a -> 'b t
+  val declare_maker : string -> ('a,'b) maker
+  val register_maker : ('a,'b) maker -> ('a -> 'b) -> unit
+
+  exception UnknownLazyMaker of string
+
+end  = struct
+
+  exception UnknownLazyMaker of string
+
+  module StringMap = Map.Make(String)
+
+  type 'a t = 'a eval ref
+
+  and 'a eval =
+      Done of 'a
+    | Raise of exn
+    | Thunk of string * Obj.t
+
+  type ('a,'b) maker = string
+
+  let makers = ref (StringMap.empty : (Obj.t -> Obj.t) StringMap.t)
+
+  let force : 'a . 'a t -> 'a = function x ->
+    match !x with
+        Done x -> x
+      | Raise e -> raise e
+      | Thunk (name, args) ->
+          let maker = try
+            StringMap.find name !makers
+          with Not_found ->
+            raise (UnknownLazyMaker name)
+          in
+          try
+            let y = Obj.magic (maker args) in
+            x := Done y;
+            y
+          with e ->
+            x := Raise e;
+            raise e
+
+  let create maker args =
+    let x = ref (Thunk (Obj.magic maker, Obj.magic args)) in
+    x
+
+  let declare_maker name =
+    if name = "" then invalid_arg "EnvLazy.maker cannot by \"\"";
+    Obj.magic name
+
+  let register_maker maker f =
+    makers := StringMap.add (Obj.magic maker) (Obj.magic f) !makers
+
+end
+
+
 type summary =
     Env_empty
   | Env_value of summary * Ident.t * value_description
@@ -107,7 +167,7 @@ type t = {
   gadt_instances: (int * TypeSet.t ref) list;
 }
 
-and module_components = module_components_repr Lazy.t
+and module_components = module_components_repr EnvLazy.t
 
 and module_components_repr =
     Structure_comps of structure_components
@@ -118,10 +178,10 @@ and structure_components = {
   mutable comp_annotations: (string, (Annot.ident * int)) Tbl.t;
   mutable comp_constrs: (string, (constructor_description * int)) Tbl.t;
   mutable comp_labels: (string, (label_description * int)) Tbl.t;
-  mutable comp_constrs_by_path: 
+  mutable comp_constrs_by_path:
       (string, (constructor_description list * int)) Tbl.t;
   mutable comp_types: (string, (type_declaration * int)) Tbl.t;
-  mutable comp_modules: (string, (module_type Lazy.t * int)) Tbl.t;
+  mutable comp_modules: (string, (module_type EnvLazy.t * int)) Tbl.t;
   mutable comp_modtypes: (string, (modtype_declaration * int)) Tbl.t;
   mutable comp_components: (string, (module_components * int)) Tbl.t;
   mutable comp_classes: (string, (class_declaration * int)) Tbl.t;
@@ -137,13 +197,20 @@ and functor_components = {
   fcomp_cache: (Path.t, module_components) Hashtbl.t  (* For memoization *)
 }
 
+let lazy_Subst__modtype = EnvLazy.declare_maker "Subst_modtype"
+let lazy_components_of_module = EnvLazy.declare_maker "components_of_module_maker"
+
+let _ =
+  EnvLazy.register_maker lazy_Subst__modtype
+    (fun (subst, mty) -> Subst.modtype subst mty)
+
 let empty = {
   values = EnvTbl.empty; annotations = EnvTbl.empty; constrs = EnvTbl.empty;
-  labels = EnvTbl.empty; types = EnvTbl.empty; 
+  labels = EnvTbl.empty; types = EnvTbl.empty;
   constrs_by_path = EnvTbl.empty;
   modules = EnvTbl.empty; modtypes = EnvTbl.empty;
   components = EnvTbl.empty; classes = EnvTbl.empty;
-  cltypes = EnvTbl.empty; 
+  cltypes = EnvTbl.empty;
   summary = Env_empty; local_constraints = false; gadt_instances = [] }
 
 let diff_keys is_local tbl1 tbl2 =
@@ -306,7 +373,7 @@ let rec find_module_descr path env =
         else raise Not_found
       end
   | Pdot(p, s, pos) ->
-      begin match Lazy.force(find_module_descr p env) with
+      begin match EnvLazy.force(find_module_descr p env) with
         Structure_comps c ->
           let (descr, pos) = Tbl.find s c.comp_components in
           descr
@@ -314,7 +381,7 @@ let rec find_module_descr path env =
          raise Not_found
       end
   | Papply(p1, p2) ->
-      begin match Lazy.force(find_module_descr p1 env) with
+      begin match EnvLazy.force(find_module_descr p1 env) with
         Functor_comps f ->
           !components_of_functor_appl' f p1 p2
       | Structure_comps c ->
@@ -327,7 +394,7 @@ let find proj1 proj2 path env =
       let (p, data) = EnvTbl.find_same id (proj1 env)
       in data
   | Pdot(p, s, pos) ->
-      begin match Lazy.force(find_module_descr p env) with
+      begin match EnvLazy.force(find_module_descr p env) with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in data
       | Functor_comps f ->
@@ -395,9 +462,9 @@ let find_module path env =
         else raise Not_found
       end
   | Pdot(p, s, pos) ->
-      begin match Lazy.force (find_module_descr p env) with
+      begin match EnvLazy.force (find_module_descr p env) with
         Structure_comps c ->
-          let (data, pos) = Tbl.find s c.comp_modules in Lazy.force data
+          let (data, pos) = Tbl.find s c.comp_modules in EnvLazy.force data
       | Functor_comps f ->
           raise Not_found
       end
@@ -418,7 +485,7 @@ let rec lookup_module_descr lid env =
       end
   | Ldot(l, s) ->
       let (p, descr) = lookup_module_descr l env in
-      begin match Lazy.force descr with
+      begin match EnvLazy.force descr with
         Structure_comps c ->
           let (descr, pos) = Tbl.find s c.comp_components in
           (Pdot(p, s, pos), descr)
@@ -428,7 +495,7 @@ let rec lookup_module_descr lid env =
   | Lapply(l1, l2) ->
       let (p1, desc1) = lookup_module_descr l1 env in
       let (p2, mty2) = lookup_module l2 env in
-      begin match Lazy.force desc1 with
+      begin match EnvLazy.force desc1 with
         Functor_comps f ->
           !check_modtype_inclusion env mty2 p2 f.fcomp_arg;
           (Papply(p1, p2), !components_of_functor_appl' f p1 p2)
@@ -448,10 +515,10 @@ and lookup_module lid env =
       end
   | Ldot(l, s) ->
       let (p, descr) = lookup_module_descr l env in
-      begin match Lazy.force descr with
+      begin match EnvLazy.force descr with
         Structure_comps c ->
           let (data, pos) = Tbl.find s c.comp_modules in
-          (Pdot(p, s, pos), Lazy.force data)
+          (Pdot(p, s, pos), EnvLazy.force data)
       | Functor_comps f ->
           raise Not_found
       end
@@ -459,7 +526,7 @@ and lookup_module lid env =
       let (p1, desc1) = lookup_module_descr l1 env in
       let (p2, mty2) = lookup_module l2 env in
       let p = Papply(p1, p2) in
-      begin match Lazy.force desc1 with
+      begin match EnvLazy.force desc1 with
         Functor_comps f ->
           !check_modtype_inclusion env mty2 p2 f.fcomp_arg;
           (p, Subst.modtype (Subst.add_module f.fcomp_param p2 f.fcomp_subst)
@@ -474,7 +541,7 @@ let lookup proj1 proj2 lid env =
       EnvTbl.find_name s (proj1 env)
   | Ldot(l, s) ->
       let (p, desc) = lookup_module_descr l env in
-      begin match Lazy.force desc with
+      begin match EnvLazy.force desc with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in
           (Pdot(p, s, pos), data)
@@ -490,7 +557,7 @@ let lookup_simple proj1 proj2 lid env =
       EnvTbl.find_name s (proj1 env)
   | Ldot(l, s) ->
       let (p, desc) = lookup_module_descr l env in
-      begin match Lazy.force desc with
+      begin match EnvLazy.force desc with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in
           data
@@ -666,7 +733,7 @@ let rec scrape_modtype mty env =
 (* Compute constructor descriptions *)
 
 let constructors_of_type ty_path decl =
-  let handle_variants cstrs = 
+  let handle_variants cstrs =
     Datarepr.constructor_descrs
       (newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
       cstrs decl.type_private
@@ -727,11 +794,14 @@ let rec prefix_idents root pos sub = function
 (* Compute structure descriptions *)
 
 let rec components_of_module env sub path mty =
-  lazy(match scrape_modtype mty env with
+  EnvLazy.create lazy_components_of_module (env, sub, path, mty)
+
+and components_of_module_maker (env, sub, path, mty) =
+  (match scrape_modtype mty env with
     Tmty_signature sg ->
       let c =
         { comp_values = Tbl.empty; comp_annotations = Tbl.empty;
-          comp_constrs = Tbl.empty; 
+          comp_constrs = Tbl.empty;
           comp_labels = Tbl.empty; comp_types = Tbl.empty;
           comp_constrs_by_path = Tbl.empty;
           comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
@@ -760,7 +830,7 @@ let rec components_of_module env sub path mty =
               Tbl.add (Ident.name id) (decl', nopos) c.comp_types;
 	    let constructors = constructors_of_type path decl' in
 	    c.comp_constrs_by_path <-
-	      Tbl.add (Ident.name id) 
+	      Tbl.add (Ident.name id)
 		(List.map snd constructors, nopos) c.comp_constrs_by_path;
             List.iter
               (fun (name, descr) ->
@@ -779,7 +849,7 @@ let rec components_of_module env sub path mty =
               Tbl.add (Ident.name id) (cstr, !pos) c.comp_constrs;
             incr pos
         | Tsig_module(id, mty, _) ->
-            let mty' = lazy (Subst.modtype sub mty) in
+            let mty' = EnvLazy.create lazy_Subst__modtype (sub, mty) in
             c.comp_modules <-
               Tbl.add (Ident.name id) (mty', !pos) c.comp_modules;
             let comps = components_of_module !env sub path mty in
@@ -817,8 +887,8 @@ let rec components_of_module env sub path mty =
   | Tmty_ident p ->
         Structure_comps {
           comp_values = Tbl.empty; comp_annotations = Tbl.empty;
-          comp_constrs = Tbl.empty; 
-          comp_labels = Tbl.empty; 
+          comp_constrs = Tbl.empty;
+          comp_labels = Tbl.empty;
           comp_types = Tbl.empty; comp_constrs_by_path = Tbl.empty;
           comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
           comp_components = Tbl.empty; comp_classes = Tbl.empty;
@@ -878,11 +948,11 @@ and store_type id path info env =
       List.fold_right
         (fun (name, descr) constrs ->
           EnvTbl.add (Ident.create name) descr constrs)
-        constructors 
+        constructors
         env.constrs;
 
-    constrs_by_path = 
-      EnvTbl.add id 
+    constrs_by_path =
+      EnvTbl.add id
         (path,List.map snd constructors) env.constrs_by_path;
     labels =
       List.fold_right
@@ -964,7 +1034,8 @@ let components_of_functor_appl f p1 p2 =
 
 let _ =
   components_of_module' := components_of_module;
-  components_of_functor_appl' := components_of_functor_appl
+  components_of_functor_appl' := components_of_functor_appl;
+  EnvLazy.register_maker lazy_components_of_module components_of_module_maker
 
 (* Insertion of bindings by identifier *)