"{ Encoding: utf8 }"

"{ Package: 'stx:libcomp' }"

"{ NameSpace: Smalltalk }"

Object subclass:#ParseNodeVisitor

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'System-Compiler-Support'

!

ParseNodeVisitor subclass:#ParseNodeChildCollector

	instanceVariableNames:'topNode children'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ParseNodeVisitor

!

!ParseNodeVisitor class methodsFor:'documentation'!

documentation

"

    a whitebox expandable abstract parsenode visitor.

    Subclasses should redefine those acceptXXX methods, in which they are interested.

"    

! !

!ParseNodeVisitor class methodsFor:'utilities'!

collectChildrenOf:aNode

    |collector|

    collector := ParseNodeChildCollector new topNode:aNode.

    aNode acceptVisitor:collector.

    ^ collector children

! !

!ParseNodeVisitor methodsFor:'visiting'!

visit:anObject 

    | stmt lastResult |

    anObject isStatementNode ifTrue:[

        stmt := anObject.

        [ stmt isNil ] whileFalse:[

            lastResult := stmt acceptVisitor:self.

            stmt := stmt nextStatement.

        ].

        ^ lastResult

    ] ifFalse:[

        ^ anObject acceptVisitor: self.

    ]

    "Modified: / 25-07-2011 / 22:33:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitAssignmentNode:anObject 

    self visit: anObject variable.

    self visit: anObject expression.

    "Modified: / 25-07-2011 / 22:30:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitBinaryNode:anObject 

    ^self visitMessageNode: anObject

    "Modified: / 25-07-2011 / 22:30:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitBlockNode:anObject 

    anObject statements ifNotNil:[

        self visit: anObject statements

    ].

    "Modified: / 25-07-2011 / 22:45:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitCascadeNode:anObject 

    self visitMessageNode: anObject.

    "Modified: / 25-07-2011 / 22:37:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitConstantNode:anObject

    "Modified: / 25-07-2011 / 22:41:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitECompletionConstantNode:anObject 

    "dispatched back from the visited eCompletionConstantNode-object (visitor pattern)"

    "fall back to general object-case - please change as required"

    ^ self visitObject:anObject

!

visitMessageNode:anObject 

    self visit: anObject receiver.

    anObject arguments do:[:arg|

        self visit: arg.

    ]

    "Modified: / 25-07-2011 / 22:37:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitObject:anObject 

    "dispatched back from the visited objects (visitor pattern)"

    "general fallBack - please change as required"

    self halt:'not yet implemented'

!

visitParseErrorNode:anObject

    "Modified: / 25-07-2011 / 22:38:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitPrimitiveNode:anObject

    "Modified: / 25-07-2011 / 22:38:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitReturnNode:anObject 

    self visit: anObject expression.

!

visitSelfNode:anObject 

    "/ to be redefined in subclasses

!

visitStatementNode:anObject 

    |expr|

    (expr := anObject expression) notNil ifTrue:[

        self visit: expr.

    ]

!

visitSuperNode:anObject 

    "/ to be redefined in subclasses

!

visitUnaryNode:anObject 

    ^self visitMessageNode: anObject

!

visitVariableNode:anObject 

    "/ to be redefined in subclasses

! !

!ParseNodeVisitor methodsFor:'visiting - javaScript'!

doesNotUnderstand:aMessage

    "catch to prevent stupid error reports from Explainer in end-user app (expecco)"

    Smalltalk isStandAloneApp ifTrue:[^ self].

    "/ ((aMessage selector startsWith:'visit') 

    "/ and:[ aMessage selector endsWith:'Node:' ]) ifTrue:[

    "/     ^ self.

    "/ ].

    ^ super doesNotUnderstand:aMessage.

!

visitFunctionCallNode:anObject

    self visitMessageNode:anObject

!

visitImplicitFunctionCallNode:aNode

    self visitFunctionCallNode:aNode

!

visitJavaScriptAssignmentNode:aNode

    self visitAssignmentNode:aNode

!

visitJavaScriptFunctionNode:aNode

    |stmt|

    stmt := aNode statements.

    [ stmt notNil ] whileTrue:[

        self visit:stmt.

        stmt := stmt nextStatement.

    ].

!

visitJavaScriptInnerFunctionNode:aNode

    self visitJavaScriptFunctionNode:aNode

!

visitJavaScriptReturnNode:aNode

    self visitReturnNode:aNode

!

visitJavaScriptStatementNode:aNode

    self visitStatementNode:aNode

!

visitJavaScriptVariableNode:aNode

    self visitVariableNode:aNode

!

visitThisNode:aNode

    self visitSelfNode:aNode

! !

!ParseNodeVisitor::ParseNodeChildCollector class methodsFor:'documentation'!

documentation

"

    documentation to be added.

    class:

        <a short class summary here, describing what instances represent>

    responsibilities:    

        <describing what my main role is>

    collaborators:    

        <describing with whom and how I talk to>

    API:

        <public api and main messages>

    example:

        <a one-line examples on how to use - can also be in a separate example method>

    implementation:

        <implementation points>

    [author:]

        exept MBP

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!ParseNodeVisitor::ParseNodeChildCollector class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!ParseNodeVisitor::ParseNodeChildCollector methodsFor:'accessing'!

children

    ^ children

!

topNode:something

    topNode := something.

! !

!ParseNodeVisitor::ParseNodeChildCollector methodsFor:'initialization'!

initialize

    children := IdentitySet new.

! !

!ParseNodeVisitor::ParseNodeChildCollector methodsFor:'visiting'!

visit:anObject 

    anObject parent == topNode ifTrue:[

        children add:anObject.

        "/ do not go deeper

    ] ifFalse:[

        super visit:anObject

    ].

! !

!ParseNodeVisitor class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !