Skip to content

Instantly share code, notes, and snippets.

@lshifr
Created December 22, 2015 09:09
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save lshifr/f07ddfaf762ae96e5ac4 to your computer and use it in GitHub Desktop.
Save lshifr/f07ddfaf762ae96e5ac4 to your computer and use it in GitHub Desktop.
An implementation of a function constructor that takes (possibly overloaded) function definitions using standard pattern-based syntax (where function name should be denoted as Fn), and returns a Function-based definition that is garbage-collectable
BeginPackage["RuleBasedFunction`"]
RuleBasedFunction::usage = "RuleBasedFunction[defs, attrs] constructs a pure function based on definitions given by rules";
Fn::usage = "Fn is a symbol used to denote a function in definitions used in RuleBasedFunction";
Begin["`Private`"]
SetAttributes[CleanUp, HoldAll]
CleanUp[expr_, cleanup_] :=
Module[{exprFn, result, abort = False, rethrow = True, seq},
exprFn[] := expr;
result =
CheckAbort[
Catch[Catch[result = exprFn[]; rethrow = False; result], _,
seq[##] &], abort = True];
cleanup;
If[abort, Abort[]];
If[rethrow, Throw[result /. seq -> Sequence]];
result]
Unprotect[RuleBasedFunction, Fn];
ClearAll[RuleBasedFunction, Fn];
SetAttributes[Fn, Protected];
SetAttributes[RuleBasedFunction, HoldFirst];
Options[RuleBasedFunction] = {Evaluator -> Normal};
RuleBasedFunction[defs:{(_Set|_SetDelayed)..}, attrs_List:{}, opts:OptionsPattern[]]:=
Module[{temp},
Unevaluated[defs] /. Fn -> temp;
With[{result = iRuleBasedFunction[temp, attrs, OptionValue[Evaluator]]},
Remove[temp];
result
]
];
(* This version constructs and then removes a temporary symbol with all function's
definition at every call. It fully follows the Mathematica's evaluation semantics,
but the symbol copy-remove procedure induces some overhead *)
ClearAll[iRuleBasedFunction];
SetAttributes[iRuleBasedFunction, HoldFirst];
iRuleBasedFunction[sym_Symbol, atts_List, Normal]:=
With[{dv = DownValues[sym] /. HoldPattern[sym] :> Fn},
Function[
Null
,
Module[{tmp, result},
DownValues[tmp] = dv /. Fn -> tmp;
SetAttributes[tmp, atts];
CleanUp[
result = tmp[##]
,
result = result /. tmp -> #0;
Remove[tmp];
];
result
]
,
atts
]
];
(* This option does not replicate the full evaluation semantics of Mathematica,
but can be much faster. In most cases, this is a good choice. It is not a default
however, since it won't be correct in certain cases *)
iRuleBasedFunction[sym_Symbol, atts_List, ReplaceRepeated]:=
Module[{fn},
SetAttributes[fn, atts];
With[{rules = DownValues[sym] /. HoldPattern[sym] :> fn},
Function[Null, fn[##] //. rules, atts]
]
];
End[]
EndPackage[]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment