"======================================================================
|
|   (Parts of) A Smalltalk parser.
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of GNU Smalltalk.
|
| GNU Smalltalk 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, or (at your option) any later version.
| 
| GNU Smalltalk 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
| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
| Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"



Object subclass: #STParseNode
       instanceVariableNames: 'comments'
       classVariableNames: ''
       poolDictionaries: 'VMOtherConstants VMByteCodeNames'
       category: 'System-Compiler'
!

STParseNode comment:
'I am the root of compiler''s node hierarchy.  All parse tree nodes are
descendants of me.  My instances know how to compile themselves and
how to establish a visit through a STParseNodeVisitor -- compilation
is not implemented through a visitor because its usage of double
dispatch is a bit slower, which can affect adversely the responsivity
of the system when compiling.'!

!STParseNode methodsFor: 'querying'!

comments
    ^comments
!

comments: anObject
    comments := anObject
!

isOptimizableToByDoStep
    ^false
!

isSuper
    ^false
!

isMessageSend
    ^false
!

isReturn
    ^false
!

isBlock
    ^false
!

parenthesizeInside: aParseNode
    ^aParseNode precedence > self precedence
!

precedence
    ^6
! !

STParseNode subclass: #STMessageSendNode
    instanceVariableNames: 'selector'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STMessageSendNode methodsFor: 'abstract'!

argumentCount
    self subclassResponsibility
!

allExpressionsDo: aBlock
    self subclassResponsibility
! !

!STMessageSendNode methodsFor: 'accessing'!

isMessageSend
    ^true
!

isWhileFalse
    self selector == #whileFalse: ifTrue: [ ^true ].
    self selector == #whileFalse  ifTrue: [ ^true ].
    ^false
!

selector
    ^selector
! !

!STMessageSendNode methodsFor: 'private'!

selector: sel
    selector := sel asSymbol
! !

STMessageSendNode subclass: #STBinaryNode
    instanceVariableNames: 'expression'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STBinaryNode class methodsFor: 'instance creation'!

selector: sel expression: expr
    ^self new init: sel expression: expr
! !

!STBinaryNode methodsFor: 'accessing'!

argumentCount
    ^1
!

allExpressionsDo: aBlock
    aBlock value: expression
!

expression
    ^expression
!

precedence
    ^2
! !


!STBinaryNode methodsFor: 'private'!

init: sel expression: expr
    self selector: sel.
    expression := expr
! !

STParseNode subclass: #STBlockNode
    instanceVariableNames: 'parameters numTemps statements'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STBlockNode class methodsFor: 'instance creation'!

parameters: params temporaries: temps statements: stmts
    ^self new init: params temporaries: temps statements: stmts
! !

!STBlockNode methodsFor: 'private'!

