
     Copyright © 2011 , 2012 MLstate 

     This file is part of  . 

      is free software : you can redistribute it and/or modify it under the 
     terms of the GNU Affero General Public License , version 3 , as published by 
     the Free Software Foundation . 

      is distributed in the hope that it will be useful , but WITHOUT ANY 
     WARRANTY ; without even the implied warranty of MERCHANTABILITY or FITNESS 
     FOR A PARTICULAR PURPOSE . See the GNU Affero General Public License for 
     more details . 

     You should have received a copy of the GNU Affero General Public License 
     along with  . If not , see < / > . 

    Copyright © 2011, 2012 MLstate

    This file is part of Opa.

    Opa is free software: you can redistribute it and/or modify it under the
    terms of the GNU Affero General Public License, version 3, as published by
    the Free Software Foundation.

    Opa is distributed in the hope that it will be useful, but WITHOUT ANY
    WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
    FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
    more details.

    You should have received a copy of the GNU Affero General Public License
    along with Opa. If not, see </>.
*)

    @author   

   @author François Pessaux
*)


(* depends *)
module List = BaseList




type detail_kind =
  | DK_none   (** No additionnal and more precise information. This is the
                   general failure case where types are simply incompatible. *)
* Arity mismatch between 2 function 
                                            types .
                                           types. *)
* Arity 
          mismatch between the arguments of 2 instances of a same named type .
         mismatch between the arguments of 2 instances of a same named type. *)
* Case of unification between 2 type 
          variables with one being generalized and the other not , or between a 
          generalized type variable and another type ( not being a type 
          variable ) .
         variables with one being generalized and the other not, or between a
         generalized type variable and another type (not being a type
         variable). *)
* Case where the 2 
          schemes of types forall do not have the same number of generalized 
          variables .
         schemes of types forall do not have the same number of generalized
         variables. *)



(* ************************************************************************** *)
* { b  } : Information precising a unification conflict when the unification 
     failed in a case where we can give more accurate description of the issue 
     to the user . 
     { b Visibility } : Exported outside this module .                             
    failed in a case where we can give more accurate description of the issue
    to the user.
    {b Visibility}: Exported outside this module.                             *)
(* ************************************************************************** *)
type unification_conflict_detail = {
  ucd_kind : detail_kind ;
* If the unification conflict appeared 
      through the unification of 2 record fields of same name , this is the name 
      of the 2 fields that caused the error .
     through the unification of 2 record fields of same name, this is the name
     of the 2 fields that caused the error. *)
}



(* ************************************************************************** *)
* { b  } : Exception raised in case of unification failure on 2 simple 
     types . 
     { b Visibility } : Exported outside this module .                             
    types.
    {b Visibility}: Exported outside this module.                             *)
(* ************************************************************************** *)
exception Unification_simple_type_conflict of
  (W_Algebra.simple_type * W_Algebra.simple_type * unification_conflict_detail)



(* ************************************************************************** *)
* { b  } : Exception raised in case of unification failure on 2 sum 
     types ( i.e. on 2 columns ) . This exception must not escape when unification 
     i d triggered by a call to the unification between 2 [ simple_type]s and 
     must caught by it ( [ unify_simple_type ] ) to issue an explicit error message . 
     Because we finally needed to export [ unify_column_type ] , this exception 
     can only escape outside this module if unification is triggered by a call 
     to unification between 2 column types . 
     { b Visibility } : Exported outside this module .                             
    types (i.e. on 2 columns). This exception must not escape when unification
    id triggered by a call to the unification between 2 [simple_type]s and
    must caught by it ([unify_simple_type]) to issue an explicit error message.
    Because we finally needed to export [unify_column_type], this exception
    can only escape outside this module if unification is triggered by a call
    to unification between 2 column types.
    {b Visibility}: Exported outside this module.                             *)
(* ************************************************************************** *)
exception Unification_column_conflict of
  (W_Algebra.column_type * W_Algebra.column_type)



(* ************************************************************************** *)
* { b  } :  types level inside a [ simple_type ] . 
     { b Visibility } : Not exported outside this module .                         
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
let rec lowerize_level_in_simple_type max_level ty =
  assert (max_level < W_CoreTypes.generic_binding_level) ;
  First , get the canonical representation of the type .
  let ty = W_CoreTypes.simple_type_repr ty in
  match ty.W_Algebra.sty_mark with
  | W_Algebra.TM_lowerise_seen -> ()
  | W_Algebra.TM_not_seen -> (
  First , mark the type as as seen to prevent looping .
      ty.W_Algebra.sty_mark <- W_Algebra.TM_lowerise_seen ;
      match ty.W_Algebra.sty_desc with
      | W_Algebra.SType_var ty_var_desc -> (
          if ty_var_desc.W_Algebra.tv_level > max_level then (
            (* Types (variables) marked as generalized are those left marked
               under a forall-type, hence remains bound by a scheme, hence must
               not be lowerized. So if a variable has the generic binding level,
               we don't touch its level. *)
            if ty_var_desc.W_Algebra.tv_level <>
              W_CoreTypes.generic_binding_level then (
                (* Set the level inside the type. *)
                W_CoreTypes.change_ty_var_level ty_var_desc max_level
              )
          )
        )
      | W_Algebra.SType_arrow (args_tys, res_ty) ->
          List.iter (lowerize_level_in_simple_type max_level) args_tys ;
          lowerize_level_in_simple_type max_level res_ty
      | W_Algebra.SType_named named ->
          (match named.W_Algebra.nst_unwinded with
           | None -> ()
           | Some t' -> lowerize_level_in_simple_type max_level t') ;
          List.iter
            (lowerize_level_in_simple_type max_level) named.W_Algebra.nst_args
      | W_Algebra.SType_sum_of_records sumcases_column ->
          lowerize_level_in_column max_level sumcases_column
      | W_Algebra.SType_forall scheme ->
          lowerize_level_in_simple_type max_level scheme.W_Algebra.body
    )
  | _ (* Other markers. *) -> assert false



(* ************************************************************************** *)
* { b  } :  variables level inside a row type . 
     { b Visibility } : Not exported outside this module .                         
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
and lowerize_level_in_row max_level row =
  First , get the canonical representation of the row type .
  let (row_fields, row_ending) =
    (W_CoreTypes.row_type_repr row).W_Algebra.rt_value in
  List.iter
    (fun (_, ty) -> lowerize_level_in_simple_type max_level ty) row_fields ;
  (match row_ending with
   | W_Algebra.Var_row row_variable ->
       (* Variables marked as generalized are those left marked under a
          forall-type, hence remains bound by a scheme, hence must not be
          lowerized. So if a variable has the generic binding level, we
          don't touch its level. *)
       if row_variable.W_Algebra.rv_level > max_level &&
         row_variable.W_Algebra.rv_level <>
         W_CoreTypes.generic_binding_level then
           W_CoreTypes.change_row_var_level row_variable max_level
   | W_Algebra.Closed_row -> ())



(* ************************************************************************** *)
* { b  } :  variables level inside a column type . 
     { b Visibility } : Not exported outside this module .                         
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
and lowerize_level_in_column max_level column =
  First , get the canonical representation of the column type .
  let (col_rows, col_ending) =
    (W_CoreTypes.column_type_repr column).W_Algebra.ct_value in
  List.iter (lowerize_level_in_row max_level) col_rows ;
  (match col_ending with
   | W_Algebra.Var_column col_variable ->
       (* Variables marked as generalized are those left marked under a
          forall-type, hence remains bound by a scheme, hence must not be
          lowerized. So if a variable has the generic binding level, we
          don't touch its level. *)
       if col_variable.W_Algebra.cv_level > max_level  &&
         col_variable.W_Algebra.cv_level <>
         W_CoreTypes.generic_binding_level then
           W_CoreTypes.change_column_var_level col_variable max_level
     | W_Algebra.Closed_column -> ())



(* ************************************************************************** *)
* { b  } : Computes the min binding level of 2 row endings . This is used 
     when creating a new row variable for unification , in order to give it 
     directly a binding level being the smallest one of the 2 endings of the 
     rows we want to unify . 
     If none of the endings have a variable , then the returned minimal level is 
     the current binding level , i.e. the one with which anyway the fresh variable 
     created before calling this function was initialized . 
     { b ATTENTION } : This function assumes it is called on row endings that are 
     canonical representation , i.e. obtained after a call to [ row_type_repr ] . 
     { b Visibility } : Not exported outside this module .                         
    when creating a new row variable for unification, in order to give it
    directly a binding level being the smallest one of the 2 endings of the
    rows we want to unify.
    If none of the endings have a variable, then the returned minimal level is
    the current binding level, i.e. the one with which anyway the fresh variable
    created before calling this function was initialized.
    {b ATTENTION}: This function assumes it is called on row endings that are
    canonical representation, i.e. obtained after a call to [row_type_repr].
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
let min_level_of_row_endings end1 end2 =
  match (end1, end2) with
  | (W_Algebra.Closed_row, W_Algebra.Closed_row) ->
      (* None of the endings is a variable, hence there is no smaller level
         than the current one. *)
      !W_CoreTypes.current_binding_level
  | ((W_Algebra.Var_row rv), W_Algebra.Closed_row)
  | (W_Algebra.Closed_row, (W_Algebra.Var_row rv)) ->
  There is only one ending with a variable . Then the minimal level is 
          the one of this only variable .
         the one of this only variable. *)
      rv.W_Algebra.rv_level
  | ((W_Algebra.Var_row rv1), (W_Algebra.Var_row rv2)) ->
      min rv1.W_Algebra.rv_level rv2.W_Algebra.rv_level



(* ************************************************************************** *)
* { b  } : Computes the min binding level of 2 column endings . This 
     function works like its counterpart for row , i.e. 
     [ min_level_of_row_endings ] . 
     { b ATTENTION } : This function assumes it is called on column endings that are 
     canonical representation , i.e. obtained after a call to [ column_type_repr ] . 
     { b Visibility } : Not exported outside this module .                         
    function works like its counterpart for row, i.e.
    [min_level_of_row_endings].
    {b ATTENTION}: This function assumes it is called on column endings that are
    canonical representation, i.e. obtained after a call to [column_type_repr].
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
let min_level_of_column_endings end1 end2 =
  match (end1, end2) with
  | (W_Algebra.Closed_column, W_Algebra.Closed_column) ->
      (* None of the endings is a variable, hence there is no smaller level
         than the current one. *)
      !W_CoreTypes.current_binding_level
  | ((W_Algebra.Var_column cv), W_Algebra.Closed_column)
  | (W_Algebra.Closed_column, (W_Algebra.Var_column cv)) ->
  There is only one ending with a variable . Then the minimal level is 
          the one of this only variable .
         the one of this only variable. *)
      cv.W_Algebra.cv_level
  | ((W_Algebra.Var_column cv1), (W_Algebra.Var_column cv2)) ->
      min cv1.W_Algebra.cv_level cv2.W_Algebra.cv_level



(* ************************************************************************* *)
  bool - > W_Algebra.simple_type list - > W_Algebra.simple_type list - > bool  
* { b  } : Function checking if 2 type variables lists are in injection 
     and if the first argument is true , are also in bijection . 
     In other words , we have 2 lists of types [ v_vars ] and [ w_vars ] , assumed 
     all to be * type variables * and we want to ensure that all the variables 
     from the first list are equal ( i.e. were unified with ) one variable of 
     the second list and , if the first argument is true the other way : that 
     all the variables of the second list are equal ( were unified with ) to one 
     variable of the first list . 
     This obviously means that both lists have the same length . 
     This function is used to ensure that during unification of 2 types forall , 
     the generalized variables of both schemes we mapped one - to - one , in other 
     words that both schemes are as general . 
     Using this mechanism of bijection allows to be independant on the order 
     of variables in the quantifications of the schemes . In effect , we take an 
     instance of each scheme and unify the bodies of these instances . During 
     this unification , generalized type variables are mapped to their 
     counterpart in the other type . At the end , we just need to verify that 
     they were all mapped once to a counterpart variable . 
     Note by the was that because this applies on qualtified variables , since 
     unification allows to unify a generalized type variable only with a also 
     generalized other type variable , we are sure that at the end of unification , 
     then when we call the present function , all the variables manipulated will 
     be generalized ones . 
     { b Visibility } : Not exported outside this module .                        
    and if the first argument is true, are also in bijection.
    In other words, we have 2 lists of types [v_vars] and [w_vars], assumed
    all to be *type variables* and we want to ensure that all the variables
    from the first list are equal (i.e. were unified with) one variable of
    the second list and, if the first argument is true the other way: that 
    all the variables of the second list are equal (were unified with) to one 
    variable of the first list.
    This obviously means that both lists have the same length.
    This function is used to ensure that during unification of 2 types forall,
    the generalized variables of both schemes we mapped one-to-one, in other
    words that both schemes are as general.
    Using this mechanism of bijection allows to be independant on the order
    of variables in the quantifications of the schemes. In effect, we take an
    instance of each scheme and unify the bodies of these instances. During
    this unification, generalized type variables are mapped to their
    counterpart in the other type. At the end, we just need to verify that
    they were all mapped once to a counterpart variable.
    Note by the was that because this applies on qualtified variables, since
    unification allows to unify a generalized type variable only with a also
    generalized other type variable, we are sure that at the end of unification,
    then when we call the present function, all the variables manipulated will
    be generalized ones.
    {b Visibility}: Not exported outside this module.                        *)
(* ************************************************************************* *)
let check_type_variables_are_in_injection check_bijection w_vars v_vars =
  Local function testing if 2 types are physically equal variables .
  let test_vars_eq t1 t2 =
    match (t1.W_Algebra.sty_desc, t2.W_Algebra.sty_desc) with
    | ((W_Algebra.SType_var v1), (W_Algebra.SType_var v2)) ->
        v1 == v2
    | (_, _) -> false in
  Local function that takes one variable and tries to remove it from the 
      list of other variables .
     list of other variables. *)
  let check_one_v v ws =
    (* If the variable can't be removed because it is not in the list, then
       [Not_found] will be raised. *)
    List.remove_first_or_fail_eq ~eq: test_vars_eq v ws in
  Now , iterate the above local function on all the variables " v " . At each 
      iteration , we get a reduced list of variables " w " in which to find the 
      next variable " v " . At the end , we expect the remaining list of variables 
      " w " to be empty , i.e. meaning that all the variables " v " were found 
      equal to one unique variable " w " and reciprocally .
     iteration, we get a reduced list of variables "w" in which to find the
     next variable "v". At the end, we expect the remaining list of variables
     "w" to be empty, i.e. meaning that all the variables "v" were found
     equal to one unique variable "w" and reciprocally. *)
  try
    let remaining_ws =
      List.fold_left
        (fun accu_ws v -> check_one_v v accu_ws)
        (List.map W_CoreTypes.simple_type_repr w_vars) v_vars in
    if check_bijection then  assert (remaining_ws = []) ;
    true
  with Not_found ->  false



(* ************************************************************************* *)
(* bool -> W_Algebra.row_variable list -> W_Algebra.row_variable list -> bool*)
* { b  } : Performs the same job than 
     [ check_type_variables_are_in_injection ] above , but on row variables . 
     See header of [ check_type_variables_are_in_injection ] for more details . 
     { b Visibility } : Not exported outside this module .                        
    [check_type_variables_are_in_injection] above, but on row variables.
    See header of [check_type_variables_are_in_injection] for more details.
    {b Visibility}: Not exported outside this module.                        *)
(* ************************************************************************* *)
let check_row_variables_are_in_injection check_bijection w_vars v_vars =
  We simulate a call to " repr " on a row variable . To do this , we manually 
      inspect the [ W_Algebra.rv_value ] fields . If it is [ W_Algebra .  ] 
      then the variable was not instantiated and we take it as it is . 
      If it is [ W_Algebra . Row_known , then we call [ W_CoreTypes.row_type_repr ] 
      to get the canonical representation of the variable 's value then we 
      check that we got a row type with not fields and if so , we take its 
      ending variable .
     inspect the [W_Algebra.rv_value] fields. If it is [W_Algebra.Row_unknown]
     then the variable was not instantiated and we take it as it is.
     If it is [W_Algebra.Row_known, then we call [W_CoreTypes.row_type_repr]
     to get the canonical representation of the variable's value then we
     check that we got a row type with not fields and if so, we take its
     ending variable. *)
  let repr v =
    match v.W_Algebra.rv_value with
    | W_Algebra.Row_unknown -> v
    | W_Algebra.Row_known row_type -> (
        match (W_CoreTypes.row_type_repr row_type).W_Algebra.rt_value with
        | ([], W_Algebra.Var_row v') -> v'
        | _ -> v
            (* Instantiated by something else than a variable. *)
      ) in
  let check_one_v v ws =
    (* If the variable can't be removed because it is not in the list, then
       [Not_found] will be raised. *)
    List.remove_first_or_fail_eq ~eq: (==) v ws in
  (* Same explanation than in [check_type_variables_are_in_injection] above. *)
  try
    let remaining_ws =
      List.fold_left
        (fun accu_ws v -> check_one_v v accu_ws)
        (List.map repr w_vars) v_vars in
    if check_bijection then assert (remaining_ws = []) ;
    true
  with Not_found -> false



(* ************************************************************************* *)
(* bool -> W_Algebra.column_variable list  
        -> W_Algebra.column_variable list -> bool                            *)
* { b  } : Performs the same job than 
     [ check_type_variables_are_in_bijection ] above , but on column variables . 
     See header of [ check_type_variables_are_in_injection ] for more details . 
     { b Visibility } : Not exported outside this module .                        
    [check_type_variables_are_in_bijection] above, but on column variables.
    See header of [check_type_variables_are_in_injection] for more details.
    {b Visibility}: Not exported outside this module.                        *)
(* ************************************************************************* *)
let check_column_variables_are_in_injection check_bijection w_vars v_vars =
  (* Same explanation than in [check_row_variables_are_in_injection] above. *)
  let repr v =
    match v.W_Algebra.cv_value with
    | W_Algebra.Col_unknown -> v
    | W_Algebra.Col_known col_type -> (
        match (W_CoreTypes.column_type_repr col_type).W_Algebra.ct_value with
        | ([], W_Algebra.Var_column v') -> v'
        | _ -> v
      ) in
  let check_one_v v ws =
    List.remove_first_or_fail_eq ~eq: (==) v ws in
  (* Same explanation than in [check_type_variables_are_in_bijection] above. *)
  try
    let remaining_ws =
      List.fold_left
        (fun accu_ws v -> check_one_v v accu_ws)
        (List.map repr w_vars) v_vars in
    if check_bijection then assert (remaining_ws = []) ;
    true
  with Not_found -> false

(* ************************************************************************** *)
* { b  } : Internal function catches the exception thrown by 
     [ _ _ unify_simple_type ] and raises a new one that contains the initial type 
     and not its synonim ( i.e. list(string ) instead of 
     { head : string ; tl : list(string ) } / nil ) 
     @raise Unification_simple_type_conflict 
     { b Visibility } : Not exported outside this module .                         
    [__unify_simple_type] and raises a new one that contains the initial type
    and not its synonim (i.e. list(string) instead of 
    {head:string; tl:list(string)} / nil)
    @raise Unification_simple_type_conflict
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)

let rec __unify_and_return_higher_type is_under_coercion 
          env seen_expansions ty1' ty2' ty1 ty2 = 
  try
    __unify_simple_type is_under_coercion env seen_expansions ty1' ty2'
  with (Unification_simple_type_conflict (ty3, ty4, context)) ->
    if ty1' == ty3 || ty1' == ty3 || ty2' == ty4 || ty2' == ty4
     then raise (Unification_simple_type_conflict(ty1, ty2, context))
     else raise (Unification_simple_type_conflict(ty3, ty4, context))

    
(* ************************************************************************** *)
* { b  } : Internal function performing unification of 2 simple types . 
     In any case ( error or success ) , this function keeps the trace of the 
     modifications done by the unification . This will be the job of the initial 
     caller ( [ unify_simple_type ] , [ unify_row_type ] or [ unify_column_type ] ) to 
     deal with what to do of this trace . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Not exported outside this module .                         
    In any case (error or success), this function keeps the trace of the
    modifications done by the unification. This will be the job of the initial
    caller ([unify_simple_type], [unify_row_type] or [unify_column_type]) to
    deal with what to do of this trace.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
and __unify_simple_type is_under_coercion env seen_expansions ty1 ty2 =
  #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
    OManager.printf "__unify_simple_type:%b  %a VERSUS %a@." is_under_coercion
    W_PrintTypes.pp_simple_type_start_sequence ty1
    W_PrintTypes.pp_simple_type_end_sequence ty2 ;
  #<End> ;    (* <---------- END DEBUG *)
  Special case optimization just in case the 2 types are already the same .
  if ty1 == ty2 then () else
  First , get the canonical representation of the 2 types to unify .
  let ty1 = W_CoreTypes.simple_type_repr ty1 in
  let ty2 = W_CoreTypes.simple_type_repr ty2 in
  if ty1 == ty2 then ()
  else
    match (ty1.W_Algebra.sty_desc, ty2.W_Algebra.sty_desc) with
    | ((W_Algebra.SType_var var1), (W_Algebra.SType_var var2)) -> (
  Unification between variables must prevent unification of a 
            generalized variable with something else than another generalized 
            variable . Otherwise , this would mean that a generalized variable 
            gets no more generalized , hence one of the 2 unified types would 
            lose its generality .
           generalized variable with something else than another generalized
           variable. Otherwise, this would mean that a generalized variable
           gets no more generalized, hence one of the 2 unified types would
           lose its generality. *)
        if (var1.W_Algebra.tv_level <> W_CoreTypes.generic_binding_level &&
            var2.W_Algebra.tv_level <> W_CoreTypes.generic_binding_level)
           ||
           (var1.W_Algebra.tv_level = W_CoreTypes.generic_binding_level &&
            var2.W_Algebra.tv_level = W_CoreTypes.generic_binding_level) then (
  To try to preserve as far as we can the names given by the user to 
              variables , if we are unifying 2 variables with on having no name 
              and the other having a name , then we make the no - name equal to the 
              with - name . Note that in case both variables have a name , this 
              heuristic wo n't work and there is no principal better choice . 
              I do n't know why , I thought that keeping the most recent name was 
              better but in fact , it seems that keeping the oldest seems to 
              give the best results . This is really hackish .
             variables, if we are unifying 2 variables with on having no name
             and the other having a name, then we make the no-name equal to the
             with-name. Note that in case both variables have a name, this
             heuristic won't work and there is no principal better choice.
             I don't know why, I thought that keeping the most recent name was
             better but in fact, it seems that keeping the oldest seems to
             give the best results. This is really hackish. *)
          let v1_name = QmlTypeVars.TypeVar.name var1.W_Algebra.tv_qml in
          let v2_name = QmlTypeVars.TypeVar.name var2.W_Algebra.tv_qml in
  A bit casual : since there are only 2 ways to assign variables , we 
              encode the assignment way by a boolean . [ true ] means that [ var1 ] is 
              assigned the identity of [ var2 ] .
             encode the assignment way by a boolean. [true] means that [var1] is
             assigned the identity of [var2]. *)
          let way =
            (match (v1_name, v2_name) with
              | ("", "") -> true   (* Arbitrary: v1 <- v2. *)
              | ("", _) -> true    (* v1 <- v2. *)
              | (_, "") -> false   (* v2 <- v1. *)
              | (_, _) ->
                 (* The most recent variable <- the oldest variable. We use
                    stamps for this. *)
                 (QmlTypeVars.TypeVar.to_int var1.W_Algebra.tv_qml) >
                 (QmlTypeVars.TypeVar.to_int var2.W_Algebra.tv_qml)) in
          if way then (
             (* [var1] has no name or both have names and [var1] is the most
                recent variable. Hence it will be assigned the identity of
                [var2]. *)
  Behave like the general case var U ty . Since we are in a case 
                 of 2 variables . We must not forget to adjust the level of the 
                 first variable .
                of 2 variables. We must not forget to adjust the level of the
                first variable. *)
             if var2.W_Algebra.tv_level > var1.W_Algebra.tv_level then
               W_CoreTypes.change_ty_var_level var2 var1.W_Algebra.tv_level ;
             W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2)
             )
         else (
            (* [var1] has a name or both have names and [var2] is the most
                recent variable. So [var2] will be assigned the identity of
               [var1] and the process is symetrical than above. *)
            if var1.W_Algebra.tv_level > var2.W_Algebra.tv_level then
               W_CoreTypes.change_ty_var_level var1 var2.W_Algebra.tv_level ;
             W_CoreTypes.change_ty_link ~receiver: ty2 ~link_val: (Some ty1)
            )
          )
        else (
  This is a failure case where one of the variable is generalized 
              and not the other . Hence accepting the unification would lead 
              into one of the type ( the more general ) to lose its generality 
              to become equal to the other . And in this case , unification 
              would not make the 2 types equal .
             and not the other. Hence accepting the unification would lead
             into one of the type (the more general) to lose its generality
             to become equal to the other. And in this case, unification
             would not make the 2 types equal. *)
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_binding_level_mismatch ;
                  ucd_through_field = None })) ;
        )
      )
    | ((W_Algebra.SType_var var1), _) -> (
        (* Prevents creating cycles through unification of ['a] and ['a t] when
          ['a t] is defined as [type 'a t = 'a u = 'a v ... = 'a]. *)
        let are_same =
          W_TypeAbbrevs.deep_exact_occur_expand_abbrev
            env seen_expansions ~ty_var: ty1 ~in_ty: ty2 in
        if are_same then ()
        else (
          (* If the variable is generalized, then we must not unify since this
             would means a loss of generality. In effect, generalized variable
             are not instantiable ! *)
          if var1.W_Algebra.tv_level = W_CoreTypes.generic_binding_level 
            then if is_under_coercion
                   then W_CoreTypes.change_ty_var_level var1
                          !W_CoreTypes.current_binding_level
                 else (
                   raise
                     (Unification_simple_type_conflict
                        (ty1, ty2,
                         { ucd_kind = DK_binding_level_mismatch ;
                           ucd_through_field = None })) 
                 );
          lowerize_level_in_simple_type var1.W_Algebra.tv_level ty2 ;
          (* Don't forget to cleanup the lowerized type. *)
          W_CoreTypes.cleanup_simple_type ty2 ;
          W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2)
         )
       )
    | (_, (W_Algebra.SType_var var2)) -> (
        (* Case symmetric than the previous one. *)
        let are_same =
          W_TypeAbbrevs.deep_exact_occur_expand_abbrev
            env seen_expansions ~ty_var: ty2 ~in_ty: ty1 in
        if are_same then ()
        else (
          if var2.W_Algebra.tv_level = W_CoreTypes.generic_binding_level then
            raise
              (Unification_simple_type_conflict
                 (ty1, ty2,
                  { ucd_kind = DK_binding_level_mismatch ;
                    ucd_through_field = None })) ;
          lowerize_level_in_simple_type var2.W_Algebra.tv_level ty1 ;
          (* Don't forget to cleanup the lowerized type. *)
          W_CoreTypes.cleanup_simple_type ty1 ;
          W_CoreTypes.change_ty_link ~receiver: ty2 ~link_val: (Some ty1)
         )
      )
    | (W_Algebra.SType_arrow (args_tys1, res_ty1),
       W_Algebra.SType_arrow (args_tys2, res_ty2)) -> (
  Ensure we are not in the case of an error of arity between the 
            two function types . Note that this also prevent the [ List.iter2 ] 
            exception from being raised in case of arity mismatch . 
            Making the test before unifying allows to issue a smarter error 
            message about arity before a possible type mismatch is detected and 
            issued first when unifying 2 - by-2 the non - matching expected and 
            provided types .
           two function types. Note that this also prevent the [List.iter2]
           exception from being raised in case of arity mismatch.
           Making the test before unifying allows to issue a smarter error
           message about arity before a possible type mismatch is detected and
           issued first when unifying 2-by-2 the non-matching expected and
           provided types. *)
        let n1 = List.length args_tys1 in
        let n2 = List.length args_tys2 in
        if n1 <> n2 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_fun_type_arity (n1, n2) ;
                  ucd_through_field = None })) ;
        W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;
  Unify types of arguments 2 by 2 .
        List.iter2
          (__unify_simple_type is_under_coercion env seen_expansions) args_tys1 args_tys2 ;
        (* Unify the types of results. *)
        __unify_simple_type is_under_coercion env seen_expansions res_ty1 res_ty2
       )
    | (W_Algebra.SType_named { W_Algebra.nst_name = name ;
                               W_Algebra.nst_args = args ;
                               W_Algebra.nst_unwinded = _manifest },
       W_Algebra.SType_named { W_Algebra.nst_name = name' ;
                               W_Algebra.nst_args = args' ;
                               W_Algebra.nst_unwinded = _manifest' })
        when QmlAst.TypeIdent.equal name name' -> (
          try
            W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;
            List.iter2 (__unify_simple_type is_under_coercion env seen_expansions) args args' ;
  Two instances of a same named type , as far as they have unifiable 
                arguments must have unifiable manifest representations . No need 
                to descend inside in order to save efficiency unless we want 
                to test assertions . 
                Moreover , with incremental abbreviations unwinding , this may not 
                hold anymore ...
               arguments must have unifiable manifest representations. No need
               to descend inside in order to save efficiency unless we want
               to test assertions.
               Moreover, with incremental abbreviations unwinding, this may not
               hold anymore... *)

             ( match ( manifest , manifest ' ) with 
              | ( None , None ) - > ( ) 
              | ( ( Some m ) , ( Some m ' ) ) - > 
                  _ _ unify_simple_type is_under_coercion env m m ' 
              | ( _ , _ ) - > 
                  ( * Two instances of a same named type should have either no 
                     manifest representation or both one .
            (match (manifest, manifest') with
             | (None, None) -> ()
             | ((Some m), (Some m')) ->
                 __unify_simple_type is_under_coercion env m m'
             | (_, _) ->
                 (* Two instances of a same named type should have either no
                    manifest representation or both one. *)
                 assert false) ;
            *)
          with Invalid_argument "List.iter2" ->
  In fact , we are in the case of an error of arity between the 
                two type constructors .
               two type constructors. *)
            let n1 = List.length args in
            let n2 = List.length args' in
            raise
              (Unification_simple_type_conflict
                 (ty1, ty2,
                  { ucd_kind = DK_named_type_arity (name, n1, n2) ;
                    ucd_through_field = None }))
        )
    | (W_Algebra.SType_named nty1,
       W_Algebra.SType_named nty2)
        (* name <> name' *) -> (
          __unify_different_named_types is_under_coercion env seen_expansions ty1 ty2 nty1 nty2
      )
    | ((W_Algebra.SType_named { W_Algebra.nst_unwinded = Some manifest }), _) ->
          (* Same remark about trivially cyclic types than in the previous
             match case. *)
        #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
        OManager.printf "Case SType_named manifest / other: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        #<End> ;                (* <---------- END DEBUG *)
        if ty1 == (W_CoreTypes.simple_type_repr manifest) then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_none ;
                  ucd_through_field = None })) ;
        __unify_simple_type is_under_coercion env seen_expansions ty2 manifest
    | (_, (W_Algebra.SType_named { W_Algebra.nst_unwinded = Some manifest })) ->
        #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
        OManager.printf "Case other / SType_named manifest: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        #<End> ;                (* <---------- END DEBUG *)
        (* Same remark about trivially cyclic types than in the previous
           match case. *)
        if ty2 == (W_CoreTypes.simple_type_repr manifest) then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        __unify_simple_type is_under_coercion env seen_expansions ty1 manifest
    | ((W_Algebra.SType_named { W_Algebra.nst_unwinded = None }), _) -> (
        #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
        OManager.printf "Case SType_named non-manifest / other: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        #<End> ;                (* <---------- END DEBUG *)
        let (ty1', seen_expansions') =
          W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
        #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
        OManager.printf "SType_named non-manifest expanded: %a@."
          W_PrintTypes.pp_simple_type ty1' ;
        #<End> ;                (* <---------- END DEBUG *)
        if ty1 == ty1' then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        __unify_and_return_higher_type is_under_coercion 
          env seen_expansions' ty2 ty1' ty2 ty1
       )
    | (_, (W_Algebra.SType_named { W_Algebra.nst_unwinded = None })) -> (
        #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
        OManager.printf "Case other / SType_named non-manifest: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        #<End> ;                (* <---------- END DEBUG *)
        let (ty2', seen_expansions') =
          W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty2 in
        if ty2 == ty2' then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
          __unify_and_return_higher_type is_under_coercion
            env seen_expansions' ty1 ty2' ty1 ty2
       )
    | ((W_Algebra.SType_sum_of_records col1),
       (W_Algebra.SType_sum_of_records col2)) -> (
        try
          W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;
          __unify_column_type is_under_coercion env seen_expansions col1 col2
        with Unification_column_conflict (_, _) ->
          (* At this point, recover the unification on columns failure.
             [TODO] There should be a clear error message here, but for the
             moment it's rather crude. ^^ *)
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None }))
      )
    | ((W_Algebra.SType_forall scheme1), (W_Algebra.SType_forall scheme2)) -> (
        W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;

           Naive unification , just instantiating both schemes then unifying 
           the obtained bodies is wrong ! 
           For example , on the following program we would get : 
             if true then { { i d = fun x - > x } } else { { i d = fun x - > 5 } } ; ; 
             - : { i d : for all ' Ta . ( ' Ta - > ' Ta ) ; . } / ' Ca 
           which is clearly wrong since in the second branch of the 
           conditional , the type of the function i d is not as general as 
           ' a - > ' a ! 
        
          Naive unification, just instantiating both schemes then unifying
          the obtained bodies is wrong !
          For example, on the following program we would get:
            if true then {{ id = fun x -> x }} else {{ id = fun x -> 5 }} ;;
            - : { id: for all 'Ta . ('Ta -> 'Ta); . } / 'Ca
          which is clearly wrong since in the second branch of the
          conditional, the type of the function id is not as general as
          'a -> 'a !
        *)
        (* We must take an instance of each scheme body, but make so that
           generalized variables keep a generic level. This means that we
           must create a copy of the bodies, with fresh variables in place
           of the generalized ones, but these fresh variables being still
           at generic level. Making a copy prevents from dirtying our
           schemes. Forcing copies of generalized variables to be generic
           will allow unification not to instantiate them by something else
           than another generic variable. *)

  We count by side effect the number of variables in each scheme 
            to save a call to  . A bit casual , but more efficient .
           to save a call to List.length. A bit casual, but more efficient. *)
        let count_ty_vars1 = ref 0 in
        let count_ty_vars2 = ref 0 in
        (* Create the mappings of generalized variables of the scheme onto
           fresh *also generalized* type variables. *)
        let ty_vars_mapping1 =
          List.map
            (fun sch ->
               incr count_ty_vars1 ;
               let tyv = W_CoreTypes.__generic_type_variable () in
               W_TypeInfo.add_linked_object 
                 tyv.W_Algebra.sty_desc ty1.W_Algebra.sty_desc ;
               (sch, tyv))
            scheme1.W_Algebra.ty_parameters in
        let ty_vars_mapping2 =
          List.map
            (fun sch ->
               incr count_ty_vars2 ;
               let tyv = W_CoreTypes.__generic_type_variable () in 
               W_TypeInfo.add_linked_object
                 tyv.W_Algebra.sty_desc ty2.W_Algebra.sty_desc ;
               (sch, tyv))
            scheme2.W_Algebra.ty_parameters in
        (* Do the same thing for row variables... *)
        let count_row_vars1 = ref 0 in
        let count_row_vars2 = ref 0 in
        let row_vars_mapping1 =
          List.map
            (fun sch_var ->
               incr count_row_vars1 ;
               (sch_var, (W_CoreTypes.__generic_row_variable ())))
            scheme1.W_Algebra.row_parameters in
        let row_vars_mapping2 =
          List.map
            (fun sch_var ->
               incr count_row_vars2 ;
               (sch_var, (W_CoreTypes.__generic_row_variable ())))
            scheme2.W_Algebra.row_parameters in
        (* Do the same thing for column variables... *)
        let count_column_vars1 = ref 0 in
        let count_column_vars2 = ref 0 in
        let column_vars_mapping1 =
          List.map
            (fun sch_var ->
               incr count_column_vars1 ;
               (sch_var, (W_CoreTypes.__generic_column_variable ())))
            scheme1.W_Algebra.column_parameters in
        let column_vars_mapping2 =
          List.map
            (fun sch_var ->
               incr count_column_vars2 ;
               (sch_var, (W_CoreTypes.__generic_column_variable ())))
            scheme2.W_Algebra.column_parameters in
        (* Ensure that both schemes have the same number of variables. *)
        if ( not (is_under_coercion  && !count_ty_vars1 > !count_ty_vars2) &&
           !count_ty_vars1 <> ! count_ty_vars2) || 
           (not (is_under_coercion  && !count_row_vars1 > !count_row_vars2) &&
           !count_row_vars1 <> !count_row_vars2) ||
           (not (is_under_coercion  && !count_column_vars1 > !count_column_vars2) &&
           !count_column_vars1 <> !count_column_vars2) then (
  In fact , we are in the case where the 2 schemes do not have the 
              same number of generalized variables .
             same number of generalized variables. *)
          let n1 = !count_ty_vars1 + !count_row_vars1 + !count_column_vars1 in
          let n2 = !count_ty_vars2 + !count_row_vars2 + !count_column_vars2 in
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_forall_type_quantification_arity (n1, n2) ;
                  ucd_through_field = None }))

        ) ;
        (* Now, create the instances of the type schemes. *)
        let scheme1_instance =
          W_SchemeGenAndInst.specialize_with_given_variables_mapping
            ~deep: false
            ty_vars_mapping1 row_vars_mapping1 column_vars_mapping1 scheme1 in
        let scheme2_instance =
          W_SchemeGenAndInst.specialize_with_given_variables_mapping
            ~deep: false
            ty_vars_mapping2 row_vars_mapping2 column_vars_mapping2 scheme2 in
        (* And now, perform the unification. Because variables that were
           generalized in the schemes have been copied, unification will
           operate on these copies, hence preventing from dirtying the
           schemes original generalized variables. *)
        __unify_simple_type is_under_coercion
          env seen_expansions scheme1_instance scheme2_instance ;
  Now , ensure that the qualtified variables of both schemes were 
            mapped one - to - one , i.e. no collapse occurred , i.e. both scheme 
            were as general . Compute the checks one at time to avoid useless 
            computation in case one fails . This way , when unifying sums for 
            which we can backtrack on type error , we avoid checking bijections 
            if a previous bijection test failed . May be we gain a bit of time 
            even if lists of variables are generally not very long .
           mapped one-to-one, i.e. no collapse occurred, i.e. both scheme
           were as general. Compute the checks one at time to avoid useless
           computation in case one fails. This way, when unifying sums for
           which we can backtrack on type error, we avoid checking bijections
           if a previous bijection test failed. May be we gain a bit of time
           even if lists of variables are generally not very long. *)
        let fresh_gen_ty_vars1 = List.map snd ty_vars_mapping1 in
        let fresh_gen_ty_vars2 = List.map snd ty_vars_mapping2 in
        (* if under coercion check only for injection, 
           otherwise check for bijection *)
        let check_for_bijection = not is_under_coercion in 
        let bij1 =
          check_type_variables_are_in_injection check_for_bijection
            fresh_gen_ty_vars1 fresh_gen_ty_vars2 in
        if not bij1 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        let fresh_gen_row_vars1 = List.map snd row_vars_mapping1 in
        let fresh_gen_row_vars2 = List.map snd row_vars_mapping2 in
        let bij2 =
          check_row_variables_are_in_injection check_for_bijection
            fresh_gen_row_vars1 fresh_gen_row_vars2 in
        if not bij2 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        let fresh_gen_column_vars1 = List.map snd column_vars_mapping1 in
        let fresh_gen_column_vars2 = List.map snd column_vars_mapping2 in
        let bij3 =
          check_column_variables_are_in_injection check_for_bijection
            fresh_gen_column_vars1 fresh_gen_column_vars2 in
        if not bij3 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None }))
      )
    | ((W_Algebra.SType_forall schm1), _)
        when is_under_coercion -> (
        __unify_simple_type is_under_coercion 
          env seen_expansions (W_SchemeGenAndInst.specialize schm1) ty2
      )
    | (_, _) ->
        raise
          (Unification_simple_type_conflict
             (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None }))



