X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_unification%2FcicRefine.ml;h=40eaa1ba6351533ce31173749f6b4c5f1ccece7a;hb=4573f1fecaf83f4706f39702555d5319d132477b;hp=245c88e0016c12f0e66fb3bcd42c0fb0a814497a;hpb=77b7183419692c82f47edb94826d0015634444cc;p=helm.git

diff --git a/helm/software/components/cic_unification/cicRefine.ml b/helm/software/components/cic_unification/cicRefine.ml
index 245c88e00..40eaa1ba6 100644
--- a/helm/software/components/cic_unification/cicRefine.ml
+++ b/helm/software/components/cic_unification/cicRefine.ml
@@ -131,6 +131,20 @@ let exp_impl metasenv subst context =
   | _ -> assert false
 ;;
 
+let unvariant newt =
+ match newt with
+ | Cic.Appl (hd::args) ->
+    let uri = CicUtil.uri_of_term hd in
+    (match 
+      CicEnvironment.get_obj CicUniv.oblivion_ugraph uri 
+    with
+    | Cic.Constant (_,Some t,_,[],attrs),_ 
+      when List.exists ((=) (`Flavour `Variant)) attrs -> 
+       Cic.Appl (t::args)
+    | _ -> newt)
+ | _ -> newt
+;;
+
 let is_a_double_coercion t =
   let rec subst_nth n x l =
     match n,l with
@@ -491,7 +505,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
              exn ->
               enrich localization_tbl s' exn
                ~f:(function _ ->
-                 lazy ("The term " ^
+                 lazy ("(2) The term " ^
                   CicMetaSubst.ppterm_in_context ~metasenv:metasenv' subst' s'
                    context ^ " has type " ^
                   CicMetaSubst.ppterm_in_context ~metasenv:metasenv' subst' ty'
@@ -617,7 +631,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
              exn ->
               enrich localization_tbl term' exn
                ~f:(function _ ->
-                 lazy ("The term " ^
+                 lazy ("(3) The term " ^
                   CicMetaSubst.ppterm_in_context ~metasenv subst term'
                    context ^ " has type " ^
                   CicMetaSubst.ppterm_in_context ~metasenv subst actual_type
@@ -663,7 +677,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                     exn ->
                      enrich localization_tbl constructor'
                       ~f:(fun _ ->
-                        lazy ("The term " ^
+                        lazy ("(4) The term " ^
                          CicMetaSubst.ppterm_in_context metasenv subst p'
                           context ^ " has type " ^
                          CicMetaSubst.ppterm_in_context metasenv subst actual_type
@@ -851,7 +865,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                       exn ->
                        enrich localization_tbl p exn
                         ~f:(function _ ->
-                          lazy ("The term " ^
+                          lazy ("(5) The term " ^
                            CicMetaSubst.ppterm_in_context ~metasenv subst p
                             context ^ " has type " ^
                            CicMetaSubst.ppterm_in_context ~metasenv subst instance'
@@ -892,7 +906,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                      exn ->
                       enrich localization_tbl bo exn
                        ~f:(function _ ->
-                         lazy ("The term " ^
+                         lazy ("(7) The term " ^
                           CicMetaSubst.ppterm_in_context ~metasenv subst bo
                            context' ^ " has type " ^
                           CicMetaSubst.ppterm_in_context ~metasenv subst ty_of_bo
@@ -945,7 +959,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                      exn ->
                       enrich localization_tbl bo exn
                        ~f:(function _ ->
-                         lazy ("The term " ^
+                         lazy ("(8) The term " ^
                           CicMetaSubst.ppterm_in_context ~metasenv subst bo
                            context' ^ " has type " ^
                           CicMetaSubst.ppterm_in_context ~metasenv subst ty_of_bo
@@ -1192,11 +1206,6 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
          let selected =
            HExtlib.list_findopt
              (fun (metasenv,last,c) _ ->
-               match c with 
-               | c when not (CoercGraph.is_composite c) -> 
-                   debug_print (lazy ("\nNot a composite.."^CicPp.ppterm c));
-                   None
-               | c ->
                let subst,metasenv,ugraph =
                 fo_unif_subst subst context metasenv last head ugraph in
                debug_print (lazy ("\nprovo" ^ CicPp.ppterm c));
@@ -1305,7 +1314,8 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                   ugraph
                 in 
                  debug_print (lazy (" has type: "^ pp tty));
-                 Some (coerc,tty,subst,metasenv,ugraph)
+
+                 Some (unvariant coerc,tty,subst,metasenv,ugraph)
               with
               | Uncertain _ | RefineFailure _
               | HExtlib.Localized (_,Uncertain _)
@@ -1444,11 +1454,21 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
                 let newt,newhety,subst,metasenv,ugraph = 
                  type_of_aux subst metasenv context c ugraph in
                 let newt, newty, subst, metasenv, ugraph = 
-                 avoid_double_coercion context subst metasenv ugraph newt expty 
+                  avoid_double_coercion context subst metasenv ugraph newt
+                    expty 
                 in
                 let subst,metasenv,ugraph = 
-                  fo_unif_subst subst context metasenv newhety expty ugraph in
-                 Some ((newt,newty), subst, metasenv, ugraph)
+                  fo_unif_subst subst context metasenv newhety expty ugraph
+                in
+                let b, ugraph =
+                  CicReduction.are_convertible 
+                    ~subst ~metasenv context infty expty ugraph
+                in
+                if b then 
+                  Some ((t,infty), subst, metasenv, ugraph)
+                else 
+                 let newt =  unvariant newt in
+                  Some ((newt,newty), subst, metasenv, ugraph)
                with 
                | Uncertain _ -> uncertain := true; None
                | RefineFailure _ -> None)
@@ -1770,7 +1790,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci
       coerce_to_something_aux t infty expty subst metasenv context ugraph
     with Uncertain _ | RefineFailure _ as exn ->
       let f _ =
-        lazy ("The term " ^
+        lazy ("(9) The term " ^
           CicMetaSubst.ppterm_in_context metasenv subst t context ^ 
           " has type " ^ CicMetaSubst.ppterm_in_context metasenv subst
           infty context ^ " but is here used with type " ^ 
@@ -1953,7 +1973,7 @@ let typecheck metasenv uri obj ~localization_tbl =
          RefineFailure _
        | Uncertain _ as exn ->
           let msg = 
-            lazy ("The term " ^
+            lazy ("(1) The term " ^
              CicMetaSubst.ppterm_in_context ~metasenv [] bo' [] ^
              " has type " ^
              CicMetaSubst.ppterm_in_context ~metasenv [] boty [] ^