Commits

camlspotter committed cf6a306

still fails to find typedecl in env

  • Participants
  • Parent commits fbe41a7
  • Branches ocamlspot

Comments (0)

Files changed (6)

ocamlspot/.depend

 command.cmi:
 pathreparse.cmi: spotapi.cmi ../typing/path.cmi
 spotapi.cmi: ../typing/types.cmi ../typing/typedtree.cmi ../typing/spot.cmi \
-    ../typing/path.cmi ../typing/ident.cmi
+    ../typing/path.cmi ../typing/ident.cmi ../typing/env.cmi
 spotconfig.cmi: spotconfig_intf.cmo
 spoteval.cmi: utils.cmi ../typing/types.cmi spotapi.cmi ../typing/path.cmi \
     ../typing/ident.cmi
 command.cmx: command.cmi
 dotfile.cmo:
 dotfile.cmx:
-ocamlspot.cmo: xmain.cmi utils.cmi spotfile.cmi spoteval.cmi spotconfig.cmi \
-    spotapi.cmi ../typing/printtyp.cmi pathreparse.cmi ../typing/path.cmi \
-    ../typing/ident.cmi ../typing/env.cmi command.cmi ../typing/annot.cmi
-ocamlspot.cmx: xmain.cmx utils.cmx spotfile.cmx spoteval.cmx spotconfig.cmx \
-    spotapi.cmx ../typing/printtyp.cmx pathreparse.cmx ../typing/path.cmx \
-    ../typing/ident.cmx ../typing/env.cmx command.cmx ../typing/annot.cmi
+ocamlspot.cmo: xmain.cmi utils.cmi typeexpand.cmi spotfile.cmi spoteval.cmi \
+    spotconfig.cmi spotapi.cmi ../typing/printtyp.cmi pathreparse.cmi \
+    ../typing/path.cmi ../typing/ident.cmi ../typing/env.cmi command.cmi \
+    ../typing/annot.cmi
+ocamlspot.cmx: xmain.cmx utils.cmx typeexpand.cmx spotfile.cmx spoteval.cmx \
+    spotconfig.cmx spotapi.cmx ../typing/printtyp.cmx pathreparse.cmx \
+    ../typing/path.cmx ../typing/ident.cmx ../typing/env.cmx command.cmx \
+    ../typing/annot.cmi
 pathreparse.cmo: utils.cmi spotapi.cmi ../typing/path.cmi ../typing/ident.cmi \
     pathreparse.cmi
 pathreparse.cmx: utils.cmx spotapi.cmx ../typing/path.cmx ../typing/ident.cmx \
     ../typing/env.cmx dotfile.cmx ../typing/annot.cmi spotfile.cmi
 treeset.cmo: xset.cmi treeset.cmi
 treeset.cmx: xset.cmx treeset.cmi
-typeexpand.cmo: ../typing/types.cmi ../typing/env.cmi ../typing/ctype.cmi \
-    typeexpand.cmi
-typeexpand.cmx: ../typing/types.cmx ../typing/env.cmx ../typing/ctype.cmx \
-    typeexpand.cmi
+typeexpand.cmo: utils.cmi ../typing/types.cmi ../typing/env.cmi \
+    ../typing/ctype.cmi typeexpand.cmi
+typeexpand.cmx: utils.cmx ../typing/types.cmx ../typing/env.cmx \
+    ../typing/ctype.cmx typeexpand.cmi
 utils.cmo: utils.cmi
 utils.cmx: utils.cmi
 xmain.cmo: ../typing/spot.cmi xmain.cmi

ocamlspot/ocamlspot.el

   (ocamlspot-message-init (buffer-file-name))
   (ocamlspot-type-init)
   (ocamlspot-delete-overlays-now)
-  (ocamlspot-query-at-cursor "-n")  
+  (ocamlspot-query-at-cursor "-n --show-typedecl")  
   (if (ocamlspot-find-tree)
       (save-current-buffer
         (ocamlspot-find-val-or-type to-kill)))

ocamlspot/tests/auto-test.pl

 	my $tested = 0;
 	my $succeed = 0;
 	if( -x "ocamlspot" ){
-	    open(IN, "../boot/ocamlrun -I ../stdlib/ -I ../otherlibs/unix/ ./ocamlspot $file:b$test_pos |");
+	    $command = "../boot/ocamlrun -I ../stdlib/ -I ../otherlibs/unix/ ./ocamlspot $file:b$test_pos";
 	} elsif( -x "../ocamlspot" )  {
-	    open(IN, "../../boot/ocamlrun -I ../../stdlib/ -I ../../otherlibs/unix/ ../ocamlspot $file:b$test_pos |");
+	    $command = "../../boot/ocamlrun -I ../../stdlib/ -I ../../otherlibs/unix/ ../ocamlspot $file:b$test_pos";
 	} else {
 	    print "no ocamlspot binary around\n";
 	    exit 1;
 	}
 
