CascadeNode.st
author Claus Gittinger <cg@exept.de>
Tue, 26 Nov 2002 10:08:56 +0100
changeset 1344 e181501d8aa0
parent 1079 2a996e0def30
child 1384 0db9682870d9
permissions -rw-r--r--
oops - cascade-evaluation did not return last value

"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

"{ Package: 'stx:libcomp' }"

MessageNode subclass:#CascadeNode
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'System-Compiler-Support'
!

!CascadeNode class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    node for parse-trees, representing cascade message sends
    This is a helper class for the compiler.

    [author:]
        Claus Gittinger
"
! !

!CascadeNode methodsFor:'code generation'!

codeForCascadeOn:aStream inBlock:b for:aCompiler
    receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
    aStream nextPut:#dup.
    self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
!

codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
    receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
    self codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
! !

!CascadeNode methodsFor:'enumerating'!

nodeDo:anEnumerator
    "helper for parse tree walking"

    "/ sigh; ST/X encodes things differently ...

    |r nd msgs msg|

    msgs := OrderedCollection new.

    r := receiver.
    [r isCascade] whileTrue:[
        r := r receiver.
    ].
    r := r receiver.

    nd := self.
    [nd isCascade] whileTrue:[
        msg := MessageNode new.
        msg receiver:r selector:nd selector args:nd args lineno:nd lineNumber.
        msgs addFirst:msg.
        nd := nd receiver.
    ].
    msg := MessageNode new.
    msg receiver:r selector:nd selector args:nd args lineno:nd lineNumber.
    msgs addFirst:msg.

    ^ anEnumerator doCascade:self receiver:r messages:msgs

    "Created: 19.6.1997 / 16:39:17 / cg"
    "Modified: 19.6.1997 / 17:32:47 / cg"
! !

!CascadeNode methodsFor:'evaluation'!

evaluate
    |t argValueArray|

    selector := selector asSymbol.

    receiver isSuper ifTrue:[
        ^ super evaluate
    ].

    t := receiver evaluateForCascade.
    argArray isNil ifTrue:[
        ^ t perform:selector.
        "/ t perform:selector. ^ t
    ].
    argValueArray := argArray collect:[:arg | arg evaluate].
    ^ t perform:selector withArguments:argValueArray
!

evaluateForCascade
    |t argValueArray|

    selector := selector asSymbol.
    receiver isSuper ifTrue:[
        ^ super evaluateForCascade
    ].

    t := receiver evaluateForCascade.
    argArray isNil ifTrue:[
        t perform:selector.
        ^ t
    ].
    argValueArray := argArray collect:[:arg | arg evaluate]. 
    t perform:selector withArguments:argValueArray.
    ^ t
! !

!CascadeNode methodsFor:'printing & storing'!

printOn:aStream indent:i
    |needParen selectorParts index index2 arg nargs|

    index := 1.
    selectorParts := OrderedCollection new.
    [index == 0] whileFalse:[
	index2 := selector indexOf:$: startingAt:index.
	index2 ~~ 0 ifTrue:[
	    selectorParts add:(selector copyFrom:index to:index2).
	    index2 := index2 + 1
	].
	index := index2
    ].

    receiver printOn:aStream indent:i.
    aStream nextPutAll:'; '.

    nargs := argArray size.
    nargs == 0 ifTrue:[
	selector printOn:aStream
    ] ifFalse:[
	1 to:nargs do:[:argIndex |
	    aStream space.
	    (selectorParts at:argIndex) printOn:aStream.
	    aStream space.
	    arg := argArray at:argIndex.
	    needParen := false.
	    arg isMessage ifTrue:[
		arg isBinaryMessage ifFalse:[
		    arg isUnaryMessage ifFalse:[
			needParen := true
		    ]
		].
	    ].
	    needParen ifTrue:[
		aStream nextPutAll:'('
	    ].
	    arg printOn:aStream indent:i.
	    needParen ifTrue:[
		aStream nextPutAll:') '
	    ].
	]
    ]
! !

!CascadeNode methodsFor:'queries'!

isCascade
    ^ true

    "Created: / 16.7.1998 / 20:03:51 / cg"
! !

!CascadeNode class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.23 2002-11-26 09:08:56 cg Exp $'
! !