essai: dyn pattern

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

2 files changed, 42 insertions, 2 deletions

diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 42ce1b89a0..31801cd20b 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -78,11 +78,16 @@ let type_variable loc name =
   with Not_found ->
     raise(Error(loc, Unbound_type_variable ("'" ^ name)))
 
-type policy = Fixed | Extensible | Delayed
+type policy = Fixed | Extensible | Delayed 
+  (* GENERIC | DynamicPattern /GENERIC *)
 
 let rec transl_type env policy styp =
   match styp.ptyp_desc with
-    Ptyp_any -> Ctype.newvar ()
+    Ptyp_any -> 
+(* GENERIC
+      if policy <> DynamicPattern then Ctype.newvar () else new_global_var ()
+/GENERIC *)
+      Ctype.newvar ()
   | Ptyp_var name ->
       begin
         match policy with
@@ -100,6 +105,19 @@ let rec transl_type env policy styp =
               type_variables := Tbl.add name v !type_variables;
               v
             end
+(* GENERIC
+	| DynamicPattern ->
+	    let polymorphic = (name.[0] <> '_') in
+            begin try
+              Tbl.find name !type_variables
+            with Not_found ->
+              let v = 
+		if polymorphic then Ctype.newvar () else new_global_var () 
+	      in
+              type_variables := Tbl.add name v !type_variables;
+              v
+            end
+/GENERIC *)
         | Delayed ->
             begin try
               Tbl.find name !used_variables
@@ -359,6 +377,23 @@ let transl_type_scheme env styp =
   generalize typ;
   typ
 
+(* GENERIC
+let transl_type_scheme_pattern env styp =
+  (* temporary forget variable informations *)
+  let type_variables_away = !type_variables in
+  let saved_type_variables_away = !saved_type_variables in
+  type_variables := Tbl.empty;
+  saved_type_variables := [];
+  begin_def();
+  let typ = transl_type env DynamicPattern styp in
+  end_def();
+  generalize typ;
+  (* regain the variable informations *)
+  type_variables := type_variables_away;
+  saved_type_variables := saved_type_variables_away;
+  typ
+/GENERIC *)
+
 (* Error report *)
 
 open Format
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index 2543bfae75..265c7dd8fa 100644
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -24,6 +24,11 @@ val transl_simple_type_delayed:
            the type and a function that binds the type variable. *)
 val transl_type_scheme:
         Env.t -> Parsetree.core_type -> Types.type_expr
+(* GENERIC
+val transl_type_scheme_pattern:
+        Env.t -> Parsetree.core_type -> Types.type_expr
+        (* Used for dynamic value pattern *)
+/GENERIC *)
 val reset_type_variables: unit -> unit
 val enter_type_variable: bool -> string -> Types.type_expr
 val type_variable : Location.t -> string -> Types.type_expr