+	print STDERR "$command\n";
+	open(IN, "$command |");
+
 	$all_tests++;
 
 	while(<IN>){

ocamlspot/typeexpand.ml

           else fprintf ppf "%s" (if l.[0] = '?' then l else "~" ^ l)))
         label_typ_list
   | Tuple typs ->
-      fprintf ppf "(@[%a@])" (Format.list ", " (fun ppf _ -> fprintf ppf "_")) typs
+      fprintf ppf "(@[%a@])" (Format.list ", " (fun ppf _ -> fprintf ppf "assert false")) typs
   | Variant args ->
-      fprintf ppf "assert false (* @[%a@] *)" 
+      fprintf ppf "(assert false (* @[%a@] *))" 
         (Format.list "| " (fun ppf -> 
           function
             | (name, []) -> fprintf ppf "%s" name
           fprintf ppf "%s = assert false" l)) 
         label_typ_list
   | Polyvar l_field_list ->
-      fprintf ppf "assert false (* @[%a@] | ... *)" 
+      fprintf ppf "(assert false (* @[%a@] | ... *))" 
         (Format.list "| " (fun ppf (name, row_field) -> 
           match row_field with
           | Rabsent | Rpresent None -> fprintf ppf "`%s" name
           | Reither (false, _, true, { contents = Some _ }) -> fprintf ppf "`%s (assert false)" name
           | Reither (false, _, false, _) -> fprintf ppf "`%s (* ??? *)" name))
         l_field_list
-  | Abstract -> fprintf ppf "assert false (* abstract *)"
+  | Abstract -> fprintf ppf "(assert false (* abstract *))"
+
+let format_as_pattern ppf = function
+  | Function (_label_typ_list, _) -> fprintf ppf "_ (* function *)"
+  | Tuple typs ->
+      fprintf ppf "(@[%a@])" (Format.list ", " (fun ppf _ -> fprintf ppf "_")) typs
+  | Variant args ->
+      fprintf ppf "( @[%a@] )" 
+        (Format.list "| " (fun ppf -> 
+          function
+            | (name, []) -> fprintf ppf "%s" name
+            | (name, args) -> 
+                fprintf ppf "%s (@[%a@])"
+                  name
+                  (Format.list ", " (fun ppf _ -> fprintf ppf "_" )) args))
+        args
+  | Record label_typ_list -> 
+      fprintf ppf "{ @[%a@] }"
+        (Format.list "; " (fun ppf (l, _ty) ->
+          fprintf ppf "%s = _" l)) 
+        label_typ_list
+  | Polyvar l_field_list ->
+      fprintf ppf "(@[%a@] | ... )" 
+        (Format.list "| " (fun ppf (name, row_field) -> 
+          match row_field with
+          | Rabsent | Rpresent None -> fprintf ppf "`%s" name
+          | Rpresent (Some _) -> fprintf ppf "`%s _" name
+          (* CR jfuruse: not sure... *)
+          | Reither (true, [], _, _) -> fprintf ppf "`%s" name
+          | Reither (true, _, _, _) -> fprintf ppf "`%s _" name
+          | Reither (false, _, true, { contents = None }) -> fprintf ppf "`%s" name
+          | Reither (false, _, true, { contents = Some _ }) -> fprintf ppf "`%s _" name
+          | Reither (false, _, false, _) -> fprintf ppf "`%s (* ??? *)" name))
+        l_field_list
+  | Abstract -> fprintf ppf "_ (* abstract *)"
 
 let rec expand env typ = 
   match (Ctype.repr typ).desc with
             | None -> Abstract
             | Some typ -> expand env typ
       with
-      | Not_found -> Abstract (* pity *)
+      | Not_found -> prerr_endline "NOTFOUND"; Abstract (* pity *)
       end
   | Tvariant row_desc -> Polyvar row_desc.row_fields
   | Tpoly (typ, _) -> expand env typ (* CR jfuruse: ? *)

ocamlspot/typeexpand.mli

 val expand : Env.t -> type_expr -> t
 
 val format_as_expr : Format.formatter -> t -> unit
+val format_as_pattern : Format.formatter -> t -> unit
   | Env_cltype of summary * Ident.t * cltype_declaration
   | Env_open of summary * Path.t
 
