Created
December 22, 2015 09:09
-
-
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
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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