help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Help-smalltalk] ParseTreeRewriter refactoring


From: Paolo Bonzini
Subject: Re: [Help-smalltalk] ParseTreeRewriter refactoring
Date: Fri, 12 Jan 2007 09:13:02 +0100
User-agent: Thunderbird 1.5.0.9 (Macintosh/20061207)


Might visitNodeList:visitor:onMatch: also be included and used where
relevant?  This gives just enough dynamism that my rewriter subclass
works without overriding accept*:.

Ok, so here's my take.

As far as I understood, what you want is to not use the new instance if nothing changed in the parse tree. Which seems good.

Search for <<< to find the bug fixes; for now I'm not applying them.

Paolo
--- orig/compiler/ParseTreeSearcher.st
+++ mod/compiler/ParseTreeSearcher.st
@@ -758,16 +758,57 @@ foundMatch
     answer := true!
 
 lookForMoreMatchesInContext: oldContext 
-    oldContext keysAndValuesDo: 
-           [:key :value | 
-           (key isString not and: [key recurseInto]) 
-               ifTrue: 
-                   [oldContext at: key put: (value collect: [:each | self 
visitNode: each])]]! !
+    oldContext keysAndValuesDo: [:key :value || newValue |
+       (key isString not and: [key recurseInto]) ifTrue: [
+           "Of course, the following statement does nothing without the 
`deepCopy'
+            which fixes the bug."
+           newValue := oldContext at: key put: value "deepCopy <<<".
+           self visitNodes: newValue
+                onMatch: [:newValue |
+                    oldContext at: key put: newValue]]]! !
 
 !ParseTreeRewriter methodsFor: 'visiting'!
 
-visitArguments: aNodeCollection 
-    ^aNodeCollection collect: [:each | self visitArgument: each]! !
+visitNode: aNode
+    ^self visitNode: aNode searches: searches onMatch: [:newNode |]!
+
+visitNodes: aNodeList
+    ^self visitNodes: aNodeList searches: searches onMatch: [:newNodes |]!
+
+visitNodes: aNodeList onMatch: aBlock
+    ^self visitNodes: aNodeList searches: searches onMatch: aBlock!
+
+visitArgument: aNode
+    ^self visitNode: aNode searches: argumentSearches onMatch: [:newNode |]!
+
+visitArguments: aNodeList
+    ^self visitNodes: aNodeList searches: argumentSearches onMatch: [:newNodes 
|]!
+
+visitArguments: aNodeList onMatch: aBlock
+    ^self visitNodes: aNodeList searches: argumentSearches onMatch: aBlock!
+
+visitNode: aNode searches: theseSearches onMatch: aBlock
+    "Visit aNode, sending visitNode:'s answer to aBlock if
+     performSearches:on: finds a match."
+    | newNode |
+    newNode := self performSearches: theseSearches on: aNode.
+    ^newNode isNil ifTrue: [aNode acceptVisitor: self.  aNode]
+                  ifFalse: [aBlock value: newNode.  newNode]!
+
+visitNodes: aNodeList searches: theseSearches onMatch: aBlock
+    "Answer aNodeList but with each element replaced by the result of
+     visitNode:onMatch: with said element (and a block of my own).  If
+     any matches occur, I'll call aBlock afterwards with the
+     replacement of aNodeList before answering it."
+    | replacementList rlHasMatch |
+    rlHasMatch := false.
+    replacementList := aNodeList collect: [:eltNode |
+       self visitNode: eltNode
+            searches: theseSearches
+            onMatch: [:newElt | rlHasMatch := true]].
+    ^rlHasMatch
+       ifTrue: [aBlock value: replacementList.  replacementList]
+       ifFalse: [aNodeList]! !
 
 !ParseTreeRewriter methodsFor: 'visitor-double dispatching'!
 
@@ -782,28 +823,35 @@ acceptBlockNode: aBlockNode 
     aBlockNode arguments: (self visitArguments: aBlockNode arguments).
     aBlockNode body: (self visitNode: aBlockNode body)!
 
+searchCascadeNodeMessage: aMessageNode messagesTo: newMessages
+    "Helper for acceptCascadeNode: -- descend to aMessageNode, but no
+     further.  Add the resulting message or cascade of messages from
+     the tree rule's foundMatchFor: to newMessages and answer said
+     result if a match is found.  Add aMessageNode to newMessages and
+     answer nil otherwise."
+    | answer newNode |
+    answer := self performSearches: searches on: aMessageNode.
+    newNode := answer ifNil: [aMessageNode].
+    newNode isCascade
+       ifTrue: [newMessages addAll: newNode messages]
+       ifFalse: [newMessages add:
+                     (newNode isMessage ifTrue: [newNode]
+                                        ifFalse: [Warning signal: 'Cannot 
replace message node inside of cascaded node with non-message node'.
+                                                  "answer := nil. <<<"
+                                                  aMessageNode])].
+    ^answer!
+
 acceptCascadeNode: aCascadeNode 
     | newMessages notFound |
     newMessages := OrderedCollection new: aCascadeNode messages size.
     notFound := OrderedCollection new: aCascadeNode messages size.
-    aCascadeNode messages do: 
-           [:each | 
-           | newNode |
-           newNode := self performSearches: searches on: each.
-           newNode isNil 
-               ifTrue: 
-                   [newNode := each.
-                   notFound add: newNode].
-           newNode isMessage 
-               ifTrue: [newMessages add: newNode]
-               ifFalse: 
-                   [newNode isCascade 
-                       ifTrue: [newMessages addAll: newNode messages]
-                       ifFalse: 
-                           [Transcript
-                               show: 'Cannot replace message node inside of 
cascaded node with non-message node.';
-                               cr.
-                           newMessages add: each]]].
+    aCascadeNode messages do: [:each | 
+       (self searchCascadeNodeMessage: each
+             messagesTo: newMessages)
+           isNil ifTrue: [notFound add: each]].
+
+    "Rewrite the receiver once and distribute it among the messages if
+     no replacements were made."
     notFound size == aCascadeNode messages size 
        ifTrue: 
            [| receiver |

reply via email to

[Prev in Thread] Current Thread [Next in Thread]