(* [TODO-REFACTOR] DOCUMENTATION. *)
and __unify_different_named_types is_under_coercion env seen_expansions ty1 ty2 nty1 nty2 =
  #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
  OManager.printf "__unify_different_named_types@." ;
  #<End> ;                (* <---------- END DEBUG *)
  let h_nty1 = W_CoreTypes.named_type_expr_height nty1 in
  let h_nty2 = W_CoreTypes.named_type_expr_height nty2 in
  if (h_nty1 < 0) && (h_nty2 < 0) then (
    #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
    OManager.printf "Both negative: expand L & R@." ;
    #<End> ;                (* <---------- END DEBUG *)
  Expand both once then unify the 2 resulting types .
    let (ty1', seen_expansions') =
      W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
    let (ty2', seen_expansions'') =
      W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions' ty2 in
    if (ty1 == ty1') && (ty2 == ty2') then
      raise
        (Unification_simple_type_conflict
           (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
    __unify_and_return_higher_type is_under_coercion 
      env seen_expansions'' ty1' ty2' ty1 ty2
  )
  else (  (* Else 0. *)
    (* Not ((h_nty1 < 0) && (h_nty2 < 0)). *)
    if h_nty1 < 0 then (
      #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
      OManager.printf "L negative: expand L@." ;
      #<End> ;                (* <---------- END DEBUG *)
      (* Expand left once then unify expanded left and right. *)
      let (ty1', seen_expansions') =
        W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
      #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
      OManager.printf "L after expand: %a@."
        W_PrintTypes.pp_simple_type ty1' ;
      #<End> ;                (* <---------- END DEBUG *)
      if ty1 == ty1' then
        raise
          (Unification_simple_type_conflict
             (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
      __unify_and_return_higher_type is_under_coercion 
        env seen_expansions' ty2 ty1' ty2 ty1
    )
    else (  (* Else 1. *)
      (* (h_nty1 >= 0). *)
      if h_nty2 < 0 then (
        #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
        OManager.printf "R negative: expand R@." ;
        #<End> ;                (* <---------- END DEBUG *)
        (* Expand right once then unify left and expanded right. *)
        let (ty2', seen_expansions') =
          W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty2 in
        #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
        OManager.printf "R after expand: %a@."
          W_PrintTypes.pp_simple_type ty2' ;
        #<End> ;                (* <---------- END DEBUG *)
        if ty2 == ty2' then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        __unify_and_return_higher_type is_under_coercion 
          env seen_expansions' ty1 ty2' ty1 ty2
      )
      else (   (* Else 2. *)
        (* None of heights are negative. *)
        if h_nty1 = h_nty2  then (
          #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
          OManager.printf "Both positive and equal (%d): expand both@." h_nty1 ;
          #<End> ;                (* <---------- END DEBUG *)
          (* None of heights are negative and they are equal. *)
          let (ty1', seen_expansions') =
            W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
          let (ty2', seen_expansions'') =
            W_TypeAbbrevs.incrementally_expand_abbrev
              env seen_expansions' ty2 in
          #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
          OManager.printf "L after expand: %a@."
            W_PrintTypes.pp_simple_type ty1' ;
          OManager.printf "R after expand: %a@."
            W_PrintTypes.pp_simple_type ty2' ;
          #<End> ;                (* <---------- END DEBUG *)
          if (ty1 == ty1') && (ty2 == ty2') then
            raise
              (Unification_simple_type_conflict
                 (ty1, ty2,
                  { ucd_kind = DK_none ; ucd_through_field = None })) ;
          __unify_and_return_higher_type is_under_coercion 
            env seen_expansions'' ty1' ty2' ty1 ty2
        )
        else (   (* Else 3. *)
          (* None of heights are negative and they are not equal.
             Expand highest to match lowest's level then unify left (possibly
             expanded) and right (possibly expanded).
             If both are at the same level: unwind them once. *)
          if h_nty1 < h_nty2 then (
            #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
            OManager.printf "L (%d) < R (%d): expand R@." h_nty1 h_nty2 ;
            #<End> ;                (* <---------- END DEBUG *)
            (* None of heights are negative and left is lower than right.
               Expand right. *)
            let nb_expansion = h_nty2 - h_nty1 in
            let (ty2', seen_expansions') =
              W_TypeAbbrevs.expand_abbrev_n_times
                nb_expansion env seen_expansions ty2 in
            #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
            OManager.printf "R after expand: %a@."
              W_PrintTypes.pp_simple_type ty2' ;
            #<End> ;                (* <---------- END DEBUG *)
            if ty2 == ty2' then
              raise
                (Unification_simple_type_conflict
                   (ty1, ty2,
                    { ucd_kind = DK_none ; ucd_through_field = None })) ;
            __unify_and_return_higher_type is_under_coercion 
              env seen_expansions' ty1 ty2' ty1 ty2
          )
          else (   (* Else 4. *)
            #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
            OManager.printf "R (%d) < L (%d): expand L@." h_nty2 h_nty1 ;
            #<End> ;                (* <---------- END DEBUG *)
            (* None of heights are negative and left is greater than right.
               Expand left. *)
            let nb_expansion = h_nty1 - h_nty2 in
            let (ty1', seen_expansions') =
              W_TypeAbbrevs.expand_abbrev_n_times
                nb_expansion env seen_expansions ty1 in
            #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
            OManager.printf "L after expand: %a@."
              W_PrintTypes.pp_simple_type ty1' ;
            #<End> ;                (* <---------- END DEBUG *)
            if ty1 == ty1' then
              raise
                (Unification_simple_type_conflict
                   (ty1, ty2,
                    { ucd_kind = DK_none ; ucd_through_field = None })) ;
            __unify_and_return_higher_type is_under_coercion 
              env seen_expansions' ty2 ty1' ty2 ty1
  End of else 4 .
  End of else 3 .
  End of else 2 .
  End of else 1 .
  )             (* End of else 0. *)



(* ************************************************************************** *)
* { b  } : Internal routine performing the unification of 2 row types . 
     Unification is performed " in place " , i.e. by physically modifying the 
     variables on which a substitution must be applied in order to make the 2 
     types equal . 
     Differently from other unification routines , this one returns a boolean 
     telling if the unification was a success of if it failed due to endings 
     compatibility . 
     More in detail , there are 2 cases where unification of rows can fail . 
     First one , and hardest one , there exist 2 fields in common in the 2 record 
     types that have incompatible types . In such a case , the unification really 
     and definitively fails . 
     The second case is when common fields have compatible types but the 2 rows 
     ca n't unify because they have incompatible endings . Intuitively , this 
     happens when one is closed and the other is open and the list of fields of 
     the records are not the same . Or , this happens when both are closed and the 
     list of fields of the records are not the same also . In these cases , 
     unification is not yet definitively a failure since column unification may 
     take the precedence and , if it is a success , then will lead to a sum type 
     instead of a record type , this sum type having cases being the union of the 
     2 records to initially unify . 
     In any case ( error or success ) , this function keeps the trace of the 
     modifications done by the unification . This will be the job of the initial 
     caller ( [ unify_simple_type ] , [ unify_row_type ] or [ unify_column_type ] ) to 
     deal with what to do of this trace . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Not exported outside this module .                         
    Unification is performed "in place", i.e. by physically modifying the
    variables on which a substitution must be applied in order to make the 2
    types equal.
    Differently from other unification routines, this one returns a boolean
    telling if the unification was a success of if it failed due to endings
    compatibility.
    More in detail, there are 2 cases where unification of rows can fail.
    First one, and hardest one, there exist 2 fields in common in the 2 record
    types that have incompatible types. In such a case, the unification really
    and definitively fails.
    The second case is when common fields have compatible types but the 2 rows
    can't unify because they have incompatible endings. Intuitively, this
    happens when one is closed and the other is open and the list of fields of
    the records are not the same. Or, this happens when both are closed and the
    list of fields of the records are not the same also. In these cases,
    unification is not yet definitively a failure since column unification may
    take the precedence and, if it is a success, then will lead to a sum type
    instead of a record type, this sum type having cases being the union of the
    2 records to initially unify.
    In any case (error or success), this function keeps the trace of the
    modifications done by the unification. This will be the job of the initial
    caller ([unify_simple_type], [unify_row_type] or [unify_column_type]) to
    deal with what to do of this trace.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
and __unify_row_type is_under_coercion env seen_expansions row_ty1 row_ty2 =
  First , get the canonical representation of the 2 row types to unify .
  let row_ty1 = W_CoreTypes.row_type_repr row_ty1 in
  let row_ty2 = W_CoreTypes.row_type_repr row_ty2 in
  if row_ty1 == row_ty2 then
    (* Unification is a full success since rows are physically the same. *)
    true
  else
    match (row_ty1.W_Algebra.rt_value, row_ty2.W_Algebra.rt_value) with
    | (([], W_Algebra.Closed_row), ([], W_Algebra.Closed_row)) ->
        (* This corresponds to the case:
             o U o
           This is also a full success. *)
        true
    | (([], (W_Algebra.Var_row rv1)),
       ([], (W_Algebra.Var_row rv2))) when rv1 == rv2 ->
        (* This corresponds to the case:
             same-rho-var U same-rho-var
           This is also a full success. *)
        true
    | (([], (W_Algebra.Var_row rv1)), (_, _)) ->
        (* This corresponds to the case:
           rho-var U any-row
           This is also a full success. *)
        lowerize_level_in_row rv1.W_Algebra.rv_level row_ty2 ;
        (* Don't forget to cleanup the lowerized type. *)
        W_CoreTypes.cleanup_row_type row_ty2 ;
        (* In this case, [rv1] must be set equal to the other row. *)
        W_CoreTypes.change_row_var_link
          ~receiver: rv1 ~link_val: (W_Algebra.Row_known row_ty2) ;
        true
    | ((_, _), ([], (W_Algebra.Var_row rv2))) ->
        (* This corresponds to the case:
           any-row U rho-var
           This is also a full success. *)
        lowerize_level_in_row rv2.W_Algebra.rv_level row_ty1 ;
        (* Don't forget to cleanup the lowerized type. *)
        W_CoreTypes.cleanup_row_type row_ty1 ;
        (* In this case, [rv2] must be set equal to the other row. *)
        W_CoreTypes.change_row_var_link
          ~receiver: rv2 ~link_val: (W_Algebra.Row_known row_ty1) ;
        true
    | (([], W_Algebra.Closed_row), (_, _))
    | ((_, _), ([], W_Algebra.Closed_row)) ->
  Error trying to unify a closed empty row with something that contains 
            fields . The unification is not yet definitively a failure , however 
            it is not a success . May be trying to unify columns will lead to 
            a correct sum type . We return [ false ] to tell that the unification 
            failed , and this will be checked by [ _ _ unify_column_type ] to try 
            unifying with its next case . To , beware this is * * not * * a real 
            failure !
           fields. The unification is not yet definitively a failure, however
           it is not a success. May be trying to unify columns will lead to
           a correct sum type. We return [false] to tell that the unification
           failed, and this will be checked by [__unify_column_type] to try
           unifying with its next case. To, beware this is **not** a real
           failure ! *)
        false
    | ((row1_fields, row1_ending), (row2_fields, row2_ending)) ->
        (* This corresponds to the general case:
           any-row-with-fields U any-row-with-fields *)
        let field0 = List.hd row1_fields in
        let phi0 = (List.tl row1_fields, row1_ending) in
        let field1 = List.hd row2_fields in
        let phi1 = (List.tl row2_fields, row2_ending) in
        if __unify_field is_under_coercion 
             env seen_expansions field0 field1 then
          (* If head field labels are equal, then we must unify their types by
             side effect and go on with the remaining fields. *)
          __unify_row_type is_under_coercion
            env seen_expansions
            { W_Algebra.rt_value = phi0 } { W_Algebra.rt_value = phi1 }
        else
          (
            let fresh_rv = W_CoreTypes.__row_variable () in
  Create the fresh variable directly with a level being the minimum 
                of the 2 endings if they were variables . Otherwise , with the 
                current binding level .
               of the 2 endings if they were variables. Otherwise, with the
               current binding level. *)
            W_CoreTypes.change_row_var_level
              fresh_rv (min_level_of_row_endings row1_ending row2_ending) ;
  Now , unify in cross . Do not unify lazily because we need to 
                anyway ensure that the common fields have compatible types 
                even if one of the sub - unification tells us it is not a 
                success .
               anyway ensure that the common fields have compatible types
               even if one of the sub-unification tells us it is not a
               success. *)
            let success1 =
              __unify_row_type is_under_coercion
                env seen_expansions
                { W_Algebra.rt_value = phi0 }
                { W_Algebra.rt_value =
                    ([field1], (W_Algebra.Var_row fresh_rv)) } in
            let success2 =
              __unify_row_type is_under_coercion
                env seen_expansions
                { W_Algebra.rt_value = phi1 }
                { W_Algebra.rt_value =
                    ([field0], (W_Algebra.Var_row fresh_rv)) } in
            success1 && success2
          )



(* ************************************************************************** *)
* { b  } : Unification of 2 column types . Since row and columns are really 
     symmetrical , this unification function works exactly like its counterpart 
     for row types . 
     In any case ( error or success ) , this function keeps the trace of the 
     modifications done by the unification . This will be the job of the initial 
     caller ( [ unify_simple_type ] , [ unify_row_type ] or [ unify_column_type ] ) to 
     deal with what to do of this trace . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     @raise Unification_column_conflict 
     { b Visibility } : Not exported outside this module .                         
    symmetrical, this unification function works exactly like its counterpart
    for row types.
    In any case (error or success), this function keeps the trace of the
    modifications done by the unification. This will be the job of the initial
    caller ([unify_simple_type], [unify_row_type] or [unify_column_type]) to
    deal with what to do of this trace.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    @raise Unification_column_conflict
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
and __unify_column_type is_under_coercion env seen_expansions col_ty1 col_ty2 =
  First , get the canonical representation of the 2 column types to unify .
  let col_ty1 = W_CoreTypes.column_type_repr col_ty1 in
  let col_ty2 = W_CoreTypes.column_type_repr col_ty2 in
  if col_ty1 == col_ty2 then ()
  else
    match (col_ty1.W_Algebra.ct_value, col_ty2.W_Algebra.ct_value) with
    | (([], W_Algebra.Closed_column), ([], W_Algebra.Closed_column)) ->
        (* This corresponds to the case:
             o U o *)
        ()
    | (([], (W_Algebra.Var_column cv1)), ([], (W_Algebra.Var_column cv2)))
          when cv1 == cv2 ->
        (* This corresponds to the case:
             same-column-var U same-column-var *)
        ()
    | (([], (W_Algebra.Var_column cv1)), (_, _)) ->
        (* This corresponds to the case:
           column-var U any-column *)
        lowerize_level_in_column cv1.W_Algebra.cv_level col_ty2 ;
        (* Don't forget to cleanup the lowerized type. *)
        W_CoreTypes.cleanup_column_type col_ty2 ;
        (* In this case, cv1 must be set equal to the other column. *)
        W_CoreTypes.change_column_var_link
          ~receiver: cv1 ~link_val: (W_Algebra.Col_known col_ty2)
    | ((_, _), ([], (W_Algebra.Var_column cv2))) ->
        (* This corresponds to the case:
           any-column U column-var *)
        lowerize_level_in_column cv2.W_Algebra.cv_level col_ty1 ;
        (* Don't forget to cleanup the lowerized type. *)
        W_CoreTypes.cleanup_column_type col_ty1 ;
  In this case , cv2 must be set equal to the other column .
        W_CoreTypes.change_column_var_link
          ~receiver: cv2 ~link_val: (W_Algebra.Col_known col_ty1)
    | (([], W_Algebra.Closed_column), (_, _))
    | ((_, _), ([], W_Algebra.Closed_column)) ->
        (* Error trying to unify a closure with something that contains rows
           (sum cases). *)
        raise (Unification_column_conflict (col_ty1, col_ty2)) ;
    | ((col1_row, col1_ending), (col2_row, col2_ending)) ->
        (* This corresponds to the general case:
           any-column-with-row U any-column-with-row *)
        let record0 = List.hd col1_row in
        let phi0 = (List.tl col1_row, col1_ending) in
        let record1 = List.hd col2_row in
        let phi1 = (List.tl col2_row, col2_ending) in
        (* Record the unification changes state to revert back to this point
           in case the unification on the row would fail. *)
        let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
        if __unify_row_type is_under_coercion
             env seen_expansions record0 record1 then (
          (* If head records are unifiable, then we must go on with the
             remaining records. *)
          __unify_column_type is_under_coercion
            env seen_expansions
            { W_Algebra.ct_value = phi0 } { W_Algebra.ct_value = phi1 }
        )
        else (
  Revert the unification changes back to the point before trying 
              to unify the 2 rows . We do not catch hard type errors reported 
              via [ Unification_simple_type_conflict ] since these ones 
              represent real type error . Only failure on row ( endings ) are 
              legal to consider as allowing to unify with another row along 
              the column .
             to unify the 2 rows. We do not catch hard type errors reported
             via [Unification_simple_type_conflict] since these ones
             represent real type error. Only failure on row (endings) are
             legal to consider as allowing to unify with another row along
             the column. *)
          W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
          (* Head records can't be unified because one or both are closed
             and this closure prevent row "appending". However, their
             common fields are type-compatible. *)
          let fresh_cv = W_CoreTypes.__column_variable () in
  Create the fresh variable directly with a level being the minimum 
              of the 2 endings if they were variables . Otherwise , with the 
              current binding level .
             of the 2 endings if they were variables. Otherwise, with the
             current binding level. *)
          W_CoreTypes.change_column_var_level
            fresh_cv (min_level_of_column_endings col1_ending col2_ending) ;
          (* Now, unify in cross. *)
          __unify_column_type is_under_coercion
            env seen_expansions
            { W_Algebra.ct_value = phi0 }
            { W_Algebra.ct_value =
                ([record1], (W_Algebra.Var_column fresh_cv)) } ;
          __unify_column_type is_under_coercion
            env seen_expansions
            { W_Algebra.ct_value = phi1 }
            { W_Algebra.ct_value =
                ([record0], (W_Algebra.Var_column fresh_cv)) }
        )



(* ************************************************************************** *)
* { b  } : Unification of 2 record fields . Fields are unifiable if they 
     have the same name and if their types are unifiable . This function performs 
     unification in place if possible and returns a boolean telling if the 
     unification succeeded . 
     There are 2 cases where unification can fail : either the fields names are 
     different and then the function stops , returning false , or the fields names 
     are the same but their types are not unifiable and in this case , an error 
     is directly raised ( no need to even return any boolean ) . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Not exported outside this module .                         
    have the same name and if their types are unifiable. This function performs
    unification in place if possible and returns a boolean telling if the
    unification succeeded.
    There are 2 cases where unification can fail: either the fields names are
    different and then the function stops, returning false, or the fields names
    are the same but their types are not unifiable and in this case, an error
    is directly raised (no need to even return any boolean).
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Not exported outside this module.                         *)
(* ************************************************************************** *)
and __unify_field is_under_coercion env seen_expansions  
      (field_name1, field_ty1) (field_name2, field_ty2) =
  if field_name1 <> field_name2 then false
  else (
    try
      __unify_simple_type is_under_coercion env seen_expansions field_ty1 field_ty2 ;
      (* If the above unification succeeded, then we arrive here then return a
         boolean telling that everything succeeded. Otherwise, the above
         unification will have raised an exception, and then we never arrive
         here. *)
      true
    with
    | Unification_simple_type_conflict
        (t1, t2, { ucd_kind = k ; ucd_through_field = None }) ->
  Embedd the name of the fields in each type that caused the error . 
            Since both fields have the same name , we expected them to be 
            unifiable . Reminding the name the these fields my give better error 
            messages . We only embedd the name if none was already recorded , this 
            way , we keep the deepest guilty field of the type structure .
           Since both fields have the same name, we expected them to be
           unifiable. Reminding the name the these fields my give better error
           messages. We only embedd the name if none was already recorded, this
           way, we keep the deepest guilty field of the type structure. *)
        raise
          (Unification_simple_type_conflict
             (t1, t2, { ucd_kind = k ; ucd_through_field = Some field_name1 }))
  )


(* ************************************************************************** *)
* { b  } : 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 .                         
    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 =
      __unify_simple_type true env seen_expansions ty1 ty2

(* ************************************************************************** *)
* { b  } : Unification of 2 simple types . The unification is performed by 
     side effect , physically modifying type variables to make them equal to what 
     they must be instantiated by the MGU substitution . 
     If unification is a success , this function forgets the trace of the 
     modifications done by the unification , otherwise it reverts them , hence 
     restoring the types as they were before starting to unify them . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Exported outside this module .                             
    side effect, physically modifying type variables to make them equal to what
    they must be instantiated by the MGU substitution.
    If unification is a success, this function forgets the trace of the
    modifications done by the unification, otherwise it reverts them, hence
    restoring the types as they were before starting to unify them.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Exported outside this module.                             *)
(* ************************************************************************** *)
let unify_simple_type env ty1 ty2 =
  #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
  OManager.printf "unify_simple_type@." ;
  #<End> ;     (* <---------- END DEBUG *)
  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
  try
    __unify_simple_type false env W_TypeAbbrevs.empty_memory ty1 ty2 ;
    #<If:TYPER $minlevel 11> (* <---------- DEBUG *)
    OManager.printf "Ended unify_simple_type@." ;
    #<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@." ;
    #<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
    __unify_simple_type true env W_TypeAbbrevs.empty_memory ty1 ty2 ;
    #<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


(* ************************************************************************** *)
* { b  } : Unification of 2 row types . Unification is performed " in place " , 
     i.e. by physically modifying the variables on which a substitution must be 
     applied in order to make the 2 types equal . 
     If unification is a success , this function forgets the trace of the 
     modifications done by the unification , otherwise it reverts them , hence 
     restoring the types as they were before starting to unify them . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Exported outside this module .                             
    i.e. by physically modifying the variables on which a substitution must be
    applied in order to make the 2 types equal.
    If unification is a success, this function forgets the trace of the
    modifications done by the unification, otherwise it reverts them, hence
    restoring the types as they were before starting to unify them.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Exported outside this module.                             *)
(* ************************************************************************** *)
let unify_row_type env row_ty1 row_ty2 =
  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
  try
    if __unify_row_type false env W_TypeAbbrevs.empty_memory row_ty1 row_ty2 then (
      (* Forget the unification trace since unification succeeded. No need to
         remind them since we won't revert this unification. *)
      W_CoreTypes.reset_unification_changes_trace () ;
      true
    )
    else (
      (* In fact, unification failed, so revert the changes it did. *)
      W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
      false
    )
  with any ->
    (* Other case of unification that failed. Do the same thing than above,
       i.e. revert the changes it did. *)
    W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
    raise any



(* ************************************************************************** *)
* { b  } : Unification of 2 column types . If unification is a success , this 
     function forgets the trace of the modifications done by the unification , 
     otherwise it reverts them , hence restoring the types as they were before 
     starting to unify them . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Exported outside this module .                             
    function forgets the trace of the modifications done by the unification,
    otherwise it reverts them, hence restoring the types as they were before
    starting to unify them.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Exported outside this module.                             *)
(* ************************************************************************** *)
let unify_column_type env column_ty1 column_ty2 =
  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
  try
    __unify_column_type false env W_TypeAbbrevs.empty_memory column_ty1 column_ty2 ;
    (* Forget the unification trace since unification succeeded. No need to
       remind them since we won't revert this unification. *)
    W_CoreTypes.reset_unification_changes_trace ()
  with any ->
    (* Unification failed, so revert the changes it did. *)
    W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
    raise any



(* [TODO-REFACTOR] DOCUMENTATION. *)
let _ = W_TypingEnv.forward_ref__unify_simple_type :=
  (fun env t1 t2 ->
     __unify_simple_type false env W_TypeAbbrevs.empty_memory t1 t2)
let _ = W_TypingEnv.forward_ref__unify_row_type :=
  (fun env row_ty1 row_ty2 ->
     __unify_row_type false env W_TypeAbbrevs.empty_memory row_ty1 row_ty2)
let _ = W_TypingEnv.forward_ref__unify_column_type :=
  (fun env column_ty1 column_ty2 ->
     __unify_column_type false env W_TypeAbbrevs.empty_memory column_ty1 column_ty2)

 depends 
* No additionnal and more precise information. This is the
                   general failure case where types are simply incompatible. 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 Types (variables) marked as generalized are those left marked
               under a forall-type, hence remains bound by a scheme, hence must
               not be lowerized. So if a variable has the generic binding level,
               we don't touch its level. 
 Set the level inside the type. 
 Other markers. 
 ************************************************************************** 
 ************************************************************************** 
 Variables marked as generalized are those left marked under a
          forall-type, hence remains bound by a scheme, hence must not be
          lowerized. So if a variable has the generic binding level, we
          don't touch its level. 
 ************************************************************************** 
 ************************************************************************** 
 Variables marked as generalized are those left marked under a
          forall-type, hence remains bound by a scheme, hence must not be
          lowerized. So if a variable has the generic binding level, we
          don't touch its level. 
 ************************************************************************** 
 ************************************************************************** 
 None of the endings is a variable, hence there is no smaller level
         than the current one. 
 ************************************************************************** 
 ************************************************************************** 
 None of the endings is a variable, hence there is no smaller level
         than the current one. 
 ************************************************************************* 
 ************************************************************************* 
 If the variable can't be removed because it is not in the list, then
       [Not_found] will be raised. 
 ************************************************************************* 
 bool -> W_Algebra.row_variable list -> W_Algebra.row_variable list -> bool
 ************************************************************************* 
 Instantiated by something else than a variable. 
 If the variable can't be removed because it is not in the list, then
       [Not_found] will be raised. 
 Same explanation than in [check_type_variables_are_in_injection] above. 
 ************************************************************************* 
 bool -> W_Algebra.column_variable list  
        -> W_Algebra.column_variable list -> bool                            
 ************************************************************************* 
 Same explanation than in [check_row_variables_are_in_injection] above. 
 Same explanation than in [check_type_variables_are_in_bijection] above. 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 <---------- DEBUG 
 <---------- END DEBUG 
 Arbitrary: v1 <- v2. 
 v1 <- v2. 
 v2 <- v1. 
 The most recent variable <- the oldest variable. We use
                    stamps for this. 
 [var1] has no name or both have names and [var1] is the most
                recent variable. Hence it will be assigned the identity of
                [var2]. 
 [var1] has a name or both have names and [var2] is the most
                recent variable. So [var2] will be assigned the identity of
               [var1] and the process is symetrical than above. 
 Prevents creating cycles through unification of ['a] and ['a t] when
          ['a t] is defined as [type 'a t = 'a u = 'a v ... = 'a]. 
 If the variable is generalized, then we must not unify since this
             would means a loss of generality. In effect, generalized variable
             are not instantiable ! 
 Don't forget to cleanup the lowerized type. 
 Case symmetric than the previous one. 
 Don't forget to cleanup the lowerized type. 
 Unify the types of results. 
 Two instances of a same named type should have either no
                    manifest representation or both one. 
 name <> name' 
 Same remark about trivially cyclic types than in the previous
             match case. 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 Same remark about trivially cyclic types than in the previous
           match case. 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 At this point, recover the unification on columns failure.
             [TODO] There should be a clear error message here, but for the
             moment it's rather crude. ^^ 
 We must take an instance of each scheme body, but make so that
           generalized variables keep a generic level. This means that we
           must create a copy of the bodies, with fresh variables in place
           of the generalized ones, but these fresh variables being still
           at generic level. Making a copy prevents from dirtying our
           schemes. Forcing copies of generalized variables to be generic
           will allow unification not to instantiate them by something else
           than another generic variable. 
 Create the mappings of generalized variables of the scheme onto
           fresh *also generalized* type variables. 
 Do the same thing for row variables... 
 Do the same thing for column variables... 
 Ensure that both schemes have the same number of variables. 
 Now, create the instances of the type schemes. 
 And now, perform the unification. Because variables that were
           generalized in the schemes have been copied, unification will
           operate on these copies, hence preventing from dirtying the
           schemes original generalized variables. 
 if under coercion check only for injection, 
           otherwise check for bijection 
 [TODO-REFACTOR] DOCUMENTATION. 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 Else 0. 
 Not ((h_nty1 < 0) && (h_nty2 < 0)). 
 <---------- DEBUG 
 <---------- END DEBUG 
 Expand left once then unify expanded left and right. 
 <---------- DEBUG 
 <---------- END DEBUG 
 Else 1. 
 (h_nty1 >= 0). 
 <---------- DEBUG 
 <---------- END DEBUG 
 Expand right once then unify left and expanded right. 
 <---------- DEBUG 
 <---------- END DEBUG 
 Else 2. 
 None of heights are negative. 
 <---------- DEBUG 
 <---------- END DEBUG 
 None of heights are negative and they are equal. 
 <---------- DEBUG 
 <---------- END DEBUG 
 Else 3. 
 None of heights are negative and they are not equal.
             Expand highest to match lowest's level then unify left (possibly
             expanded) and right (possibly expanded).
             If both are at the same level: unwind them once. 
 <---------- DEBUG 
 <---------- END DEBUG 
 None of heights are negative and left is lower than right.
               Expand right. 
 <---------- DEBUG 
 <---------- END DEBUG 
 Else 4. 
 <---------- DEBUG 
 <---------- END DEBUG 
 None of heights are negative and left is greater than right.
               Expand left. 
 <---------- DEBUG 
 <---------- END DEBUG 
 End of else 0. 
 ************************************************************************** 
 ************************************************************************** 
 Unification is a full success since rows are physically the same. 
 This corresponds to the case:
             o U o
           This is also a full success. 
 This corresponds to the case:
             same-rho-var U same-rho-var
           This is also a full success. 
 This corresponds to the case:
           rho-var U any-row
           This is also a full success. 
 Don't forget to cleanup the lowerized type. 
 In this case, [rv1] must be set equal to the other row. 
 This corresponds to the case:
           any-row U rho-var
           This is also a full success. 
 Don't forget to cleanup the lowerized type. 
 In this case, [rv2] must be set equal to the other row. 
 This corresponds to the general case:
           any-row-with-fields U any-row-with-fields 
 If head field labels are equal, then we must unify their types by
             side effect and go on with the remaining fields. 
 ************************************************************************** 
 ************************************************************************** 
 This corresponds to the case:
             o U o 
 This corresponds to the case:
             same-column-var U same-column-var 
 This corresponds to the case:
           column-var U any-column 
 Don't forget to cleanup the lowerized type. 
 In this case, cv1 must be set equal to the other column. 
 This corresponds to the case:
           any-column U column-var 
 Don't forget to cleanup the lowerized type. 
 Error trying to unify a closure with something that contains rows
           (sum cases). 
 This corresponds to the general case:
           any-column-with-row U any-column-with-row 
 Record the unification changes state to revert back to this point
           in case the unification on the row would fail. 
 If head records are unifiable, then we must go on with the
             remaining records. 
 Head records can't be unified because one or both are closed
             and this closure prevent row "appending". However, their
             common fields are type-compatible. 
 Now, unify in cross. 
 ************************************************************************** 
 ************************************************************************** 
 If the above unification succeeded, then we arrive here then return a
         boolean telling that everything succeeded. Otherwise, the above
         unification will have raised an exception, and then we never arrive
         here. 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 ************************************************************************** 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 <---------- DEBUG 
 <---------- END DEBUG 
 ************************************************************************** 
 ************************************************************************** 
 Forget the unification trace since unification succeeded. No need to
         remind them since we won't revert this unification. 
 In fact, unification failed, so revert the changes it did. 
 Other case of unification that failed. Do the same thing than above,
       i.e. revert the changes it did. 
 ************************************************************************** 
 ************************************************************************** 
 Forget the unification trace since unification succeeded. No need to
       remind them since we won't revert this unification. 
 Unification failed, so revert the changes it did. 
 [TODO-REFACTOR] DOCUMENTATION. 

     Copyright © 2011 , 2012 MLstate 

     This file is part of  . 

      is free software : you can redistribute it and/or modify it under the 
     terms of the GNU Affero General Public License , version 3 , as published by 
     the Free Software Foundation . 

      is distributed in the hope that it will be useful , but WITHOUT ANY 
     WARRANTY ; without even the implied warranty of MERCHANTABILITY or FITNESS 
     FOR A PARTICULAR PURPOSE . See the GNU Affero General Public License for 
     more details . 

     You should have received a copy of the GNU Affero General Public License 
     along with  . If not , see < / > . 

    Copyright © 2011, 2012 MLstate

    This file is part of Opa.

    Opa is free software: you can redistribute it and/or modify it under the
    terms of the GNU Affero General Public License, version 3, as published by
    the Free Software Foundation.

    Opa is distributed in the hope that it will be useful, but WITHOUT ANY
    WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
    FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
    more details.

    You should have received a copy of the GNU Affero General Public License
    along with Opa. If not, see </>.
*)

    @author   

   @author François Pessaux
*)


module List = BaseList




type detail_kind =
* Arity mismatch between 2 function 
                                            types .
                                           types. *)
* Arity 
          mismatch between the arguments of 2 instances of a same named type .
         mismatch between the arguments of 2 instances of a same named type. *)
* Case of unification between 2 type 
          variables with one being generalized and the other not , or between a 
          generalized type variable and another type ( not being a type 
          variable ) .
         variables with one being generalized and the other not, or between a
         generalized type variable and another type (not being a type
         variable). *)
