X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicSubstitution.ml;h=43a2f8174a74a1cad4696523908e8a4575f6933e;hb=a90c31c1b53222bd6d57360c5ba5c2d0fe7d5207;hp=d3e6756d8322bd562149762cb81bf0817a1afd72;hpb=4377e950998c9c63937582952a79975947aa9a45;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicSubstitution.ml b/helm/software/components/ng_kernel/nCicSubstitution.ml index d3e6756d8..43a2f8174 100644 --- a/helm/software/components/ng_kernel/nCicSubstitution.ml +++ b/helm/software/components/ng_kernel/nCicSubstitution.ml @@ -22,7 +22,7 @@ module Ref = NReference let debug_print = fun _ -> ();; -let lift_from ?(no_implicit=true) k n = +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)) @@ -31,16 +31,15 @@ let lift_from ?(no_implicit=true) k n = | C.Meta (i,(m,l)) -> let lctx = NCicUtils.expand_local_context l in C.Meta (i, (m, C.Ctx (HExtlib.sharing_map (liftaux (k-m)) lctx))) - | C.Implicit _ as t -> (* was the identity *) - if no_implicit then assert false - else t + | C.Implicit _ -> (* was the identity *) assert false | t -> NCicUtils.map (fun _ k -> k + 1) k liftaux t in liftaux k ;; -let lift ?(from=1) ?(no_implicit=true) n t = - if n = 0 then t else lift_from ~no_implicit from n t +let lift ?(from=1) n t = + if n = 0 then t + else lift_from from n t ;; @@ -51,7 +50,7 @@ let lift ?(from=1) ?(no_implicit=true) n t = (* well typed and avoid_beta_redexes is true. *) (* map_arg is ReductionStrategy.from_env_for_unwind when psubst is *) (* used to implement nCicReduction.unwind' *) -let rec psubst ?(avoid_beta_redexes=false) ?(no_implicit=true) map_arg args = +let rec psubst ?(avoid_beta_redexes=false) map_arg args = let nargs = List.length args in let rec substaux k = function | C.Rel n as t -> @@ -60,7 +59,7 @@ let rec psubst ?(avoid_beta_redexes=false) ?(no_implicit=true) map_arg args = if nargs <> 0 then C.Rel (n - nargs) else t | n when n < k -> t | n (* k <= n < k+nargs *) -> - (try lift ~no_implicit (k-1) (map_arg (List.nth args (n-k))) + (try lift (k-1) (map_arg (List.nth args (n-k))) 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 @@ -68,11 +67,8 @@ let rec psubst ?(avoid_beta_redexes=false) ?(no_implicit=true) map_arg args = | C.Meta (i,(m,l)) -> let lctx = NCicUtils.expand_local_context l in C.Meta (i,(0, - C.Ctx (HExtlib.sharing_map - (fun x -> substaux k (lift ~no_implicit m x)) lctx))) - | C.Implicit _ as t -> - if no_implicit then assert false (* was identity *) - else t + 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 *) let rec avoid he' = function @@ -84,8 +80,7 @@ let rec psubst ?(avoid_beta_redexes=false) ?(no_implicit=true) map_arg args = (* map_arg is here \x.x, Obj magic is needed because * we don't have polymorphic recursion w/o records *) avoid (psubst - ~avoid_beta_redexes ~no_implicit - Obj.magic [Obj.magic arg] bo) tl' + ~avoid_beta_redexes Obj.magic [Obj.magic arg] bo) tl' | _ -> if he == he' && args == tl then t else C.Appl (he'::args)) in let tl = HExtlib.sharing_map (substaux k) tl in @@ -95,8 +90,8 @@ let rec psubst ?(avoid_beta_redexes=false) ?(no_implicit=true) map_arg args = substaux 1 ;; -let subst ?avoid_beta_redexes ?no_implicit arg = - psubst ?avoid_beta_redexes ?no_implicit(fun x -> x)[arg];; +let subst ?avoid_beta_redexes arg = + psubst ?avoid_beta_redexes (fun x -> x)[arg];; (* subst_meta (n, C.Ctx [t_1 ; ... ; t_n]) t *) (* returns the term [t] where [Rel i] is substituted with [t_i] lifted by n *)