X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2FnCicUnification.ml;h=b7141398465eb08afe6d453f690782dfd64dc1ad;hb=d44567ba4b1a658974ee353e67c05d114c264f7f;hp=325cd3e5f1e5520365a8bcb90712cd4f84e8c8a2;hpb=651c5c55cba9ddbe592badc86b18502b83ecf580;p=helm.git diff --git a/helm/software/components/ng_refiner/nCicUnification.ml b/helm/software/components/ng_refiner/nCicUnification.ml index 325cd3e5f..b71413984 100644 --- a/helm/software/components/ng_refiner/nCicUnification.ml +++ b/helm/software/components/ng_refiner/nCicUnification.ml @@ -109,7 +109,9 @@ let fix_sorts swap exc t = | NCic.Sort (NCic.Type u) as orig -> if swap then match NCicEnvironment.sup u with - | None -> prerr_endline "no sup for" ; raise exc + | None -> + prerr_endline ("no sup for " ^ NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] orig) ; + raise exc | Some u1 -> if u = u1 then orig else NCic.Sort (NCic.Type u1) else NCic.Sort (NCic.Type ( @@ -217,7 +219,6 @@ and instantiate rdb test_eq_only metasenv subst context n lc t swap = prerr_endline (Lazy.force msg); pp msg; assert false in - let ty_t = fix_sorts swap exc_to_be ty_t in let lty = NCicSubstitution.subst_meta lc ty in match ty_t with | NCic.Implicit _ -> @@ -229,7 +230,12 @@ and instantiate rdb test_eq_only metasenv subst context n lc t swap = NCicPp.ppterm ~metasenv ~subst ~context lty ^ " === " ^ NCicPp.ppterm ~metasenv ~subst ~context ty_t)); let metasenv,subst = - unify test_eq_only metasenv subst context lty ty_t in + try + unify test_eq_only metasenv subst context lty ty_t + with NCicEnvironment.BadConstraint _ as exc -> + let ty_t = fix_sorts swap exc_to_be ty_t in + try unify test_eq_only metasenv subst context lty ty_t + with _ -> raise exc in metasenv, subst, t in pp (lazy(string_of_int n ^ " := 111 = "^ @@ -666,3 +672,5 @@ pp (lazy (string_of_bool norm1 ^ " ?? " ^ string_of_bool norm2)); let unify rdb ?(test_eq_only=false) = indent := ""; unify rdb test_eq_only;; + +let fix_sorts = fix_sorts false (UnificationFailure (lazy "no sup"));;