Replace TypedtreeMap with a more standard open-recursion iterator Tas…

…t_mapper. Keep TypedtreeMap/Iter for now, for external projects.

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

.depend

@@ -121,6 +121,8 @@ typing/printtyped.cmi : typing/typedtree.cmi
 typing/stypes.cmi : typing/typedtree.cmi parsing/location.cmi \
     typing/annot.cmi
 typing/subst.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi
+typing/tast_mapper.cmi : typing/typedtree.cmi typing/env.cmi \
+    parsing/asttypes.cmi
 typing/typeclass.cmi : typing/types.cmi typing/typedtree.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
     typing/ident.cmi typing/env.cmi typing/ctype.cmi parsing/asttypes.cmi
@@ -153,12 +155,12 @@ typing/cmi_format.cmo : typing/types.cmi parsing/location.cmi \
     utils/config.cmi typing/cmi_format.cmi
 typing/cmi_format.cmx : typing/types.cmx parsing/location.cmx \
     utils/config.cmx typing/cmi_format.cmi
-typing/cmt_format.cmo : typing/types.cmi typing/typedtreeMap.cmi \
-    typing/typedtree.cmi utils/misc.cmi parsing/location.cmi \
+typing/cmt_format.cmo : typing/types.cmi typing/typedtree.cmi \
+    typing/tast_mapper.cmi utils/misc.cmi parsing/location.cmi \
     parsing/lexer.cmi typing/env.cmi utils/config.cmi typing/cmi_format.cmi \
     utils/clflags.cmi typing/cmt_format.cmi
-typing/cmt_format.cmx : typing/types.cmx typing/typedtreeMap.cmx \
-    typing/typedtree.cmx utils/misc.cmx parsing/location.cmx \
+typing/cmt_format.cmx : typing/types.cmx typing/typedtree.cmx \
+    typing/tast_mapper.cmx utils/misc.cmx parsing/location.cmx \
     parsing/lexer.cmx typing/env.cmx utils/config.cmx typing/cmi_format.cmx \
     utils/clflags.cmx typing/cmt_format.cmi
 typing/ctype.cmo : typing/types.cmi typing/subst.cmi typing/path.cmi \
@@ -193,6 +195,8 @@ typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \
 typing/envaux.cmx : typing/types.cmx typing/subst.cmx typing/printtyp.cmx \
     typing/path.cmx utils/misc.cmx typing/ident.cmx typing/env.cmx \
     parsing/asttypes.cmi typing/envaux.cmi
+typing/foo.cmo : parsing/asttypes.cmi
+typing/foo.cmx : parsing/asttypes.cmi
 typing/ident.cmo : typing/ident.cmi
 typing/ident.cmx : typing/ident.cmi
 typing/includeclass.cmo : typing/types.cmi typing/printtyp.cmi \
@@ -279,6 +283,10 @@ typing/subst.cmo : typing/types.cmi utils/tbl.cmi typing/path.cmi \
 typing/subst.cmx : typing/types.cmx utils/tbl.cmx typing/path.cmx \
     utils/misc.cmx parsing/location.cmx typing/ident.cmx utils/clflags.cmx \
     typing/btype.cmx parsing/ast_mapper.cmx typing/subst.cmi
+typing/tast_mapper.cmo : typing/typedtree.cmi typing/env.cmi \
+    parsing/asttypes.cmi typing/tast_mapper.cmi
+typing/tast_mapper.cmx : typing/typedtree.cmx typing/env.cmx \
+    parsing/asttypes.cmi typing/tast_mapper.cmi
 typing/typeclass.cmo : utils/warnings.cmi typing/typetexp.cmi \
     typing/types.cmi typing/typedtree.cmi typing/typedecl.cmi \
     typing/typecore.cmi parsing/syntaxerr.cmi typing/subst.cmi \
@@ -974,13 +982,15 @@ toplevel/expunge.cmo : bytecomp/symtable.cmi bytecomp/runtimedef.cmi \
 toplevel/expunge.cmx : bytecomp/symtable.cmx bytecomp/runtimedef.cmx \
     utils/misc.cmx typing/ident.cmx bytecomp/bytesections.cmx
 toplevel/genprintval.cmo : typing/types.cmi typing/printtyp.cmi \
-    typing/predef.cmi typing/path.cmi typing/outcometree.cmi utils/misc.cmi \
-    parsing/longident.cmi typing/ident.cmi typing/env.cmi typing/datarepr.cmi \
-    typing/ctype.cmi typing/btype.cmi toplevel/genprintval.cmi
+    typing/predef.cmi typing/path.cmi typing/outcometree.cmi \
+    typing/oprint.cmi utils/misc.cmi parsing/longident.cmi typing/ident.cmi \
+    typing/env.cmi typing/datarepr.cmi typing/ctype.cmi typing/btype.cmi \
+    toplevel/genprintval.cmi
 toplevel/genprintval.cmx : typing/types.cmx typing/printtyp.cmx \