* Case where the 2 
          schemes of types forall do not have the same number of generalized 
          variables .
         schemes of types forall do not have the same number of generalized
         variables. *)



* { b  } : Information precising a unification conflict when the unification 
     failed in a case where we can give more accurate description of the issue 
     to the user . 
     { b Visibility } : Exported outside this module .                             
    failed in a case where we can give more accurate description of the issue
    to the user.
    {b Visibility}: Exported outside this module.                             *)
type unification_conflict_detail = {
  ucd_kind : detail_kind ;
* If the unification conflict appeared 
      through the unification of 2 record fields of same name , this is the name 
      of the 2 fields that caused the error .
     through the unification of 2 record fields of same name, this is the name
     of the 2 fields that caused the error. *)
}



* { b  } : Exception raised in case of unification failure on 2 simple 
     types . 
     { b Visibility } : Exported outside this module .                             
    types.
    {b Visibility}: Exported outside this module.                             *)
exception Unification_simple_type_conflict of
  (W_Algebra.simple_type * W_Algebra.simple_type * unification_conflict_detail)



* { b  } : Exception raised in case of unification failure on 2 sum 
     types ( i.e. on 2 columns ) . This exception must not escape when unification 
     i d triggered by a call to the unification between 2 [ simple_type]s and 
     must caught by it ( [ unify_simple_type ] ) to issue an explicit error message . 
     Because we finally needed to export [ unify_column_type ] , this exception 
     can only escape outside this module if unification is triggered by a call 
     to unification between 2 column types . 
     { b Visibility } : Exported outside this module .                             
    types (i.e. on 2 columns). This exception must not escape when unification
    id triggered by a call to the unification between 2 [simple_type]s and
    must caught by it ([unify_simple_type]) to issue an explicit error message.
    Because we finally needed to export [unify_column_type], this exception
    can only escape outside this module if unification is triggered by a call
    to unification between 2 column types.
    {b Visibility}: Exported outside this module.                             *)
exception Unification_column_conflict of
  (W_Algebra.column_type * W_Algebra.column_type)



* { b  } :  types level inside a [ simple_type ] . 
     { b Visibility } : Not exported outside this module .                         
    {b Visibility}: Not exported outside this module.                         *)
let rec lowerize_level_in_simple_type max_level ty =
  assert (max_level < W_CoreTypes.generic_binding_level) ;
  First , get the canonical representation of the type .
  let ty = W_CoreTypes.simple_type_repr ty in
  match ty.W_Algebra.sty_mark with
  | W_Algebra.TM_lowerise_seen -> ()
  | W_Algebra.TM_not_seen -> (
  First , mark the type as as seen to prevent looping .
      ty.W_Algebra.sty_mark <- W_Algebra.TM_lowerise_seen ;
      match ty.W_Algebra.sty_desc with
      | W_Algebra.SType_var ty_var_desc -> (
          if ty_var_desc.W_Algebra.tv_level > max_level then (
            if ty_var_desc.W_Algebra.tv_level <>
              W_CoreTypes.generic_binding_level then (
                W_CoreTypes.change_ty_var_level ty_var_desc max_level
              )
          )
        )
      | W_Algebra.SType_arrow (args_tys, res_ty) ->
          List.iter (lowerize_level_in_simple_type max_level) args_tys ;
          lowerize_level_in_simple_type max_level res_ty
      | W_Algebra.SType_named named ->
          (match named.W_Algebra.nst_unwinded with
           | None -> ()
           | Some t' -> lowerize_level_in_simple_type max_level t') ;
          List.iter
            (lowerize_level_in_simple_type max_level) named.W_Algebra.nst_args
      | W_Algebra.SType_sum_of_records sumcases_column ->
          lowerize_level_in_column max_level sumcases_column
      | W_Algebra.SType_forall scheme ->
          lowerize_level_in_simple_type max_level scheme.W_Algebra.body
    )



* { b  } :  variables level inside a row type . 
     { b Visibility } : Not exported outside this module .                         
    {b Visibility}: Not exported outside this module.                         *)
and lowerize_level_in_row max_level row =
  First , get the canonical representation of the row type .
  let (row_fields, row_ending) =
    (W_CoreTypes.row_type_repr row).W_Algebra.rt_value in
  List.iter
    (fun (_, ty) -> lowerize_level_in_simple_type max_level ty) row_fields ;
  (match row_ending with
   | W_Algebra.Var_row row_variable ->
       if row_variable.W_Algebra.rv_level > max_level &&
         row_variable.W_Algebra.rv_level <>
         W_CoreTypes.generic_binding_level then
           W_CoreTypes.change_row_var_level row_variable max_level
   | W_Algebra.Closed_row -> ())



* { b  } :  variables level inside a column type . 
     { b Visibility } : Not exported outside this module .                         
    {b Visibility}: Not exported outside this module.                         *)
and lowerize_level_in_column max_level column =
  First , get the canonical representation of the column type .
  let (col_rows, col_ending) =
    (W_CoreTypes.column_type_repr column).W_Algebra.ct_value in
  List.iter (lowerize_level_in_row max_level) col_rows ;
  (match col_ending with
   | W_Algebra.Var_column col_variable ->
       if col_variable.W_Algebra.cv_level > max_level  &&
         col_variable.W_Algebra.cv_level <>
         W_CoreTypes.generic_binding_level then
           W_CoreTypes.change_column_var_level col_variable max_level
     | W_Algebra.Closed_column -> ())



* { b  } : Computes the min binding level of 2 row endings . This is used 
     when creating a new row variable for unification , in order to give it 
     directly a binding level being the smallest one of the 2 endings of the 
     rows we want to unify . 
     If none of the endings have a variable , then the returned minimal level is 
     the current binding level , i.e. the one with which anyway the fresh variable 
     created before calling this function was initialized . 
     { b ATTENTION } : This function assumes it is called on row endings that are 
     canonical representation , i.e. obtained after a call to [ row_type_repr ] . 
     { b Visibility } : Not exported outside this module .                         
    when creating a new row variable for unification, in order to give it
    directly a binding level being the smallest one of the 2 endings of the
    rows we want to unify.
    If none of the endings have a variable, then the returned minimal level is
    the current binding level, i.e. the one with which anyway the fresh variable
    created before calling this function was initialized.
    {b ATTENTION}: This function assumes it is called on row endings that are
    canonical representation, i.e. obtained after a call to [row_type_repr].
    {b Visibility}: Not exported outside this module.                         *)
let min_level_of_row_endings end1 end2 =
  match (end1, end2) with
  | (W_Algebra.Closed_row, W_Algebra.Closed_row) ->
      !W_CoreTypes.current_binding_level
  | ((W_Algebra.Var_row rv), W_Algebra.Closed_row)
  | (W_Algebra.Closed_row, (W_Algebra.Var_row rv)) ->
  There is only one ending with a variable . Then the minimal level is 
          the one of this only variable .
         the one of this only variable. *)
      rv.W_Algebra.rv_level
  | ((W_Algebra.Var_row rv1), (W_Algebra.Var_row rv2)) ->
      min rv1.W_Algebra.rv_level rv2.W_Algebra.rv_level



