local_constraint flag now works

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

typing/ctype.ml

@@ -1619,7 +1619,7 @@ let reify env t =
 	let name = get_new_abstract_name () in 
 	if row then name ^ "#row" else name
       in
-      let (id, new_env) = Env.enter_local_constraint name decl !env in    
+      let (id, new_env) = Env.enter_type name decl !env in    
       let t = newty2 pattern_level (Tconstr (Path.Pident id,[],ref Mnil))  in 
       env := new_env;
       t
@@ -2046,7 +2046,7 @@ and unify3 mode env t1 t1' t2 t2' =
 		p',t1
 	    in
 	    let decl = new_declaration true (Some destination) in 
-	    env := Env.add_type source decl !env
+	    env := Env.add_local_constraint source decl !env
 	| Tconstr ((Path.Pident p) as path,[],_), _  when is_abstract_newtype !env path && mode = Pattern -> 
 	    reify env t2 ;
 	    local_non_recursive_abbrev !env (Path.Pident p) t2;
@@ -2055,7 +2055,7 @@ and unify3 mode env t1 t1' t2 t2' =
 	    end_def ();
 	    generalize t2 ;
 	    let decl = new_declaration true (Some t2) in
-            env := Env.add_type p decl !env 
+            env := Env.add_local_constraint p decl !env 
 	| _, Tconstr ((Path.Pident p) as path,[],_) when is_abstract_newtype !env path && mode = Pattern -> 
 	    reify env t1 ;
 	    local_non_recursive_abbrev !env (Path.Pident p) t1;
@@ -2063,9 +2063,8 @@ and unify3 mode env t1 t1' t2 t2' =
 	    let t1 = duplicate_type t1 in
 	    end_def ();
 	    generalize t1 ;
-	    
 	    let decl = new_declaration true (Some t1) in
-            env := Env.add_type p decl !env 
+            env := Env.add_local_constraint p decl !env 
 	| Tconstr (p1,_,_), Tconstr (p2,_,_) when mode = Pattern ->
 	    reify env t1;
 	    reify env t2;

typing/env.ml

@@ -732,6 +732,10 @@ and add_class id ty env =
 and add_cltype id ty env =
   store_cltype id (Pident id) ty env
 
+let add_local_constraint id info env =
+  let env = add_type id info env in 
+  { env with local_constraints = true }
+
 (* Insertion of bindings by name *)
 
 let enter store_fun name data env =
@@ -745,9 +749,6 @@ and enter_modtype = enter store_modtype
 and enter_class = enter store_class
 and enter_cltype = enter store_cltype
 
-let enter_local_constraint x y z = 
-  let (ident,env) = enter_type x y z in 
-  (ident, { env with local_constraints = true })
 (* Insertion of all components of a signature *)
 
 let add_item comp env =

typing/env.mli

@@ -66,6 +66,7 @@ val add_module: Ident.t -> module_type -> t -> t
 val add_modtype: Ident.t -> modtype_declaration -> t -> t
 val add_class: Ident.t -> class_declaration -> t -> t
 val add_cltype: Ident.t -> cltype_declaration -> t -> t
+val add_local_constraint: Ident.t -> type_declaration -> t -> t
 
 (* Insertion of all fields of a signature. *)
 
@@ -82,7 +83,6 @@ val open_pers_signature: string -> t -> t
 
 val enter_value: string -> value_description -> t -> Ident.t * t
 val enter_type: string -> type_declaration -> t -> Ident.t * t
-val enter_local_constraint: string -> type_declaration -> t -> Ident.t * t
 val enter_exception: string -> exception_declaration -> t -> Ident.t * t
 val enter_module: string -> module_type -> t -> Ident.t * t
 val enter_modtype: string -> modtype_declaration -> t -> Ident.t * t