public

lshifr / AutoRenamings

Last active 2012-01-26

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]