* { b  } : Computes the min binding level of 2 column endings . This 
     function works like its counterpart for row , i.e. 
     [ min_level_of_row_endings ] . 
     { b ATTENTION } : This function assumes it is called on column endings that are 
     canonical representation , i.e. obtained after a call to [ column_type_repr ] . 
     { b Visibility } : Not exported outside this module .                         
    function works like its counterpart for row, i.e.
    [min_level_of_row_endings].
    {b ATTENTION}: This function assumes it is called on column endings that are
    canonical representation, i.e. obtained after a call to [column_type_repr].
    {b Visibility}: Not exported outside this module.                         *)
let min_level_of_column_endings end1 end2 =
  match (end1, end2) with
  | (W_Algebra.Closed_column, W_Algebra.Closed_column) ->
      !W_CoreTypes.current_binding_level
  | ((W_Algebra.Var_column cv), W_Algebra.Closed_column)
  | (W_Algebra.Closed_column, (W_Algebra.Var_column cv)) ->
  There is only one ending with a variable . Then the minimal level is 
          the one of this only variable .
         the one of this only variable. *)
      cv.W_Algebra.cv_level
  | ((W_Algebra.Var_column cv1), (W_Algebra.Var_column cv2)) ->
      min cv1.W_Algebra.cv_level cv2.W_Algebra.cv_level



  bool - > W_Algebra.simple_type list - > W_Algebra.simple_type list - > bool  
* { b  } : Function checking if 2 type variables lists are in injection 
     and if the first argument is true , are also in bijection . 
     In other words , we have 2 lists of types [ v_vars ] and [ w_vars ] , assumed 
     all to be * type variables * and we want to ensure that all the variables 
     from the first list are equal ( i.e. were unified with ) one variable of 
     the second list and , if the first argument is true the other way : that 
     all the variables of the second list are equal ( were unified with ) to one 
     variable of the first list . 
     This obviously means that both lists have the same length . 
     This function is used to ensure that during unification of 2 types forall , 
     the generalized variables of both schemes we mapped one - to - one , in other 
     words that both schemes are as general . 
     Using this mechanism of bijection allows to be independant on the order 
     of variables in the quantifications of the schemes . In effect , we take an 
     instance of each scheme and unify the bodies of these instances . During 
     this unification , generalized type variables are mapped to their 
     counterpart in the other type . At the end , we just need to verify that 
     they were all mapped once to a counterpart variable . 
     Note by the was that because this applies on qualtified variables , since 
     unification allows to unify a generalized type variable only with a also 
     generalized other type variable , we are sure that at the end of unification , 
     then when we call the present function , all the variables manipulated will 
     be generalized ones . 
     { b Visibility } : Not exported outside this module .                        
    and if the first argument is true, are also in bijection.
    In other words, we have 2 lists of types [v_vars] and [w_vars], assumed
    all to be *type variables* and we want to ensure that all the variables
    from the first list are equal (i.e. were unified with) one variable of
    the second list and, if the first argument is true the other way: that 
    all the variables of the second list are equal (were unified with) to one 
    variable of the first list.
    This obviously means that both lists have the same length.
    This function is used to ensure that during unification of 2 types forall,
    the generalized variables of both schemes we mapped one-to-one, in other
    words that both schemes are as general.
    Using this mechanism of bijection allows to be independant on the order
    of variables in the quantifications of the schemes. In effect, we take an
    instance of each scheme and unify the bodies of these instances. During
    this unification, generalized type variables are mapped to their
    counterpart in the other type. At the end, we just need to verify that
    they were all mapped once to a counterpart variable.
    Note by the was that because this applies on qualtified variables, since
    unification allows to unify a generalized type variable only with a also
    generalized other type variable, we are sure that at the end of unification,
    then when we call the present function, all the variables manipulated will
    be generalized ones.
    {b Visibility}: Not exported outside this module.                        *)
let check_type_variables_are_in_injection check_bijection w_vars v_vars =
  Local function testing if 2 types are physically equal variables .
  let test_vars_eq t1 t2 =
    match (t1.W_Algebra.sty_desc, t2.W_Algebra.sty_desc) with
    | ((W_Algebra.SType_var v1), (W_Algebra.SType_var v2)) ->
        v1 == v2
    | (_, _) -> false in
  Local function that takes one variable and tries to remove it from the 
      list of other variables .
     list of other variables. *)
  let check_one_v v ws =
    List.remove_first_or_fail_eq ~eq: test_vars_eq v ws in
  Now , iterate the above local function on all the variables " v " . At each 
      iteration , we get a reduced list of variables " w " in which to find the 
      next variable " v " . At the end , we expect the remaining list of variables 
      " w " to be empty , i.e. meaning that all the variables " v " were found 
      equal to one unique variable " w " and reciprocally .
     iteration, we get a reduced list of variables "w" in which to find the
     next variable "v". At the end, we expect the remaining list of variables
     "w" to be empty, i.e. meaning that all the variables "v" were found
     equal to one unique variable "w" and reciprocally. *)
  try
    let remaining_ws =
      List.fold_left
        (fun accu_ws v -> check_one_v v accu_ws)
        (List.map W_CoreTypes.simple_type_repr w_vars) v_vars in
    if check_bijection then  assert (remaining_ws = []) ;
    true
  with Not_found ->  false



* { b  } : Performs the same job than 
     [ check_type_variables_are_in_injection ] above , but on row variables . 
     See header of [ check_type_variables_are_in_injection ] for more details . 
     { b Visibility } : Not exported outside this module .                        
    [check_type_variables_are_in_injection] above, but on row variables.
    See header of [check_type_variables_are_in_injection] for more details.
    {b Visibility}: Not exported outside this module.                        *)
let check_row_variables_are_in_injection check_bijection w_vars v_vars =
  We simulate a call to " repr " on a row variable . To do this , we manually 
      inspect the [ W_Algebra.rv_value ] fields . If it is [ W_Algebra .  ] 
      then the variable was not instantiated and we take it as it is . 
      If it is [ W_Algebra . Row_known , then we call [ W_CoreTypes.row_type_repr ] 
      to get the canonical representation of the variable 's value then we 
      check that we got a row type with not fields and if so , we take its 
      ending variable .
     inspect the [W_Algebra.rv_value] fields. If it is [W_Algebra.Row_unknown]
     then the variable was not instantiated and we take it as it is.
     If it is [W_Algebra.Row_known, then we call [W_CoreTypes.row_type_repr]
     to get the canonical representation of the variable's value then we
     check that we got a row type with not fields and if so, we take its
     ending variable. *)
  let repr v =
    match v.W_Algebra.rv_value with
    | W_Algebra.Row_unknown -> v
    | W_Algebra.Row_known row_type -> (
        match (W_CoreTypes.row_type_repr row_type).W_Algebra.rt_value with
        | ([], W_Algebra.Var_row v') -> v'
        | _ -> v
      ) in
  let check_one_v v ws =
    List.remove_first_or_fail_eq ~eq: (==) v ws in
  try
    let remaining_ws =
      List.fold_left
        (fun accu_ws v -> check_one_v v accu_ws)
        (List.map repr w_vars) v_vars in
    if check_bijection then assert (remaining_ws = []) ;
    true
  with Not_found -> false



* { b  } : Performs the same job than 
     [ check_type_variables_are_in_bijection ] above , but on column variables . 
     See header of [ check_type_variables_are_in_injection ] for more details . 
     { b Visibility } : Not exported outside this module .                        
    [check_type_variables_are_in_bijection] above, but on column variables.
    See header of [check_type_variables_are_in_injection] for more details.
    {b Visibility}: Not exported outside this module.                        *)
let check_column_variables_are_in_injection check_bijection w_vars v_vars =
  let repr v =
    match v.W_Algebra.cv_value with
    | W_Algebra.Col_unknown -> v
    | W_Algebra.Col_known col_type -> (
        match (W_CoreTypes.column_type_repr col_type).W_Algebra.ct_value with
        | ([], W_Algebra.Var_column v') -> v'
        | _ -> v
      ) in
  let check_one_v v ws =
    List.remove_first_or_fail_eq ~eq: (==) v ws in
  try
    let remaining_ws =
      List.fold_left
        (fun accu_ws v -> check_one_v v accu_ws)
        (List.map repr w_vars) v_vars in
    if check_bijection then assert (remaining_ws = []) ;
    true
  with Not_found -> false

* { b  } : Internal function catches the exception thrown by 
     [ _ _ unify_simple_type ] and raises a new one that contains the initial type 
     and not its synonim ( i.e. list(string ) instead of 
     { head : string ; tl : list(string ) } / nil ) 
     @raise Unification_simple_type_conflict 
     { b Visibility } : Not exported outside this module .                         
    [__unify_simple_type] and raises a new one that contains the initial type
    and not its synonim (i.e. list(string) instead of 
    {head:string; tl:list(string)} / nil)
    @raise Unification_simple_type_conflict
    {b Visibility}: Not exported outside this module.                         *)

let rec __unify_and_return_higher_type is_under_coercion 
          env seen_expansions ty1' ty2' ty1 ty2 = 
  try
    __unify_simple_type is_under_coercion env seen_expansions ty1' ty2'
  with (Unification_simple_type_conflict (ty3, ty4, context)) ->
    if ty1' == ty3 || ty1' == ty3 || ty2' == ty4 || ty2' == ty4
     then raise (Unification_simple_type_conflict(ty1, ty2, context))
     else raise (Unification_simple_type_conflict(ty3, ty4, context))

    
* { b  } : Internal function performing unification of 2 simple types . 
     In any case ( error or success ) , this function keeps the trace of the 
     modifications done by the unification . This will be the job of the initial 
     caller ( [ unify_simple_type ] , [ unify_row_type ] or [ unify_column_type ] ) to 
     deal with what to do of this trace . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Not exported outside this module .                         
    In any case (error or success), this function keeps the trace of the
    modifications done by the unification. This will be the job of the initial
    caller ([unify_simple_type], [unify_row_type] or [unify_column_type]) to
    deal with what to do of this trace.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Not exported outside this module.                         *)