init: params temporaries: temps statements: stmts
    | tempsColl |
    tempsColl   := temps  isNil ifTrue: [ #()       ] ifFalse: [ temps ].
    statements  := stmts  isNil ifTrue: [ #()       ] ifFalse: [ stmts ].
    parameters  := params isNil ifTrue: [ tempsColl ] ifFalse: [ params, tempsColl ].
    numTemps    := temps size
! !

!STBlockNode methodsFor: 'accessing'!

numArgs
    ^parameters size - numTemps
!

numTemps
    ^numTemps
!

isOptimizableWithArgs: n
    ^(parameters size = n) and: [numTemps = 0]
!

parameters
    ^parameters
!

precedence
    ^0
!

statements
    ^statements
! !

!STBlockNode methodsFor: 'querying'!

isBlock
    ^true
! !

STParseNode subclass: #STCascadeNode
    instanceVariableNames: 'receiver messages'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STCascadeNode class methodsFor: 'instance creation'!

expression: expr cascade: msgs
    ^self new init: expr cascade: msgs
! !

!STCascadeNode methodsFor: 'accessing'!

receiver
    ^receiver receiver
!

firstMessage
    ^receiver message
!

otherMessages
    ^messages
!

precedence
    ^4
! !

!STCascadeNode methodsFor: 'private'!

init: expr cascade: msgs
    receiver := expr.
    messages := msgs
! !

STParseNode subclass: #STConstNode
    instanceVariableNames: 'value'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STConstNode class methodsFor: 'instance creation'!

one
    ^self new init: 1
!

value: anObject
    ^self new init: anObject
! !

!STConstNode methodsFor: 'accessing'!

isOptimizableToByDoStep
    ^value respondsTo: #>
!

isPositive
    ^value > 0
!

value
    ^value
! !

!STConstNode methodsFor: 'private'!

init: anObject
    value := anObject
! !

STParseNode subclass: #STExpressionNode
    instanceVariableNames: 'assigns expression'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STExpressionNode class methodsFor: 'instance creation'!

expression: expr
    ^self new init: #() expression: expr
!

assign: assignsList expression: expr
    ^self new init: assignsList expression: expr
! !


!STExpressionNode methodsFor: 'accessing'!

assigns
    ^assigns
!

assignsDo: aBlock
    assigns do: aBlock
!

expression
    ^expression
!

precedence
    ^self assigns isEmpty ifFalse: [ 5 ] ifTrue: [ expression precedence ]
! !



!STExpressionNode methodsFor: 'private'!

init: assignsList expression: expr
    assigns := assignsList.
    expression := expr
! !

STParseNode subclass: #STIdentifierNode
    instanceVariableNames: 'id'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STIdentifierNode class methodsFor: 'instance creation'!

id: identifier
    ^self new init: identifier
! !

!STIdentifierNode methodsFor: 'accessing'!

id
    ^id
!

precedence
    ^0
! !

!STIdentifierNode methodsFor: 'private'!

init: identifier
    id := identifier
! !

STMessageSendNode subclass: #STKeywordNode
    instanceVariableNames: 'expressions'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STKeywordNode class methodsFor: 'instance creation'!

selector: selector expressions: exprs
    ^self new init: selector expressions: exprs
! !

!STKeywordNode methodsFor: 'accessing'!

argumentCount
    ^expressions size
!

allExpressionsDo: aBlock
    expressions do: aBlock
!

expressions
    ^expressions
!

parenthesizeInside: aParseNode
    ^aParseNode isMessageSend or: [ super parenthesizeInside: aParseNode ]
!

precedence
    ^3
! !

!STKeywordNode methodsFor: 'private'!

init: aSelector expressions: exprs
    self selector: aSelector.
    expressions := exprs
! !



STParseNode subclass: #STMethodBodyNode
    instanceVariableNames: 'temporaries primitive statements'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STMethodBodyNode class methodsFor: 'instance creation'!

temps: temps primIndex: pi stmts: stmts
    ^self new init: temps primIndex: pi stmts: stmts
! !


!STMethodBodyNode methodsFor: 'accessing'!

temporaries
    ^temporaries
!

primitive
    ^primitive
!

statements
    ^statements
! !

!STMethodBodyNode methodsFor: 'private'!

init: temps primIndex: prim stmts: stmts
    temporaries := temps.
    primitive := prim isNil ifTrue: [ 0 ] ifFalse: [ prim ].
    statements := stmts
! !


STParseNode subclass: #STMethodDefinitionNode
    instanceVariableNames: 'selector body source'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STMethodDefinitionNode class methodsFor: 'instance creation'!

new: selector body: methodBody source: source
    ^self new init: selector body: methodBody source: source
! !


!STMethodDefinitionNode methodsFor: 'accessing'!

selector
    ^selector
!

source
    ^source
!

body
    ^body
! !


!STMethodDefinitionNode methodsFor: 'private'!

init: aSelector body: methodBody source: source
    selector := aSelector.
    body := methodBody.
    source := source
! !


STParseNode subclass: #STMessageNode
    instanceVariableNames: 'receiver message'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STMessageNode class methodsFor: 'instance creation'!

receiver: rec message: mess
    ^self new init: rec message: mess
! !


!STMessageNode methodsFor: 'accessing'!

receiver
    ^receiver
!

message
    ^message
! !

!STMessageNode methodsFor: 'private'!

init: rec message: mess
    receiver := rec.
    message := mess
! !


STParseNode subclass: #STReturnNode
    instanceVariableNames: 'expression'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STReturnNode class methodsFor: 'instance creation'!

expression: expr
    ^self new init: expr
! !


!STReturnNode methodsFor: 'accessing'!

expression
    ^expression
!

isReturn
    ^true
! !



!STReturnNode methodsFor: 'private'!

init: expr
    expression := expr.
! !


STParseNode subclass: #STSelectorNode
	  instanceVariableNames: 'selector args'
	  classVariableNames: ''
	  poolDictionaries: ''
	  category: 'System-Compiler'
!

!STSelectorNode class methodsFor: 'instance creation'!

selector: sel args: args
    ^self new init: sel args: args
! !


!STSelectorNode methodsFor: 'accessing'!

selector
    ^selector
!

args
    ^args
! !



!STSelectorNode methodsFor: 'private'!

init: aSelector args: argList
    selector := aSelector.
    args := argList
! !

STIdentifierNode subclass: #STSpecialIdentifierNode
    instanceVariableNames: 'id'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STSpecialIdentifierNode methodsFor: 'querying'!

bytecodeID
    ^self isSuper
	ifTrue: [ 0 "self" ]
	ifFalse: [ id ]
!

isSuper
    ^id < 0
! !

STMessageSendNode subclass: #STUnaryNode
    instanceVariableNames: 'selector'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!

!STUnaryNode class methodsFor: 'instance creation'!

selector: sel
    ^self new selector: sel
! !

!STUnaryNode methodsFor: 'accessing'!

argumentCount
    ^0
!

allExpressionsDo: aBlock
!

precedence
    ^1
! !

STIdentifierNode subclass: #STVariableNode
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'System-Compiler'
!
