lshifr
5/19/2016 - 2:59 PM

A non-standard evaluator for Mathematica code, allowing to evaluate the code in the "frozen" mode

A non-standard evaluator for Mathematica code, allowing to evaluate the code in the "frozen" mode

BeginPackage["FrozenCode`"]

FrozenCodeEvaluate::usage = "FrozenCodeEvaluate[Hold[code], {heads}] evaluates the code
in the 'frozen' mode, where only specific heads are allowed to evaluate";

Begin["`Private`"]

ClearAll[symbolToHideQ]
SetAttributes[symbolToHideQ, HoldFirst];
symbolToHideQ[s_Symbol, expandedSymbs_] :=! MemberQ[expandedSymbs, Unevaluated[s]];

ClearAll[globalProperties]
globalProperties[] := {DownValues, SubValues, UpValues (*,OwnValues*)};

ClearAll[getSymbolsToHide];
Options[getSymbolsToHide] = {
     "Exceptions" -> {List, Hold, HoldComplete, 
        HoldForm, HoldPattern, Blank, BlankSequence, BlankNullSequence, 
       Optional, Repeated, Verbatim, Pattern, RuleDelayed, Rule, True, 
       False, Integer, Real, Complex, Alternatives, String, 
       PatternTest,(*Note-  this one is dangerous since it opens a hole 
                    to evaluation leaks. But too good to be ingored *)
       Condition, PatternSequence, Except
      }
 };

getSymbolsToHide[code_Hold, headsToExpand : {___Symbol}, opts : OptionsPattern[]] :=
  Join @@ Complement[
       Cases[{
          Flatten[Outer[Compose, globalProperties[], headsToExpand]], code},
            s_Symbol /; symbolToHideQ[s, headsToExpand] :> Hold[s],
            Infinity,
            Heads -> True
       ],
       Hold /@ OptionValue["Exceptions"]];

ClearAll[makeHidingSymbol]
SetAttributes[makeHidingSymbol, HoldAll];
makeHidingSymbol[s_Symbol] := 
    Unique[hidingSymbol(*Unevaluated[s]*) (*,Attributes[s]*)];

ClearAll[makeHidingRules]
makeHidingRules[symbs : Hold[__Symbol]] :=
     Thread[List @@ Map[HoldPattern, symbs] -> List @@ Map[makeHidingSymbol, symbs]];

ClearAll[reverseHidingRules];
reverseHidingRules[rules : {(_Rule | _RuleDelayed) ..}] :=
   rules /. (Rule | RuleDelayed)[Verbatim[HoldPattern][lhs_], rhs_] :> (rhs :> lhs);


FrozenCodeEvaluate[code_Hold, headsToEvaluate : {___Symbol}] :=   
   Module[{symbolsToHide, hidingRules, revHidingRules,  result}, 
      symbolsToHide = getSymbolsToHide[code, headsToEvaluate];
      hidingRules = makeHidingRules[symbolsToHide];
      revHidingRules = reverseHidingRules[hidingRules];
      result = 
         Hold[Evaluate[ReleaseHold[code /. hidingRules]]] /. revHidingRules;
      Apply[Remove, revHidingRules[[All, 1]]];
      result];

End[]

EndPackage[]