and __unify_simple_type is_under_coercion env seen_expansions ty1 ty2 =
    OManager.printf "__unify_simple_type:%b  %a VERSUS %a@." is_under_coercion
    W_PrintTypes.pp_simple_type_start_sequence ty1
    W_PrintTypes.pp_simple_type_end_sequence ty2 ;
  Special case optimization just in case the 2 types are already the same .
  if ty1 == ty2 then () else
  First , get the canonical representation of the 2 types to unify .
  let ty1 = W_CoreTypes.simple_type_repr ty1 in
  let ty2 = W_CoreTypes.simple_type_repr ty2 in
  if ty1 == ty2 then ()
  else
    match (ty1.W_Algebra.sty_desc, ty2.W_Algebra.sty_desc) with
    | ((W_Algebra.SType_var var1), (W_Algebra.SType_var var2)) -> (
  Unification between variables must prevent unification of a 
            generalized variable with something else than another generalized 
            variable . Otherwise , this would mean that a generalized variable 
            gets no more generalized , hence one of the 2 unified types would 
            lose its generality .
           generalized variable with something else than another generalized
           variable. Otherwise, this would mean that a generalized variable
           gets no more generalized, hence one of the 2 unified types would
           lose its generality. *)
        if (var1.W_Algebra.tv_level <> W_CoreTypes.generic_binding_level &&
            var2.W_Algebra.tv_level <> W_CoreTypes.generic_binding_level)
           ||
           (var1.W_Algebra.tv_level = W_CoreTypes.generic_binding_level &&
            var2.W_Algebra.tv_level = W_CoreTypes.generic_binding_level) then (
  To try to preserve as far as we can the names given by the user to 
              variables , if we are unifying 2 variables with on having no name 
              and the other having a name , then we make the no - name equal to the 
              with - name . Note that in case both variables have a name , this 
              heuristic wo n't work and there is no principal better choice . 
              I do n't know why , I thought that keeping the most recent name was 
              better but in fact , it seems that keeping the oldest seems to 
              give the best results . This is really hackish .
             variables, if we are unifying 2 variables with on having no name
             and the other having a name, then we make the no-name equal to the
             with-name. Note that in case both variables have a name, this
             heuristic won't work and there is no principal better choice.
             I don't know why, I thought that keeping the most recent name was
             better but in fact, it seems that keeping the oldest seems to
             give the best results. This is really hackish. *)
          let v1_name = QmlTypeVars.TypeVar.name var1.W_Algebra.tv_qml in
          let v2_name = QmlTypeVars.TypeVar.name var2.W_Algebra.tv_qml in
  A bit casual : since there are only 2 ways to assign variables , we 
              encode the assignment way by a boolean . [ true ] means that [ var1 ] is 
              assigned the identity of [ var2 ] .
             encode the assignment way by a boolean. [true] means that [var1] is
             assigned the identity of [var2]. *)
          let way =
            (match (v1_name, v2_name) with
              | (_, _) ->
                 (QmlTypeVars.TypeVar.to_int var1.W_Algebra.tv_qml) >
                 (QmlTypeVars.TypeVar.to_int var2.W_Algebra.tv_qml)) in
          if way then (
  Behave like the general case var U ty . Since we are in a case 
                 of 2 variables . We must not forget to adjust the level of the 
                 first variable .
                of 2 variables. We must not forget to adjust the level of the
                first variable. *)
             if var2.W_Algebra.tv_level > var1.W_Algebra.tv_level then
               W_CoreTypes.change_ty_var_level var2 var1.W_Algebra.tv_level ;
             W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2)
             )
         else (
            if var1.W_Algebra.tv_level > var2.W_Algebra.tv_level then
               W_CoreTypes.change_ty_var_level var1 var2.W_Algebra.tv_level ;
             W_CoreTypes.change_ty_link ~receiver: ty2 ~link_val: (Some ty1)
            )
          )
        else (
  This is a failure case where one of the variable is generalized 
              and not the other . Hence accepting the unification would lead 
              into one of the type ( the more general ) to lose its generality 
              to become equal to the other . And in this case , unification 
              would not make the 2 types equal .
             and not the other. Hence accepting the unification would lead
             into one of the type (the more general) to lose its generality
             to become equal to the other. And in this case, unification
             would not make the 2 types equal. *)
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_binding_level_mismatch ;
                  ucd_through_field = None })) ;
        )
      )
    | ((W_Algebra.SType_var var1), _) -> (
        let are_same =
          W_TypeAbbrevs.deep_exact_occur_expand_abbrev
            env seen_expansions ~ty_var: ty1 ~in_ty: ty2 in
        if are_same then ()
        else (
          if var1.W_Algebra.tv_level = W_CoreTypes.generic_binding_level 
            then if is_under_coercion
                   then W_CoreTypes.change_ty_var_level var1
                          !W_CoreTypes.current_binding_level
                 else (
                   raise
                     (Unification_simple_type_conflict
                        (ty1, ty2,
                         { ucd_kind = DK_binding_level_mismatch ;
                           ucd_through_field = None })) 
                 );
          lowerize_level_in_simple_type var1.W_Algebra.tv_level ty2 ;
          W_CoreTypes.cleanup_simple_type ty2 ;
          W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2)
         )
       )
    | (_, (W_Algebra.SType_var var2)) -> (
        let are_same =
          W_TypeAbbrevs.deep_exact_occur_expand_abbrev
            env seen_expansions ~ty_var: ty2 ~in_ty: ty1 in
        if are_same then ()
        else (
          if var2.W_Algebra.tv_level = W_CoreTypes.generic_binding_level then
            raise
              (Unification_simple_type_conflict
                 (ty1, ty2,
                  { ucd_kind = DK_binding_level_mismatch ;
                    ucd_through_field = None })) ;
          lowerize_level_in_simple_type var2.W_Algebra.tv_level ty1 ;
          W_CoreTypes.cleanup_simple_type ty1 ;
          W_CoreTypes.change_ty_link ~receiver: ty2 ~link_val: (Some ty1)
         )
      )
    | (W_Algebra.SType_arrow (args_tys1, res_ty1),
       W_Algebra.SType_arrow (args_tys2, res_ty2)) -> (
  Ensure we are not in the case of an error of arity between the 
            two function types . Note that this also prevent the [ List.iter2 ] 
            exception from being raised in case of arity mismatch . 
            Making the test before unifying allows to issue a smarter error 
            message about arity before a possible type mismatch is detected and 
            issued first when unifying 2 - by-2 the non - matching expected and 
            provided types .
           two function types. Note that this also prevent the [List.iter2]
           exception from being raised in case of arity mismatch.
           Making the test before unifying allows to issue a smarter error
           message about arity before a possible type mismatch is detected and
           issued first when unifying 2-by-2 the non-matching expected and
           provided types. *)
        let n1 = List.length args_tys1 in
        let n2 = List.length args_tys2 in
        if n1 <> n2 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_fun_type_arity (n1, n2) ;
                  ucd_through_field = None })) ;
        W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;
  Unify types of arguments 2 by 2 .
        List.iter2
          (__unify_simple_type is_under_coercion env seen_expansions) args_tys1 args_tys2 ;
        __unify_simple_type is_under_coercion env seen_expansions res_ty1 res_ty2
       )
    | (W_Algebra.SType_named { W_Algebra.nst_name = name ;
                               W_Algebra.nst_args = args ;
                               W_Algebra.nst_unwinded = _manifest },
       W_Algebra.SType_named { W_Algebra.nst_name = name' ;
                               W_Algebra.nst_args = args' ;
                               W_Algebra.nst_unwinded = _manifest' })
        when QmlAst.TypeIdent.equal name name' -> (
          try
            W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;
            List.iter2 (__unify_simple_type is_under_coercion env seen_expansions) args args' ;
  Two instances of a same named type , as far as they have unifiable 
                arguments must have unifiable manifest representations . No need 
                to descend inside in order to save efficiency unless we want 
                to test assertions . 
                Moreover , with incremental abbreviations unwinding , this may not 
                hold anymore ...
               arguments must have unifiable manifest representations. No need
               to descend inside in order to save efficiency unless we want
               to test assertions.
               Moreover, with incremental abbreviations unwinding, this may not
               hold anymore... *)

             ( match ( manifest , manifest ' ) with 
              | ( None , None ) - > ( ) 
              | ( ( Some m ) , ( Some m ' ) ) - > 
                  _ _ unify_simple_type is_under_coercion env m m ' 
              | ( _ , _ ) - > 
                  ( * Two instances of a same named type should have either no 
                     manifest representation or both one .
            (match (manifest, manifest') with
             | (None, None) -> ()
             | ((Some m), (Some m')) ->
                 __unify_simple_type is_under_coercion env m m'
             | (_, _) ->
                 assert false) ;
            *)
          with Invalid_argument "List.iter2" ->
  In fact , we are in the case of an error of arity between the 
                two type constructors .
               two type constructors. *)
            let n1 = List.length args in
            let n2 = List.length args' in
            raise
              (Unification_simple_type_conflict
                 (ty1, ty2,
                  { ucd_kind = DK_named_type_arity (name, n1, n2) ;
                    ucd_through_field = None }))
        )
    | (W_Algebra.SType_named nty1,
       W_Algebra.SType_named nty2)
          __unify_different_named_types is_under_coercion env seen_expansions ty1 ty2 nty1 nty2
      )
    | ((W_Algebra.SType_named { W_Algebra.nst_unwinded = Some manifest }), _) ->
        OManager.printf "Case SType_named manifest / other: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        if ty1 == (W_CoreTypes.simple_type_repr manifest) then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_none ;
                  ucd_through_field = None })) ;
        __unify_simple_type is_under_coercion env seen_expansions ty2 manifest
    | (_, (W_Algebra.SType_named { W_Algebra.nst_unwinded = Some manifest })) ->
        OManager.printf "Case other / SType_named manifest: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        if ty2 == (W_CoreTypes.simple_type_repr manifest) then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        __unify_simple_type is_under_coercion env seen_expansions ty1 manifest
    | ((W_Algebra.SType_named { W_Algebra.nst_unwinded = None }), _) -> (
        OManager.printf "Case SType_named non-manifest / other: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        let (ty1', seen_expansions') =
          W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
        OManager.printf "SType_named non-manifest expanded: %a@."
          W_PrintTypes.pp_simple_type ty1' ;
        if ty1 == ty1' then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        __unify_and_return_higher_type is_under_coercion 
          env seen_expansions' ty2 ty1' ty2 ty1
       )
    | (_, (W_Algebra.SType_named { W_Algebra.nst_unwinded = None })) -> (
        OManager.printf "Case other / SType_named non-manifest: %a VERSUS %a@."
          W_PrintTypes.pp_simple_type_start_sequence ty1
          W_PrintTypes.pp_simple_type_end_sequence ty2 ;
        let (ty2', seen_expansions') =
          W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty2 in
        if ty2 == ty2' then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
          __unify_and_return_higher_type is_under_coercion
            env seen_expansions' ty1 ty2' ty1 ty2
       )
    | ((W_Algebra.SType_sum_of_records col1),
       (W_Algebra.SType_sum_of_records col2)) -> (
        try
          W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;
          __unify_column_type is_under_coercion env seen_expansions col1 col2
        with Unification_column_conflict (_, _) ->
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None }))
      )
    | ((W_Algebra.SType_forall scheme1), (W_Algebra.SType_forall scheme2)) -> (
        W_CoreTypes.change_ty_link ~receiver: ty1 ~link_val: (Some ty2) ;

           Naive unification , just instantiating both schemes then unifying 
           the obtained bodies is wrong ! 
           For example , on the following program we would get : 
             if true then { { i d = fun x - > x } } else { { i d = fun x - > 5 } } ; ; 
             - : { i d : for all ' Ta . ( ' Ta - > ' Ta ) ; . } / ' Ca 
           which is clearly wrong since in the second branch of the 
           conditional , the type of the function i d is not as general as 
           ' a - > ' a ! 
        
          Naive unification, just instantiating both schemes then unifying
          the obtained bodies is wrong !
          For example, on the following program we would get:
            if true then {{ id = fun x -> x }} else {{ id = fun x -> 5 }} ;;
            - : { id: for all 'Ta . ('Ta -> 'Ta); . } / 'Ca
          which is clearly wrong since in the second branch of the
          conditional, the type of the function id is not as general as
          'a -> 'a !
        *)

  We count by side effect the number of variables in each scheme 
            to save a call to  . A bit casual , but more efficient .
           to save a call to List.length. A bit casual, but more efficient. *)
        let count_ty_vars1 = ref 0 in
        let count_ty_vars2 = ref 0 in
        let ty_vars_mapping1 =
          List.map
            (fun sch ->
               incr count_ty_vars1 ;
               let tyv = W_CoreTypes.__generic_type_variable () in
               W_TypeInfo.add_linked_object 
                 tyv.W_Algebra.sty_desc ty1.W_Algebra.sty_desc ;
               (sch, tyv))
            scheme1.W_Algebra.ty_parameters in
        let ty_vars_mapping2 =
          List.map
            (fun sch ->
               incr count_ty_vars2 ;
               let tyv = W_CoreTypes.__generic_type_variable () in 
               W_TypeInfo.add_linked_object
                 tyv.W_Algebra.sty_desc ty2.W_Algebra.sty_desc ;
               (sch, tyv))
            scheme2.W_Algebra.ty_parameters in
        let count_row_vars1 = ref 0 in
        let count_row_vars2 = ref 0 in
        let row_vars_mapping1 =
          List.map
            (fun sch_var ->
               incr count_row_vars1 ;
               (sch_var, (W_CoreTypes.__generic_row_variable ())))
            scheme1.W_Algebra.row_parameters in
        let row_vars_mapping2 =
          List.map
            (fun sch_var ->
               incr count_row_vars2 ;
               (sch_var, (W_CoreTypes.__generic_row_variable ())))
            scheme2.W_Algebra.row_parameters in
        let count_column_vars1 = ref 0 in
        let count_column_vars2 = ref 0 in
        let column_vars_mapping1 =
          List.map
            (fun sch_var ->
               incr count_column_vars1 ;
               (sch_var, (W_CoreTypes.__generic_column_variable ())))
            scheme1.W_Algebra.column_parameters in
        let column_vars_mapping2 =
          List.map
            (fun sch_var ->
               incr count_column_vars2 ;
               (sch_var, (W_CoreTypes.__generic_column_variable ())))
            scheme2.W_Algebra.column_parameters in
        if ( not (is_under_coercion  && !count_ty_vars1 > !count_ty_vars2) &&
           !count_ty_vars1 <> ! count_ty_vars2) || 
           (not (is_under_coercion  && !count_row_vars1 > !count_row_vars2) &&
           !count_row_vars1 <> !count_row_vars2) ||
           (not (is_under_coercion  && !count_column_vars1 > !count_column_vars2) &&
           !count_column_vars1 <> !count_column_vars2) then (
  In fact , we are in the case where the 2 schemes do not have the 
              same number of generalized variables .
             same number of generalized variables. *)
          let n1 = !count_ty_vars1 + !count_row_vars1 + !count_column_vars1 in
          let n2 = !count_ty_vars2 + !count_row_vars2 + !count_column_vars2 in
          raise
            (Unification_simple_type_conflict
               (ty1, ty2,
                { ucd_kind = DK_forall_type_quantification_arity (n1, n2) ;
                  ucd_through_field = None }))

        ) ;
        let scheme1_instance =
          W_SchemeGenAndInst.specialize_with_given_variables_mapping
            ~deep: false
            ty_vars_mapping1 row_vars_mapping1 column_vars_mapping1 scheme1 in
        let scheme2_instance =
          W_SchemeGenAndInst.specialize_with_given_variables_mapping
            ~deep: false
            ty_vars_mapping2 row_vars_mapping2 column_vars_mapping2 scheme2 in
        __unify_simple_type is_under_coercion
          env seen_expansions scheme1_instance scheme2_instance ;
  Now , ensure that the qualtified variables of both schemes were 
            mapped one - to - one , i.e. no collapse occurred , i.e. both scheme 
            were as general . Compute the checks one at time to avoid useless 
            computation in case one fails . This way , when unifying sums for 
            which we can backtrack on type error , we avoid checking bijections 
            if a previous bijection test failed . May be we gain a bit of time 
            even if lists of variables are generally not very long .
           mapped one-to-one, i.e. no collapse occurred, i.e. both scheme
           were as general. Compute the checks one at time to avoid useless
           computation in case one fails. This way, when unifying sums for
           which we can backtrack on type error, we avoid checking bijections
           if a previous bijection test failed. May be we gain a bit of time
           even if lists of variables are generally not very long. *)
        let fresh_gen_ty_vars1 = List.map snd ty_vars_mapping1 in
        let fresh_gen_ty_vars2 = List.map snd ty_vars_mapping2 in
        let check_for_bijection = not is_under_coercion in 
        let bij1 =
          check_type_variables_are_in_injection check_for_bijection
            fresh_gen_ty_vars1 fresh_gen_ty_vars2 in
        if not bij1 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        let fresh_gen_row_vars1 = List.map snd row_vars_mapping1 in
        let fresh_gen_row_vars2 = List.map snd row_vars_mapping2 in
        let bij2 =
          check_row_variables_are_in_injection check_for_bijection
            fresh_gen_row_vars1 fresh_gen_row_vars2 in
        if not bij2 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        let fresh_gen_column_vars1 = List.map snd column_vars_mapping1 in
        let fresh_gen_column_vars2 = List.map snd column_vars_mapping2 in
        let bij3 =
          check_column_variables_are_in_injection check_for_bijection
            fresh_gen_column_vars1 fresh_gen_column_vars2 in
        if not bij3 then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None }))
      )
    | ((W_Algebra.SType_forall schm1), _)
        when is_under_coercion -> (
        __unify_simple_type is_under_coercion 
          env seen_expansions (W_SchemeGenAndInst.specialize schm1) ty2
      )
    | (_, _) ->
        raise
          (Unification_simple_type_conflict
             (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None }))



