(* :Title: Local Patterns *)
(* :Author: Ted Ersek *)
(* : Copyright 1999 by Ted Ersek.
Permission is hereby granted to use this package or any portion
thereof provided this MathSource item and it's author are referenced.
An exception is made for Wolfram Research who may use the package or
any portion of the package without giving credit.
*)
(* :Summary:
The functions Rule, Set, UpSet, TagSet each evaluate their right side
immediately. If these functions have named patterns on the left
side, and the symbols used to name the pattern are needed on the right
side then the global value of these symbols are used on the right side.
In that case the functions don't give the intended result.
This package defines functions that work like Rule, Set, UpSet, TagSet
but don't have this problem.
*)
(* :Context: LocalPatterns` *)
(* Keywords: Rule, Set, UpSet, TagSet, scope, local variable *)
(* :Mathematica Version: 3.0 *)
(* :History:
V1.0, Submitted to MathSource but rejected due to a need for more
examples, Dec 1999.
V1.1, Examples revised, and submitted to MathSource again, Sept 1999.
*)
(* :Package Version: 1.1, September 1999 *)
(* :Acknowledgment:
The elegant implementation of LocalPatterns was provided
by Robby Villegas of Wolfram Research.
*)
(* :Warning: *)
(* :Limitations:
The functions defined in this package don't implement some subtle
details of nested scoping constructs the way built-in scoping
constructs do.
*)
(* :Discussion: *)
BeginPackage["Enhancements`LocalPatterns`"]
LocalRule::usage=
"LocalRule[lhs,rhs] represents a rule where rhs is evaluated \
immediately using a local environment for any variable used as a \
pattern in lhs. LocalRule[lhs,rhs] is equivalent to \
lhs\[RightArrow]rhs where \[RightArrow] is entered \
as \\[RightArrow].";
LongRightArrow::usage=
"lhs\[LongRightArrow]rhs represents a rule where rhs is evaluated \
immediately using a local environment for any variable used as a \
pattern in lhs. The infix operator \[LongRightArrow] is entered \
as \\[LongRightArrow]. The expression lhs\[LongRightArrow]rhs has \
an equivalent form LocalRule[lhs,rhs].";
HumpEqual::usage=
"lhs\[HumpEqual]rhs represents an UpValue where rhs is evaluated \
immediately using a local environment for any variable used as a \
pattern in lhs. The infix operator \[HumpEqual] is entered \
as \\[HumpEqual]. The expression lhs\[HumpEqual]rhs is equivalent \
to LocalUpSet[lhs,rhs].";
LocalSet::usage=
"LocalSet[lhs,rhs] evaluates rhs using a local environment for any \
variable used as a pattern in lhs. From then on lhs is replaced by the \
result of evaluating rhs whenever lhs appears. LocalSet[lhs,rhs] is \
equivalent to lhs\[DotEqual]rhs where \[DotEqual] is entered \
as \\[DotEqual].";
LocalUpSet::usage=
"LocalUpSet[lhs,rhs] evaluates rhs using a local environment for \
any variable used as a pattern in lhs. Once the local environment is \
established rhs is assigned the value of lhs, and associated the \
assignment with symbols that accur at level one in lhs. \
LocalSet[lhs,rhs] is equivalent to lhs^\[DotEqual]rhs where \
^\[DotEqual] is entered as ^\\[DotEqual].";
VerticalSeparator::usage="VerticalSeparator is used for the input form \
of LocalTagSet."
LocalTagSet::usage="LocalTagSet[f,lhs,rhs] uses a local environment for \
any variable used as a pattern in lhs, and assigns rhs to be the value of lhs, \
and associates the assignment with the symbol f. The expression \
LocalTagSet[f,lhs,rhs] can be entered as f \[EscapeKey]|\[EscapeKey] \
lhs \\[HumpEqual] rhs."
DotEqual::usage=
"lhs\[DotEqual]rhs evaluates rhs using a local environment for any \
variable used as a pattern in lhs. From then on lhs is replaced by \
the result of evaluating rhs whenever lhs appears. The infix operator \
\[DotEqual] is entered as \\[DotEqual]. The expression lhs\[DotEqual]rhs, \
has an equivalent form LocalSet[lhs,rhs].";
PatternNames::usage=
"PatternNames[expr] returns a list of the names of patterns \
included in expr. The list returned is wrapped in Hold. \
PatternNames does not consider patterns that appear inside Verbatim. \
Example:\n PatternNames[foo[a_,b_:1,c_?NumericQ,d,e]] returns \n
Hold[{a,b,c}].";
Begin["`Private`"]
Unprotect[LocalRule,LongRightArrow,HumpEqual,
LocalSet,DotEqual,LocalUpSet,VerticalSeparator,PatternNames];
LocalSet=DotEqual;
LocalRule=LongRightArrow;
LocalUpSet=HumpEqual;
Attributes[DotEqual]={HoldAll,SequenceHold};
Attributes[LongRightArrow]={HoldRest,SequenceHold};
Attributes[HumpEqual]={HoldAll, SequenceHold};
Attributes[VerticalSeparator]={HoldAll,SequenceHold};
Attributes[LocalTagSet]={HoldAll,SequenceHold};
Attributes[PatternNames] = {HoldAll};
PatternNames[lhs__]:=
Module[{lhsWithoutVerbatim,heldNames},
lhsWithoutVerbatim=ReplaceAll[Hold[lhs],_Verbatim -> Null];
heldNames = Cases[lhsWithoutVerbatim,
Verbatim[Pattern][name_Symbol,_] :> Hold[name],
{0,-2}, Heads -> True
];
If[heldNames==={},Hold[{}],Thread[Union@heldNames,Hold]]
]
LongRightArrow[lhs_,rhs_]:=Module[{q},
q=PatternNames[lhs];
If[q===Hold[{}],(lhs:>Evaluate@rhs),
Block@@Join[q,Hold[lhs:>Evaluate@rhs] ]
]]
DotEqual[lhs_,rhs_]:=Module[{b1,b2},(
b1=PatternNames[lhs];
If[b1===Hold[{}],(Unevaluated@lhs:=Evaluate@rhs),
b2=Hold[#:=Evaluate@rhs]& @@{Unevaluated@lhs};
Block@@Join[b1,b2]
]
)]
HumpEqual[lhs_,rhs_]:=Module[{b1,b2},(
b1=PatternNames[lhs];
If[b1===Hold[{}],(Unevaluated@lhs^:=Evaluate@rhs),
b2=Hold[#^:=Evaluate@rhs]& @@{Unevaluated@lhs};
Block@@Join[b1,b2]
]
)]
LocalTagSet[hed_,lhs_,rhs_]:=
VerticalSeparator[hed,HumpEqual[lhs,rhs]]
HumpEqual/:
HoldPattern[hed_\[VerticalSeparator]HumpEqual[lhs_,rhs_]]:=
Module[{b1,b2},(
b1=PatternNames[lhs];
If[b1===Hold[{}],TagSetDelayed[hed,Unevaluated@lhs,Evaluate@rhs],
b2=Hold[TagSetDelayed[hed,#,Evaluate@rhs]]& @@{Unevaluated@lhs};
Block@@Join[b1,b2]
]
)]
Protect[LocalRule,LongRightArrow,HumpEqual,
LocalSet,DotEqual,LocalUpSet,VerticalSeparator,PatternNames]
End[]
EndPackage[]