diff options
Diffstat (limited to 'ocaml-binary-annot/typing')
| -rw-r--r-- | ocaml-binary-annot/typing/env.ml | 20 | ||||
| -rw-r--r-- | ocaml-binary-annot/typing/typemod.ml | 11 | ||||
| -rw-r--r-- | ocaml-binary-annot/typing/typemod.mli | 2 |
3 files changed, 22 insertions, 11 deletions
diff --git a/ocaml-binary-annot/typing/env.ml b/ocaml-binary-annot/typing/env.ml index 4acd66c70f..6424de5144 100644 --- a/ocaml-binary-annot/typing/env.ml +++ b/ocaml-binary-annot/typing/env.ml @@ -54,18 +54,18 @@ be evaluated once per maker. *) | Thunk of string * Obj.t type ('a,'b) maker = string - + let makers = ref (StringMap.empty : (Obj.t -> Obj.t) StringMap.t) - let force (x : 'a t) = + let force (x : 'a t) = let x = (Obj.magic x : Obj.t t) in match !x with Done x -> (Obj.magic x : 'a) | Thunk (name, args) -> let maker = try - StringMap.find name !makers + StringMap.find name !makers with Not_found -> - raise (UnknownLazyMaker name) + raise (UnknownLazyMaker name) in let y = maker args in x := Done y; @@ -75,7 +75,7 @@ be evaluated once per maker. *) let create maker args = ref (Thunk (Obj.magic maker, Obj.magic args)) - let declare_maker name = + let declare_maker name = if name = "" then invalid_arg "Lazy.maker cannot by \"\""; Obj.magic name @@ -387,7 +387,7 @@ let find_module path env = | Pdot(p, s, pos) -> begin match Lazy.force (find_module_descr p env) with Structure_comps c -> - let (data, pos) = Tbl.find s c.comp_modules in + let (data, pos) = Tbl.find s c.comp_modules in Lazy.force data | Functor_comps f -> raise Not_found @@ -585,7 +585,7 @@ let rec path_subst_last path id = Pident _ -> Pident id | Pdot (p, name, pos) -> Pdot(p, Ident.name id, pos) | Papply (p1, p2) -> assert false - + (* Compute structure descriptions *) let rec components_of_module env sub path mty = @@ -890,6 +890,10 @@ let imported_units() = (* Save a signature to a file *) +(* Fabrice: when saving signatures, there is a substitution on type names to +replace the timestamp, probably to unify interfaces. What shall we do in +our case ? Keep the substitution for later use ? *) + let save_signature_with_imports sg modname filename imports = Btype.cleanup_abbrev (); Subst.reset_for_saving (); @@ -957,5 +961,5 @@ let report_error ppf = function import export "The compilation flag -rectypes is required" -let _ = +let _ = Lazy.register_maker lazy_components_of_module components_of_module_maker diff --git a/ocaml-binary-annot/typing/typemod.ml b/ocaml-binary-annot/typing/typemod.ml index b668e1e8e1..f67a21e635 100644 --- a/ocaml-binary-annot/typing/typemod.ml +++ b/ocaml-binary-annot/typing/typemod.ml @@ -1171,16 +1171,21 @@ let type_implementation sourcefile outputprefix modulename initial_env ast = end end +let save_signature tsg outputprefix = + if !Clflags.annotations then + let oc = open_out (outputprefix ^ ".cmti") in + output_value oc [| Saved_signature tsg |]; + close_out oc + let type_implementation sourcefile outputprefix modulename initial_env ast = try Typedtree.set_saved_types []; let (str, coercion) = type_implementation sourcefile outputprefix modulename initial_env ast in if !Clflags.annotations then begin Typedtree.set_saved_types []; - let oc = open_out (outputprefix ^ ".types") in + let oc = open_out (outputprefix ^ ".cmt") in output_value oc [| Saved_implementation str |]; close_out oc; - (* let oc = open_out (outputprefix ^ "_ast2src.ml") in let ppf = Format.formatter_of_out_channel oc in @@ -1199,7 +1204,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast = (str, coercion) with e -> if !Clflags.annotations then begin - let oc = open_out (outputprefix ^ ".types") in + let oc = open_out (outputprefix ^ ".cmt") in output_value oc (Array.of_list (Typedtree.get_saved_types ())); close_out oc; end; diff --git a/ocaml-binary-annot/typing/typemod.mli b/ocaml-binary-annot/typing/typemod.mli index d6f709209b..c86cf95e9c 100644 --- a/ocaml-binary-annot/typing/typemod.mli +++ b/ocaml-binary-annot/typing/typemod.mli @@ -32,6 +32,8 @@ val check_nongen_schemes: val simplify_signature: signature -> signature +val save_signature : Typedtree.signature -> string -> unit + val package_units: string list -> string -> string -> Typedtree.module_coercion |