X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fng_kernel%2FnCicUntrusted.ml;h=ba5ad9f5ad6480e744b9ea9bb53a0a3840721412;hb=b3093b1353395ee96d03d9e3771798c3425ff4ac;hp=bd5055874822a917951454dab279a5673622ee95;hpb=894d518aa760c9f816ddb0dc2b3fa88e1fe20a94;p=helm.git diff --git a/matita/components/ng_kernel/nCicUntrusted.ml b/matita/components/ng_kernel/nCicUntrusted.ml index bd5055874..ba5ad9f5a 100644 --- a/matita/components/ng_kernel/nCicUntrusted.ml +++ b/matita/components/ng_kernel/nCicUntrusted.ml @@ -160,43 +160,34 @@ let clean_or_fix_dependent_abstrations status ctx t = aux (List.map fst ctx) t ;; -let rec fire_projection_redex status on_args = function +let rec fire_projection_redex status () = function | C.Meta _ as t -> t - | C.Appl(C.Const(Ref.Ref(_,Ref.Fix(fno,rno,_)) as r)::args as ol)as ot-> - let l= if on_args then List.map (fire_projection_redex status true) ol else ol in - let t = if l == ol then ot else C.Appl l in + | C.Appl((C.Const(Ref.Ref(_,Ref.Fix(fno,rno,_)) as r) as hd)::args) as ot-> + let args'= HExtlib.sharing_map (fire_projection_redex status ()) args in + let t = if args == args' then ot else C.Appl (hd::args') in let ifl,(_,_,pragma),_ = NCicEnvironment.get_checked_fixes_or_cofixes status r in - let conclude () = - if on_args then - let l' = HExtlib.sharing_map (fire_projection_redex status true) l in - if l == l' then t else C.Appl l' - else - t (* ot is the same *) - in - if pragma <> `Projection || List.length args <= rno then conclude () + if pragma <> `Projection || List.length args <= rno then t else - (match List.nth l (rno+1) with + (match List.nth args' rno with | C.Appl (C.Const(Ref.Ref(_,Ref.Con _))::_) -> let _, _, _, _, fbody = List.nth ifl fno in (* fbody is closed! *) - let t = C.Appl (fbody::List.tl l) in + let t = C.Appl (fbody::args') in (match NCicReduction.head_beta_reduce status ~delta:max_int t with | C.Match (_,_, C.Appl(C.Const(Ref.Ref(_,Ref.Con (_,_,leftno))) ::kargs),[pat])-> let _,kargs = HExtlib.split_nth leftno kargs in - fire_projection_redex status false - (NCicReduction.head_beta_reduce status - ~delta:max_int (C.Appl (pat :: kargs))) + NCicReduction.head_beta_reduce status + ~delta:max_int (C.Appl (pat :: kargs)) | C.Appl(C.Match(_,_,C.Appl(C.Const(Ref.Ref(_,Ref.Con (_,_,leftno))) ::kargs),[pat]) :: args) -> let _,kargs = HExtlib.split_nth leftno kargs in - fire_projection_redex status false + fire_projection_redex status () (NCicReduction.head_beta_reduce status ~delta:max_int (C.Appl (pat :: kargs @ args))) - | _ -> conclude ()) - | _ -> conclude ()) - | t when on_args -> - NCicUtils.map status (fun _ x -> x) true (fire_projection_redex status) t - | t -> t + | _ -> assert false) + | _ -> t) + | t -> + NCicUtils.map status (fun _ x -> x) () (fire_projection_redex status) t ;; let apply_subst status ?(fix_projections=false) subst context t = @@ -218,8 +209,12 @@ let apply_subst status ?(fix_projections=false) subst context t = apply_subst subst () (NCicSubstitution.lift status n t)) l)))) | t -> NCicUtils.map status (fun _ () -> ()) () (apply_subst subst) t in - (if fix_projections then fire_projection_redex status true else fun x -> x) - (clean_or_fix_dependent_abstrations status context (apply_subst subst () t)) + let t = apply_subst subst () t in + let t = clean_or_fix_dependent_abstrations status context t in + if fix_projections then + fire_projection_redex status () t + else + t ;; let apply_subst_context status ~fix_projections subst context =