public
Last active

A tiny framework to cure the leaks of lexical scoping in Mathematica

  • Download Gist
AutoRenamings
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
ClearAll[getPatternSymbols, getDeclaredSymbols];
SetAttributes[{getPatternSymbols, getDeclaredSymbols}, HoldAll];
getPatternSymbols[expr_] :=
Cases[Unevaluated[expr],
Verbatim[Pattern][ss_, _] :> HoldComplete[ss], {0, Infinity},
Heads -> True];
 
getDeclaredSymbols[{decs___}] :=
Thread@Replace[HoldComplete[{decs}],
HoldPattern[a_ = rhs_] :> a, {2}];
 
 
ClearAll[renamingRules];
renamingRules[symbs : {___HoldComplete}] :=
MapThread[
Rule,
symbs /.
{{HoldComplete[s_] :> HoldPattern[s]},
{HoldComplete[s_] :> Unique[Unevaluated[s]]}}]
 
 
ClearAll[myHold];
SetAttributes[myHold, HoldAllComplete];
 
 
ClearAll[makeRenamings];
SetAttributes[makeRenamings, HoldAll];
makeRenamings[expr : (_myHold | _Pattern)] := expr;
 
makeRenamings[SetDelayed[lhs_, rhs_]] :=
ReplaceAll[#, renamingRules[getPatternSymbols[#]]] &@
Apply[myHold[SetDelayed[##]] &, {makeRenamings[lhs],
makeRenamings[rhs]}];
 
makeRenamings[Function[x_Symbol, body_]] :=
makeRenamings[Function[{x}, body]];
 
makeRenamings[(head : With | Function | Module)[decl_, body_,
atts_: Automatic]] :=
With[{rules = renamingRules@getDeclaredSymbols[decl]},
Apply[myHold[head[#1, #2]] &,
{makeRenamings[decl],
makeRenamings[body],
If[atts === Automatic, Sequence @@ {}, atts]}] /. rules];
 
makeRenamings[f_[elems___]] :=
makeRenamings[f] @@ Map[makeRenamings, Unevaluated[{elems}]];
 
makeRenamings[a_ /; AtomQ[Unevaluated[a]]] := myHold[a]
 
makeRenamings[expr_, Full] :=
Hold[Evaluate[makeRenamings[expr]]] //. myHold[x_] :> x
 
 
ClearAll[runWithRenamings];
SetAttributes[runWithRenamings, HoldAll];
runWithRenamings[code_] :=
ReleaseHold@makeRenamings[code, Full];
 
 
ClearAll[enableAutoRenamings, disableAutoRenamings, $inSetDelayed];
enableAutoRenamings[] :=
Module[{},
Unprotect[SetDelayed];
s_SetDelayed /; ! TrueQ[$inSetDelayed] :=
Block[{$inSetDelayed = True},
runWithRenamings[s]];
Protect[SetDelayed];
];
 
disableAutoRenamings[] :=
Module[{},
Unprotect[SetDelayed];
DownValues[SetDelayed] =
DeleteCases[DownValues[SetDelayed] ,
def_ /; ! FreeQ[def, $inSetDelayed ]]
];
AutoRenamingsTests
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
makeRenamings[
ClearAll[f, g];
f[x_] := g[With[{a = #}, x] &];
g[fn_] := Module[{h}, h[a_] := fn[a]; h[0]];,
Full
]
 
enableAutoRenamings[]
 
ClearAll[f, g];
f[x_] := g[With[{a = #}, x] &];
g[fn_] := Module[{h}, h[a_] := fn[a]; h[0]];
 
?f
 
?g
 
f[999]
 
disableAutoRenamings[]
 
ClearAll[f, g];
f[x_] := g[With[{a = #}, x] &];
g[fn_] := Module[{h}, h[a_] := fn[a]; h[0]];
f[999]

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.