(* ::Package:: *) (* :Title: CheckOptions *) (* :Author: Leonid B.Shifrin *) (* :Summary: The present functionality allows to set up additional and more stringent tests for option values than those achieved by traditional option filtering, and, more importantly, set up the responding bahavior of the option-receiving function. Only the functions which use opts___?OptionQ pattern for declaring optional arguments, can be protected (the name is arbitrary). The "protection" does add new definitions to functions being "protected". Effort was made to ensure that this will not affect their main functionality, however still this may work incorrectly in certain rare cases. *) (* :Context: CheckOptions` *) (* :Package version: 1.0 *) (* :Copyright: Copyright 2009, Leonid B.Shifrin. Permission is granted to distribute verbatim copies of this package together with any of your packages that use it, provided the following acknowledgement is printed in a standard place: "PackageOptionChecks.m is distributed with permission by Leonid B. Shifrin." *) (* :History: Version 1.0 January 2009 *) (* :Keywords: checks, debugging, options, bulletproofing *) (* :Mathematica version: 5.0 *) (* :Discussion: Possible flaws: 1. The ___?OptionQ pattern is needed to be present in function's signatures. OptionPattern-OptionValue constructs not handled (yet). 2. Only DownValue-based definitions for functions are considered. 3. The "pattern-stripping" parser is very simplistic and may miss some less trivial cases. 4. Definitions of functions being protected are intruded directly, and modified. In some cases this may be unsatisfactory. 5. In UnsortedUnion, Reap-Sow are used, which prevents the package from working in earlier versions of Mathematica. 6. ... *) BeginPackage["CheckOptions`"]; (**********************************************************) (****************** Usage messages ********************) (**********************************************************) AddOptionsCheck::usage = "AddOptionsCheck[f_,test_Symbol,rhsF_] adds a DownValue (global definition) for any existing (DwonValue)definition of where argument list of contains options in the form opts___?OptionQ (the name is arbitrary). The function returns a new list of DownValues upon success and $Failed upon failure. These new definitions allow to test options for validity with the help of function, and execute the function if the latter yields True. The function has to be a Symbol (pure functions are NOT allowed), and takes as its 3 arguments the name of the function , the optional arguments wrapped in Hold (e.g. Hold[opts]), and a list of all function arguments wrapped in Hold. Of course, it is not always necessary to use all these arguments, they are provided to have the maximal information related to the function call available. The function rhsF takes the same 3 arguments, and can also be a pure function. One can use AddOptionsCheck more than once on the same function but with different testing functions . The last added testing definition will be applied first, and so on, with the original definition of (with this signature) applied last. This means that has to be constructed to give on valid arguments and when some options are invalid"; RemoveOptionsCheck::usage = "RemoveOptionsCheck[f_,test_Symbol] removes definitions associated with the testing function . The latter has to be a Symbol (pure functions not allowed)."; RemoveAllOptionsChecks::usage = "RemoveAllOptionChecks[f_Symbol] removes all previously added option- checking definitions "; OptionIsChecked::usage = "OptionIsChecked[f_Symbol,test_Symbol] gives True when there are option-checking definitions of invloving . It is assumed that is not used for any purpose other than option-checking."; (**********************************************************) (****************** Error messages ********************) (**********************************************************) AddOptionsCheck::badarg = "The first two arguments have to be Symbols"; AddOptionsCheck::argnum = "The function was called with `1` argument(s). 3 arguments were expected"; RemoveOptionsCheck::badarg = "The first argument has to be a Symbol"; RemoveOptionsCheck::argnum = "The function was called with `1` argument(s). 2 arguments were expected"; RemoveAllOptionsChecks::badarg = "The first argument must be a Symbol"; RemoveAllOptionsChecks::argnum = "The function was called with `1` argument(s). 1 argument was expected"; OptionIsChecked::badargs= "Both arguments are supposed to be Symbols"; OptionIsChecked::argnum = "The function was called with `1` argument(s). 2 arguments were expected"; AddOptionsCheck::prtctd = "The function `1` is Protected. It has to be Unprotected first"; RemoveOptionsCheck::prtctd = "The function `1` is Protected. It has to be Unprotected first"; RemoveAllOptionsChecks::prtctd = "The function `1` is Protected. It has to be Unprotected first"; Begin["`Private`"]; (**********************************************************) (****************** General functions ********************) (**********************************************************) Attributes[WithCodeAfter]={HoldRest}; WithCodeAfter[expr_,code_]:=(code;expr); splitHeldSequence[Hold[seq___],f_:Hold]:= List@@Map[f,Hold[seq]]; JoinHeld[a__Hold]:= Hold@@Replace[Hold[a],Hold[x___]:>Sequence[x],{1}]; UnsortedUnion[x_]:= Reap[Sow[1,x],_,#1&][[2]]; (**********************************************************) (************** General parsing functionality *************) (**********************************************************) getFunArguments[Verbatim[HoldPattern][ Verbatim[Condition][f_[args___],test_]]]:= getFunArguments[HoldPattern[f[args]]]; getFunArguments[Verbatim[HoldPattern][f_[args___]]]:= FunArguments[FName[f],FArgs@@splitHeldSequence[Hold[args]]]; (* This is a simplistic "parser". It may miss some less trivial cases*) getArgumentNames[args__FArgs]:= args//.{ Verbatim[Pattern][tag_,___]:>tag, Verbatim[Condition][z_,_]:>z, Verbatim[PatternTest][z_,_]:>z}; SignaturesFromDefs[f_Symbol]:= Cases[DownValues[f], Verbatim[RuleDelayed][x_HoldPattern,_]:> FunSignature[DefPattern[x],getFunArguments[x]],2]; SpecificSignatures[f_Symbol,testAll_:(True&)]:= Select[SignaturesFromDefs[f],testAll]; argSelect[test_,signatures:{(_FunSignature)..}]:= signatures/.x_FArgs:>Select[x,test]; removePatterns[{}]={}; removePatterns[signatures:{(_FunSignature)..}]:= signatures/.x_FArgs:>getArgumentNames[x]; (* Note: possible (nested) conditions are stripped off and ignored, since this new def is supposed to be an error-checking definition *) addCondition[Verbatim[HoldPattern][ Verbatim[Condition][inner_,_]],test_]:= addCondition[HoldPattern[inner],test]; addCondition[x_HoldPattern,test_]:= x/.Verbatim[HoldPattern][pt_]:>HoldPattern[pt/;test]; (**********************************************************) (********* Specific options-related functionality *********) (**********************************************************) currentlyUsedTestFunctions[_]={}; (* Note that we identify options by the following specific pattern *) optionsPresentQ[x_HoldPattern]:= !FreeQ[x,Verbatim[PatternTest][ Verbatim[Pattern][_,___],OptionQ]]; optionsPresentQ[signature_FunSignature]:= Catch[ Cases[signature,DefPattern[x_HoldPattern]:> Throw[optionsPresentQ[x]],Infinity]]; optionsMissedQ[f_Symbol]:= SpecificSignatures[f,optionsPresentQ]=!= SpecificSignatures[f,!FreeQ[#,OptionQ]&]; optionsNames[{}]={}; optionsNames[signatures:{(_FunSignature?optionsPresentQ)..}]:= Map[getIfUnique[Cases[#,x_FArgs:>OptName@@x,2]]&, removePatterns[argSelect[!FreeQ[#,OptionQ]&,signatures]]]; getIfUnique[x_List]/;Length[x]==1:=First[x]; getIfUnique[___]:=Throw[$Failed]; Attributes[customHold]={HoldAll}; constructOptionCondition[x:{_FunSignature,_OptName}, test_Symbol,rhsF_]:= With[{sel=getIfUnique[Cases[x,#,Infinity]]&}, With[{pt=sel[DefPattern[y_]:>y], fname=sel[FName[fun_]:>Hold[fun]], optname=sel[OptName[y_]:>Hold[y]], args=sel[FArgs[args__Hold]:>Hold[Evaluate[JoinHeld[args]]]]}, (* These games with Hold, JoinHeld, Evaluate etc are needed to prevent premature evaluation of test[args] and rhsF[args]*) RuleDelayed@@ JoinHeld[ Hold[Evaluate[ addCondition[pt, customHold@@JoinHeld[fname,optname,args]]]]/. customHold-> test, Hold[Evaluate[ customHold@@JoinHeld[fname,optname,args]]]/. customHold-> rhsF]]]; OptionsCheckingDefs[f_Symbol,test_Symbol,rhsF_]/;!optionsMissedQ[f]:= With[{signaturesAndOptions= Map[Flatten[#,1]&, Transpose[Through[{removePatterns,optionsNames}[ SpecificSignatures[ f, And[FreeQ[#,Alternatives@@ Join[{test},currentlyUsedTestFunctions[f]]], optionsPresentQ[#] ]& ]]]]]}, (* body *) Map[constructOptionCondition[#,test,rhsF]&, signaturesAndOptions]]; OptionsCheckingDefs[___]:=Throw[$Failed]; (**********************************************************) (***************** Public interface ******************) (**********************************************************) AddOptionsCheck[f_Symbol,test_Symbol,rhsF_]/; Not[MemberQ[Attributes[f],Protected]]:= Catch[ WithCodeAfter[ DownValues[f]= UnsortedUnion[ Join[OptionsCheckingDefs[f,test,rhsF], DownValues[f]]], AppendTo[currentlyUsedTestFunctions[f],test] ]]; (* Error cases *) AddOptionsCheck[f_Symbol,test_Symbol,rhsF_]:= "never happens"/;Message[AddOptionsCheck::prtctd,f]; AddOptionsCheck[f_,test_,_]/;Head[f]=!=Symbol||Head[test]=!=Symbol:= "never happens"/;Message[AddOptionsCheck::badarg]; AddOptionsCheck[x___]/;Length[{x}]=!=3:= "never happens"/;Message[AddOptionsCheck::argnum,Length[{x}]]; RemoveOptionsCheck[f_Symbol,test_Symbol]/; Not[MemberQ[Attributes[f],Protected]]:= DownValues[f]=DeleteCases[DownValues[f],x_/;!FreeQ[x,test]]; (* Error cases *) RemoveOptionsCheck[f_Symbol,test_Symbol]:= "never happens"/;Message[RemoveOptionsCheck::prtctd,f]; RemoveOptionsCheck[f_,test_]/;Head[f]=!=Symbol||Head[test]=!=Symbol:= "never happens"/;Message[RemoveOptionsCheck::badarg]; RemoveOptionsCheck[x___]/;Length[{x}]=!=2:= "never happens"/;Message[RemoveOptionsCheck::argnum,Length[{x}]]; RemoveAllOptionsChecks[f_Symbol]/; Not[MemberQ[Attributes[f],Protected]]:= (Scan[RemoveOptionsCheck[f,#]&, currentlyUsedTestFunctions[f]]; DownValues[f]); (* Error cases *) RemoveAllOptionsChecks[f_Symbol]:= "never happens"/;Message[RemoveAllOptionsChecks::prtctd,f]; RemoveAllOptionsChecks[f_]/;Head[f]=!=Symbol:= "never happens"/;Message[RemoveAllOptionsChecks::badarg]; RemoveAllOptionsChecks[x___]/;Length[{x}]=!=1:= "never happens"/;Message[RemoveAllOptionsChecks::argnum,Length[{x}]]; OptionIsChecked[f_Symbol,test_Symbol]:= !FreeQ[DownValues[f],test]; (* Error cases *) OptionIsChecked[_,_]:= "never happens"/;Message[OptionIsChecked::badargs]; OptionIsChecked[x___]/;Length[{x}]=!=2:= "never happens"/;Message[OptionIsChecked::argnum,Length[{x}]]; End[]; Protect[AddOptionsCheck,RemoveOptionsCheck,RemoveAllOptionsChecks, OptionIsChecked]; EndPackage[];