X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_tactics%2FnTacStatus.ml;h=a2847a410061089440699f1612b412555f652b50;hb=f1f80d3696cca276a0e07babe46debd2447007f7;hp=f8ee5f1e5e929ab197773adaf6c8be5a567c0f3e;hpb=d6100bf05b70c3fdd7ee69d776d67d149c53f638;p=helm.git diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml index f8ee5f1e5..a2847a410 100644 --- a/helm/software/components/ng_tactics/nTacStatus.ml +++ b/helm/software/components/ng_tactics/nTacStatus.ml @@ -135,6 +135,13 @@ let whd status ?delta ctx t = status, (name, ctx, t) ;; +let normalize status ?delta ctx t = + let status, (name,_,t) = relocate status ctx t in + let _,_,_,subst,_ = status.pstatus in + let t = NCicTacReduction.normalize ~subst ?delta ctx t in + status, (name, ctx, t) +;; + let unify status ctx a b = let status, (_,_,a) = relocate status ctx a in let status, (_,_,b) = relocate status ctx b in @@ -231,22 +238,23 @@ let select_term | NCicUnification.Uncertain _ -> false, status in let match_term status ctx (wanted : cic_term) t = - let rec aux ctx status t = + let rec aux ctx (status,already_found) t = let b, status = is_found status ctx t wanted in if b then let status , (_,_,t) = found status (None, ctx, t) in - status, t + (status,true),t else let _,_,_,subst,_ = status.pstatus in match t with | NCic.Meta (i,lc) when List.mem_assoc i subst -> let _,_,t,_ = NCicUtils.lookup_subst i subst in - aux ctx status t - | NCic.Meta _ -> status, t - | _ -> - NCicUntrusted.map_term_fold_a (fun e c -> e::c) ctx aux status t + aux ctx (status,already_found) t + | NCic.Meta _ -> (status,already_found),t + | _ -> + NCicUntrusted.map_term_fold_a (fun e c -> e::c) ctx aux + (status,already_found) t in - aux ctx status t + aux ctx (status,false) t in let _,_,_,subst,_ = low_status.pstatus in let rec select status ctx pat cic = @@ -296,9 +304,12 @@ let select_term | NCic.Implicit `Hole, t -> (match wanted with | Some wanted -> - let status, wanted = disambiguate status wanted None ctx in - match_term status ctx wanted t - | None -> match_term status ctx (None,ctx,t) t) + let status', wanted = disambiguate status wanted None ctx in + let (status',found), t' = match_term status' ctx wanted t in + if found then status',t' else status,t + | None -> + let (status,_),t = match_term status ctx (None,ctx,t) t in + status,t) | NCic.Implicit _, t -> status, t | _,t -> fail (lazy ("malformed pattern: " ^ NCicPp.ppterm ~metasenv:[] @@ -329,22 +340,5 @@ let mk_cic_term c t = None,c,t ;; let apply_subst status ctx t = let status, (name,_,t) = relocate status ctx t in let _,_,_,subst,_ = status.pstatus in - let rec aux ctx = - function - NCic.Meta (i,lc) -> - (try - let _,_,t,_ = NCicUtils.lookup_subst i subst in - let t = NCicSubstitution.subst_meta lc t in - aux ctx t - with - Not_found -> - match lc with - _,NCic.Irl _ -> NCic.Meta (i,lc) - | n,NCic.Ctx l -> - NCic.Meta - (i,(0,NCic.Ctx - (List.map (fun t -> aux ctx (NCicSubstitution.lift n t)) l)))) - | t -> NCicUtils.map (fun item ctx -> item::ctx) ctx aux t - in - status, (name, ctx, aux ctx t) + status, (name, ctx, NCicUntrusted.apply_subst subst ctx t) ;;