Skip to content

Instantly share code, notes, and snippets.

@lshifr
Created January 26, 2012 16:04
Show Gist options
  • Save lshifr/1683497 to your computer and use it in GitHub Desktop.
Save lshifr/1683497 to your computer and use it in GitHub Desktop.
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