fix PR#5674: move Texp_poly and Texp_newtype to exp_extra

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

2 files changed, 22 insertions, 22 deletions

diff --git a/tools/typedtreeIter.ml b/tools/typedtreeIter.ml
index 4af9a3a06..a4f45ec98 100644
--- a/tools/typedtreeIter.ml
+++ b/tools/typedtreeIter.ml
@@ -228,8 +228,11 @@ module MakeIterator(Iter : IteratorArgument) : sig
       Iter.enter_expression exp;
       List.iter (function (cstr, _) ->
         match cstr with
-            Texp_constraint (cty1, cty2) -> option iter_core_type cty1; option iter_core_type cty2
-        | Texp_open (path, _, _) -> ())
+          Texp_constraint (cty1, cty2) ->
+            option iter_core_type cty1; option iter_core_type cty2
+        | Texp_open (path, _, _) -> ()
+        | Texp_poly cto -> option iter_core_type cto
+        | Texp_newtype s -> ())
         exp.exp_extra;
       begin
         match exp.exp_desc with
@@ -322,11 +325,6 @@ module MakeIterator(Iter : IteratorArgument) : sig
             iter_class_structure cl
         | Texp_pack (mexpr) ->
             iter_module_expr mexpr
-        | Texp_poly (exp, None) -> iter_expression exp
-        | Texp_poly (exp, Some ct) ->
-            iter_expression exp; iter_core_type ct
-        | Texp_newtype (s, exp) ->
-            iter_expression exp
       end;
       Iter.leave_expression exp;
 
diff --git a/tools/untypeast.ml b/tools/untypeast.ml
index 7f44cff7f..eb9ffbaf1 100644
--- a/tools/untypeast.ml
+++ b/tools/untypeast.ml
@@ -176,15 +176,22 @@ and untype_pattern pat =
 
 and option f x = match x with None -> None | Some e -> Some (f e)
 
+and untype_extra (extra, loc) sexp =
+  let desc =
+    match extra with
+      Texp_constraint (cty1, cty2) ->
+        Pexp_constraint (sexp,
+                         option untype_core_type cty1,
+                         option untype_core_type cty2)
+    | Texp_open (path, lid, _) -> Pexp_open (lid, sexp)
+    | Texp_poly cto -> Pexp_poly (sexp, option untype_core_type cto)
+    | Texp_newtype s -> Pexp_newtype (s, sexp)
+  in
+  { pexp_desc = desc;
+    pexp_loc = loc }
+      
 and untype_expression exp =
   let desc =
-  match exp.exp_extra with
-      (Texp_constraint (cty1, cty2), _) :: rem ->
-        Pexp_constraint (untype_expression { exp with exp_extra = rem },
-                         option untype_core_type cty1, option untype_core_type cty2)
-    | (Texp_open (path, lid, _), _) :: rem ->
-        Pexp_open (lid, untype_expression { exp with exp_extra = rem} )
-    | [] ->
     match exp.exp_desc with
       Texp_ident (path, lid, _) -> Pexp_ident (lid)
     | Texp_constant cst -> Pexp_constant cst
@@ -279,15 +286,10 @@ and untype_expression exp =
         Pexp_object (untype_class_structure cl)
     | Texp_pack (mexpr) ->
         Pexp_pack (untype_module_expr mexpr)
-    | Texp_poly (exp, None) -> Pexp_poly(untype_expression exp, None)
-    | Texp_poly (exp, Some ct) ->
-        Pexp_poly (untype_expression exp, Some (untype_core_type ct))
-    | Texp_newtype (s, exp) ->
-        Pexp_newtype (s, untype_expression exp)
   in
-  { pexp_loc = exp.exp_loc;
-    pexp_desc = desc;
-  }
+  List.fold_right untype_extra exp.exp_extra
+    { pexp_loc = exp.exp_loc;
+      pexp_desc = desc }
 
 and untype_package_type pack =
   (pack.pack_txt,