A tiny framework to cure the leaks of lexical scoping in Mathematica
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 ]] | |
]; |
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] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment