X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2FnCicUnification.ml;h=2f6332d51d748ad0c90ecf71c81c5219ccd79cec;hb=d6ba7f4b8fbd98f2f1c848857022ef5fba80db53;hp=c224708533e5c6789606d943ac37fa4d23a609fb;hpb=686f7f4f4444125885bc7ef9e8ec3e0b6f567137;p=helm.git diff --git a/helm/software/components/ng_refiner/nCicUnification.ml b/helm/software/components/ng_refiner/nCicUnification.ml index c22470853..2f6332d51 100644 --- a/helm/software/components/ng_refiner/nCicUnification.ml +++ b/helm/software/components/ng_refiner/nCicUnification.ml @@ -95,8 +95,8 @@ let outside () = let pp s = prerr_endline (Printf.sprintf "%-20s" !indent ^ " " ^ Lazy.force s) ;; -let pp _ = ();; +let pp _ = ();; let ppcontext = NCicPp.ppcontext;; let ppmetasenv = NCicPp.ppmetasenv;; @@ -152,20 +152,11 @@ let rec lambda_intros rdb metasenv subst context t args = in metasenv, subst, bo | (arg,ty)::tail -> + let metasenv, subst, telescopic_ty = + delift_term_wrt_terms rdb metasenv subst context_of_args ty + (List.rev processed_args) + in let name = "HBeta"^string_of_int n in - let metasenv,_,instance,_ = - NCicMetaSubst.mk_meta metasenv context_of_args `Term in - let meta_applied = - NCicUntrusted.mk_appl instance (List.rev processed_args) in -let metasenv,subst,_,_ = - !refiner_typeof ((rdb :> NRstatus.status)#set_coerc_db NCicCoercion.empty_db) metasenv subst context_of_args meta_applied None -in - let metasenv,subst = - unify rdb true metasenv subst context_of_args meta_applied ty in - let telescopic_ty = NCicSubstitution.lift n instance in - let telescopic_ty = - NCicUntrusted.mk_appl - telescopic_ty (mk_irl (List.length processed_args)) in let metasenv, subst, bo = mk_lambda metasenv subst ((name,NCic.Decl telescopic_ty)::context) (n+1) (arg::processed_args) tail @@ -669,8 +660,23 @@ pp (lazy (string_of_bool norm1 ^ " ?? " ^ string_of_bool norm2)); | UnificationFailure _ -> raise (UnificationFailure msg) | Uncertain _ -> raise exn (*D*) in outside(); rc with exn -> outside (); raise exn + +and delift_term_wrt_terms rdb metasenv subst context t args = + let metasenv, _, instance, _ = + NCicMetaSubst.mk_meta metasenv context `Term in + let meta_applied = NCicUntrusted.mk_appl instance args in + let metasenv,subst,meta_applied,_ = + !refiner_typeof ((rdb:> NRstatus.status)#set_coerc_db NCicCoercion.empty_db) + metasenv subst context meta_applied None + in + let metasenv, subst = + unify rdb true metasenv subst context meta_applied t in + let t = NCicSubstitution.lift (List.length args) instance in + let t = NCicUntrusted.mk_appl t (mk_irl (List.length args)) in + metasenv, subst, t ;; + let unify rdb ?(test_eq_only=false) = indent := ""; unify rdb test_eq_only;;