diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 2010-03-07 09:34:21 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 2010-03-07 09:34:21 +0000 |
| commit | 49113246e668d99d4b8302e9530034cb52f94ea6 (patch) | |
| tree | d56d28f10adb01fb7a6b18cd49f16282d3f3c9fc /typing/typemod.ml | |
| parent | c87be95c8dafbb0bbe9e911d7b6ae493aa8aa717 (diff) | |
| download | ocaml-moduletypeof.tar.gz | |
Experiment: module type ofmoduletypeof
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/moduletypeof@9637 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'typing/typemod.ml')
| -rw-r--r-- | typing/typemod.ml | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/typing/typemod.ml b/typing/typemod.ml index 8c590b4588..161dbc17dd 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -75,6 +75,11 @@ let rm node = Stypes.record (Stypes.Ti_mod node); node +(* Forward declaration, to be filled in by type_module_type_of *) +let type_module_type_of_fwd + : (Env.t -> Parsetree.module_expr -> module_type) ref + = ref (fun env m -> assert false) + (* Merge one "with" constraint in a signature *) let rec add_rec_types env = function @@ -179,6 +184,8 @@ let rec approx_modtype env smty = Tmty_functor(id, arg, res) | Pmty_with(sbody, constraints) -> approx_modtype env sbody + | Pmty_typeof smod -> + !type_module_type_of_fwd env smod and approx_sig env ssg = match ssg with @@ -297,6 +304,8 @@ let rec transl_modtype env smty = merge_constraint env smty.pmty_loc sg lid sdecl) init_sg constraints in Mtype.freshen (Tmty_signature final_sg) + | Pmty_typeof smod -> + !type_module_type_of_fwd env smod and transl_signature env sg = let type_names = ref StringSet.empty @@ -826,12 +835,20 @@ and type_structure funct_body anchor env sstr scope = let type_module = type_module false None let type_structure = type_structure false None -(* Fill in the forward declaration *) +let type_module_type_of env smod = + match smod.pmod_desc with + | Pmod_ident lid -> (* turn off strengthening in this case *) + let (path, mty) = type_module_path env smod.pmod_loc lid in mty + | _ -> + (type_module env smod).mod_type + +(* Fill in the forward declarations *) let () = Typecore.type_module := type_module; Typetexp.transl_modtype_longident := transl_modtype_longident; Typetexp.transl_modtype := transl_modtype; - Typecore.type_open := type_open + Typecore.type_open := type_open; + type_module_type_of_fwd := type_module_type_of (* Normalize types in a signature *) |