"====================================================================== | | (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' !