and __unify_different_named_types is_under_coercion env seen_expansions ty1 ty2 nty1 nty2 =
  OManager.printf "__unify_different_named_types@." ;
  let h_nty1 = W_CoreTypes.named_type_expr_height nty1 in
  let h_nty2 = W_CoreTypes.named_type_expr_height nty2 in
  if (h_nty1 < 0) && (h_nty2 < 0) then (
    OManager.printf "Both negative: expand L & R@." ;
  Expand both once then unify the 2 resulting types .
    let (ty1', seen_expansions') =
      W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
    let (ty2', seen_expansions'') =
      W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions' ty2 in
    if (ty1 == ty1') && (ty2 == ty2') then
      raise
        (Unification_simple_type_conflict
           (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
    __unify_and_return_higher_type is_under_coercion 
      env seen_expansions'' ty1' ty2' ty1 ty2
  )
    if h_nty1 < 0 then (
      OManager.printf "L negative: expand L@." ;
      let (ty1', seen_expansions') =
        W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
      OManager.printf "L after expand: %a@."
        W_PrintTypes.pp_simple_type ty1' ;
      if ty1 == ty1' then
        raise
          (Unification_simple_type_conflict
             (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
      __unify_and_return_higher_type is_under_coercion 
        env seen_expansions' ty2 ty1' ty2 ty1
    )
      if h_nty2 < 0 then (
        OManager.printf "R negative: expand R@." ;
        let (ty2', seen_expansions') =
          W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty2 in
        OManager.printf "R after expand: %a@."
          W_PrintTypes.pp_simple_type ty2' ;
        if ty2 == ty2' then
          raise
            (Unification_simple_type_conflict
               (ty1, ty2, { ucd_kind = DK_none ; ucd_through_field = None })) ;
        __unify_and_return_higher_type is_under_coercion 
          env seen_expansions' ty1 ty2' ty1 ty2
      )
        if h_nty1 = h_nty2  then (
          OManager.printf "Both positive and equal (%d): expand both@." h_nty1 ;
          let (ty1', seen_expansions') =
            W_TypeAbbrevs.incrementally_expand_abbrev env seen_expansions ty1 in
          let (ty2', seen_expansions'') =
            W_TypeAbbrevs.incrementally_expand_abbrev
              env seen_expansions' ty2 in
          OManager.printf "L after expand: %a@."
            W_PrintTypes.pp_simple_type ty1' ;
          OManager.printf "R after expand: %a@."
            W_PrintTypes.pp_simple_type ty2' ;
          if (ty1 == ty1') && (ty2 == ty2') then
            raise
              (Unification_simple_type_conflict
                 (ty1, ty2,
                  { ucd_kind = DK_none ; ucd_through_field = None })) ;
          __unify_and_return_higher_type is_under_coercion 
            env seen_expansions'' ty1' ty2' ty1 ty2
        )
          if h_nty1 < h_nty2 then (
            OManager.printf "L (%d) < R (%d): expand R@." h_nty1 h_nty2 ;
            let nb_expansion = h_nty2 - h_nty1 in
            let (ty2', seen_expansions') =
              W_TypeAbbrevs.expand_abbrev_n_times
                nb_expansion env seen_expansions ty2 in
            OManager.printf "R after expand: %a@."
              W_PrintTypes.pp_simple_type ty2' ;
            if ty2 == ty2' then
              raise
                (Unification_simple_type_conflict
                   (ty1, ty2,
                    { ucd_kind = DK_none ; ucd_through_field = None })) ;
            __unify_and_return_higher_type is_under_coercion 
              env seen_expansions' ty1 ty2' ty1 ty2
          )
            OManager.printf "R (%d) < L (%d): expand L@." h_nty2 h_nty1 ;
            let nb_expansion = h_nty1 - h_nty2 in
            let (ty1', seen_expansions') =
              W_TypeAbbrevs.expand_abbrev_n_times
                nb_expansion env seen_expansions ty1 in
            OManager.printf "L after expand: %a@."
              W_PrintTypes.pp_simple_type ty1' ;
            if ty1 == ty1' then
              raise
                (Unification_simple_type_conflict
                   (ty1, ty2,
                    { ucd_kind = DK_none ; ucd_through_field = None })) ;
            __unify_and_return_higher_type is_under_coercion 
              env seen_expansions' ty2 ty1' ty2 ty1
  End of else 4 .
  End of else 3 .
  End of else 2 .
  End of else 1 .



* { b  } : Internal routine performing the unification of 2 row types . 
     Unification is performed " in place " , i.e. by physically modifying the 
     variables on which a substitution must be applied in order to make the 2 
     types equal . 
     Differently from other unification routines , this one returns a boolean 
     telling if the unification was a success of if it failed due to endings 
     compatibility . 
     More in detail , there are 2 cases where unification of rows can fail . 
     First one , and hardest one , there exist 2 fields in common in the 2 record 
     types that have incompatible types . In such a case , the unification really 
     and definitively fails . 
     The second case is when common fields have compatible types but the 2 rows 
     ca n't unify because they have incompatible endings . Intuitively , this 
     happens when one is closed and the other is open and the list of fields of 
     the records are not the same . Or , this happens when both are closed and the 
     list of fields of the records are not the same also . In these cases , 
     unification is not yet definitively a failure since column unification may 
     take the precedence and , if it is a success , then will lead to a sum type 
     instead of a record type , this sum type having cases being the union of the 
     2 records to initially unify . 
     In any case ( error or success ) , this function keeps the trace of the 
     modifications done by the unification . This will be the job of the initial 
     caller ( [ unify_simple_type ] , [ unify_row_type ] or [ unify_column_type ] ) to 
     deal with what to do of this trace . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Not exported outside this module .                         
    Unification is performed "in place", i.e. by physically modifying the
    variables on which a substitution must be applied in order to make the 2
    types equal.
    Differently from other unification routines, this one returns a boolean
    telling if the unification was a success of if it failed due to endings
    compatibility.
    More in detail, there are 2 cases where unification of rows can fail.
    First one, and hardest one, there exist 2 fields in common in the 2 record
    types that have incompatible types. In such a case, the unification really
    and definitively fails.
    The second case is when common fields have compatible types but the 2 rows
    can't unify because they have incompatible endings. Intuitively, this
    happens when one is closed and the other is open and the list of fields of
    the records are not the same. Or, this happens when both are closed and the
    list of fields of the records are not the same also. In these cases,
    unification is not yet definitively a failure since column unification may
    take the precedence and, if it is a success, then will lead to a sum type
    instead of a record type, this sum type having cases being the union of the
    2 records to initially unify.
    In any case (error or success), this function keeps the trace of the
    modifications done by the unification. This will be the job of the initial
    caller ([unify_simple_type], [unify_row_type] or [unify_column_type]) to
    deal with what to do of this trace.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Not exported outside this module.                         *)
and __unify_row_type is_under_coercion env seen_expansions row_ty1 row_ty2 =
  First , get the canonical representation of the 2 row types to unify .
  let row_ty1 = W_CoreTypes.row_type_repr row_ty1 in
  let row_ty2 = W_CoreTypes.row_type_repr row_ty2 in
  if row_ty1 == row_ty2 then
    true
  else
    match (row_ty1.W_Algebra.rt_value, row_ty2.W_Algebra.rt_value) with
    | (([], W_Algebra.Closed_row), ([], W_Algebra.Closed_row)) ->
        true
    | (([], (W_Algebra.Var_row rv1)),
       ([], (W_Algebra.Var_row rv2))) when rv1 == rv2 ->
        true
    | (([], (W_Algebra.Var_row rv1)), (_, _)) ->
        lowerize_level_in_row rv1.W_Algebra.rv_level row_ty2 ;
        W_CoreTypes.cleanup_row_type row_ty2 ;
        W_CoreTypes.change_row_var_link
          ~receiver: rv1 ~link_val: (W_Algebra.Row_known row_ty2) ;
        true
    | ((_, _), ([], (W_Algebra.Var_row rv2))) ->
        lowerize_level_in_row rv2.W_Algebra.rv_level row_ty1 ;
        W_CoreTypes.cleanup_row_type row_ty1 ;
        W_CoreTypes.change_row_var_link
          ~receiver: rv2 ~link_val: (W_Algebra.Row_known row_ty1) ;
        true
    | (([], W_Algebra.Closed_row), (_, _))
    | ((_, _), ([], W_Algebra.Closed_row)) ->
  Error trying to unify a closed empty row with something that contains 
            fields . The unification is not yet definitively a failure , however 
            it is not a success . May be trying to unify columns will lead to 
            a correct sum type . We return [ false ] to tell that the unification 
            failed , and this will be checked by [ _ _ unify_column_type ] to try 
            unifying with its next case . To , beware this is * * not * * a real 
            failure !
           fields. The unification is not yet definitively a failure, however
           it is not a success. May be trying to unify columns will lead to
           a correct sum type. We return [false] to tell that the unification
           failed, and this will be checked by [__unify_column_type] to try
           unifying with its next case. To, beware this is **not** a real
           failure ! *)
        false
    | ((row1_fields, row1_ending), (row2_fields, row2_ending)) ->
        let field0 = List.hd row1_fields in
        let phi0 = (List.tl row1_fields, row1_ending) in
        let field1 = List.hd row2_fields in
        let phi1 = (List.tl row2_fields, row2_ending) in
        if __unify_field is_under_coercion 
             env seen_expansions field0 field1 then
          __unify_row_type is_under_coercion
            env seen_expansions
            { W_Algebra.rt_value = phi0 } { W_Algebra.rt_value = phi1 }
        else
          (
            let fresh_rv = W_CoreTypes.__row_variable () in
  Create the fresh variable directly with a level being the minimum 
                of the 2 endings if they were variables . Otherwise , with the 
                current binding level .
               of the 2 endings if they were variables. Otherwise, with the
               current binding level. *)
            W_CoreTypes.change_row_var_level
              fresh_rv (min_level_of_row_endings row1_ending row2_ending) ;
  Now , unify in cross . Do not unify lazily because we need to 
                anyway ensure that the common fields have compatible types 
                even if one of the sub - unification tells us it is not a 
                success .
               anyway ensure that the common fields have compatible types
               even if one of the sub-unification tells us it is not a
               success. *)
            let success1 =
              __unify_row_type is_under_coercion
                env seen_expansions
                { W_Algebra.rt_value = phi0 }
                { W_Algebra.rt_value =
                    ([field1], (W_Algebra.Var_row fresh_rv)) } in
            let success2 =
              __unify_row_type is_under_coercion
                env seen_expansions
                { W_Algebra.rt_value = phi1 }
                { W_Algebra.rt_value =
                    ([field0], (W_Algebra.Var_row fresh_rv)) } in
            success1 && success2
          )



* { b  } : Unification of 2 column types . Since row and columns are really 
     symmetrical , this unification function works exactly like its counterpart 
     for row types . 
     In any case ( error or success ) , this function keeps the trace of the 
     modifications done by the unification . This will be the job of the initial 
     caller ( [ unify_simple_type ] , [ unify_row_type ] or [ unify_column_type ] ) to 
     deal with what to do of this trace . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     @raise Unification_column_conflict 
     { b Visibility } : Not exported outside this module .                         
    symmetrical, this unification function works exactly like its counterpart
    for row types.
    In any case (error or success), this function keeps the trace of the
    modifications done by the unification. This will be the job of the initial
    caller ([unify_simple_type], [unify_row_type] or [unify_column_type]) to
    deal with what to do of this trace.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    @raise Unification_column_conflict
    {b Visibility}: Not exported outside this module.                         *)
and __unify_column_type is_under_coercion env seen_expansions col_ty1 col_ty2 =
  First , get the canonical representation of the 2 column types to unify .
  let col_ty1 = W_CoreTypes.column_type_repr col_ty1 in
  let col_ty2 = W_CoreTypes.column_type_repr col_ty2 in
  if col_ty1 == col_ty2 then ()
  else
    match (col_ty1.W_Algebra.ct_value, col_ty2.W_Algebra.ct_value) with
    | (([], W_Algebra.Closed_column), ([], W_Algebra.Closed_column)) ->
        ()
    | (([], (W_Algebra.Var_column cv1)), ([], (W_Algebra.Var_column cv2)))
          when cv1 == cv2 ->
        ()
    | (([], (W_Algebra.Var_column cv1)), (_, _)) ->
        lowerize_level_in_column cv1.W_Algebra.cv_level col_ty2 ;
        W_CoreTypes.cleanup_column_type col_ty2 ;
        W_CoreTypes.change_column_var_link
          ~receiver: cv1 ~link_val: (W_Algebra.Col_known col_ty2)
    | ((_, _), ([], (W_Algebra.Var_column cv2))) ->
        lowerize_level_in_column cv2.W_Algebra.cv_level col_ty1 ;
        W_CoreTypes.cleanup_column_type col_ty1 ;
  In this case , cv2 must be set equal to the other column .
        W_CoreTypes.change_column_var_link
          ~receiver: cv2 ~link_val: (W_Algebra.Col_known col_ty1)
    | (([], W_Algebra.Closed_column), (_, _))
    | ((_, _), ([], W_Algebra.Closed_column)) ->
        raise (Unification_column_conflict (col_ty1, col_ty2)) ;
    | ((col1_row, col1_ending), (col2_row, col2_ending)) ->
        let record0 = List.hd col1_row in
        let phi0 = (List.tl col1_row, col1_ending) in
        let record1 = List.hd col2_row in
        let phi1 = (List.tl col2_row, col2_ending) in
        let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
        if __unify_row_type is_under_coercion
             env seen_expansions record0 record1 then (
          __unify_column_type is_under_coercion
            env seen_expansions
            { W_Algebra.ct_value = phi0 } { W_Algebra.ct_value = phi1 }
        )
        else (
  Revert the unification changes back to the point before trying 
              to unify the 2 rows . We do not catch hard type errors reported 
              via [ Unification_simple_type_conflict ] since these ones 
              represent real type error . Only failure on row ( endings ) are 
              legal to consider as allowing to unify with another row along 
              the column .
             to unify the 2 rows. We do not catch hard type errors reported
             via [Unification_simple_type_conflict] since these ones
             represent real type error. Only failure on row (endings) are
             legal to consider as allowing to unify with another row along
             the column. *)
          W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
          let fresh_cv = W_CoreTypes.__column_variable () in
  Create the fresh variable directly with a level being the minimum 
              of the 2 endings if they were variables . Otherwise , with the 
              current binding level .
             of the 2 endings if they were variables. Otherwise, with the
             current binding level. *)
          W_CoreTypes.change_column_var_level
            fresh_cv (min_level_of_column_endings col1_ending col2_ending) ;
          __unify_column_type is_under_coercion
            env seen_expansions
            { W_Algebra.ct_value = phi0 }
            { W_Algebra.ct_value =
                ([record1], (W_Algebra.Var_column fresh_cv)) } ;
          __unify_column_type is_under_coercion
            env seen_expansions
            { W_Algebra.ct_value = phi1 }
            { W_Algebra.ct_value =
                ([record0], (W_Algebra.Var_column fresh_cv)) }
        )



* { b  } : Unification of 2 record fields . Fields are unifiable if they 
     have the same name and if their types are unifiable . This function performs 
     unification in place if possible and returns a boolean telling if the 
     unification succeeded . 
     There are 2 cases where unification can fail : either the fields names are 
     different and then the function stops , returning false , or the fields names 
     are the same but their types are not unifiable and in this case , an error 
     is directly raised ( no need to even return any boolean ) . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Not exported outside this module .                         
    have the same name and if their types are unifiable. This function performs
    unification in place if possible and returns a boolean telling if the
    unification succeeded.
    There are 2 cases where unification can fail: either the fields names are
    different and then the function stops, returning false, or the fields names
    are the same but their types are not unifiable and in this case, an error
    is directly raised (no need to even return any boolean).
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Not exported outside this module.                         *)
and __unify_field is_under_coercion env seen_expansions  
      (field_name1, field_ty1) (field_name2, field_ty2) =
  if field_name1 <> field_name2 then false
  else (
    try
      __unify_simple_type is_under_coercion env seen_expansions field_ty1 field_ty2 ;
      true
    with
    | Unification_simple_type_conflict
        (t1, t2, { ucd_kind = k ; ucd_through_field = None }) ->
  Embedd the name of the fields in each type that caused the error . 
            Since both fields have the same name , we expected them to be 
            unifiable . Reminding the name the these fields my give better error 
            messages . We only embedd the name if none was already recorded , this 
            way , we keep the deepest guilty field of the type structure .
           Since both fields have the same name, we expected them to be
           unifiable. Reminding the name the these fields my give better error
           messages. We only embedd the name if none was already recorded, this
           way, we keep the deepest guilty field of the type structure. *)
        raise
          (Unification_simple_type_conflict
             (t1, t2, { ucd_kind = k ; ucd_through_field = Some field_name1 }))
  )


* { b  } : 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 .                         
    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 =
      __unify_simple_type true env seen_expansions ty1 ty2

* { b  } : Unification of 2 simple types . The unification is performed by 
     side effect , physically modifying type variables to make them equal to what 
     they must be instantiated by the MGU substitution . 
     If unification is a success , this function forgets the trace of the 
     modifications done by the unification , otherwise it reverts them , hence 
     restoring the types as they were before starting to unify them . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Exported outside this module .                             
    side effect, physically modifying type variables to make them equal to what
    they must be instantiated by the MGU substitution.
    If unification is a success, this function forgets the trace of the
    modifications done by the unification, otherwise it reverts them, hence
    restoring the types as they were before starting to unify them.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Exported outside this module.                             *)
let unify_simple_type env ty1 ty2 =
  OManager.printf "unify_simple_type@." ;
  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
  try
    __unify_simple_type false env W_TypeAbbrevs.empty_memory ty1 ty2 ;
    OManager.printf "Ended unify_simple_type@." ;
    W_CoreTypes.reset_unification_changes_trace ()
  with any ->
    W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
    OManager.printf "Ended unify_simple_type@." ;
    raise any

let unify_simple_type_in_coercion env ty1 ty2 =
  OManager.printf "unify_simple_type_in_coercion@." ;
  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
  try
    __unify_simple_type true env W_TypeAbbrevs.empty_memory ty1 ty2 ;
    OManager.printf "Ended unify_simple_type_in_coercion@." ;
    W_CoreTypes.reset_unification_changes_trace ()
  with any ->
    W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
    OManager.printf "Ended unify_simple_type_in_coercion@." ;
    raise any


* { b  } : Unification of 2 row types . Unification is performed " in place " , 
     i.e. by physically modifying the variables on which a substitution must be 
     applied in order to make the 2 types equal . 
     If unification is a success , this function forgets the trace of the 
     modifications done by the unification , otherwise it reverts them , hence 
     restoring the types as they were before starting to unify them . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Exported outside this module .                             
    i.e. by physically modifying the variables on which a substitution must be
    applied in order to make the 2 types equal.
    If unification is a success, this function forgets the trace of the
    modifications done by the unification, otherwise it reverts them, hence
    restoring the types as they were before starting to unify them.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Exported outside this module.                             *)
let unify_row_type env row_ty1 row_ty2 =
  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
  try
    if __unify_row_type false env W_TypeAbbrevs.empty_memory row_ty1 row_ty2 then (
      W_CoreTypes.reset_unification_changes_trace () ;
      true
    )
    else (
      W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
      false
    )
  with any ->
    W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
    raise any



* { b  } : Unification of 2 column types . If unification is a success , this 
     function forgets the trace of the modifications done by the unification , 
     otherwise it reverts them , hence restoring the types as they were before 
     starting to unify them . 
     @raise Unification_simple_type_conflict 
     @raise Unification_binding_level_conflict 
     { b Visibility } : Exported outside this module .                             
    function forgets the trace of the modifications done by the unification,
    otherwise it reverts them, hence restoring the types as they were before
    starting to unify them.
    @raise Unification_simple_type_conflict
    @raise Unification_binding_level_conflict
    {b Visibility}: Exported outside this module.                             *)
let unify_column_type env column_ty1 column_ty2 =
  let checkpoint = W_CoreTypes.get_current_changes_checkpoint () in
  try
    __unify_column_type false env W_TypeAbbrevs.empty_memory column_ty1 column_ty2 ;
    W_CoreTypes.reset_unification_changes_trace ()
  with any ->
    W_CoreTypes.rewind_unification_changes ~performed_after: checkpoint ;
    raise any



let _ = W_TypingEnv.forward_ref__unify_simple_type :=
  (fun env t1 t2 ->
     __unify_simple_type false env W_TypeAbbrevs.empty_memory t1 t2)
let _ = W_TypingEnv.forward_ref__unify_row_type :=
  (fun env row_ty1 row_ty2 ->
     __unify_row_type false env W_TypeAbbrevs.empty_memory row_ty1 row_ty2)
let _ = W_TypingEnv.forward_ref__unify_column_type :=
  (fun env column_ty1 column_ty2 ->
     __unify_column_type false env W_TypeAbbrevs.empty_memory column_ty1 column_ty2)
