# HG changeset patch # User wenzelm # Date 1702033556 -3600 # Node ID 90ba93146eb558b1c4acda5702626139f7abc531 # Parent cd52f4e8e3535077d23dedf2e368b011e3859afd tuned; diff -r cd52f4e8e353 -r 90ba93146eb5 src/Pure/proofterm.ML --- a/src/Pure/proofterm.ML Fri Dec 08 11:46:42 2023 +0100 +++ b/src/Pure/proofterm.ML Fri Dec 08 12:05:56 2023 +0100 @@ -618,25 +618,28 @@ fun prf_abstract_over v = let - fun abst' lev u = if v aconv u then Bound lev else - (case u of - Abs (a, T, t) => Abs (a, T, abst' (lev + 1) t) - | f $ t => (abst' lev f $ absth' lev t handle Same.SAME => f $ abst' lev t) - | _ => raise Same.SAME) - and absth' lev t = (abst' lev t handle Same.SAME => t); + fun term lev u = + if v aconv u then Bound lev + else + (case u of + Abs (a, T, t) => Abs (a, T, term (lev + 1) t) + | t $ u => + (term lev t $ Same.commit (term lev) u + handle Same.SAME => t $ term lev u) + | _ => raise Same.SAME); - fun abst lev (AbsP (a, t, prf)) = - (AbsP (a, Same.map_option (abst' lev) t, absth lev prf) - handle Same.SAME => AbsP (a, t, abst lev prf)) - | abst lev (Abst (a, T, prf)) = Abst (a, T, abst (lev + 1) prf) - | abst lev (prf1 %% prf2) = (abst lev prf1 %% absth lev prf2 - handle Same.SAME => prf1 %% abst lev prf2) - | abst lev (prf % t) = (abst lev prf % Option.map (absth' lev) t - handle Same.SAME => prf % Same.map_option (abst' lev) t) - | abst _ _ = raise Same.SAME - and absth lev prf = (abst lev prf handle Same.SAME => prf); + fun proof lev (AbsP (a, t, p)) = + (AbsP (a, Same.map_option (term lev) t, Same.commit (proof lev) p) + handle Same.SAME => AbsP (a, t, proof lev p)) + | proof lev (Abst (a, T, p)) = Abst (a, T, proof (lev + 1) p) + | proof lev (p %% q) = (proof lev p %% Same.commit (proof lev) q + handle Same.SAME => p %% proof lev q) + | proof lev (p % t) = + (proof lev p % Option.map (Same.commit (term lev)) t + handle Same.SAME => p % Same.map_option (term lev) t) + | proof _ _ = raise Same.SAME; - in absth 0 end; + in Same.commit (proof 0) end; (*increments a proof term's non-local bound variables diff -r cd52f4e8e353 -r 90ba93146eb5 src/Pure/term.ML --- a/src/Pure/term.ML Fri Dec 08 11:46:42 2023 +0100 +++ b/src/Pure/term.ML Fri Dec 08 12:05:56 2023 +0100 @@ -780,16 +780,16 @@ The resulting term is ready to become the body of an Abs.*) fun abstract_over (v, body) = let - fun abs lev tm = + fun term lev tm = if v aconv tm then Bound lev else (case tm of - Abs (a, T, t) => Abs (a, T, abs (lev + 1) t) + Abs (a, T, t) => Abs (a, T, term (lev + 1) t) | t $ u => - (abs lev t $ (abs lev u handle Same.SAME => u) - handle Same.SAME => t $ abs lev u) + (term lev t $ Same.commit (term lev) u + handle Same.SAME => t $ term lev u) | _ => raise Same.SAME); - in abs 0 body handle Same.SAME => body end; + in Same.commit (term 0) body end; fun term_name (Const (x, _)) = Long_Name.base_name x | term_name (Free (x, _)) = x