X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_unification%2FcicRefine.ml;h=fe5ee7fe378942f14c08ebe923a7a689698af4b4;hb=ff6a1396270493dcf0e1f673f32a8213a8ce3751;hp=f55b1fed0e646de07d387aacfad9aae8bc60d11f;hpb=f386b970edc5798769c96e44f5c9ab30efa06605;p=helm.git diff --git a/helm/software/components/cic_unification/cicRefine.ml b/helm/software/components/cic_unification/cicRefine.ml index f55b1fed0..fe5ee7fe3 100644 --- a/helm/software/components/cic_unification/cicRefine.ml +++ b/helm/software/components/cic_unification/cicRefine.ml @@ -405,6 +405,39 @@ and type_of_aux' ?(clean_dummy_dependent_types=true) ?(localization_tbl = Cic.Ci let te',inferredty,subst'',metasenv'',ugraph2 = type_of_aux subst' metasenv' context te ugraph1 in + let rec count_prods context ty = + match CicReduction.whd context ty with + | Cic.Prod (n,s,t) -> + 1 + count_prods (Some (n,Cic.Decl s)::context) t + | _ -> 0 + in + let exp_prods = count_prods context ty' in + let inf_prods = count_prods context inferredty in + let te', inferredty, metasenv'', subst'', ugraph2 = + let rec aux t m s ug it = function + | 0 -> t,it,m,s,ug + | n -> + match CicReduction.whd context it with + | Cic.Prod (_,src,tgt) -> + let newmeta, metaty, s, m, ug = + type_of_aux s m context (Cic.Implicit None) ug + in + let s,m,ug = + fo_unif_subst s context m metaty src ug + in +(* prerr_endline "saturo"; *) + let t = + match t with + | Cic.Appl l -> Cic.Appl (l @ [newmeta]) + | _ -> Cic.Appl [t;newmeta] + in + aux t m s ug (CicSubstitution.subst newmeta tgt) (n-1) + | _ -> t,it,m,s,ug + in + aux te' metasenv'' subst'' ugraph2 inferredty + (max 0 (inf_prods - exp_prods)) + in +(* prerr_endline ("ottengo: " ^ CicPp.ppterm te'); *) let (te', ty'), subst''',metasenv''',ugraph3 = coerce_to_something true localization_tbl te' inferredty ty' subst'' metasenv'' context ugraph2