From: Enrico Tassi Date: Mon, 22 Sep 2008 15:35:20 +0000 (+0000) Subject: new iterator X-Git-Tag: make_still_working~4751 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=9bd50f57560e6877c3829b788bab2c8c063678a4;p=helm.git new iterator --- diff --git a/helm/software/components/ng_kernel/nCicUtils.ml b/helm/software/components/ng_kernel/nCicUtils.ml index f4f77a367..74d1a7834 100644 --- a/helm/software/components/ng_kernel/nCicUtils.ml +++ b/helm/software/components/ng_kernel/nCicUtils.ml @@ -80,3 +80,39 @@ let map g k f = function if oty1 == oty && t1 == t && pl1 == pl then orig else C.Match(r,oty1,t1,pl1) ;; + +let map_term_fold_a g k f a = function + | C.Meta _ -> assert false + | C.Implicit _ + | C.Sort _ + | C.Const _ + | C.Rel _ as t -> a,t + | C.Appl [] | C.Appl [_] -> assert false + | C.Appl l as orig -> + let a,l = + (* sharing fold? *) + List.fold_right (fun t (a,l) -> let a,t = f k a t in a, t :: l) l (a,[]) + in + a, (match l with + | C.Appl l :: tl -> C.Appl (l@tl) + | l1 when l == l1 -> orig + | l1 -> C.Appl l1) + | C.Prod (n,s,t) as orig -> + let a,s1 = f k a s in let a,t1 = f (g (n,C.Decl s) k) a t in + a, if t1 == t && s1 == s then orig else C.Prod (n,s1,t1) + | C.Lambda (n,s,t) as orig -> + let a,s1 = f k a s in let a,t1 = f (g (n,C.Decl s) k) a t in + a, if t1 == t && s1 == s then orig else C.Lambda (n,s1,t1) + | C.LetIn (n,ty,t,b) as orig -> + let a,ty1 = f k a ty in let a,t1 = f k a t in + let a,b1 = f (g (n,C.Def (t,ty)) k) a b in + a, if ty1 == ty && t1 == t && b1 == b then orig else C.LetIn (n,ty1,t1,b1) + | C.Match (r,oty,t,pl) as orig -> + let a,oty1 = f k a oty in let a,t1 = f k a t in + let a,pl1 = + (* sharing fold? *) + List.fold_right (fun t (a,l) -> let a,t = f k a t in a,t::l) pl (a,[]) + in + a, if oty1 == oty && t1 == t && pl1 == pl then orig + else C.Match(r,oty1,t1,pl1) +;; diff --git a/helm/software/components/ng_kernel/nCicUtils.mli b/helm/software/components/ng_kernel/nCicUtils.mli index c87dd6638..1560094dc 100644 --- a/helm/software/components/ng_kernel/nCicUtils.mli +++ b/helm/software/components/ng_kernel/nCicUtils.mli @@ -27,3 +27,6 @@ val fold: val map: (NCic.hypothesis -> 'k -> 'k) -> 'k -> ('k -> NCic.term -> NCic.term) -> NCic.term -> NCic.term +val map_term_fold_a: + (NCic.hypothesis -> 'k -> 'k) -> 'k -> + ('k -> 'a -> NCic.term -> 'a * NCic.term) -> 'a -> NCic.term -> 'a * NCic.term