+module XLazy : sig 
+  type ('param, 'result) t
+  val create : 'param -> ('param, 'result) t
+  val create_from_result : 'result -> ('param, 'result) t
+  val force : ('param -> 'result) -> ('param, 'result) t -> 'result
+end = struct
+  type ('param, 'result) desc = 
+    | Done of 'result
+    | Not_yet of 'param
+    | Exception of exn
+  type ('param, 'result) t = ('param, 'result) desc ref
+  let create param = ref (Not_yet param)
+  let create_from_result result = ref (Done result)
+  let force compute = function
+    | { contents = Done res } -> res
+    | { contents = Exception exn } -> raise exn
+    | ({ contents = Not_yet param } as t) ->
+        try
+          let res = compute param in
+          t := Done res;
+          res
+        with
+        | exn -> 
+            t := Exception exn;
+            raise exn
+end
+
 type t = {
   values: (Path.t * value_description) Ident.tbl;
   annotations: (Path.t * Annot.ident) Ident.tbl;
   summary: summary
 }
 
-and module_components = module_components_repr Lazy.t
+and module_components = (t * Subst.t * Path.t * Types.module_type,
+                         module_components_repr) XLazy.t
 
 and module_components_repr =
     Structure_comps of structure_components
   mutable comp_constrs: (string, (constructor_description * int)) Tbl.t;
   mutable comp_labels: (string, (label_description * 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, ((Subst.t * module_type, module_type) XLazy.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;
 (* Forward declarations *)
 
 let components_of_module' =
-  ref ((fun env sub path mty -> assert false) :
-          t -> Subst.t -> Path.t -> module_type -> module_components)
+  ref ((fun (env, sub, path, mty) -> assert false) :
+          (t * Subst.t * Path.t * module_type) -> module_components)
 let components_of_functor_appl' =
   ref ((fun f p1 p2 -> assert false) :
           functor_components -> Path.t -> Path.t -> module_components)
   ref ((fun env mty1 path1 mty2 -> assert false) :
           t -> module_type -> Path.t -> module_type -> unit)
 
+let force_components_of_module' = ref (fun _ -> assert false : module_components -> module_components_repr)
+let force_subst_modtype' = ref (fun _ -> assert false : (Subst.t * module_type, module_type) XLazy.t -> module_type)
+
 (* The name of the compilation unit currently compiled.
    "" if outside a compilation unit. *)
 
     let flags = input_value ic in
     close_in ic;
     let comps =
-      !components_of_module' empty Subst.identity
-                             (Pident(Ident.create_persistent name))
-                             (Tmty_signature sign) in
+      !components_of_module' (empty, Subst.identity,
+                              (Pident(Ident.create_persistent name)),
+                              (Tmty_signature sign)) in
     let ps = { ps_name = name;
                ps_sig = sign;
                ps_comps = comps;
         else raise Not_found
       end
   | Pdot(p, s, pos) ->
-      begin match Lazy.force(find_module_descr p env) with
+      begin match !force_components_of_module'(find_module_descr p env) with
         Structure_comps c ->
           let (descr, pos) = Tbl.find s c.comp_components in
           descr
          raise Not_found
       end
   | Papply(p1, p2) ->
-      begin match Lazy.force(find_module_descr p1 env) with
+      begin match !force_components_of_module'(find_module_descr p1 env) with
         Functor_comps f ->
           !components_of_functor_appl' f p1 p2
       | Structure_comps c ->
       let (p, data) = Ident.find_same id (proj1 env)
       in data
   | Pdot(p, s, pos) ->
-      begin match Lazy.force(find_module_descr p env) with
+      begin match !force_components_of_module'(find_module_descr p env) with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in data
       | Functor_comps f ->
         else raise Not_found
       end
   | Pdot(p, s, pos) ->
-      begin match Lazy.force (find_module_descr p env) with
+      begin match !force_components_of_module' (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 !force_subst_modtype' data
       | Functor_comps f ->
           raise Not_found
       end
       end
   | Ldot(l, s) ->
       let (p, descr) = lookup_module_descr l env in
-      begin match Lazy.force descr with
+      begin match !force_components_of_module' descr with
         Structure_comps c ->
           let (descr, pos) = Tbl.find s c.comp_components in
           (Pdot(p, s, pos), descr)
   | 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 !force_components_of_module' desc1 with
         Functor_comps f ->
           !check_modtype_inclusion env mty2 p2 f.fcomp_arg;
           (Papply(p1, p2), !components_of_functor_appl' f p1 p2)
       end
   | Ldot(l, s) ->
       let (p, descr) = lookup_module_descr l env in
-      begin match Lazy.force descr with
+      begin match !force_components_of_module' 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), !force_subst_modtype' data)
       | Functor_comps f ->
           raise Not_found
       end
       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 !force_components_of_module' 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)
       Ident.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 !force_components_of_module' desc with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in
           (Pdot(p, s, pos), data)
       Ident.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 !force_components_of_module' desc with
         Structure_comps c ->
           let (data, pos) = Tbl.find s (proj2 c) in
           data
 
 (* Compute structure descriptions *)
 
-let rec components_of_module env sub path mty =
-  lazy(match scrape_modtype mty env with
-    Tmty_signature sg ->
-      let c =
-        { comp_values = Tbl.empty; comp_annotations = Tbl.empty;
-          comp_constrs = Tbl.empty;
-          comp_labels = Tbl.empty; comp_types = Tbl.empty;
-          comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
-          comp_components = Tbl.empty; comp_classes = Tbl.empty;
-          comp_cltypes = Tbl.empty } in
-      let (pl, sub) = prefix_idents path 0 sub sg in
-      let env = ref env in
-      let pos = ref 0 in
-      List.iter2 (fun item path ->
-        match item with
-          Tsig_value(id, decl) ->
-            let decl' = Subst.value_description sub decl in
-            c.comp_values <-
-              Tbl.add (Ident.name id) (decl', !pos) c.comp_values;
-            if !Clflags.annotations then begin
-              c.comp_annotations <-
-                Tbl.add (Ident.name id) (Annot.Iref_external, !pos)
-                        c.comp_annotations;
-            end;
-            begin match decl.val_kind with
-              Val_prim _ -> () | _ -> incr pos
-            end
-        | Tsig_type(id, decl, _) ->
-            let decl' = Subst.type_declaration sub decl in
-            c.comp_types <-
-              Tbl.add (Ident.name id) (decl', nopos) c.comp_types;
-            List.iter
-              (fun (name, descr) ->
-                c.comp_constrs <- Tbl.add name (descr, nopos) c.comp_constrs)
-              (constructors_of_type path decl');
-            List.iter
-              (fun (name, descr) ->
-                c.comp_labels <- Tbl.add name (descr, nopos) c.comp_labels)
-              (labels_of_type path decl');
-            env := store_type_infos id path decl !env
-        | Tsig_exception(id, decl) ->
-            let decl' = Subst.exception_declaration sub decl in
-            let cstr = Datarepr.exception_descr path decl' in
-            c.comp_constrs <-
-              Tbl.add (Ident.name id) (cstr, !pos) c.comp_constrs;
-            incr pos
-        | Tsig_module(id, mty, _) ->
-            let mty' = 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
-            c.comp_components <-
-              Tbl.add (Ident.name id) (comps, !pos) c.comp_components;
-            env := store_module id path mty !env;
-            incr pos
-        | Tsig_modtype(id, decl) ->
-            let decl' = Subst.modtype_declaration sub decl in
-            c.comp_modtypes <-
-              Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes;
-            env := store_modtype id path decl !env
-        | Tsig_class(id, decl, _) ->
-            let decl' = Subst.class_declaration sub decl in
-            c.comp_classes <-
-              Tbl.add (Ident.name id) (decl', !pos) c.comp_classes;
-            incr pos
-        | Tsig_cltype(id, decl, _) ->
-            let decl' = Subst.cltype_declaration sub decl in
-            c.comp_cltypes <-
-              Tbl.add (Ident.name id) (decl', !pos) c.comp_cltypes)
-        sg pl;
-        Structure_comps c
-  | Tmty_functor(param, ty_arg, ty_res) ->
-        Functor_comps {
-          fcomp_param = param;
-          (* fcomp_arg must be prefixed eagerly, because it is interpreted
-             in the outer environment, not in env *)
-          fcomp_arg = Subst.modtype sub ty_arg;
-          (* fcomp_res is prefixed lazily, because it is interpreted in env *)
-          fcomp_res = ty_res;
-          fcomp_env = env;
-          fcomp_subst = sub;
-          fcomp_cache = Hashtbl.create 17 }
-  | Tmty_ident p ->
-        Structure_comps {
-          comp_values = Tbl.empty; comp_annotations = Tbl.empty;
-          comp_constrs = Tbl.empty;
-          comp_labels = Tbl.empty; comp_types = Tbl.empty;
-          comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
-          comp_components = Tbl.empty; comp_classes = Tbl.empty;
-          comp_cltypes = Tbl.empty })
+let components_of_module env sub path mty : module_components = XLazy.create (env, sub, path, mty)
 
 (* Insertion of bindings by identifier + path *)
 
-and store_value id path decl env =
+let rec store_value id path decl env =
   { env with
     values = Ident.add id (path, decl) env.values;
     summary = Env_value(env.summary, id, decl) }
     cltypes = Ident.add id (path, desc) env.cltypes;
     summary = Env_cltype(env.summary, id, desc) }
 
+let force_components_of_module = XLazy.force (fun (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_labels = Tbl.empty; comp_types = Tbl.empty;
+          comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
+          comp_components = Tbl.empty; comp_classes = Tbl.empty;
+          comp_cltypes = Tbl.empty } in
+      let (pl, sub) = prefix_idents path 0 sub sg in
+      let env = ref env in
+      let pos = ref 0 in
+      List.iter2 (fun item path ->
+        match item with
+          Tsig_value(id, decl) ->
+            let decl' = Subst.value_description sub decl in
+            c.comp_values <-
+              Tbl.add (Ident.name id) (decl', !pos) c.comp_values;
+            if !Clflags.annotations then begin
+              c.comp_annotations <-
+                Tbl.add (Ident.name id) (Annot.Iref_external, !pos)
+                        c.comp_annotations;
+            end;
+            begin match decl.val_kind with
+              Val_prim _ -> () | _ -> incr pos
+            end
+        | Tsig_type(id, decl, _) ->
+            let decl' = Subst.type_declaration sub decl in
+            c.comp_types <-
+              Tbl.add (Ident.name id) (decl', nopos) c.comp_types;
+            List.iter
+              (fun (name, descr) ->
+                c.comp_constrs <- Tbl.add name (descr, nopos) c.comp_constrs)
+              (constructors_of_type path decl');
+            List.iter
+              (fun (name, descr) ->
+                c.comp_labels <- Tbl.add name (descr, nopos) c.comp_labels)
+              (labels_of_type path decl');
+            env := store_type_infos id path decl !env
+        | Tsig_exception(id, decl) ->
+            let decl' = Subst.exception_declaration sub decl in
+            let cstr = Datarepr.exception_descr path decl' in
+            c.comp_constrs <-
+              Tbl.add (Ident.name id) (cstr, !pos) c.comp_constrs;
+            incr pos
+        | Tsig_module(id, mty, _) ->
+            let mty' = XLazy.create (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
+            c.comp_components <-
+              Tbl.add (Ident.name id) (comps, !pos) c.comp_components;
+            env := store_module id path mty !env;
+            incr pos
+        | Tsig_modtype(id, decl) ->
+            let decl' = Subst.modtype_declaration sub decl in
+            c.comp_modtypes <-
+              Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes;
+            env := store_modtype id path decl !env
+        | Tsig_class(id, decl, _) ->
+            let decl' = Subst.class_declaration sub decl in
+            c.comp_classes <-
+              Tbl.add (Ident.name id) (decl', !pos) c.comp_classes;
+            incr pos
+        | Tsig_cltype(id, decl, _) ->
+            let decl' = Subst.cltype_declaration sub decl in
+            c.comp_cltypes <-
+              Tbl.add (Ident.name id) (decl', !pos) c.comp_cltypes)
+        sg pl;
+        Structure_comps c
+  | Tmty_functor(param, ty_arg, ty_res) ->
+        Functor_comps {
+          fcomp_param = param;
+          (* fcomp_arg must be prefixed eagerly, because it is interpreted
+             in the outer environment, not in env *)
+          fcomp_arg = Subst.modtype sub ty_arg;
+          (* fcomp_res is prefixed lazily, because it is interpreted in env *)
+          fcomp_res = ty_res;
+          fcomp_env = env;
+          fcomp_subst = sub;
+          fcomp_cache = Hashtbl.create 17 }
+  | Tmty_ident p ->
+        Structure_comps {
+          comp_values = Tbl.empty; comp_annotations = Tbl.empty;
+          comp_constrs = Tbl.empty;
+          comp_labels = Tbl.empty; comp_types = Tbl.empty;
+          comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
+          comp_components = Tbl.empty; comp_classes = Tbl.empty;
+          comp_cltypes = Tbl.empty })
+
 (* Compute the components of a functor application in a path. *)
 
 let components_of_functor_appl f p1 p2 =
 (* Define forward functions *)
 
 let _ =
-  components_of_module' := components_of_module;
-  components_of_functor_appl' := components_of_functor_appl
+  components_of_module' := (fun (x,y,z,w) -> components_of_module x y z w);
+  components_of_functor_appl' := components_of_functor_appl;
+  force_components_of_module' := force_components_of_module;
+  force_subst_modtype' := XLazy.force (fun (sub, mty) -> Subst.modtype sub mty)
 
 (* Insertion of bindings by identifier *)