initial checkin
authorClaus Gittinger <cg@exept.de>
Wed, 27 Apr 2016 14:11:43 +0200
changeset 3782 226f62e32424
parent 3781 05e4db8b31e3
child 3783 e7a3fe517286
initial checkin
PluggableParseNodeVisitor.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/PluggableParseNodeVisitor.st	Wed Apr 27 14:11:43 2016 +0200
@@ -0,0 +1,67 @@
+"{ Package: 'stx:libcomp' }"
+
+"{ NameSpace: Smalltalk }"
+
+ParseNodeVisitor subclass:#PluggableParseNodeVisitor
+	instanceVariableNames:'actionsPerNodeType'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'System-Compiler-Support'
+!
+
+!PluggableParseNodeVisitor class methodsFor:'documentation'!
+
+documentation
+"
+    a pluggable node visitor.
+    setup with:
+        actionForNodeClass:aClass put:aBlock
+        
+    for example, if you are only interested in assignments,
+    use the following code:
+        |v|
+        v := PluggableParseNodeVisitor new.
+        v actionForNodeClass:AssignmentNode put:[:node | Transcript showCR:node. true].
+        v visit:(Parser parse:code in:someClass.
+"
+! !
+
+!PluggableParseNodeVisitor methodsFor:'setup'!
+
+actionForNodeClass:aNodeClass put:aBlock
+    "setup so that for nodes of type aNodeClass, aBlock is invoked.
+     If the block returns true, subnodes (eg. right side of assignments, etc.)
+     will be enumerated as well.
+     Otherwise, no subnodes are visited."
+
+    actionsPerNodeType isNil ifTrue:[
+         actionsPerNodeType := Dictionary new.
+    ].
+    actionsPerNodeType at:aNodeClass put:aBlock
+! !
+
+!PluggableParseNodeVisitor methodsFor:'visiting'!
+
+visit:aNodeObject
+    "redefined to look for an action for this node's class.
+     If there is one, it can specify if subnodes are to be visited too"
+     
+    |action|
+
+    action := actionsPerNodeType at:aNodeObject class.
+    action notNil ifTrue:[ 
+        (action value:aNodeObject) ifFalse:[^ self].
+    ].
+    super visit:aNodeObject
+! !
+
+!PluggableParseNodeVisitor class methodsFor:'documentation'!
+
+version
+    ^ '$Header$'
+!
+
+version_CVS
+    ^ '$Header$'
+! !
+