-let sharing_map f l =
- let unchanged = ref true in
- let rec aux b = function
- | [] as t -> unchanged := b; t
- | he::tl ->
- let he1 = f he in
- he1 :: aux (b && he1 == he) tl
- in
- let l1 = aux true l in
- if !unchanged then l else l1
-;;
-
-let map f g k = function
- | NCic.Implicit _
- | NCic.Sort _
- | NCic.Const _
- | NCic.Meta _
- | NCic.Rel _ as t -> t
- | NCic.Appl l -> NCic.Appl (sharing_map (f k) l)
- | NCic.Prod (n,s,t) as orig ->
- let s1 = f k s in let t1 = f (g k) t in
- if t1 == t && s1 == s then orig else NCic.Prod (n,s1,t1)
- | NCic.Lambda (n,s,t) as orig ->
- let s1 = f k s in let t1 = f (g k) t in
- if t1 == t && s1 == s then orig else NCic.Prod (n,s1,t1)
- | NCic.LetIn (n,ty,t,b) as orig ->
- let ty1 = f k ty in let t1 = f k t in let b1 = f (g k) b in
- if ty1 == ty && t1 == t && b1 == b then orig else NCic.LetIn (n,ty1,t1,b1)
- | NCic.Match (r,oty,t,pl) as orig ->
- let oty1 = f k oty in let t1 = f k t in let pl1 = sharing_map (f k) pl in
+let map g k f = function
+ | C.Meta _ -> assert false
+ | C.Implicit _
+ | C.Sort _
+ | C.Const _
+ | C.Rel _ as t -> t
+ | C.Appl [] | C.Appl [_] -> assert false
+ | C.Appl l as orig ->
+ let fire_beta, upto =
+ match l with C.Meta _ :: _ -> true, List.length l - 1 | _ -> false, 0
+ in
+ let l1 = HExtlib.sharing_map (f k) l in
+ if l == l1 then orig else
+ let t =
+ match l1 with
+ | C.Appl l :: tl -> C.Appl (l@tl)
+ | l1 -> C.Appl l1
+ in
+ if fire_beta then !head_beta_reduce ~upto t
+ else t
+ | C.Prod (n,s,t) as orig ->
+ let s1 = f k s in let t1 = f (g (n,C.Decl s) k) t in
+ if t1 == t && s1 == s then orig else C.Prod (n,s1,t1)
+ | C.Lambda (n,s,t) as orig ->
+ let s1 = f k s in let t1 = f (g (n,C.Decl s) k) t in
+ if t1 == t && s1 == s then orig else C.Lambda (n,s1,t1)
+ | C.LetIn (n,ty,t,b) as orig ->
+ let ty1 = f k ty in let t1 = f k t in
+ let b1 = f (g (n,C.Def (t,ty)) k) b in
+ 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 oty1 = f k oty in let t1 = f k t in let pl1 = HExtlib.sharing_map (f k) pl in