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=7b472a851b0e50839e0125a150e37163280875d1;hpb=84e6cbe962c9a534be48542c098d7bb0d90be9a1;p=helm.git diff --git a/helm/software/components/cic_unification/cicRefine.ml b/helm/software/components/cic_unification/cicRefine.ml index 7b472a851..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 @@ -1300,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 _) @@ -1452,6 +1467,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci 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 @@ -1774,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 " ^ @@ -1957,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 [] ^