X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2FnCicUnification.ml;h=fcc76b0adc5bf72b38129bd36a3ddca7952d4676;hb=a0b7db9844126ebcdf4b5dbb586514854cef5d93;hp=dd1e4b80c520b71e6d96b0e915f98f86e3716659;hpb=3b4ec24b0bf7b1cd23cdc632fa3fcbb9dbbda139;p=helm.git diff --git a/helm/software/components/ng_refiner/nCicUnification.ml b/helm/software/components/ng_refiner/nCicUnification.ml index dd1e4b80c..fcc76b0ad 100644 --- a/helm/software/components/ng_refiner/nCicUnification.ml +++ b/helm/software/components/ng_refiner/nCicUnification.ml @@ -382,8 +382,8 @@ let rec instantiate rdb test_eq_only metasenv subst context n lc t swap = | _ -> let lty = NCicSubstitution.subst_meta lc ty in pp (lazy ("On the types: " ^ - ppterm ~metasenv ~subst ~context lty ^ "=<=" ^ - ppterm ~metasenv ~subst ~context ty_t)); + ppterm ~metasenv ~subst ~context ty_t ^ "=<=" ^ + ppterm ~metasenv ~subst ~context lty)); let metasenv, subst = unify rdb false metasenv subst context ty_t lty false in @@ -559,6 +559,17 @@ and unify rdb test_eq_only metasenv subst context t1 t2 swap = len2 < len1 && cc2 = fst (HExtlib.split_nth len2 cc1) -> instantiate rdb test_eq_only metasenv subst context m lc' (NCicReduction.head_beta_reduce ~subst t1) (not swap) + | C.Meta (n,lc), C.Meta (m,lc') when + let _,_,tyn = NCicUtils.lookup_meta n metasenv in + let _,_,tym = NCicUtils.lookup_meta m metasenv in + let tyn = NCicSubstitution.subst_meta lc tyn in + let tym = NCicSubstitution.subst_meta lc tym in + match tyn,tym with + NCic.Sort NCic.Type u1, NCic.Sort NCic.Type u2 -> + NCicEnvironment.universe_lt u1 u2 + | _,_ -> false -> + instantiate rdb test_eq_only metasenv subst context m lc' + (NCicReduction.head_beta_reduce ~subst t1) (not swap) | C.Meta (n,lc), t -> instantiate rdb test_eq_only metasenv subst context n lc (NCicReduction.head_beta_reduce ~subst t) swap @@ -575,17 +586,21 @@ and unify rdb test_eq_only metasenv subst context t1 t2 swap = * function even in the easy case above *) let easy_case = match t2 with - | NCic.Appl (f :: f_args) - when List.length args = List.length f_args && + | NCic.Appl (f :: f_args) + when List.exists (NCicMetaSubst.is_flexible context ~subst) args -> + let mlen = List.length args in + let flen = List.length f_args in + let min_len = min mlen flen in + let mhe,margs = HExtlib.split_nth (mlen - min_len) args in + let fhe,fargs = HExtlib.split_nth (flen - min_len) f_args in (try - let metasenv, subst = - unify rdb test_eq_only metasenv subst context meta f swap - in Some (List.fold_left2 (fun (m, s) t1 t2 -> - unify rdb test_eq_only m s context t1 t2 swap) - (metasenv, subst) args f_args) + unify rdb test_eq_only m s context t1 t2 swap + ) (metasenv,subst) + ((NCicUntrusted.mk_appl meta mhe)::margs) + ((NCicUntrusted.mk_appl f fhe)::fargs)) with UnificationFailure _ | Uncertain _ | KeepReducing _ -> None) | _ -> None @@ -861,7 +876,7 @@ and unify rdb test_eq_only metasenv subst context t1 t2 swap = | KeepReducing _ -> assert false | KeepReducingThis _ -> assert (not (norm1 && norm2)); - unif_machines metasenv subst (small_delta_step ~subst m1 m2) + unif_machines metasenv subst (small_delta_step ~subst m1 m2) | UnificationFailure _ | Uncertain _ when (not (norm1 && norm2)) -> unif_machines metasenv subst (small_delta_step ~subst m1 m2) | UnificationFailure msg