-    typing/predef.cmx typing/path.cmx typing/outcometree.cmi utils/misc.cmx \
-    parsing/longident.cmx typing/ident.cmx typing/env.cmx typing/datarepr.cmx \
-    typing/ctype.cmx typing/btype.cmx toplevel/genprintval.cmi
+    typing/predef.cmx typing/path.cmx typing/outcometree.cmi \
+    typing/oprint.cmx utils/misc.cmx parsing/longident.cmx typing/ident.cmx \
+    typing/env.cmx typing/datarepr.cmx typing/ctype.cmx typing/btype.cmx \
+    toplevel/genprintval.cmi
 toplevel/opttopdirs.cmo : utils/warnings.cmi typing/types.cmi \
     typing/printtyp.cmi toplevel/opttoploop.cmi utils/misc.cmi \
     parsing/longident.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
@@ -1032,15 +1042,17 @@ toplevel/topdirs.cmo : utils/warnings.cmi typing/typetexp.cmi \
     bytecomp/meta.cmi parsing/longident.cmi parsing/location.cmi \
     typing/ident.cmi typing/env.cmi bytecomp/dll.cmi typing/ctype.cmi \
     utils/consistbl.cmi utils/config.cmi bytecomp/cmo_format.cmi \
-    utils/clflags.cmi parsing/asttypes.cmi toplevel/topdirs.cmi
+    utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
+    toplevel/topdirs.cmi
 toplevel/topdirs.cmx : utils/warnings.cmx typing/typetexp.cmx \
     typing/types.cmx toplevel/trace.cmx toplevel/toploop.cmx \
     bytecomp/symtable.cmx typing/printtyp.cmx typing/predef.cmx \
     typing/path.cmx parsing/parsetree.cmi bytecomp/opcodes.cmx utils/misc.cmx \
     bytecomp/meta.cmx parsing/longident.cmx parsing/location.cmx \
     typing/ident.cmx typing/env.cmx bytecomp/dll.cmx typing/ctype.cmx \
     utils/consistbl.cmx utils/config.cmx bytecomp/cmo_format.cmi \
-    utils/clflags.cmx parsing/asttypes.cmi toplevel/topdirs.cmi
+    utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
+    toplevel/topdirs.cmi
 toplevel/toploop.cmo : utils/warnings.cmi typing/types.cmi \
     typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \
     bytecomp/translmod.cmi bytecomp/symtable.cmi bytecomp/simplif.cmi \

Makefile

@@ -57,7 +57,9 @@ TYPING=typing/ident.cmo typing/path.cmo \
   typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \
   typing/printtyp.cmo typing/includeclass.cmo \
   typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \
-  typing/typedtreeIter.cmo typing/typedtreeMap.cmo typing/cmt_format.cmo \
+  typing/typedtreeIter.cmo typing/typedtreeMap.cmo \
+  typing/tast_mapper.cmo \
+  typing/cmt_format.cmo \
   typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \
   typing/stypes.cmo typing/typecore.cmo \
   typing/typedecl.cmo typing/typeclass.cmo \

Makefile.nt

@@ -53,7 +53,9 @@ TYPING=typing/ident.cmo typing/path.cmo \
   typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \
   typing/printtyp.cmo typing/includeclass.cmo \
   typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \
-  typing/typedtreeIter.cmo typing/typedtreeMap.cmo typing/cmt_format.cmo \
+  typing/typedtreeIter.cmo typing/typedtreeMap.cmo \
+  typing/tast_mapper.cmo \
+  typing/cmt_format.cmo \
   typing/includemod.cmo typing/typetexp.cmo typing/parmatch.cmo \
   typing/stypes.cmo typing/typecore.cmo \
   typing/typedecl.cmo typing/typeclass.cmo \

tools/Makefile.shared

@@ -225,8 +225,7 @@ READ_CMT= \
           ../typing/printtyp.cmo \
           ../typing/mtype.cmo \
           ../typing/envaux.cmo \
-          ../typing/typedtreeMap.cmo \
-          ../typing/typedtreeIter.cmo \
+          ../typing/tast_mapper.cmo \
           ../typing/cmt_format.cmo \
           ../typing/stypes.cmo \
           \

typing/cmt_format.ml

@@ -68,89 +68,36 @@ let need_to_clear_env =
 
 let keep_only_summary = Env.keep_only_summary
 
