X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicSubstitution.ml;h=43a2f8174a74a1cad4696523908e8a4575f6933e;hb=1b70a1f66be53f76e475383e86d63c2b5c1fbcaa;hp=240dd0b27622c7c669f57b23af04270a9c3b55ae;hpb=1ef41da37d7b39da1521f53d3b22981556bfbe68;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicSubstitution.ml b/helm/software/components/ng_kernel/nCicSubstitution.ml index 240dd0b27..43a2f8174 100644 --- a/helm/software/components/ng_kernel/nCicSubstitution.ml +++ b/helm/software/components/ng_kernel/nCicSubstitution.ml @@ -11,6 +11,12 @@ (* $Id$ *) +let ppterm = + ref (fun ~context:_ ~subst:_ ~metasenv:_ ?inside_fix _ -> + let _ = inside_fix in assert false) +;; +let set_ppterm f = ppterm := f;; + module C = NCic module Ref = NReference @@ -19,6 +25,7 @@ let debug_print = fun _ -> ();; let lift_from k n = let rec liftaux k = function | C.Rel m as t -> if m < k then t else C.Rel (m + n) + | C.Meta (i,(m,(C.Irl 0 as l))) when k <= m+1 -> C.Meta (i,(m,l)) | C.Meta (i,(m,l)) when k <= m+1 -> C.Meta (i,(m+n,l)) | C.Meta (_,(m,C.Irl l)) as t when k > l + m -> t | C.Meta (i,(m,l)) -> @@ -53,16 +60,14 @@ let rec psubst ?(avoid_beta_redexes=false) map_arg args = | n when n < k -> t | n (* k <= n < k+nargs *) -> (try lift (k-1) (map_arg (List.nth args (n-k))) - with Failure _ -> assert false)) + with Failure _ | Invalid_argument _ -> assert false)) | C.Meta (i,(m,l)) as t when m >= k + nargs - 1 -> if nargs <> 0 then C.Meta (i,(m-nargs,l)) else t - | C.Meta (i,(m,(C.Irl l as irl))) as t when k > l + m -> - if nargs <> 0 then C.Meta (i,(m-nargs,irl)) else t + | C.Meta (_,(m,(C.Irl l))) as t when k > l + m -> t | C.Meta (i,(m,l)) -> let lctx = NCicUtils.expand_local_context l in - (* 1-nargs < k-m, when <= 0 is still reasonable because we will - * substitute args[ k-m ... k-m+nargs-1 > 0 ] *) - C.Meta (i,(m, C.Ctx (HExtlib.sharing_map (substaux (k-m)) lctx))) + C.Meta (i,(0, + C.Ctx (HExtlib.sharing_map (fun x -> substaux k (lift m x)) lctx))) | C.Implicit _ -> assert false (* was identity *) | C.Appl (he::tl) as t -> (* Invariant: no Appl applied to another Appl *)