[revert] typer_w: allow unification of schema with type in coercion

This reverts commit f26a60a53a522aa715041a0ae159292699e2c29f
MLstate · Jul 31, 2012 · ce2f7a7 · ce2f7a7
1 parent 1503466
commit ce2f7a7
Show file tree

Hide file tree

Showing 3 changed files with 4 additions and 62 deletions.
diff --git a/compiler/libqmlcompil/typer_w/w_Infer.ml b/compiler/libqmlcompil/typer_w/w_Infer.ml
@@ -482,7 +482,7 @@ and infer_pattern_type typing_env pattern =
       W_TypeInfo.addrec_loc_object coercing_ty.W_Algebra.sty_desc loc ;
       (* Force unification between the type inferred for the pattern and the
          coercing type. *)
-      (try W_Unify.unify_simple_type_in_coercion typing_env pat_ty coercing_ty
+      (try W_Unify.unify_simple_type typing_env pat_ty coercing_ty
        with W_Unify.Unification_simple_type_conflict (err_t1, err_t2, detail) ->
          raise
            (W_InferErrors.Infer_detailled_unification_conflict
@@ -976,7 +976,7 @@ let rec infer_expr_type ~bypass_typer typing_env original_expr =
       #<End> ; (* <---------- END DEBUG *)
       (* Force unification between the type inferred for the expression and the
          coercing type. *)
-      (try W_Unify.unify_simple_type_in_coercion typing_env expr_ty coercing_ty
+      (try W_Unify.unify_simple_type typing_env expr_ty coercing_ty
        with W_Unify.Unification_simple_type_conflict (err_t1, err_t2, detail) ->
          raise
            (W_InferErrors.Infer_detailled_unification_conflict

diff --git a/compiler/libqmlcompil/typer_w/w_Unify.ml b/compiler/libqmlcompil/typer_w/w_Unify.ml
@@ -82,13 +82,6 @@ exception Unification_column_conflict of
   (W_Algebra.column_type * W_Algebra.column_type)
 
 
-(* ************************************************************************** *)
-(** {b Descr}: If [unification_under_coercion] is set allows 
-    unification of forall a.t with s.
-    {b Visibility}: Not exported outside this module.                         *)
-(* ************************************************************************** *)
-let unification_under_coercion = ref false
-
 
 (* ************************************************************************** *)
 (** {b Descr}: Lowerize types level inside a [simple_type].
@@ -785,14 +778,6 @@ and __unify_simple_type env seen_expansions ty1 ty2 =
             (Unification_simple_type_conflict
                (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None }))
       )
-    | ((W_Algebra.SType_forall _), _)
-        when !unification_under_coercion -> (
-        __unify_simple_type_in_coercion env seen_expansions ty1 ty2
-      )
-    | (_, (W_Algebra.SType_forall _))
-        when !unification_under_coercion -> (
-        __unify_simple_type_in_coercion env seen_expansions ty1 ty2
-    )
     | (_, _) ->
         raise
           (Unification_simple_type_conflict
@@ -1200,26 +1185,6 @@ and __unify_field env seen_expansions  (field_name1, field_ty1) (field_name2, fi
   )
 
 
-(* ************************************************************************** *)
-(** {b Descr}: Internal function performing unification of 2 simple types
-    when unification was initally called from coercion. It unifies a schema s
-    with a type t, by generalizing the type and calling __unify_simple_type
-    @raise Unification_simple_type_conflict
-    @raise Unification_binding_level_conflict
-    {b Visibility}: Not exported outside this module.                         *)
-(* ************************************************************************** *)
-and __unify_simple_type_in_coercion env seen_expansions ty1 ty2 =
-  match (ty1.W_Algebra.sty_desc, ty2.W_Algebra.sty_desc) with
-   | (W_Algebra.SType_forall _, W_Algebra.SType_forall _) ->
-       __unify_simple_type env seen_expansions ty1 ty2
-   | (W_Algebra.SType_forall scheme1, _) -> 
-      __unify_simple_type env seen_expansions 
-        (W_SchemeGenAndInst.specialize scheme1) ty2
-   | (_, W_Algebra.SType_forall scheme2) ->
-       __unify_simple_type env seen_expansions
-       ty1 (W_SchemeGenAndInst.specialize scheme2)
-   | _ -> __unify_simple_type env seen_expansions ty1 ty2
-
 
 (* ************************************************************************** *)
 (** {b Descr}: Unification of 2 simple types. The unification is performed by
@@ -1250,26 +1215,6 @@ let unify_simple_type env ty1 ty2 =
     #<End> ;    (* <---------- END DEBUG *)
     raise any
 
-let unify_simple_type_in_coercion env ty1 ty2 =
-  #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
-  OManager.printf "unify_simple_type_in_coercion@." ;
-  #<End> ;     (* <---------- END DEBUG *)
-  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
-  try
-    let tmp_unification_under_coercion = !unification_under_coercion in
-    unification_under_coercion := true ;
-    __unify_simple_type_in_coercion env W_TypeAbbrevs.empty_memory ty1 ty2 ;
-    unification_under_coercion := tmp_unification_under_coercion ;
-    #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
-    OManager.printf "Ended unify_simple_type_in_coercion@." ;
-    #<End> ;    (* <---------- END DEBUG *)
-    W_CoreTypes.reset_unification_changes_trace ()
-  with any ->
-    W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
-    #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
-    OManager.printf "Ended unify_simple_type_in_coercion@." ;
-    #<End> ;    (* <---------- END DEBUG *)
-    raise any
 
 
 (* ************************************************************************** *)
@@ -1327,6 +1272,7 @@ let unify_column_type env column_ty1 column_ty2 =
     raise any
 
 
+
 (* [TODO-REFACTOR] DOCUMENTATION. *)
 let _ = W_TypingEnv.forward_ref__unify_simple_type :=
   (fun env t1 t2 ->

diff --git a/compiler/libqmlcompil/typer_w/w_Unify.mli b/compiler/libqmlcompil/typer_w/w_Unify.mli
@@ -43,17 +43,13 @@ exception Unification_column_conflict of
 val unify_simple_type:
   W_TypingEnv.t -> W_Algebra.simple_type -> W_Algebra.simple_type -> unit
 
-(** @raise Unification_simple_type_conflict *)
-val unify_simple_type_in_coercion:
-  W_TypingEnv.t -> W_Algebra.simple_type -> W_Algebra.simple_type -> unit
-
 (** @raise Unification_simple_type_conflict if rows had a same field having
     2 different types or return [false] in case of failure not due to fields
     having different types but because then rows can't unify due to the fact
     they have different fields and are not opened to each "absorb" the fields
     coming from the other row. *)
 val unify_row_type:
-  W_TypingEnv.t -> W_Algebra.row_type -> W_Algebra.row_type -> bool
+  W_TypingEnv.t ->W_Algebra.row_type -> W_Algebra.row_type -> bool
 
 (** @raise Unification_simple_type_conflict
     @raise Unification_column_conflict *)