-module ClearEnv  = TypedtreeMap.MakeMap (struct
-  open TypedtreeMap
-  include DefaultMapArgument
+open Tast_mapper
 
-  let leave_pattern p = { p with pat_env = keep_only_summary p.pat_env }
-  let leave_expression e =
-    let exp_extra = List.map (function
-        (Texp_open (ovf, path, lloc, env), loc, attrs) ->
-          (Texp_open (ovf, path, lloc, keep_only_summary env), loc, attrs)
-      | exp_extra -> exp_extra) e.exp_extra in
-    { e with
-      exp_env = keep_only_summary e.exp_env;
-      exp_extra = exp_extra }
-  let leave_class_expr c =
-    { c with cl_env = keep_only_summary c.cl_env }
-  let leave_module_expr m =
-    let rec module_coercion = function
-      | Tcoerce_none -> Tcoerce_none
-      | Tcoerce_functor (c1,c2) ->
-          Tcoerce_functor (module_coercion c1, module_coercion c2)
-      | Tcoerce_alias (p, c1) ->
-          Tcoerce_alias (p, module_coercion c1)
-      | Tcoerce_structure (l1, l2) ->
-          let l1' = List.map (fun (i,c) -> i, module_coercion c) l1 in
-          let l2' = List.map (fun (id,i,c) -> id, i, module_coercion c) l2 in
-          Tcoerce_structure (l1', l2')
-      | Tcoerce_primitive pc ->
-          Tcoerce_primitive {pc with pc_env = keep_only_summary pc.pc_env}
-    in
-    let module_expr_desc = function
-        Tmod_ident _ | Tmod_structure _ | Tmod_functor _ | Tmod_unpack _ as me
-        -> me
-      | Tmod_apply (me1,me2,mc) -> Tmod_apply (me1, me2, module_coercion mc)
-      | Tmod_constraint (me, mty, mtyc, mc) ->
-          Tmod_constraint (me, mty, mtyc, module_coercion mc)
-    in
-    { m with mod_desc = module_expr_desc m.mod_desc;
-             mod_env = keep_only_summary m.mod_env }
-  let leave_structure s =
-    { s with str_final_env = keep_only_summary s.str_final_env }
-  let leave_structure_item str =
-    { str with str_env = keep_only_summary str.str_env }
-  let leave_module_type m =
-    { m with mty_env = keep_only_summary m.mty_env }
-  let leave_signature s =
-    { s with sig_final_env = keep_only_summary s.sig_final_env }
-  let leave_signature_item s =
-    { s with sig_env = keep_only_summary s.sig_env }
-  let leave_core_type c =
-    { c with ctyp_env = keep_only_summary c.ctyp_env }
-  let leave_class_type c =
-    { c with cltyp_env = keep_only_summary c.cltyp_env }
-
-end)
+let cenv =
+  {Tast_mapper.default with env = fun _sub env -> keep_only_summary env}
 
-let clear_part p = match p with
-  | Partial_structure s -> Partial_structure (ClearEnv.map_structure s)
+let clear_part = function
+  | Partial_structure s -> Partial_structure (cenv.structure cenv s)
   | Partial_structure_item s ->
-    Partial_structure_item (ClearEnv.map_structure_item s)
-  | Partial_expression e -> Partial_expression (ClearEnv.map_expression e)
-  | Partial_pattern p -> Partial_pattern (ClearEnv.map_pattern p)
-  | Partial_class_expr ce -> Partial_class_expr (ClearEnv.map_class_expr ce)
-  | Partial_signature s -> Partial_signature (ClearEnv.map_signature s)
+      Partial_structure_item (cenv.structure_item cenv s)
+  | Partial_expression e -> Partial_expression (cenv.expr cenv e)
+  | Partial_pattern p -> Partial_pattern (cenv.pat cenv p)
+  | Partial_class_expr ce -> Partial_class_expr (cenv.class_expr cenv ce)
+  | Partial_signature s -> Partial_signature (cenv.signature cenv s)
   | Partial_signature_item s ->
-    Partial_signature_item (ClearEnv.map_signature_item s)
-  | Partial_module_type s -> Partial_module_type (ClearEnv.map_module_type s)
+      Partial_signature_item (cenv.signature_item cenv s)
+  | Partial_module_type s -> Partial_module_type (cenv.module_type cenv s)
 
 let clear_env binary_annots =
   if need_to_clear_env then
     match binary_annots with
-      | Implementation s -> Implementation (ClearEnv.map_structure s)
-      | Interface s -> Interface (ClearEnv.map_signature s)
-      | Packed _ -> binary_annots
-      | Partial_implementation array ->
+    | Implementation s -> Implementation (cenv.structure cenv s)
+    | Interface s -> Interface (cenv.signature cenv s)
+    | Packed _ -> binary_annots
+    | Partial_implementation array ->
         Partial_implementation (Array.map clear_part array)
-      | Partial_interface array ->
+    | Partial_interface array ->
         Partial_interface (Array.map clear_part array)
 
   else binary_annots
 
-
-
-
 exception Error of error
 
 let input_cmt ic = (input_value ic : cmt_infos)