X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fsoftware%2Fcomponents%2Fcic_unification%2FcicRefine.ml;h=f55b1fed0e646de07d387aacfad9aae8bc60d11f;hb=b763e29c46531b2bee8fabd35fa33746f0784d3b;hp=fc9dc840d1bb5323ff9526ce57d561664b5999ac;hpb=4d765cc85e3a1e84c80c348a1e67ea1eed984916;p=helm.git diff --git a/helm/software/components/cic_unification/cicRefine.ml b/helm/software/components/cic_unification/cicRefine.ml index fc9dc840d..f55b1fed0 100644 --- a/helm/software/components/cic_unification/cicRefine.ml +++ b/helm/software/components/cic_unification/cicRefine.ml @@ -1104,7 +1104,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci | (C.Sort (C.CProp t1), C.Sort (C.Type t2)) -> let t' = CicUniv.fresh() in (try - let ugraph1 = CicUniv.add_gt t' t1 ugraph in + let ugraph1 = CicUniv.add_ge t' t1 ugraph in let ugraph2 = CicUniv.add_ge t' t2 ugraph1 in C.Sort (C.Type t'),subst,metasenv,ugraph2 with @@ -1251,9 +1251,11 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci (* given he:hety, gives beack all (c he) such that (c e):?->? *) let fix_arity n metasenv context subst he hetype ugraph = let hetype = CicMetaSubst.apply_subst subst hetype in - let src = CoercDb.coerc_carr_of_term hetype 0 in - let tgt = CoercDb.coerc_carr_of_term (Cic.Implicit None) 1 in - match CoercGraph.look_for_coercion' metasenv subst context src tgt with + (* instead of a dummy functional type we may create the real product + * using args_bo_and_ty, but since coercions lookup ignores the + * actual ariety we opt for the simple solution *) + let fty = Cic.Prod(Cic.Anonymous, Cic.Sort Cic.Prop, Cic.Sort Cic.Prop) in + match CoercGraph.look_for_coercion metasenv subst context hetype fty with | CoercGraph.NoCoercion -> [] | CoercGraph.NotHandled -> raise (MoreArgsThanExpected (n,Uncertain (lazy ""))) @@ -1306,6 +1308,7 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci "Fixing arity of: "^ pp he ^ "\n that has type: "^ pp hetype^ "\n but is applyed to: " ^ String.concat ";" (List.map (fun (t,_)->pp t) args_bo_and_ty)); (*}}}*) + let error = ref None in let possible_fixes = fix_arity (List.length args) metasenv context subst he hetype ugraph in @@ -1323,14 +1326,18 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci with | RefineFailure _ | Uncertain _ | HExtlib.Localized (_,RefineFailure _) - | HExtlib.Localized (_,Uncertain _) -> None) + | HExtlib.Localized (_,Uncertain _) as exn -> + error := Some exn; None) possible_fixes with | Some x -> x | None -> - raise - (MoreArgsThanExpected - (List.length args, RefineFailure (lazy ""))) + match !error with + None -> + raise + (MoreArgsThanExpected + (List.length args, RefineFailure (lazy ""))) + | Some exn -> raise exn in (* first we check if we are in the simple case of a meta closed term *) let subst,metasenv,ugraph1,hetype',he,args_bo_and_ty =