# HG changeset patch # User wenzelm # Date 1702299919 -3600 # Node ID 197b155f8818765f395133efa3a8c4901da6dd07 # Parent 0e15387c03005e52311de62c56257a82fe797baa minor performance tuning: prefer Same.operation; diff -r 0e15387c0300 -r 197b155f8818 src/Pure/term.ML --- a/src/Pure/term.ML Mon Dec 11 13:40:02 2023 +0100 +++ b/src/Pure/term.ML Mon Dec 11 14:05:19 2023 +0100 @@ -655,18 +655,22 @@ (* strip abstractions created by parameters *) val match_bvars = apply2 strip_abs_body #> match_bvs; -fun map_abs_vars f (t $ u) = map_abs_vars f t $ map_abs_vars f u - | map_abs_vars f (Abs (a, T, t)) = Abs (f a, T, map_abs_vars f t) - | map_abs_vars f t = t; +fun map_abs_vars_same rename = + let + fun term (Abs (x, T, t)) = + let val y = rename x + in if x = y then Abs (x, T, term t) else Abs (y, T, Same.commit term t) end + | term (t $ u) = (term t $ Same.commit term u handle Same.SAME => t $ term u) + | term _ = raise Same.SAME; + in term end; + +fun map_abs_vars rename = Same.commit (map_abs_vars_same rename); fun rename_abs pat obj t = let - val ren = match_bvs (pat, obj) []; - fun ren_abs (Abs (x, T, b)) = - Abs (the_default x (AList.lookup (op =) ren x), T, ren_abs b) - | ren_abs (f $ t) = ren_abs f $ ren_abs t - | ren_abs t = t - in if null ren then NONE else SOME (ren_abs t) end; + val renaming = match_bvs (pat, obj) []; + fun rename x = perhaps (AList.lookup (op =) renaming) x; + in if null renaming then NONE else Same.catch (map_abs_vars_same rename) t end; (*Accumulate all 'loose' bound vars referring to level 'lev' or beyond. (Bound 0) is loose at level 0 *)