X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_refiner%2FnCicMetaSubst.ml;h=927c288a0543766830a730ee0df60ac39d33b773;hb=e869500069d11aadd7bbe8afddcdd9044d0b56a7;hp=94cfe669036143734c56d3c4e5d5992fe0977256;hpb=f094694e53cfeea2c33e8c2aa2abac6dd7e44138;p=helm.git diff --git a/helm/software/components/ng_refiner/nCicMetaSubst.ml b/helm/software/components/ng_refiner/nCicMetaSubst.ml index 94cfe6690..927c288a0 100644 --- a/helm/software/components/ng_refiner/nCicMetaSubst.ml +++ b/helm/software/components/ng_refiner/nCicMetaSubst.ml @@ -14,9 +14,10 @@ exception MetaSubstFailure of string Lazy.t exception Uncertain of string Lazy.t -let newmeta = +let newmeta,maxmeta = let maxmeta = ref 0 in - fun () -> incr maxmeta; !maxmeta + (fun () -> incr maxmeta; !maxmeta), + (fun () -> !maxmeta) ;; exception NotInTheList;; @@ -71,31 +72,41 @@ let rec force_does_not_occur metasenv subst restrictions t = in if amount > 0 then ms, NCic.Rel (r - amount) else ms, orig | NCic.Meta (n, (shift,lc as l)) as orig -> - (* we ignore the subst since restrict will take care of already - * instantiated/restricted metavariabels *) - let (metasenv,subst as ms), restrictions_for_n, l' = - let l = NCicUtils.expand_local_context lc in - - let ms, _, restrictions_for_n, l = - List.fold_right - (fun t (ms, i, restrictions_for_n, l) -> - try - let ms, t = aux (k-shift) ms t in - ms, i-1, restrictions_for_n, t::l - with Occur -> - ms, i-1, i::restrictions_for_n, l) - l (ms, List.length l, [], []) - in - - ms, restrictions_for_n, pack_lc (shift, NCic.Ctx l) + let meta_chain = + try + Some (NCicUtils.lookup_subst n subst) + with + NCicUtils.Subst_not_found _ -> None in - if restrictions_for_n = [] then - ms, if l = l' then orig else NCic.Meta (n, l') - else - let metasenv, subst, newmeta = - restrict metasenv subst n restrictions_for_n - in - (metasenv, subst), NCic.Meta (newmeta, l') + (match meta_chain with + Some (_,_,bo,_) -> + aux k ms (NCicSubstitution.subst_meta l bo) + | None -> + (* we ignore the subst since restrict will take care of already + * instantiated/restricted metavariabels *) + let (metasenv,subst as ms), restrictions_for_n, l' = + let l = NCicUtils.expand_local_context lc in + + let ms, _, restrictions_for_n, l = + List.fold_right + (fun t (ms, i, restrictions_for_n, l) -> + try + let ms, t = aux (k-shift) ms t in + ms, i-1, restrictions_for_n, t::l + with Occur -> + ms, i-1, i::restrictions_for_n, l) + l (ms, List.length l, [], []) + in + + ms, restrictions_for_n, pack_lc (shift, NCic.Ctx l) + in + if restrictions_for_n = [] then + ms, if l = l' then orig else NCic.Meta (n, l') + else + let metasenv, subst, newmeta = + restrict metasenv subst n restrictions_for_n + in + (metasenv, subst), NCic.Meta (newmeta, l')) | t -> NCicUntrusted.map_term_fold_a (fun _ k -> k+1) k aux ms t in aux 0 (metasenv,subst) t @@ -204,8 +215,6 @@ let rec flexible_arg subst = function | _ -> false ;; -let flexible subst l = List.exists (flexible_arg subst) l;; - let in_scope_tag = "tag:in_scope" ;; let out_scope_tag_prefix = "tag:out_scope:" let out_scope_tag n = out_scope_tag_prefix ^ string_of_int n ;; @@ -220,6 +229,8 @@ let int_of_out_scope_tag tag = ;; +exception Found;; + (* INVARIANT: we suppose that t is not another occurrence of Meta(n,_), otherwise the occur check does not make sense in case of unification of ?n with ?n *) @@ -232,11 +243,22 @@ let delift ~unify metasenv subst context n l t = with NCicUtils.Subst_not_found _ -> false) | _ -> false in + let contains_in_scope subst t = + let rec aux _ () = function + | NCic.Meta _ as t -> + if is_in_scope_meta subst t then raise Found + else () + | t -> + if is_in_scope_meta subst t then raise Found + else NCicUtils.fold (fun _ () -> ()) () aux () t + in + try aux () () t; false with Found -> true + in let unify_list in_scope = match l with | _, NCic.Irl _ -> fun _ _ _ _ _ -> None | shift, NCic.Ctx l -> fun metasenv subst context k t -> - if flexible_arg subst t || is_in_scope_meta subst t then None else + if flexible_arg subst t || contains_in_scope subst t then None else let lb = List.map (fun t -> t, flexible_arg subst t) l in HExtlib.list_findopt (fun (li,flexible) i -> @@ -400,10 +422,7 @@ let delift ~unify metasenv subst context n l t = let lc = NCicUtils.expand_local_context lc in let l = List.map (NCicSubstitution.lift shift) lc in if - List.exists - (fun t -> - NCicUntrusted.metas_of_term subst context t = []) - l + List.exists (fun t-> NCicUntrusted.metas_of_term subst context t <> [])l then raise (Uncertain msg) else