"Presource.st: Smalltalk syntax extension through 'message expansion'. Copyright (C) 2006, 2007 Stephen Compall. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA" "Commentary This is a glue of the ParseTreeRewriter to STCompiler, as previously integrated into GST by the 'Compiler' package. We principally use it to introduce 'special form' messages, through the pseudo-message macro expansion performed. The easiest way, and hence standard way, to start using Presource in your code is to choose ``Backstage story'' when creating a story in No Candy Backstage's Neptune exploration program. If you are not using Backstage, or chose ``Smalltalk story'', the easiest way is to add a prologue saying: Namespace current at: #Compiler put: NoCandy.Presrc.RewritingCompiler. NoCandy.Presrc.CodeMindset new installIn: Namespace current. Transformations of parse trees to final trees passed to the compiler are performed by a CodeMindset object -- most of this story is devoted to either providing new transformation abilities to a CodeMindset, or telling GST to use a CodeMindset in the proper places. As this story modifies the Smalltalk language through the RewritingCompiler, it is designed to avoid globally modifying the system compiler. As such, it expects subspaces of Smalltalk to be used as Common Lisp packages -- Behavior>>#codeMindset carries this further by searching for the current set of message macros by way of the enclosing class's namespace, unless this method is overridden. To do this, simply use a class method #codeMindset. In short, if you are looking for fine-grained, class-by-class CodeMindset selection, override #codeMindset. Otherwise, stick with the standard way described above. The use of a dynamically-bound cancelBlock makes MessageMacro's expander, and therefore compilation in general, NOT THREAD SAFE. Notes: * Features for conditional expansion should be part of CodeMindset - RewritingCompiler should remain a simple pass-through class that delegates all other decisions to a CodeMindset. This is anyway far more extensible, because CodeMindsets are easily extensible on the instance level." "Code" Namespace current: NoCandy.Presrc! Object subclass: #CodeMindset instanceVariableNames: 'messageMacroDictionary rewriters directUnderMindsets mindsetPrecedenceList overMindsets' classVariableNames: '' poolDictionaries: '' category: 'Presource-source code transformation' ! CodeMindset comment: 'Each group of Lisp code develops its own "mindset", defined by the general-purpose macros and reader macros the writers have agreed upon. As such, when looking at each group of code, the Lisper must absorb the idioms used and acceptable in that code. Some would say that you can completely describe this mindset by the imported and available macros ("Environment") and reader macros ("Readtable"). Though we initially desire a simple mapping from pseudo-message selectors to objects that can expand those pseudo-sends into concrete code, we would like future expansion to be possible. As such, I am the "mindset" of the code that I am responsible for transforming into concrete code suitable to be passed to a parse tree compiler STCompiler. messageMacroDictionary Exported dictionary of selectors to MessageMacros rewriters Exported, settable collection of other ParseTreeRewriters to apply after the macroRewriter directUnderMindsets Private list of other CodeMindsets, used strictly for parse tree expansion and installing in namespaces and classes. mindsetPrecedenceList The memoized result of computeMindsetList. overMindsets A WeakIdentitySet of CodeMindsets that include me in their directUnderMindsets.' ! Object subclass: #MessageMacro instanceVariableNames: 'selector cancelBlock' classVariableNames: 'NewVariableNumber' poolDictionaries: '' category: 'Presource-source code transformation' ! MessageMacro comment: 'I represent a single message macro, which applies an in-place source code tree transformation to an RBMessageNode. "selector" is the selector for message sends that I match in source code. Expansion is implemented by way of sending #expandMessageInPlace: to me, with the RBMessageNode as an argument. See the docstring for my version of that method for more details. I can also produce an RBReplaceRule that will perform the expansion in the context of a ParseTreeRewriter; see #replaceRuleOnSelector:. selector A temporary selector Symbol saved for printing/debugging purposes, or nil' ! Object subclass: #PatternBySelector instanceVariableNames: 'selector' classVariableNames: '' poolDictionaries: '' category: 'Presource-source code transformation' ! PatternBySelector comment: 'I am a pattern node that responds to #match:inContext:, thus allowing RBParseTreeRule>>#performOn: to match me against any RBMessageNode matching my selector. I am not a full RBProgramNode, and should never appear in a node tree. selector A selector Symbol; described above.' ! MessageMacro subclass: #BlockMessageMacro instanceVariableNames: 'expandBlock' classVariableNames: '' poolDictionaries: '' category: 'Presource-source code transformation' ! BlockMessageMacro comment: 'I am a pseudo-message macro whose expansion is governed by a block that receives the arguments to expandMessage:to:withArguments:. expandBlock Said BlockClosure.' ! MessageMacro subclass: #PatternMacro instanceVariableNames: 'sourcePattern expansionPattern newVariables' classVariableNames: '' poolDictionaries: '' category: 'Presource-source code transformation' ! PatternMacro comment: 'I am a pseudo-message macro that expands by applying a pattern expression to the original source tree (forgoing expansion if this pattern does not match the source), and replacing the pattern variables matched in another pattern expression. sourcePattern The pattern to match against the original expression. expansionPattern The pattern to copy using the pattern variables from sourcePattern. newVariables A collection of pattern variable names, used in the expansion but *not* in the source, that will be replaced by generated, unique variable names in the expansion.' ! STInST.STCompiler subclass: #RewritingCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Presource-source code compilation' ! RewritingCompiler comment: 'I am a compilerClass that transforms input, in the form of parsed trees, to "final" compilable trees using a CodeMindset. This CodeMindset is retrieved as an attribute of the for: aBehavior argument. Point of note: this compiler *destroys* its input MethodNode. Therefore, you shouldn''t reuse such things; the current STInST compiler framework, my main expandTree: client, does not reuse parsed trees.' ! CodeMindset subclass: #EnvironmentCodeMindset instanceVariableNames: 'homeEnvironment' classVariableNames: '' poolDictionaries: '' category: 'Presource-source code transformation' ! EnvironmentCodeMindset comment: 'I am a mindset for writing Smalltalk code that has special integration features for Smalltalk environments, including Namespaces and Classes. homeEnvironment The Environment on whose behalf I affect Smalltalk code semantics.' ! STInST.ParseTreeRewriter subclass: #ParseTreeTrampolineRewriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Presource-source code transformation' ! ParseTreeTrampolineRewriter comment: 'I am a ParseTreeRewriter that behaves differently during ProgramNode rewriting in two major ways: * When a RBReplaceRule successfully matches and answers a different ProgramNode at a particular point in the tree, I immediately place the new node in the tree, stop rewriting the old node, and resume rewriting with the new node. This is called "trampolining". * As would naturally follow from this, replacing a ProgramNode does not imply that I won''t rewrite anything within the replacement. Instead, when all trampolining rewrites at a particular point in the tree are finished, I start rewriting the components of the final node, be it the original or a replacement. In addition, I don''t count "rewrites" that don''t answer a new ProgramNode as successful matches.' ! "TODO: I believe a correct MessageMacro>>#expandMessageInPlace: extension interface demands that RBProgramNode's copyInContext:/copyList:inContext: methods actually #copy values pulled from the expansion bindings. Come up with a test (repeating expansion of pattern values?) for this." !CodeMindset class methodsFor: 'instance creation'! new "Answer a new instance that treats input source trees as final compilable code." ^self nullOverMindsets: #() ! nullOverMindsets: mindsets "Answer a new instance that, after transforming parse trees myself, uses each of the mindsets in turn to further transform the trees. You'll want to use this if you want a new mindset that behaves just like one you already have, and you don't want changes to the new one to affect the old one." ^super new messageMacroDictionary: IdentityDictionary new directUnderMindsets: mindsets overMindsets: (WeakIdentitySet new); rewriters: OrderedCollection new; recomputeAllMindsetLists; yourself ! ! !CodeMindset methodsFor: 'activation'! installIn: aNamespace "Configure aNamespace for use with this CodeMindset. See Behavior's methods #compilerClass and #codeMindset to see why this works." | newUnderMindsets bindingName | ((aNamespace at: #Compiler ifAbsent: [STInST.STCompiler]) includesBehavior: RewritingCompiler) ifFalse: [aNamespace at: #Compiler put: RewritingCompiler]. newUnderMindsets := OrderedCollection with: self. bindingName := self environmentMindsetClass defaultName. (aNamespace hereAt: bindingName ifAbsent: [nil]) "wants ifPresent:!" ifNotNil: [:oldSet | oldSet installMindset: self. ^oldSet]. ^aNamespace at: bindingName put: (self environmentMindsetClass nullInEnvironment: aNamespace overMindsets: newUnderMindsets asArray). ! installMindset: newMindset "Add newMindset's expansions to myself by adding it to my list of under-Mindsets. Answer newMindset." self == newMindset ifTrue: [^self]. (directUnderMindsets identityIncludes: newMindset) ifFalse: [directUnderMindsets := directUnderMindsets copyWith: newMindset. self recomputeAllMindsetLists]. ^newMindset ! environmentMindsetClass "Answer the class that can create CodeMindsets for use in environments." ^EnvironmentCodeMindset ! ! !CodeMindset class methodsFor: 'activation'! defaultName "Answer the Symbol that names the binding searched for by the RewritingCompiler to find a CodeMindset to preprocess Smalltalk sources with." ^#MyCodeMindset ! ! !CodeMindset methodsFor: 'extending Smalltalk'! expandTree: aProgramNode "Apply the expansions of pseudo-messages based on the message macros indexed in my messageMacroDictionary, and ParseTreeRewriters registered with my rewriters property." "Do all macros first, then all rewriters starting with mine." ^self withInferiorMindsets inject: (self macroRewriter executeTree: aProgramNode; tree) into: [:tree :mindset | mindset expandWithRewriters: tree] ! messageMacroDictionary "Answer a Dictionary mapping each selector symbol key to a MessageMacro used for expanding each apparent message with that selector." ^messageMacroDictionary ! ! !CodeMindset methodsFor: 'rewriting parse trees'! rewriters "Answer a Collection of parse tree rewriters (executeTree: tree) that will be applied to each parse tree by expandTree:. This collection does not include the special rewriter used for expanding the message macros in messageMacroDictionary." ^rewriters ! rewriters: aCollection "Change the answer of rewriters." rewriters := aCollection ! ! !CodeMindset methodsFor: 'printing'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' with '; display: self messageMacroDictionary size; nextPutAll: ' message macros and '; display: self withInferiorMindsets size - 1; nextPutAll: ' other CodeMindsets included ('; display: self allMessageMacros size; nextPutAll: ' macros total)'. ! ! !CodeMindset methodsFor: 'private'! macroRewriterClass "Answer a class-y object that will produce a new ParseTreeRewriter (addRule: executeTree: tree) implementing the rewriting RBProgramNode walker for me." ^ParseTreeTrampolineRewriter ! messageMacroDictionary: aDictionary directUnderMindsets: mindsets overMindsets: omSet "Used for initialization." messageMacroDictionary := aDictionary. directUnderMindsets := mindsets. overMindsets := omSet. ! directUnderMindsets "Answer the list of CodeMindsets containing further message macros and rewriters that I should use." ^directUnderMindsets ! directOverMindsets "Answer the list of CodeMindsets that should include me in their answer to directUnderMindsets." ^overMindsets ! registerOverMindset: aMindset "Inform me that aMindset has me as a direct under-mindset." overMindsets add: aMindset ! withInferiorMindsets "Answer the collection of all mindsets to use for rewriting expansion and macro-binding search. This is memoized; use computeMindsetList to change behavior instead." ^mindsetPrecedenceList ifNil: [mindsetPrecedenceList := self computeMindsetList] ! computeMindsetList "Calculate a precedence list for withInferiorMindsets that places all mindsets before those on which they depend." | newList seenMindsetStates addWithInferiors | newList := OrderedCollection new. seenMindsetStates := IdentityDictionary new. (addWithInferiors := [:mindset | | mState | mState := seenMindsetStates at: mindset ifAbsent: [nil]. "detect infinite recursion" #visiting == mState ifTrue: [SystemExceptions.InvalidValue signalOn: mindset reason: 'mutually-dependent code mindsets']. "This 'topological sort' algorithm finds a linear ordering for which it is never the case that a mindset in the list will never depend on one before it." #visited == mState ifFalse: [seenMindsetStates at: mindset put: #visiting. mindset directUnderMindsets reverseDo: addWithInferiors. newList addLast: mindset. seenMindsetStates at: mindset put: #visited]]) value: self. ^newList reverse ! recomputeAllMindsetLists "Force my mindset precedence list and all those that include me to be recomputed. Don't override this method; override recomputeMindsetListInState: instead." ^self recomputeAllMindsetListsInState: IdentityDictionary new ! recomputeMindsetList "Force my inferior CodeMindset precedence list to be recomputed." mindsetPrecedenceList := nil. ! canRecomputeAllMindsetLists: seenMindsetStates "Check whether I should perform a recomputation of my inferior CodeMindset precedence list. Signal an error if this is infinite recursion, and answer whether I should proceed." | mState | mState := seenMindsetStates at: self ifAbsent: [nil]. "detect infinite recursion" #visiting == mState ifTrue: [SystemExceptions.InvalidValue signalOn: self reason: 'mutually-dependent code mindsets']. ^#visited ~~ mState ! recomputeAllMindsetListsInState: seenMindsetStates "Helper for recomputeAllMindsetLists; seenMindsetStates is a dictionary of CodeMindsets to symbols, where #visited means recomputeMindsetListInState: has completed on that mindset, and #visiting means its recomputeMindsetListInState: method is currently executing with it as receiver." (self canRecomputeAllMindsetLists: seenMindsetStates) ifFalse: [seenMindsetStates at: self put: #visiting. self recomputeMindsetList. self directOverMindsets do: [:ms | ms recomputeAllMindsetListsInState: seenMindsetStates]. seenMindsetStates at: self put: #visited]. ! expandWithRewriters: aProgramNode "Use all my rewriters, but the macroRewriter, on aProgramNode in sequence." ^self rewriters inject: aProgramNode into: [:tree :rewriter | rewriter executeTree: tree; tree]. ! allMessageMacros "Answer a composite messageMacroDictionary, containing macros from me and inherited from my underMindsets." | compositeDictionary | compositeDictionary := self messageMacroDictionary class new. self withInferiorMindsets do: [:mindset | mindset messageMacroDictionary keysAndValuesDo: [:s :m | compositeDictionary at: s ifAbsentPut: [m]]]. ^compositeDictionary ! macroRewriter "Answer a parse tree rewriter (executeTree: tree)." | rewriteWalker compositeDictionary | rewriteWalker := self macroRewriterClass new. self allMessageMacros keysAndValuesDo: [:selector :macro | rewriteWalker addRule: (macro replaceRuleOnSelector: selector)]. ^rewriteWalker ! ! | mmPool | mmPool := MessageMacro classPool. (mmPool at: #NewVariableNumber) isNil ifTrue: [mmPool at: #NewVariableNumber put: 120]! !MessageMacro class methodsFor: 'generating variables'! newVariable "Answer a new RBVariableNode with a generated name." ^self newVariable: 'gensym' "from Lisp tradition, really 'G'" ! newVariable: prefix "Answer a new RBVariableNode with a generated name starting with 'prefix', a String." ^STInST.RBVariableNode named: ((WriteStream with: prefix) display: (NewVariableNumber := 1 + NewVariableNumber); contents) ! ! !MessageMacro methodsFor: 'tree rewriting'! expandMessageInPlace: aMessageNode "Answer an RBValueNode to replace aMessageNode in the expanded source code. This method is used by an RBBlockReplaceRule directly to implement expansion. This implementation calls expandMessage: to: withArguments: appropriately; extenders may choose which one to override." ^self expandMessage: aMessageNode selector to: aMessageNode receiver withArguments: aMessageNode arguments ! expandMessage: selector to: receiver withArguments: arguments "Like expandMessageInPlace:, but with the parts of the message send broken out." ^MessageMacro == (self class whichClassIncludesSelector: #expandMessageInPlace:) ifTrue: [self subclassResponsibility] ifFalse: [self shouldNotImplement] ! forgoExpansion "Return from my innermost invocation (on this instance) to the tree rewriter without modifying the tree." cancelBlock value "hooray for lexical closures!" ! replaceRuleOnSelector: aSelector "Answer a new STInST.RBReplaceRule that performs the pseudo-message expansion I represent on MessageNodes with selector aSelector." selector := aSelector. "for printOn:" ^STInST.RBBlockReplaceRule searchForTree: (PatternBySelector forSelector: aSelector) replaceWith: [:aMessageNode | self expandMessageWithLocalReturn: aMessageNode] ! ! !MessageMacro methodsFor: 'private'! expandMessageWithLocalReturn: aMessageNode "Sets up forgoExpansion before entering the expand protocol, forgoing if aMessageNode's parent is a cascade." | oldCancelBlock | aMessageNode parent isCascade ifTrue: [^aMessageNode]. oldCancelBlock := cancelBlock. ^[cancelBlock := [^aMessageNode]. self expandMessageInPlace: aMessageNode] ensure: [cancelBlock := oldCancelBlock] ! ! !MessageMacro class methodsFor: 'common mistakes'! replaceRuleOnSelector: aSelector "Signal an error. CodeMindset expects instances, not subclasses." ^SystemExceptions.WrongClass signalOn: self mustBe: self ! ! !PatternBySelector class methodsFor: 'instance creation'! forSelector: aSymbol "Answer a new instance who matches RBMessageNodes with selector aSymbol." ^self new selector: aSymbol; yourself ! ! !PatternBySelector methodsFor: 'matching'! match: aNode inContext: aDictionary "Answer whether I match aNode." ^aNode class == self matchingClass and: [selector == aNode selector] ! matchingClass "Answer the class of nodes I match with match:inContext:." ^STInST.RBMessageNode ! ! !PatternBySelector methodsFor: 'private'! selector: aSymbol selector := aSymbol ! ! !BlockMessageMacro class methodsFor: 'instance creation'! expandingWith: aBlock "Answer a new instance expanding received message nodes by asking aBlock." ^self new expandBlock: aBlock; yourself ! ! !BlockMessageMacro methodsFor: 'tree rewriting'! expandMessage: selector to: receiver withArguments: arguments "Implement the protocol described in my super by calling the expandWith: block with these arguments." ^expandBlock value: selector value: receiver value: arguments ! ! !BlockMessageMacro methodsFor: 'private'! expandBlock: aBlock expandBlock := aBlock ! ! !PatternMacro class methodsFor: 'instance creation'! given: sourceString use: expansionString "Answer a new instance who matches sourceString and, if the match is successful, expands to expansionString, replacing patterns therein with the matched pieces." ^self given: sourceString use: expansionString withExtraVariables: #() ! given: sourceString use: expansionString withExtraVariables: variableNames ^self new given: (STInST.RBParser parseRewriteExpression: sourceString) use: (STInST.RBParser parseRewriteExpression: expansionString) withExtraVariables: variableNames; yourself ! ! !PatternMacro methodsFor: 'tree rewriting'! expandMessageInPlace: messageNode "Answer an expansion of messageNode, created by applying sourcePattern to it, then using those matches and extra bindings created from the usingVariables: instance creation argument, copy the expansionPattern, inserting the results where appropriate." | expansionBindings | expansionBindings := Dictionary new. "Even though I appear to be doing the work of replaceRuleOnSelector:'s answered rule, this is more of a 'refined' match done after the initial selector-based match." (sourcePattern match: messageNode inContext: expansionBindings) ifFalse: [^self forgoExpansion]. "add extra newVariables to expansionBindings" expansionBindings := self addNewVariablesTo: expansionBindings. ^(expansionPattern copyInContext: expansionBindings) copyCommentsFrom: messageNode; yourself ! addNewVariablesTo: expansionBindings "Make new variables from newVariables and add them to expansionBindings, a Dictionary of match:inContext: bindings. Answer expansionBindings." newVariables isEmpty ifFalse: [ | patternChars | patternChars := self patternMetaCharacters. newVariables do: [:varPatternName | | varName | varName := varPatternName reject: [:char | patternChars includes: char]. expansionBindings at: (STInST.RBVariableNode named: varPatternName) put: (self class newVariable: varName)]]. ^expansionBindings ! ! !PatternMacro methodsFor: 'private'! patternMetaCharacters "Answer a list of the special characters used to identify features of pattern variables to the parser, so they can be removed, making a pattern variable suitable for use as a normal variable. I currently use the expansionPattern to derive this, as this tree is where the variables we are generating replacements for should appear." ^{expansionPattern listCharacter. expansionPattern literalCharacter. expansionPattern recurseIntoCharacter. expansionPattern statementCharacter. STInST.RBScanner patternVariableCharacter} ! given: source use: expansion withExtraVariables: variables "Slightly different argument meanings than the class method; see source of that." sourcePattern := source. expansionPattern := expansion. newVariables := variables. ! ! !RewritingCompiler class methodsFor: 'compiling'! compile: methodNode asMethodOf: aBehavior classified: aString parser: aParser environment: aNamespace "As with super, but translate methodNode first according to aBehavior's current CodeMindset." ^super compile: (aBehavior codeMindset expandTree: methodNode) asMethodOf: aBehavior classified: aString parser: aParser environment: aNamespace ! ! !EnvironmentCodeMindset class methodsFor: 'instance creation'! new "Signal an error, saying to use nullInEnvironment:overMindsets: instead." ^SystemExceptions.WrongMessageSent signalOn: #new useInstead: #nullInEnvironment:overMindsets: ! nullInEnvironment: aNamespace overMindsets: mindsets "Answer a new mindset transforming code using CodeMindsets in super-environments of aNamespace, then also " ^(self nullOverMindsets: mindsets) homeEnvironment: aNamespace; yourself ! ! !EnvironmentCodeMindset methodsFor: 'accessing'! environment "Answer the environment on whose behalf I transform Smalltalk code." ^homeEnvironment ! ! !EnvironmentCodeMindset methodsFor: 'printing'! printOn: aStream aStream nextPutAll: 'Installed in '; print: self environment; nextPutAll: ': '. super printOn: aStream. ! ! !EnvironmentCodeMindset methodsFor: 'private'! homeEnvironment: environment homeEnvironment := environment. ! directUnderMindsets | explicitMindsets | explicitMindsets := super directUnderMindsets. homeEnvironment allSuperspacesDo: [:ss | | superMindset | superMindset := ss hereAt: self class defaultName ifAbsent: [nil]. (superMindset isNil or: [explicitMindsets identityIncludes: superMindset]) ifFalse: [^explicitMindsets copyWith: superMindset]]. ^explicitMindsets ! directOverMindsets | superAnswer findShallowestCMs | superAnswer := super directOverMindsets copy. "add the 1-step-away environment CMs in subspaces" self environment subspacesDo: (findShallowestCMs := [:subspace | (subspace hereAt: self class defaultName ifAbsent: [nil]) ifNil: [subspace subspacesDo: findShallowestCMs] ifNotNil: [:subCM | superAnswer add: subCM]]). ^superAnswer ! ! !ParseTreeTrampolineRewriter methodsFor: 'changing ProgramNodes'! performSearches: aSearchCollection on: aNode "As with super, but consider performOn: answering its node argument to be equivalent to it answering nil." aSearchCollection do: [:search | | searchResult | searchResult := search performOn: aNode. searchResult notNil & (aNode ~~ searchResult) ifTrue: [self foundMatch. ^searchResult]]. ^nil ! visitNode: programNode searches: aSearchCollection onMatch: aBlock "Visit programNode using aSearchCollection, and then its resultant, repeatedly until visiting fails to replace the node. On each replacement, pass the new node to aBlock." | testNode nextNode | testNode := programNode. [nextNode := self performSearches: aSearchCollection on: testNode. nextNode isNil] whileFalse: [aBlock value: (testNode := nextNode)]. testNode acceptVisitor: self. ^testNode ! visitNodes: aNodeList searches: aSearchCollection onMatch: aBlock "Answer aNodeList but with each element replaced by the result of sending visitNode:searches:onMatch to me with said element, aSearchCollection, (and a block of my own). As each match occurs, I'll call aBlock immediately with the replacement of aNodeList before answering it." | replacementList | replacementList := nil. aNodeList keysAndValuesDo: [:idx :eltNode | self visitNode: eltNode searches: aSearchCollection onMatch: [:newElt | "create/fix the new list and send it (again)" replacementList isNil ifTrue: [replacementList := aNodeList copy]. replacementList at: idx put: newElt. aBlock value: replacementList]]. ^replacementList ifNil: [aNodeList] ! ! !ParseTreeTrampolineRewriter methodsFor: 'changing ProgramNode fields'! acceptCascadeNode: cascadeNode "Multiple strategies available: Just visit the messages, and verify that all receivers are equal. Doesn't work with indeterminate matching, as macros that use MessageMacro>>#newVariable: are. Not using at this time. Visit the first message, install its replacement everywhere, and visit all the arguments. Has the drawback that cascade messages can't be replaced, but that doesn't matter for the message macroRewriter. Currently using this." self visitNode: cascadeNode messages first receiver onMatch: [:newRecv | cascadeNode messages do: [:msg | msg receiver: newRecv]]. cascadeNode messages do: [:msg | self visitNodes: msg arguments onMatch: [:newArgs | msg arguments: newArgs]]. ! recusivelySearchInContext "This message is normally sent to me by an RBParseTreeRule to allow rewriting of matched pattern variables that answer 'true' to #recurseInto. Only the values that match those variables are rewritten; after the rule's foundMatchFor: answers a rewrite of the matched ProgramNode, I leave that new node alone. As my strategy is not to do that, but instead to always rewrite every element of a replacement ProgramNode, this message is not only unnecessary, but expands MessageMacros in the wrong order -- a MessageMacro expects pre-order expansion, where a message is expanded before its receiver and argument expressions are searched for expansions. Therefore, I do nothing in response to this message." ! ! "Putting expansion into environment's Compiler" !Smalltalk.Behavior methodsFor: 'compiling'! codeMindset "Answer the CodeMindset representing the syntactic and semantic idiosyncracies of code compiled for this class." ^self environment at: EnvironmentCodeMindset defaultName ifAbsent: [##(NoCandy.Presrc.CodeMindset new)] ! compilerClass "This method is present for symmetry with #parserClass. It specifies the class that will be used to compile the parse nodes into bytecodes." "Behavior>>#codeMindset must be compiled before this may ever answer RewritingCompiler in place of STCompiler" ^self environment at: #Compiler ifAbsent: [STInST.STCompiler] ! ! !Smalltalk.Metaclass methodsFor: 'delegation'! codeMindset "Delegate to instanceClass; see Behavior." ^self instanceClass codeMindset ! compilerClass "Delegate to instanceClass. While this override changes the meaning of 'current compiler' somewhat, I think users will expect class methods to compile with the same compilerClass as instance methods." ^self instanceClass compilerClass ! ! "Presource.st ends here"