SystemOrganization addCategory: #'AST-Core-Nodes'!
SystemOrganization addCategory: #'AST-Core-NodesExt'!
SystemOrganization addCategory: #'AST-Core-Matching'!
SystemOrganization addCategory: #'AST-Core-Parser'!
SystemOrganization addCategory: #'AST-Core-Tokens'!
SystemOrganization addCategory: #'AST-Core-Visitors'!

!Trait methodsFor: '*ast-core' stamp: 'DamienCassou 8/21/2009 11:20'!
formatterClass
	^ self class formatterClass ! !

!Trait methodsFor: '*ast-core' stamp: 'md 4/6/2007 14:20'!
isVariable
	"hack for Lint"
	^false! !

!Trait methodsFor: '*ast-core' stamp: 'md 4/6/2007 14:20'!
superclass
	"hack for Lint"
	^nil! !

!Trait methodsFor: '*ast-core' stamp: 'md 4/6/2007 14:20'!
withAllSubclasses
	"hack for Lint"
	^Array with: self! !

Stream subclass: #RBScanner
	instanceVariableNames: 'stream buffer tokenStart currentCharacter characterType classificationTable comments extendedLanguage errorBlock'
	classVariableNames: 'ClassificationTable PatternVariableCharacter'
	poolDictionaries: ''
	category: 'AST-Core-Parser'!

!RBScanner commentStamp: 'md 8/9/2005 14:54' prior: 0!
RBScanner is a stream that returns a sequence of token from the string that it is created on. The tokens know where they came from in the source code and which comments were attached to them.

Instance Variables:
	buffer	<PositionableStream>	Accumulates the text for the current token.
	characterType	<ByteSymbol>	The type of the next character. (e.g. #alphabetic, etc.)
	classificationTable	<Array of: Symbol>	Mapping from Character values to their characterType.
	comments	<Collection of: Interval>	Source intervals of scanned comments that must be attached to the next token.
	currentCharacter	<Character>	The character currently being processed.
	errorBlock	<BlockClosure>	The block to execute on lexical errors.
	extendedLiterals	<Boolean>	True if IBM-type literals are allowed. In VW, this is false.
	nameSpaceCharacter	<Character>	The character used to separate namespaces.
	numberType	<ByteSymbol>	The method to perform: to scan a number. 
	separatorsInLiterals	<Boolean>	True if separators are allowed within literals.
	stream	<PositionableStream>	Contains the text to be scanned.
	tokenStart	<Integer>	The source position of the beginning of the current token

Class Instance Variables:
	classificationTable	<Array>		the default classification table for all characters

Shared Variables:
	PatternVariableCharacter	<Character>	the character that starts a pattern node!

!RBScanner class methodsFor: 'accessing' stamp: ''!
classificationTable
	ClassificationTable isNil ifTrue: [self initialize].
	^ClassificationTable! !

!RBScanner class methodsFor: 'class initialization' stamp: 'ls 3/20/2004 14:17'!
initialize
	PatternVariableCharacter := $`.
	ClassificationTable := Array new: 255.
	self initializeChars: 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' to: #alphabetic.
	self initializeChars: (128 to: 255) asByteArray asString to: #alphabetic.
	self initializeChars: '01234567890' to: #digit.
	self initializeChars: '!!!!%&*+,-/<=>?@\~|' to: #binary.
	ClassificationTable at: 177 put: #binary.	"plus-or-minus"
	ClassificationTable at: 183 put: #binary.	"centered dot"
	ClassificationTable at: 215 put: #binary.	"times"
	ClassificationTable at: 247 put: #binary.	"divide"
	self initializeChars: '().:;[]^{}_' to: #special.
	#(9 10 12 13 26 32) do: [:i | ClassificationTable at: i put: #separator]! !

!RBScanner class methodsFor: 'class initialization' stamp: ''!
initializeChars: characters to: aSymbol 
	characters do: [:c | ClassificationTable at: c asInteger put: aSymbol]! !

!RBScanner class methodsFor: 'testing' stamp: ''!
isSelector: aSymbol 
	| scanner token |
	scanner := self basicNew.
	scanner on: (ReadStream on: aSymbol asString).
	scanner step.
	token := scanner scanAnySymbol.
	token isLiteral ifFalse: [^false].
	token value isEmpty ifTrue: [^false].
	^scanner atEnd! !

!RBScanner class methodsFor: 'testing' stamp: ''!
isVariable: aString 
	| scanner token |
	aString isString ifFalse: [^false].
	aString isEmpty ifTrue: [^false].
	(ClassificationTable at: aString first asInteger) == #alphabetic
		ifFalse: [^false].
	scanner := self basicNew.
	scanner on: (ReadStream on: aString asString).
	scanner errorBlock: [:s :p | ^false].
	scanner step.
	token := scanner scanIdentifierOrKeyword.
	token isKeyword ifTrue: [^false].
	^scanner atEnd! !

!RBScanner class methodsFor: 'instance creation' stamp: ''!
on: aStream 
	| str |
	str := self basicNew on: aStream.
	str
		step;
		stripSeparators.
	^str! !

!RBScanner class methodsFor: 'instance creation' stamp: ''!
on: aStream errorBlock: aBlock 
	| str |
	str := self basicNew on: aStream.
	str
		errorBlock: aBlock;
		step;
		stripSeparators.
	^str! !

!RBScanner class methodsFor: 'accessing' stamp: ''!
patternVariableCharacter
	^PatternVariableCharacter! !

!RBScanner class methodsFor: 'instance creation' stamp: ''!
rewriteOn: aStream 
	| str |
	str := self basicNew on: aStream.
	str
		extendedLanguage: true;
		step;
		stripSeparators.
	^str! !

!RBScanner class methodsFor: 'instance creation' stamp: ''!
rewriteOn: aStream errorBlock: aBlock 
	| str |
	str := self basicNew on: aStream.
	str
		extendedLanguage: true;
		errorBlock: aBlock;
		step;
		stripSeparators.
	^str! !

!RBScanner methodsFor: 'testing' stamp: ''!
atEnd
	^characterType == #eof! !

!RBScanner methodsFor: 'accessing' stamp: ''!
classificationTable: anObject
	classificationTable := anObject! !

!RBScanner methodsFor: 'private' stamp: 'lr 10/17/2009 11:41'!
classify: aCharacter 
	| index |
	aCharacter isNil 
		ifTrue: [ ^ nil ].
	index := aCharacter asInteger.
	index == 0 
		ifTrue: [ ^ #separator].
	index > 255 ifTrue: [
		^ aCharacter isLetter
			ifTrue: [ #alphabetic ]
			ifFalse: [
				aCharacter isSeparator
					ifTrue: [ #separator ]
					ifFalse: [ nil ] ] ].
	^ classificationTable at: index! !

!RBScanner methodsFor: 'accessing' stamp: ''!
contents
	| contentsStream |
	contentsStream := WriteStream on: (Array new: 50).
	self do: [:each | contentsStream nextPut: each].
	^contentsStream contents! !

!RBScanner methodsFor: 'error handling' stamp: ''!
errorBlock
	^errorBlock isNil
		ifTrue: [[:message :position | ]]
		ifFalse: [errorBlock]! !

!RBScanner methodsFor: 'accessing' stamp: ''!
errorBlock: aBlock 
	errorBlock := aBlock! !

!RBScanner methodsFor: 'error handling' stamp: ''!
errorPosition
	^stream position! !

!RBScanner methodsFor: 'accessing' stamp: ''!
extendedLanguage
	^extendedLanguage! !

!RBScanner methodsFor: 'accessing' stamp: ''!
extendedLanguage: aBoolean 
	extendedLanguage := aBoolean! !

!RBScanner methodsFor: 'accessing' stamp: ''!
flush! !

!RBScanner methodsFor: 'accessing' stamp: ''!
getComments
	| oldComments |
	comments isEmpty ifTrue: [^nil].
	oldComments := comments.
	comments := OrderedCollection new: 1.
	^oldComments! !

!RBScanner methodsFor: 'initialize-release' stamp: 'lr 10/17/2009 13:10'!
initializeForSqueak! !

!RBScanner methodsFor: 'testing' stamp: ''!
isReadable
	^true! !

!RBScanner methodsFor: 'testing' stamp: ''!
isWritable
	^false! !

!RBScanner methodsFor: 'accessing' stamp: ''!
next
	| token |
	buffer reset.
	tokenStart := stream position.
	characterType == #eof ifTrue: [^RBToken start: tokenStart + 1].	"The EOF token should occur after the end of input"
	token := self scanToken.
	self stripSeparators.
	^token! !

!RBScanner methodsFor: 'accessing' stamp: ''!
nextPut: anObject 
	"Provide an error notification that the receiver does not
	implement this message."

	self shouldNotImplement! !

!RBScanner methodsFor: 'initialize-release' stamp: 'lr 10/17/2009 13:11'!
on: aStream 
	buffer := WriteStream on: (String new: 60).
	stream := aStream.
	classificationTable := self class classificationTable.
	extendedLanguage := false.
	comments := OrderedCollection new! !

!RBScanner methodsFor: 'private' stamp: ''!
previousStepPosition
	^characterType == #eof 
		ifTrue: [stream position]
		ifFalse: [stream position - 1]! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanAnySymbol
	characterType == #alphabetic ifTrue: [^self scanSymbol].
	characterType == #binary ifTrue: [^self scanBinary: RBLiteralToken].
	^RBToken new! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 4/17/2008 11:09'!
scanBinary: aClass 
	buffer nextPut: currentCharacter.
	self step.
	[ characterType == #binary and: [ currentCharacter ~~ $- ] ] whileTrue: 
		[ buffer nextPut: currentCharacter.
		self step ].
	^ aClass
		value: buffer contents asSymbol
		start: tokenStart! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanByteArray
	| byteStream number |
	byteStream := WriteStream on: (ByteArray new: 100).
	self step.
	
	[self stripSeparators.
	characterType == #digit] whileTrue: 
				[number := self scanNumber value.
				(number isInteger and: [number between: 0 and: 255]) 
					ifFalse: [self scannerError: 'Expecting 8-bit integer'].
				byteStream nextPut: number].
	currentCharacter == $] ifFalse: [self scannerError: ''']'' expected'].
	self step.	"]"
	^RBLiteralToken 
		value: byteStream contents
		start: tokenStart
		stop: self previousStepPosition! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanExponentMultipler
	| exponent isExpNegative position |
	currentCharacter == $e
		ifTrue: 
			[position := stream position.
			self step.
			(isExpNegative := currentCharacter == $-) ifTrue: [self step].
			exponent := self scanNumberOfBase: 10.
			exponent isNil
				ifTrue: 
					["Did not read a valid exponent, e must be start of a message send"

					stream position: position - 1.
					self step.
					exponent := 0]
				ifFalse: [isExpNegative ifTrue: [exponent := exponent negated]]]
		ifFalse: [exponent := 0].
	^10 raisedToInteger: exponent! !

!RBScanner methodsFor: 'private-scanning' stamp: 'ls 1/30/2000 19:21'!
scanExtendedSymbol
	"scan symbols like #. which are allowed by Squeak but aren't standard"

	| token |
	token := RBLiteralToken value: (currentCharacter asString asSymbol) start: tokenStart stop: stream position.
	self step.
	^token
! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 10/17/2009 12:47'!
scanIdentifierOrKeyword
	| tokenType name |
	self scanName.
	(currentCharacter == $: and: [stream peek ~~ $=]) 
		ifTrue: 
			[buffer nextPut: currentCharacter.
			self step.	":"
			tokenType := RBKeywordToken]
		ifFalse: [tokenType := RBIdentifierToken].
	name := buffer contents.
	name = 'true' 
		ifTrue: 
			[^RBLiteralToken 
				value: true
				start: tokenStart
				stop: self previousStepPosition].
	name = 'false' 
		ifTrue: 
			[^RBLiteralToken 
				value: false
				start: tokenStart
				stop: self previousStepPosition].
	name = 'nil' 
		ifTrue: 
			[^RBLiteralToken 
				value: nil
				start: tokenStart
				stop: self previousStepPosition].
	^tokenType value: name start: tokenStart! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 10/17/2009 13:07'!
scanLiteral
	self step.
	self stripSeparators.
	characterType == #alphabetic ifTrue: [^self scanSymbol].
	characterType == #binary 
		ifTrue: [^(self scanBinary: RBLiteralToken) stop: self previousStepPosition].
	currentCharacter == $' ifTrue: [^self scanStringSymbol].
	currentCharacter == $( ifTrue: [^self scanLiteralArray].
	currentCharacter == $[ ifTrue: [^self scanByteArray].
	characterType == #special ifTrue: [^self scanExtendedSymbol].
	self scannerError: 'Expecting a literal type'! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 10/17/2009 12:59'!
scanLiteralArray
	| arrayStream start |
	arrayStream := WriteStream on: (Array new: 10).
	self step.
	start := tokenStart.
	[self stripSeparators.
	tokenStart := stream position.
	currentCharacter == $)] 
			whileFalse: 
				[arrayStream nextPut: self scanLiteralArrayParts.
				buffer reset].
	self step.
	^RBLiteralToken 
		value: arrayStream contents
		start: start
		stop: self previousStepPosition! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 10/17/2009 13:07'!
scanLiteralArrayParts
	currentCharacter == $# ifTrue: [^self scanLiteral].
	characterType == #alphabetic 
		ifTrue: 
			[| token value |
			token := self scanSymbol.
			value := token value.
			value == #nil ifTrue: [token value: nil].
			value == #true ifTrue: [token value: true].
			value == #false ifTrue: [token value: false].
			^token].
	(characterType == #digit 
		or: [currentCharacter == $- and: [(self classify: stream peek) == #digit]]) 
			ifTrue: [^self scanNumber].
	characterType == #binary 
		ifTrue: [^(self scanBinary: RBLiteralToken) stop: self previousStepPosition].
	currentCharacter == $' ifTrue: [^self scanLiteralString].
	currentCharacter == $$ ifTrue: [^self scanLiteralCharacter].
	currentCharacter == $( ifTrue: [^self scanLiteralArray].
	characterType == #special ifTrue: [^self scanExtendedSymbol].
	^self scannerError: 'Unknown character in literal array'! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanLiteralCharacter
	| token |
	self step.	"$"
	token := RBLiteralToken 
				value: currentCharacter
				start: tokenStart
				stop: stream position.
	self step.	"char"
	^token! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanLiteralString
	self step.
	
	[currentCharacter isNil 
		ifTrue: [self scannerError: 'Unmatched '' in string literal.'].
	currentCharacter == $' and: [self step ~~ $']] 
			whileFalse: 
				[buffer nextPut: currentCharacter.
				self step].
	^RBLiteralToken 
		value: buffer contents
		start: tokenStart
		stop: self previousStepPosition! !

!RBScanner methodsFor: 'private-scanning' stamp: 'pmm 7/12/2006 16:08'!
scanName
	[ #(alphabetic digit) includes: characterType ] whileTrue: 
			[buffer nextPut: currentCharacter.
			self step]! !

!RBScanner methodsFor: 'private-scanning' stamp: 'lr 10/17/2009 13:10'!
scanNumber
	^RBLiteralToken 
		value: self scanNumberIBM
		start: tokenStart
		stop: self previousStepPosition! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanNumberIBM
	| number isNegative |
	isNegative := false.
	currentCharacter == $- 
		ifTrue: 
			[isNegative := true.
			self step].
	number := self scanNumberWithoutExponent.
	^(isNegative ifTrue: [number negated] ifFalse: [number]) 
		* self scanExponentMultipler! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanNumberOfBase: anInteger 
	"Scan a number. Return the number or nil if the current input isn't a valid number."

	| number digits fraction isFloat succeeded |
	digits := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' copyFrom: 1 to: anInteger.
	number := 0.
	succeeded := false.
	[digits includes: currentCharacter] whileTrue: 
			[number := number * anInteger + (digits indexOf: currentCharacter) - 1.
			self step.
			succeeded := true].
	succeeded ifFalse: [^nil].
	isFloat := false.
	(currentCharacter == $. and: [digits includes: stream peek]) ifTrue: 
			[self step.
			isFloat := true.
			fraction := 1 / anInteger.
			[digits includes: currentCharacter] whileTrue: 
					[number := number + (((digits indexOf: currentCharacter) - 1) * fraction).
					fraction := fraction / anInteger.
					self step]].
	^isFloat ifTrue: [number asFloat] ifFalse: [number]! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanNumberWithoutExponent
	"Scan an IBM number with the radix -- don't scan the exponent though"

	| number base |
	base := self scanNumberOfBase: 10.
	(currentCharacter == $r and: [base isInteger])
		ifTrue: 
			[| position |
			position := stream position.
			self step.
			number := self scanNumberOfBase: base.
			number isNil ifTrue: 
					["Did not read a correct number, r must be start of a message send."

					stream position: position - 1.
					self step.
					number := base]]
		ifFalse: [number := base].
	^number! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanPatternVariable
	buffer nextPut: currentCharacter.
	self step.
	currentCharacter == ${ 
		ifTrue: 
			[self step.
			^RBPatternBlockToken value: '`{' start: tokenStart].
	[characterType == #alphabetic] whileFalse: 
			[characterType == #eof 
				ifTrue: [self scannerError: 'Meta variable expected'].
			buffer nextPut: currentCharacter.
			self step].
	^self scanIdentifierOrKeyword! !

!RBScanner methodsFor: 'private-scanning' stamp: 'ls 1/21/2000 22:38'!
scanSpecialCharacter
	| character |
	currentCharacter == $: ifTrue: 
			[self step.
			^currentCharacter == $=
				ifTrue: 
					[self step.
					RBAssignmentToken start: tokenStart]
				ifFalse: [RBSpecialCharacterToken value: $: start: tokenStart]].
	currentCharacter = $_ ifTrue:
		[ self step.  ^RBShortAssignmentToken start: tokenStart ].

	character := currentCharacter.
	self step.
	^RBSpecialCharacterToken value: character start: tokenStart! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanStringSymbol
	| literalToken |
	literalToken := self scanLiteralString.
	literalToken value: literalToken value asSymbol.
	^literalToken! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
scanSymbol
	| lastPosition hasColon value startPosition |
	hasColon := false.
	startPosition := lastPosition := stream position.
	[characterType == #alphabetic] whileTrue: 
			[self scanName.
			currentCharacter == $: 
				ifTrue: 
					[buffer nextPut: $:.
					hasColon := true.
					lastPosition := stream position.
					self step]].
	value := buffer contents.
	(hasColon and: [value last ~~ $:]) 
		ifTrue: 
			[stream position: lastPosition.
			self step.
			value := value copyFrom: 1 to: lastPosition - startPosition + 1].
	^RBLiteralToken 
		value: value asSymbol
		start: tokenStart
		stop: self previousStepPosition! !

!RBScanner methodsFor: 'accessing' stamp: 'bh 3/7/2000 02:17'!
scanToken
	"fast-n-ugly. Don't write stuff like this. Has been found to cause cancer in laboratory rats. Basically a 
	case statement. Didn't use Dictionary because lookup is pretty slow."

	characterType == #alphabetic ifTrue: [^self scanIdentifierOrKeyword].
	(characterType == #digit 
		or: [currentCharacter == $- and: [(self classify: stream peek) == #digit]]) 
			ifTrue: [^self scanNumber].
	characterType == #binary ifTrue: [^self scanBinary: RBBinarySelectorToken].
	characterType == #special ifTrue: [^self scanSpecialCharacter].
	currentCharacter == $' ifTrue: [^self scanLiteralString].
	currentCharacter == $# ifTrue: [^self scanLiteral].
	currentCharacter == $$ ifTrue: [^self scanLiteralCharacter].
	extendedLanguage 
		ifTrue: 
			[currentCharacter == PatternVariableCharacter 
				ifTrue: [^self scanPatternVariable].
			currentCharacter == $} ifTrue: [^self scanSpecialCharacter]].
	^self scannerError: 'Unknown character'! !

!RBScanner methodsFor: 'error handling' stamp: ''!
scannerError: aString 
	"Evaluate the block. If it returns raise an error"

	self errorBlock value: aString value: self errorPosition.
	self error: aString! !

!RBScanner methodsFor: 'private' stamp: ''!
step
	stream atEnd ifTrue: 
			[characterType := #eof.
			^currentCharacter := nil].
	currentCharacter := stream next.
	characterType := self classify: currentCharacter.
	^currentCharacter! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
stripComment
	| start stop |
	start := stream position.
	[self step == $"] whileFalse: 
			[characterType == #eof
				ifTrue: [self scannerError: 'Unmatched " in comment.']].
	stop := stream position.
	self step.
	comments add: (start to: stop)! !

!RBScanner methodsFor: 'private-scanning' stamp: ''!
stripSeparators
	
	[[characterType == #separator]
		whileTrue: [self step].
	currentCharacter == $"]
		whileTrue: [self stripComment]! !

!Behavior methodsFor: '*ast-core' stamp: 'DamienCassou 8/21/2009 11:26'!
formatterClass
	^Preferences useRBASTForPrettyPrint
		ifFalse: [ self compilerClass ]
		ifTrue: [ RBParser ]! !

!Behavior methodsFor: '*ast-core' stamp: 'md 4/16/2007 10:41'!
parseTreeFor: aSymbol	
	self flag: #FIXME.
	"UGLY hack for beeing able to share AST package with Persephone... this
	 needs to be fixed later".
	
	Smalltalk at: #ReflectiveMethod ifPresent: [:cls | 	| method |
		method := self compiledMethodAt: aSymbol.
		method hasReflectiveMethod ifTrue: [^method reflectiveMethod methodNode].
	].

	^RBParser parseMethod: (self sourceCodeAt: aSymbol)
		onError: [:aString :pos | ^nil]! !

!TraitBehavior methodsFor: '*ast-core' stamp: 'md 4/16/2007 10:41'!
parseTreeFor: aSymbol	
	self flag: #FIXME.
	"UGLY hack for beeing able to share AST package with Persephone... this
	 needs to be fixed later".
	
	Smalltalk at: #ReflectiveMethod ifPresent: [:cls | 	| method |
		method := self compiledMethodAt: aSymbol.
		method hasReflectiveMethod ifTrue: [^method reflectiveMethod methodNode].
	].

	^RBParser parseMethod: (self sourceCodeAt: aSymbol)
		onError: [:aString :pos | ^nil]! !

!CompiledMethod methodsFor: '*ast-core' stamp: 'dvf 11/8/2003 15:01'!
parseTree
	^ RBParser parseMethod: self getSource asString.! !

PrettyPrinting subclass: #ASTPrettyPrinting
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Parser'!

!ASTPrettyPrinting class methodsFor: 'class initialization' stamp: 'damiencassou 7/31/2009 12:58'!
initialize
	PrettyPrinting register: self.
	PrettyPrinting default: self.! !

!ASTPrettyPrinting class methodsFor: 'pretty printing' stamp: 'damiencassou 7/30/2009 11:27'!
prettyPrinterClassFor: aBehavior
	^ Preferences useRBASTForPrettyPrint
		ifTrue: [RBParser]
		ifFalse: [aBehavior compilerClass]! !

!TPureBehavior methodsFor: '*ast-core' stamp: 'md 4/16/2007 10:41'!
parseTreeFor: aSymbol	
	self flag: #FIXME.
	"UGLY hack for beeing able to share AST package with Persephone... this
	 needs to be fixed later".
	
	Smalltalk at: #ReflectiveMethod ifPresent: [:cls | 	| method |
		method := self compiledMethodAt: aSymbol.
		method hasReflectiveMethod ifTrue: [^method reflectiveMethod methodNode].
	].

	^RBParser parseMethod: (self sourceCodeAt: aSymbol)
		onError: [:aString :pos | ^nil]! !

Object subclass: #PrimitiveNode
	instanceVariableNames: 'primitiveNum spec'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!PrimitiveNode commentStamp: 'ajh 3/24/2003 21:35' prior: 0!
I represent a primitive.  I am more than just a number if I am a named primitive.

Structure:

 num	<Integer>	Primitive number.
 spec	<Object>		Stored in first literal when num is 117 or 120.
!

!PrimitiveNode class methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:47'!
null

	^ self new num: 0! !

!PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:37'!
num

	^ primitiveNum! !

!PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:23'!
num: n

	primitiveNum := n! !

!PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 12:26'!
printOn: aStream

	aStream nextPutAll: 'primitive '; print: primitiveNum! !

!PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/19/2003 22:06'!
printPrimitiveOn: aStream 
	"Print the primitive on aStream"

	| primIndex primDecl |
	primIndex := primitiveNum.
	primIndex = 0 ifTrue: [^ self].
	primIndex = 120 ifTrue: [
		"External call spec"
		^ aStream print: spec].
	aStream nextPutAll: '<primitive: '.
	primIndex = 117 ifTrue: [
		primDecl := spec.
		aStream nextPut: $';
			nextPutAll: (primDecl at: 2);
			nextPut: $'.
		(primDecl at: 1) ifNotNil: [
			aStream nextPutAll: ' module: ';
				nextPut: $';
				nextPutAll: (primDecl at: 1);
				nextPut: $'].
	] ifFalse: [aStream print: primIndex].
	aStream nextPut: $>.
	(primIndex ~= 117 and: [primIndex ~= 120]) ifTrue: [
		Smalltalk at: #Interpreter ifPresent: [:cls |
			aStream nextPutAll: ' "', 
				((cls classPool at: #PrimitiveTable) at: primIndex + 1) , '" '
		].
	].
! !

!PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/19/2003 22:02'!
sourceText

	^ String streamContents: [:stream |
		self printPrimitiveOn: stream]! !

!PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:37'!
spec

	^ spec! !

!PrimitiveNode methodsFor: 'as yet unclassified' stamp: 'ajh 7/14/2001 12:30'!
spec: literal

	spec := literal! !

Object subclass: #RBParseTreeRule
	instanceVariableNames: 'searchTree owner'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBParseTreeRule commentStamp: 'md 8/9/2005 14:55' prior: 0!
RBParseTreeRule is the abstract superclass of all of the parse tree searching rules. A parse tree rule is the first class representation of a particular rule to search for. The owner of a rule is the algorithm that actually executes the search. This arrangement allows multiple searches to be conducted by a single Searcher.

Instance Variables:
	owner	<ParseTreeSearcher>	The searcher that is actually performing the search.
	searchTree	<RBProgramNode>	The parse tree to be searched.

!

!RBParseTreeRule class methodsFor: 'instance creation' stamp: ''!
methodSearch: aString 
	^(self new)
		methodSearchString: aString;
		yourself! !

!RBParseTreeRule class methodsFor: 'instance creation' stamp: ''!
search: aString 
	^(self new)
		searchString: aString;
		yourself! !

!RBParseTreeRule methodsFor: 'matching' stamp: ''!
canMatch: aProgramNode 
	^true! !

!RBParseTreeRule methodsFor: 'private' stamp: ''!
context
	^owner context! !

!RBParseTreeRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode
	^aProgramNode! !

!RBParseTreeRule methodsFor: 'initialize-release' stamp: ''!
methodSearchString: aString 
	searchTree := RBParser parseRewriteMethod: aString! !

!RBParseTreeRule methodsFor: 'initialize-release' stamp: ''!
owner: aParseTreeSearcher
	owner := aParseTreeSearcher! !

!RBParseTreeRule methodsFor: 'matching' stamp: ''!
performOn: aProgramNode 
	self context empty.
	^((searchTree match: aProgramNode inContext: self context) 
		and: [self canMatch: aProgramNode]) 
			ifTrue: 
				[owner recusivelySearchInContext.
				self foundMatchFor: aProgramNode]
			ifFalse: [nil]! !

!RBParseTreeRule methodsFor: 'initialize-release' stamp: ''!
searchString: aString 
	searchTree := RBParser parseRewriteExpression: aString! !

!RBParseTreeRule methodsFor: 'accessing' stamp: ''!
sentMessages
	^searchTree sentMessages! !

RBParseTreeRule subclass: #RBReplaceRule
	instanceVariableNames: 'verificationBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBReplaceRule commentStamp: 'md 8/9/2005 14:56' prior: 0!
RBReplaceRule is the abstract superclass of all of the transforming rules. The rules change the source code by replacing the node that matches the rule. Subclasses implement different strategies for this replacement.

Subclasses must implement the following messages:
	matching
		foundMatchFor:

Instance Variables:
	verificationBlock	<BlockClosure>	Is evaluated with the matching node. This allows for further verification of a match beyond simple tree matching.

!

RBReplaceRule subclass: #RBBlockReplaceRule
	instanceVariableNames: 'replaceBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBBlockReplaceRule commentStamp: 'md 8/9/2005 14:55' prior: 0!
RBBlockReplaceRule replaces the matching node by the result of evaluating replaceBlock. This allows arbitrary computation to come up with a replacement.

Instance Variables:
	replaceBlock	<BlockClosure>	The block that returns the node to replace to matching node with.
!

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceBlock 
	^self new searchFor: searchString replaceWith: replaceBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceBlock when: aBlock 
	^self new 
		searchFor: searchString
		replaceWith: replaceBlock
		when: aBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceBlock 
	^self new searchForMethod: searchString replaceWith: replaceBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceBlock when: aBlock 
	^self new 
		searchForMethod: searchString
		replaceWith: replaceBlock
		when: aBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: searchString replaceWith: replaceBlock 
	^self new searchForTree: searchString replaceWith: replaceBlock! !

!RBBlockReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: searchString replaceWith: replaceBlock when: aBlock 
	^self new 
		searchFor: searchString
		replaceWith: replaceBlock
		when: aBlock! !

!RBBlockReplaceRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode 
	^replaceBlock value: aProgramNode! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
initialize
	super initialize.
	replaceBlock := [:aNode | aNode]! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: aBlock 
	self searchString: searchString.
	replaceBlock := aBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: replBlock when: verifyBlock 
	self searchFor: searchString replaceWith: replBlock.
	verificationBlock := verifyBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: aBlock 
	self methodSearchString: searchString.
	replaceBlock := aBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: replBlock when: verifyBlock 
	self searchForMethod: searchString replaceWith: replBlock.
	verificationBlock := verifyBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: aBlock 
	searchTree := aBRProgramNode.
	replaceBlock := aBlock! !

!RBBlockReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: replBlock when: verifyBlock 
	self searchForTree: aBRProgramNode replaceWith: replBlock.
	verificationBlock := verifyBlock! !

!RBReplaceRule methodsFor: 'matching' stamp: ''!
canMatch: aProgramNode 
	^verificationBlock value: aProgramNode! !

!RBReplaceRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode 
	self subclassResponsibility! !

!RBReplaceRule methodsFor: 'initialize-release' stamp: ''!
initialize
	super initialize.
	verificationBlock := [:aNode | true]! !

RBReplaceRule subclass: #RBStringReplaceRule
	instanceVariableNames: 'replaceTree'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBStringReplaceRule commentStamp: 'md 8/9/2005 14:56' prior: 0!
RBStringReplaceRule replaces a matched tree with another tree (which may include metavariable from the matching tree). This is a very succint syntax for specifying most rewrites.

Instance Variables:
	replaceTree	<RBProgramNode>	The tree to replace the matched tree with.

!

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceString 
	^self new searchFor: searchString replaceWith: replaceString! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchFor: searchString replaceWith: replaceString when: aBlock 
	^self new 
		searchFor: searchString
		replaceWith: replaceString
		when: aBlock! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceString
	^self new searchForMethod: searchString replaceWith: replaceString! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: searchString replaceWith: replaceString when: aBlock 
	^self new 
		searchForMethod: searchString
		replaceWith: replaceString
		when: aBlock! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: searchString replaceWith: replaceString 
	^self new searchForTree: searchString replaceWith: replaceString! !

!RBStringReplaceRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: searchString replaceWith: replaceString when: aBlock 
	^self new 
		searchForTree: searchString
		replaceWith: replaceString
		when: aBlock! !

!RBStringReplaceRule methodsFor: 'matching' stamp: ''!
foundMatchFor: aProgramNode 
	| newTree |
	newTree := replaceTree copyInContext: self context.
	newTree copyCommentsFrom: aProgramNode.
	^newTree! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
methodReplaceString: replaceString 
	replaceTree := RBParser parseRewriteMethod: replaceString! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
replaceString: replaceString 
	replaceTree := RBParser parseRewriteExpression: replaceString.
	searchTree isSequence = replaceTree isSequence 
		ifFalse: 
			[searchTree isSequence 
				ifTrue: [replaceTree := RBSequenceNode statements: (Array with: replaceTree)]
				ifFalse: [searchTree := RBSequenceNode statements: (Array with: searchTree)]]! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: replaceString 
	self searchString: searchString.
	self replaceString: replaceString! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchFor: searchString replaceWith: replaceString when: aBlock 
	self searchFor: searchString replaceWith: replaceString.
	verificationBlock := aBlock! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: replaceString 
	self methodSearchString: searchString.
	self methodReplaceString: replaceString! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: searchString replaceWith: replaceString when: aBlock 
	self searchForMethod: searchString replaceWith: replaceString.
	verificationBlock := aBlock! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: replaceNode 
	searchTree := aBRProgramNode.
	replaceTree := replaceNode! !

!RBStringReplaceRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode replaceWith: replaceString when: aBlock 
	self searchForTree: aBRProgramNode replaceWith: replaceString.
	verificationBlock := aBlock! !

RBParseTreeRule subclass: #RBSearchRule
	instanceVariableNames: 'answerBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBSearchRule commentStamp: 'md 8/9/2005 14:56' prior: 0!
RBSearchRule is a parse tree rule that simply searches for matches to the rule. Every time a match is found, answerBlock is evaluated with the node that matches and the cureent answer. This two-argument approach allows a collection to be formed from all of the matches (Think inject:into:).

Instance Variables:
	answerBlock	<BlockClosure>	Block to evaluate with the matching node and the current answer.

!

!RBSearchRule class methodsFor: 'instance creation' stamp: ''!
searchFor: aString thenDo: aBlock 
	^self new searchFor: aString thenDo: aBlock! !

!RBSearchRule class methodsFor: 'instance creation' stamp: ''!
searchForMethod: aString thenDo: aBlock 
	^self new searchForMethod: aString thenDo: aBlock! !

!RBSearchRule class methodsFor: 'instance creation' stamp: ''!
searchForTree: aBRProgramNode thenDo: aBlock 
	^self new searchForTree: aBRProgramNode thenDo: aBlock! !

!RBSearchRule methodsFor: 'testing' stamp: 'lr 2/14/2009 10:49'!
canMatch: aProgramNode 
	owner answer: (answerBlock reentrant
		value: aProgramNode
		value: owner answer).
	^ true! !

!RBSearchRule methodsFor: 'initialize-release' stamp: ''!
searchFor: aString thenDo: aBlock 
	self searchString: aString.
	answerBlock := aBlock! !

!RBSearchRule methodsFor: 'initialize-release' stamp: ''!
searchForMethod: aString thenDo: aBlock 
	self methodSearchString: aString.
	answerBlock := aBlock! !

!RBSearchRule methodsFor: 'initialize-release' stamp: ''!
searchForTree: aBRProgramNode thenDo: aBlock 
	searchTree := aBRProgramNode.
	answerBlock := aBlock! !

Object subclass: #RBParser
	instanceVariableNames: 'scanner currentToken nextToken errorBlock pragmas source'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Parser'!

!RBParser commentStamp: 'md 8/9/2005 14:54' prior: 0!
RBParser takes a source code string and generates an AST for it. This is a hand-written, recursive descent parser and has been optimized for speed. The simplest way to call this is either 'RBParser parseExpression: aString' if you want the AST for an expression, or 'RBParser parseMethod: aString' if you want to parse an entire method.

Instance Variables:
	currentToken	<RBToken>	The current token being processed.
	emptyStatements	<Boolean>	True if empty statements are allowed. In IBM, they are, in VW they aren't.
	errorBlock	<BlockClosure>	The block to evaluate on a syntax error.
	nextToken	<RBToken>	The next token that will be processed. This allows one-token lookahead.
	scanner	<RBScanner>	The scanner that generates a stream of tokens to parse.
	source	<String>	The source code to parse
	tags	<Collection of: Interval>	The source intervals of the tags appearing at the top of a method (e.g. Primitive calls)

Shared Variables:
	ParserType	<Symbol>	the type code we are parsing!

!RBParser class methodsFor: 'accessing' stamp: 'damiencassou 7/30/2009 11:35'!
format: textOrStream in: aClass notifying: aRequestor 
	
	^ self format: textOrStream in: aClass notifying: aRequestor decorated: true! !

!RBParser class methodsFor: 'accessing' stamp: 'md 7/17/2006 10:39'!
format: textOrStream in: aClass notifying: aRequestor contentsSymbol: aSymbol
	"Compile a parse tree from the argument, textOrStream. Answer a string containing the original code, formatted nicely.  If aBoolean is true, then decorate the resulting text with color and hypertext actions"

	^self format: textOrStream asString in: aClass notifying: aRequestor decorated: (aSymbol == #colorPrint)! !

!RBParser class methodsFor: 'accessing' stamp: 'nk 2/23/2005 18:28'!
format: aString in: anIgnoredClass notifying: aRequester decorated: decorated 
	| parser squeakString node errorBlock |
	squeakString := aString asString withBlanksTrimmed.
	squeakString isEmpty ifTrue: [ ^squeakString ].
	errorBlock := [:message :position | self error: ('{1} at position {2}' format: { message. position}) ].
	parser := self new.
	parser errorBlock: errorBlock.
	parser initializeParserWith: squeakString type: #on:errorBlock:.
	node := parser parseMethod: squeakString.
	^decorated 
		ifTrue: [node colorizedFormattedCode]
		ifFalse: [node formattedCode]! !

!RBParser class methodsFor: 'accessing' stamp: ''!
parseExpression: aString 
	^self parseExpression: aString onError: nil! !

!RBParser class methodsFor: 'accessing' stamp: 'dvf 11/8/2003 15:02'!
parseExpression: aString onError: aBlock 
	| node parser |
	parser := self new.
	parser errorBlock: aBlock.
	parser initializeParserWith: aString type: #on:errorBlock:.
	node := parser parseExpression.
	^(node statements size == 1 and: [node temporaries isEmpty])
		ifTrue: [node statements first]
		ifFalse: [node]! !

!RBParser class methodsFor: 'accessing' stamp: ''!
parseMethod: aString 
	^self parseMethod: aString onError: nil! !

!RBParser class methodsFor: 'accessing' stamp: 'dvf 11/8/2003 04:44'!
parseMethod: aString onError: aBlock 
	| parser squeakString |
	squeakString := aString .
	parser := self new.
	parser errorBlock: aBlock.
	parser initializeParserWith: squeakString type: #on:errorBlock:.
	^parser parseMethod: squeakString! !

!RBParser class methodsFor: 'parsing' stamp: ''!
parseMethodPattern: aString 
	| parser |
	parser := self new.
	parser errorBlock: [:error :position | ^nil].
	parser initializeParserWith: aString type: #on:errorBlock:.
	^parser parseMessagePattern selector! !

!RBParser class methodsFor: 'accessing' stamp: 'bh 3/7/2000 01:35'!
parseMethodWithNoComments: aString 
	^ self parseMethodWithNoComments: aString onError: nil! !

!RBParser class methodsFor: 'accessing' stamp: 'bh 3/7/2000 01:34'!
parseMethodWithNoComments: aString onError: aBlock 
	| parser |
	parser := self new.
	parser errorBlock: aBlock.
	parser initializeParserWith: aString type: #on:errorBlock:.
	^ parser parseMethodWithNoComments: aString! !

!RBParser class methodsFor: 'accessing' stamp: ''!
parseRewriteExpression: aString 
	^self parseRewriteExpression: aString onError: nil! !

!RBParser class methodsFor: 'accessing' stamp: ''!
parseRewriteExpression: aString onError: aBlock 
	| node parser |
	parser := self new.
	parser errorBlock: aBlock.
	parser initializeParserWith: aString type: #rewriteOn:errorBlock:.
	node := parser parseExpression.
	^(node statements size == 1 and: [node temporaries isEmpty])
		ifTrue: [node statements first]
		ifFalse: [node]! !

!RBParser class methodsFor: 'accessing' stamp: ''!
parseRewriteMethod: aString 
	^self parseRewriteMethod: aString onError: nil! !

!RBParser class methodsFor: 'accessing' stamp: ''!
parseRewriteMethod: aString onError: aBlock 
	| parser |
	parser := self new.
	parser errorBlock: aBlock.
	parser initializeParserWith: aString type: #rewriteOn:errorBlock:.
	^parser parseMethod: aString! !

!RBParser methodsFor: 'private' stamp: 'tween 6/29/2006 18:42'!
addCommentsTo: aNode
	| existingComments newComments allComments |
	
	existingComments := aNode comments ifNil:[OrderedCollection new].
	newComments := scanner getComments ifNil:[OrderedCollection new].
	allComments := existingComments, newComments.
	allComments isEmpty ifTrue:[allComments := nil].
	aNode comments: allComments! !

!RBParser methodsFor: 'testing' stamp: ''!
atEnd
	^currentToken class == RBToken! !

!RBParser methodsFor: 'error handling' stamp: ''!
errorBlock
	^errorBlock isNil
		ifTrue: [[:message :position | ]]
		ifFalse: [errorBlock]! !

!RBParser methodsFor: 'accessing' stamp: ''!
errorBlock: aBlock 
	errorBlock := aBlock.
	scanner notNil ifTrue: [scanner errorBlock: aBlock]! !

!RBParser methodsFor: 'error handling' stamp: ''!
errorPosition
	^currentToken start! !

!RBParser methodsFor: 'accessing' stamp: ''!
initializeParserWith: aString type: aSymbol 
	source := aString.
	self scanner: (RBScanner 
				perform: aSymbol
				with: (ReadStream on: aString)
				with: self errorBlock)! !

!RBParser methodsFor: 'private' stamp: ''!
nextToken
	^nextToken isNil
		ifTrue: [nextToken := scanner next]
		ifFalse: [nextToken]! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseArgs
	| args |
	args := OrderedCollection new.
	[currentToken isIdentifier]
		whileTrue: [args add: self parseVariableNode].
	^args! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 16:49'!
parseArray
	"parse Squeak's {} construct"
	| leftBrace node rightBrace |
	leftBrace := currentToken start.
	self step.

	node := RBArrayNode new.
	self parseStatementList: false  into: node.

	(currentToken isSpecial and: [currentToken value == $}]) ifFalse: [
		self parserError: 'expected }' ].

	rightBrace := currentToken start.
	self step.

	node leftBrace: leftBrace rightBrace: rightBrace.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseAssignment
	"Need one token lookahead to see if we have a ':='. This method could 
	make it possible to assign the literals true, false and nil."

	| node position |
	(currentToken isIdentifier and: [self nextToken isAssignment]) 
		ifFalse: [^self parseCascadeMessage].
	node := self parseVariableNode.
	position := currentToken start.
	self step.
	^RBAssignmentNode 
		variable: node
		value: self parseAssignment
		position: position! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseBinaryMessage
	| node |
	node := self parseUnaryMessage.
	
	[currentToken isLiteral ifTrue: [self patchNegativeLiteral].
	currentToken isBinary] 
			whileTrue: [node := self parseBinaryMessageWith: node].
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseBinaryMessageWith: aNode 
	| binaryToken |
	binaryToken := currentToken.
	self step.
	^RBMessageNode 
		receiver: aNode
		selectorParts: (Array with: binaryToken)
		arguments: (Array with: self parseUnaryMessage)! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseBinaryPattern
	| binaryToken |
	currentToken isBinary 
		ifFalse: [self parserError: 'Message pattern expected'].
	binaryToken := currentToken.
	self step.
	^RBMethodNode selectorParts: (Array with: binaryToken)
		arguments: (Array with: self parseVariableNode)! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 14:47'!
parseBinaryPragma
	| binaryToken |
	currentToken isBinary 
		ifFalse: [ self parserError: 'Message pattern expected' ].
	binaryToken := currentToken.
	self step.
	^ RBPragmaNode 
		selectorParts: (Array with: binaryToken)
		arguments: (Array with: self parsePragmaLiteral)! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseBlock
	| position node |
	position := currentToken start.
	self step.
	node := self parseBlockArgsInto: RBBlockNode new.
	node left: position.
	node body: (self parseStatements: false).
	(currentToken isSpecial and: [currentToken value == $]]) 
		ifFalse: [self parserError: ''']'' expected'].
	node right: currentToken start.
	self step.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseBlockArgsInto: node 
	| verticalBar args colons |
	args := OrderedCollection new: 2.
	colons := OrderedCollection new: 2.
	verticalBar := false.
	[currentToken isSpecial and: [currentToken value == $:]] whileTrue: 
			[colons add: currentToken start.
			self step.	":"
			verticalBar := true.
			args add: self parseVariableNode].
	verticalBar 
		ifTrue: 
			[currentToken isBinary 
				ifTrue: 
					[node bar: currentToken start.
					currentToken value == #| 
						ifTrue: [self step]
						ifFalse: 
							[currentToken value == #'||' 
								ifTrue: 
									["Hack the current token to be the start 
									of temps bar"

									currentToken
										value: #|;
										start: currentToken start + 1]
								ifFalse: [self parserError: '''|'' expected']]]
				ifFalse: 
					[(currentToken isSpecial and: [currentToken value == $]]) 
						ifFalse: [self parserError: '''|'' expected']]].
	node
		arguments: args;
		colons: colons.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseCascadeMessage
	| node receiver messages semicolons |
	node := self parseKeywordMessage.
	(currentToken isSpecial 
		and: [currentToken value == $; and: [node isMessage]]) ifFalse: [^node].
	receiver := node receiver.
	messages := OrderedCollection new: 3.
	semicolons := OrderedCollection new: 3.
	messages add: node.
	[currentToken isSpecial and: [currentToken value == $;]] whileTrue: 
			[semicolons add: currentToken start.
			self step.
			messages add: (currentToken isIdentifier 
						ifTrue: [self parseUnaryMessageWith: receiver]
						ifFalse: 
							[currentToken isKeyword 
								ifTrue: [self parseKeywordMessageWith: receiver]
								ifFalse: 
									[| temp |
									currentToken isLiteral ifTrue: [self patchNegativeLiteral].
									currentToken isBinary ifFalse: [self parserError: 'Message expected'].
									temp := self parseBinaryMessageWith: receiver.
									temp == receiver ifTrue: [self parserError: 'Message expected'].
									temp]])].
	^RBCascadeNode messages: messages semicolons: semicolons! !

!RBParser methodsFor: 'accessing' stamp: ''!
parseExpression
	| node |
	node := self parseStatements: false.
	self atEnd ifFalse: [self parserError: 'Unknown input at end'].
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseKeywordMessage
	^self parseKeywordMessageWith: self parseBinaryMessage! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseKeywordMessageWith: node 
	| args isKeyword keywords |
	args := OrderedCollection new: 3.
	keywords := OrderedCollection new: 3.
	isKeyword := false.
	[currentToken isKeyword] whileTrue: 
			[keywords add: currentToken.
			self step.
			args add: self parseBinaryMessage.
			isKeyword := true].
	^isKeyword 
		ifTrue: 
			[RBMessageNode 
				receiver: node
				selectorParts: keywords
				arguments: args]
		ifFalse: [node]! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseKeywordPattern
	| keywords args |
	keywords := OrderedCollection new: 2.
	args := OrderedCollection new: 2.
	[currentToken isKeyword] whileTrue: 
			[keywords add: currentToken.
			self step.
			args add: self parseVariableNode].
	^RBMethodNode selectorParts: keywords arguments: args! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 14:47'!
parseKeywordPragma
	| keywords arguments |
	keywords := OrderedCollection new: 2.
	arguments := OrderedCollection new: 2.
	[ currentToken isKeyword ] whileTrue: [
		keywords addLast: currentToken.
		self step.
		arguments addLast: self parsePragmaLiteral ].
	^ RBPragmaNode selectorParts: keywords arguments: arguments! !

!RBParser methodsFor: 'private-parsing' stamp: 'ms 9/16/2006 20:43'!
parseMessagePattern

	^currentToken isIdentifier
		ifTrue: [self parseUnaryPattern]
		ifFalse: 
			[currentToken isKeyword
				ifTrue: [self parseKeywordPattern]
				ifFalse: [self parseBinaryPattern]]! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 12:23'!
parseMethod
	| methodNode |
	methodNode := self parseMessagePattern.
	self parsePragmas.
	self addCommentsTo: methodNode.
	methodNode body: (self parseStatements: true).
	methodNode pragmas: pragmas.
	^methodNode! !

!RBParser methodsFor: 'accessing' stamp: ''!
parseMethod: aString 
	| node |
	node := self parseMethod.
	self atEnd ifFalse: [self parserError: 'Unknown input at end'].
	node source: aString.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 12:23'!
parseMethodWithNoComments
	| methodNode |
	methodNode := self parseMessagePattern.
	self parsePragmas.
	"self addCommentsTo: methodNode."
	methodNode body: (self parseStatements: true).
	methodNode pragmas: pragmas.
	^ methodNode! !

!RBParser methodsFor: 'accessing' stamp: 'bh 3/7/2000 01:40'!
parseMethodWithNoComments: aString 
	| node |
	node := self parseMethodWithNoComments.
	self atEnd ifFalse: [self parserError: 'Unknown input at end'].
	node source: aString.
	^ node! !

!RBParser methodsFor: 'private-parsing' stamp: 'ls 1/30/2000 18:16'!
parseNegatedNumber
	| token |

	(self nextToken isLiteral not or: [ self nextToken realValue isNumber not ])
		ifTrue: [ self parserError: 'only numbers may be negated' ].

	"create a new token out of the $- and the number"
	token := RBLiteralToken value: (self nextToken realValue negated) start: currentToken start stop: nextToken stop.

	self step.
	self step.


	^RBLiteralNode literalToken: token! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseParenthesizedExpression
	| leftParen node |
	leftParen := currentToken start.
	self step.
	node := self parseAssignment.
	^(currentToken isSpecial and: [currentToken value == $)])
		ifTrue: 
			[node addParenthesis: (leftParen to: currentToken start).
			self step.
			node]
		ifFalse: [self parserError: ''')'' expected']! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parsePatternBlock
	| position node |
	position := currentToken start.
	self step.
	node := self parseBlockArgsInto: RBPatternBlockNode new.
	node left: position.
	node body: (self parseStatements: false).
	(currentToken isSpecial and: [currentToken value == $}]) 
		ifFalse: [self parserError: '''}'' expected'].
	node right: currentToken start.
	self step.
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 12:17'!
parsePragma
	^ currentToken isIdentifier
		ifTrue: [ self parseUnaryPragma ]
		ifFalse: [
			currentToken isKeyword
				ifTrue: [ self parseKeywordPragma ]
				ifFalse: [ self parseBinaryPragma ] ]! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 15:03'!
parsePragmaLiteral
	(currentToken isLiteral or: [ currentToken isIdentifier ])
		ifTrue: [ ^ self parsePrimitiveLiteral ].
	(currentToken isBinary and: [ currentToken value == #- ]) 
		ifTrue: [ ^ self parseNegatedNumber ].
	^ self parserError: 'Literal expected'! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 12:27'!
parsePragmas
	| pragma start |
	[ currentToken isBinary and: [ currentToken value == #< ] ] whileTrue: [
		start := currentToken start.
		self step.
		pragma := self parsePragma.
		(currentToken isBinary and: [ currentToken value == #> ]) 
			ifFalse: [ self parserError: '''>'' expected' ].
		pragma leftBrace: start.
		pragma rightBrace: currentToken start.
		pragmas addLast: pragma.
		self step ]! !

!RBParser methodsFor: 'private-parsing' stamp: 'cmm 4/10/2007 21:18'!
parsePrimitiveIdentifier
	| token |
	token := currentToken.
	self step.
	^RBVariableNode identifierToken: token! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parsePrimitiveLiteral
	| token |
	token := currentToken.
	self step.
	^RBLiteralNode literalToken: token! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 13:55'!
parsePrimitiveObject
	currentToken isIdentifier ifTrue: [^self parsePrimitiveIdentifier].
	currentToken isLiteral ifTrue: [^self parsePrimitiveLiteral].
	currentToken isSpecial ifTrue: 
			[currentToken value == $[ ifTrue: [^self parseBlock].
			currentToken value == $( ifTrue: [^self parseParenthesizedExpression].
			currentToken value == ${ ifTrue: [^self parseArray]].
	(currentToken isBinary and: [ currentToken value == #- ]) 
		ifTrue: [ ^self parseNegatedNumber ].
	currentToken isPatternBlock ifTrue:[^self parsePatternBlock].
	self parserError: 'Variable expected'! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 13:54'!
parseStatementList: tagBoolean into: sequenceNode 
	| statements return periods returnPosition node |
	return := false.
	statements := OrderedCollection new.
	periods := OrderedCollection new.
	self addCommentsTo: sequenceNode.
	tagBoolean ifTrue: [self parsePragmas].
	
	["skip empty statements"
		[currentToken isSpecial and: [currentToken value == $.]] whileTrue: 
			[periods add: currentToken start.
			self step].

		"check if we are finished yet"
	 	self atEnd 
			or: [currentToken isSpecial and: ['])}' includes: currentToken value]]] 
			whileFalse: 
				[return ifTrue: [self parserError: 'End of statement list encounted'].
				(currentToken isSpecial and: [currentToken value == $^]) 
					ifTrue: 
						[returnPosition := currentToken start.
						self step.
						node := RBReturnNode return: returnPosition value: self parseAssignment.
						self addCommentsTo: node.
						statements add: node.
						return := true]
					ifFalse: 
						[node := self parseAssignment.
						self addCommentsTo: node.
						statements add: node].
				(currentToken isSpecial and: [currentToken value == $.]) 
					ifTrue: 
						[periods add: currentToken start.
						self step]
					ifFalse: [return := true].
				].
	statements notEmpty ifTrue: [self addCommentsTo: statements last].
	sequenceNode
		statements: statements;
		periods: periods.
	^sequenceNode! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseStatements: tagBoolean 
	| args leftBar rightBar |
	args := #().
	leftBar := rightBar := nil.
	currentToken isBinary 
		ifTrue: 
			[currentToken value == #| 
				ifTrue: 
					[leftBar := currentToken start.
					self step.
					args := self parseArgs.
					(currentToken isBinary and: [currentToken value = #|]) 
						ifFalse: [self parserError: '''|'' expected'].
					rightBar := currentToken start.
					self step]
				ifFalse: 
					[currentToken value == #'||' 
						ifTrue: 
							[rightBar := (leftBar := currentToken start) + 1.
							self step]]].
	^self parseStatementList: tagBoolean
		into: (RBSequenceNode 
				leftBar: leftBar
				temporaries: args
				rightBar: rightBar)! !

!RBParser methodsFor: 'private-parsing' stamp: 'cmm 10/17/2007 16:56'!
parseUnaryMessage
	| node |
	node := self parsePrimitiveObject.
	
	[currentToken isLiteral ifTrue: [self patchLiteralMessage].
	currentToken isIdentifier] 
			whileTrue: [node := self parseUnaryMessageWith: node].
	^node! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseUnaryMessageWith: aNode 
	| selector |
	selector := currentToken.
	self step.
	^RBMessageNode 
		receiver: aNode
		selectorParts: (Array with: selector)
		arguments: #()! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseUnaryPattern
	| selector |
	selector := currentToken.
	self step.
	^RBMethodNode selectorParts: (Array with: selector) arguments: #()! !

!RBParser methodsFor: 'private-parsing' stamp: 'lr 10/18/2009 12:17'!
parseUnaryPragma
	| selector |
	selector := currentToken.
	self step.
	^ RBPragmaNode selectorParts: (Array with: selector) arguments: #()! !

!RBParser methodsFor: 'private-parsing' stamp: ''!
parseVariableNode
	currentToken isIdentifier 
		ifFalse: [self parserError: 'Variable name expected'].
	^self parsePrimitiveIdentifier! !

!RBParser methodsFor: 'error handling' stamp: ''!
parserError: aString 
	"Evaluate the block. If it returns raise an error"

	self errorBlock value: aString value: self errorPosition.
	self error: aString! !

!RBParser methodsFor: 'private' stamp: 'pmm 7/12/2006 15:24'!
patchLiteralMessage
	currentToken value == true 
		ifTrue: 
			[^currentToken := RBIdentifierToken value: 'true' start: currentToken start].
	currentToken value == false 
		ifTrue: 
			[^currentToken := RBIdentifierToken value: 'false' start: currentToken start].
	currentToken value isNil
		ifTrue: 
			[^currentToken := RBIdentifierToken value: 'nil' start: currentToken start]! !

!RBParser methodsFor: 'private' stamp: 'pmm 7/12/2006 15:14'!
patchNegativeLiteral
	"Handle the special negative number case for binary message sends."

	currentToken value isNumber ifFalse: [^self].
	currentToken value <= 0 ifFalse: [^self].
	currentToken value = 0 
		ifTrue: 
			[(source notNil and: 
					[source isEmpty not 
						and: [(source at: (currentToken start min: source size)) == $-]]) 
				ifFalse: [^self]].
	nextToken := currentToken.
	currentToken := RBBinarySelectorToken value: #- start: nextToken start.
	nextToken value: nextToken value negated.
	nextToken start: nextToken start + 1! !

!RBParser methodsFor: 'initialize-release' stamp: 'lr 10/18/2009 13:55'!
scanner: aScanner 
	scanner := aScanner.
	pragmas := OrderedCollection new.
	self step! !

!RBParser methodsFor: 'private' stamp: ''!
step
	nextToken notNil ifTrue: 
			[currentToken := nextToken.
			nextToken := nil.
			^currentToken].
	currentToken := scanner next! !

Object subclass: #RBProgramNode
	instanceVariableNames: 'parent comments properties'
	classVariableNames: 'FormatterClass'
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBProgramNode commentStamp: 'md 7/6/2007 14:44' prior: 0!
RBProgramNode is an abstract class that represents an abstract syntax tree node in a Smalltalk program.

Subclasses must implement the following messages:
	accessing
		start
		stop
	visitor
		acceptVisitor:

The #start and #stop methods are used to find the source that corresponds to this node. "source copyFrom: self start to: self stop" should return the source for this node.

The #acceptVisitor: method is used by RBProgramNodeVisitors (the visitor pattern). This will also require updating all the RBProgramNodeVisitors so that they know of the new node.

Subclasses might also want to redefine match:inContext: and copyInContext: to do parse tree searching and replacing.

Subclasses that contain other nodes should override equalTo:withMapping: to compare nodes while ignoring renaming temporary variables, and children that returns a collection of our children nodes.

Instance Variables:

	parent	<RBProgramNode>	the node we're contained in

Properties:
	comments	<Collection of: Interval>	the intervals in the source that have comments for this node	

Shared Variables:
	FormatterClass	<Behavior>	the formatter class that is used when we are formatted!

RBProgramNode subclass: #RBDoItNode
	instanceVariableNames: 'body source scope ir byteSurgeon'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBDoItNode class methodsFor: 'instance creation' stamp: 'ajh 3/11/2003 19:08'!
body: aSequenceNode

	^ self new body: aSequenceNode! !

!RBDoItNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:03'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	self body = anObject body ifFalse: [ ^ false ].
	^ true! !

!RBDoItNode methodsFor: 'visitor' stamp: 'ajh 2/26/2003 18:31'!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptDoItNode: self! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
addNode: aNode 
	^body addNode: aNode! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
addReturn
	body addReturn! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
addSelfReturn
	^body addSelfReturn! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ms 7/3/2007 13:39'!
arguments

	^#()! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
body
	^body! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
body: stmtsNode 
	body := stmtsNode.
	body parent: self! !

!RBDoItNode methodsFor: 'accessing' stamp: 'md 6/29/2005 12:21'!
byteSurgeon
	byteSurgeon ifNil: [byteSurgeon := false].
	^byteSurgeon! !

!RBDoItNode methodsFor: 'accessing' stamp: 'md 6/29/2005 12:20'!
byteSurgeon: boolean
	byteSurgeon := boolean.! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:28'!
children
	^ {self body}! !

!RBDoItNode methodsFor: 'matching' stamp: 'ajh 2/26/2003 18:24'!
copyInContext: aDictionary 
	^(self class new)
		body: (body copyInContext: aDictionary);
		source: (aDictionary at: '-source-');
		yourself! !

!RBDoItNode methodsFor: 'comparing' stamp: 'ajh 2/26/2003 18:35'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	(self body equalTo: anObject body withMapping: aDictionary) 
		ifFalse: [^false].
	^self primitiveSources = anObject primitiveSources! !

!RBDoItNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:56'!
freeNames
	"Filter out hidden ones that have space in there name such as 'top env'"

	^ ((self freeVars collect: [:var | var name])
		reject: [:name | name includes: $ ]) asSortedCollection! !

!RBDoItNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:59'!
freeVars
	"Return children variable node bindings that refer to variables outside my scope (ignoring global vars)"

	| freeVars |
	freeVars := Set new.
	scope := self owningScope.
	self nodesDo: [:node | | var |
		(node isVariable or: [node isReturn and: [node binding notNil]]) ifTrue: [
			var := node binding.
			(scope hasOuter: var scope) ifTrue: [
				var isGlobal ifFalse: [
					freeVars add: var]]]].
	^ freeVars! !

!RBDoItNode methodsFor: 'comparing' stamp: 'ajh 2/26/2003 18:36'!
hash
	^ self body hash! !

!RBDoItNode methodsFor: 'testing' stamp: 'ajh 6/29/2004 14:11'!
isDoIt

	^ true! !

!RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'!
isLast: aNode 
	^body isLast: aNode! !

!RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'!
lastIsReturn
	^body lastIsReturn! !

!RBDoItNode methodsFor: 'matching' stamp: 'ajh 2/26/2003 18:28'!
match: aNode inContext: aDictionary 
	self class == aNode class ifFalse: [^false].
	aDictionary at: '-source-' put: aNode source.
	^ body match: aNode body inContext: aDictionary! !

!RBDoItNode methodsFor: 'semantics' stamp: 'ajh 6/30/2004 14:07'!
owningBlock

	^ self! !

!RBDoItNode methodsFor: 'semantics' stamp: 'ajh 3/13/2003 04:25'!
owningScope

	^ scope! !

!RBDoItNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:40'!
postCopy
	super postCopy.
	self body: self body copy! !

!RBDoItNode methodsFor: 'printing' stamp: 'ajh 2/26/2003 18:22'!
printOn: aStream
	aStream nextPutAll: self formattedCode! !

!RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'!
references: aVariableName 
	^body references: aVariableName! !

!RBDoItNode methodsFor: 'replacing' stamp: 'ajh 2/26/2003 18:57'!
replaceNode: aNode withNode: anotherNode
	aNode == body ifTrue: [self body: anotherNode].
! !

!RBDoItNode methodsFor: 'semantics' stamp: 'ajh 3/16/2003 08:33'!
scope

	^ scope ifNil: [
		self verifyIn: nil parseScope.
		scope
	  ]! !

!RBDoItNode methodsFor: 'semantics' stamp: 'ajh 3/17/2003 15:34'!
scope: aSemScope

	scope := aSemScope! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
source
	^source! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
source: anObject
	source := anObject! !

!RBDoItNode methodsFor: 'debugging' stamp: 'ms 11/22/2007 00:20'!
sourceMap
	"Return a mapping from bytecode pcs to source code ranges"

	^ self ir sourceMap 	asSortedCollection! !

!RBDoItNode methodsFor: 'printing' stamp: 'ajh 6/29/2004 14:31'!
sourceText

	^ (self source ifNil: [self formattedCode]) asText! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
start
	^1! !

!RBDoItNode methodsFor: 'accessing' stamp: 'ajh 2/26/2003 18:22'!
stop
	^source size! !

!RBDoItNode methodsFor: 'debugging' stamp: 'ajh 6/29/2004 16:06'!
tempNames
	"All temp names in context order"

	^ self scope tempVars allButFirst "without receiver" collect: [:var | var name]! !

!RBDoItNode methodsFor: 'testing' stamp: 'ajh 2/26/2003 18:22'!
uses: aNode 
	^body == aNode and: [aNode lastIsReturn]! !

RBProgramNode subclass: #RBMethodNode
	instanceVariableNames: 'selector selectorParts body source arguments scope methodProperties ir pragmas'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBMethodNode commentStamp: 'md 4/7/2007 20:16' prior: 0!
RBMethodNode is the AST that represents a Smalltalk method.

Instance Variables:
	arguments	<SequenceableCollection of: RBVariableNode>	the arguments to the method
	body	<BRSequenceNode>	the body/statements of the method
	selector	<Symbol | nil>	the method name (cached)
	selectorParts	<SequenceableCollection of: RBValueToken>	the tokens for the selector keywords
	source	<String>	the source we compiled
			
Properties:			
	tags	<Collection of: Interval>	the source location of any resource/primitive tags

!

!RBMethodNode class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol arguments: variableNodes body: aSequenceNode 
	^(self new)
		arguments: variableNodes;
		selector: aSymbol;
		body: aSequenceNode;
		yourself! !

!RBMethodNode class methodsFor: 'instance creation' stamp: ''!
selector: aSymbol body: aSequenceNode 
	^self 
		selector: aSymbol
		arguments: #()
		body: aSequenceNode! !

!RBMethodNode class methodsFor: 'instance creation' stamp: 'pmm 7/12/2006 15:20'!
selectorParts: tokenCollection arguments: variableNodes 
	^((tokenCollection anySatisfy: [:each | each isPatternVariable]) 
		ifTrue: [RBPatternMethodNode] ifFalse: [RBMethodNode]) 
		new selectorParts: tokenCollection arguments: variableNodes! !

!RBMethodNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:03'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	(self selector = anObject selector
		and: [ self pragmas size = anObject pragmas size
		and: [ self body = anObject body ] ])
			ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	self pragmas with: anObject pragmas do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBMethodNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptMethodNode: self! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
addNode: aNode 
	^body addNode: aNode! !

!RBMethodNode methodsFor: 'accessing' stamp: 'ms 7/26/2006 21:52'!
addPragma: aPragma
	self properties addPragma: aPragma! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
addReturn
	body addReturn! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
addSelfReturn
	^body addSelfReturn! !

!RBMethodNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:13'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	selectorParts do: [:token |
		token start > sourcePos ifTrue: [
			token start: token start + delta]
	].
	super adjustPositionsAfter: sourcePos by: delta.
! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
allArgumentVariables
	^(self argumentNames asOrderedCollection)
		addAll: super allArgumentVariables;
		yourself! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	^(self argumentNames asOrderedCollection) addAll: super allDefinedVariables;
		yourself! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
argumentNames
	^self arguments collect: [:each | each name]! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
arguments
	^arguments! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
arguments: variableNodes 
	arguments := variableNodes.
	arguments do: [:each | each parent: self]! !

!RBMethodNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:31'!
basicFirstToken
	
	^self selectorParts first! !

!RBMethodNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:32'!
basicLastToken
	
	^self body lastToken ifNil:[^(RBPatternMethodNode selectorParts: self selectorParts arguments: self arguments) lastToken]! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
body
	^body! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
body: stmtsNode 
	body := stmtsNode.
	body parent: self! !

!RBMethodNode methodsFor: 'private' stamp: ''!
buildSelector
	| selectorStream |
	selectorStream := WriteStream on: (String new: 50).
	selectorParts do: [:each | selectorStream nextPutAll: each value].
	^selectorStream contents asSymbol! !

!RBMethodNode methodsFor: 'accessing' stamp: 'ms 11/11/2006 19:22'!
children
	^(self arguments copyWith: self body), self pragmas! !

!RBMethodNode methodsFor: 'matching' stamp: 'lr 10/18/2009 13:50'!
copyInContext: aDictionary 
	^ self class new
		selectorParts: (self selectorParts collect: [ :each | each removePositions ]);
		arguments: (self arguments collect: [ :each | each copyInContext: aDictionary ]);
		pragmas: (self pragmas collect: [ :each | each copyInContext: aDictionary ]);
		body: (self body copyInContext: aDictionary);
		source: (aDictionary at: '-source-');
		yourself! !

!RBMethodNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:18'!
defines: aName 
	^arguments anySatisfy: [:each | each name = aName]! !

!RBMethodNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 15:44'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [ ^ false ].
	(self selector = anObject selector
		and: [ self pragmas size = anObject pragmas size
		and: [ self body equalTo: anObject body withMapping: aDictionary ] ]) 
			ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		(first equalTo: second	withMapping: aDictionary)
			ifFalse: [ ^ false ].
		aDictionary removeKey: first name ].
	self pragmas with: anObject pragmas do: [ :first :second |
		(first equalTo: second	withMapping: aDictionary) 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBMethodNode methodsFor: 'comparing' stamp: ''!
hash
	^(self selector hash bitXor: self body hash)
		bitXor: self arguments hash! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	^body isLast: aNode! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
isMethod
	^true! !

!RBMethodNode methodsFor: 'testing' stamp: 'lr 10/17/2009 12:18'!
isPrimitive
	^ self pragmas anySatisfy: [ :each | each isPrimitive ]! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
lastIsReturn
	^body lastIsReturn! !

!RBMethodNode methodsFor: 'accessing-token' stamp: 'ms 4/1/2007 17:34'!
lastTokenOfPatternMethod
	
	^self arguments ifEmpty: [^self selectorParts last] ifNotEmpty: [ ^self arguments last token]! !

!RBMethodNode methodsFor: 'matching' stamp: 'lr 10/18/2009 13:52'!
match: aNode inContext: aDictionary 
	self class == aNode class ifFalse: [ ^ false ].
	aDictionary at: '-source-' put: aNode source.
	self selector == aNode selector ifFalse: [ ^ false ].
	^ (self matchList: arguments against: aNode arguments inContext: aDictionary)
		and: [ (self matchList: self pragmas against: aNode pragmas inContext: aDictionary)
		and: [ body match: aNode body inContext: aDictionary ] ]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'ajh 3/11/2003 19:58'!
methodPatternStop

	^ self arguments isEmpty
		ifTrue: [self selectorParts first stop]
		ifFalse: [self arguments last stop]! !

!RBMethodNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:40'!
postCopy
	super postCopy.
	self body: self body copy.
	self pragmas: (self pragmas collect: [ :each | each copy ]).
	self arguments: (self arguments collect: [ :each | each copy ])! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 12:25'!
pragmas 
	^ pragmas ifNil: [ #() ]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 12:25'!
pragmas: aCollection
	pragmas := aCollection.
	pragmas do: [ :each | each parent: self ]! !

!RBMethodNode methodsFor: 'printing' stamp: ''!
printOn: aStream
	aStream nextPutAll: self formattedCode! !

!RBMethodNode methodsFor: 'accessing' stamp: 'md 4/1/2007 13:32'!
properties
	^methodProperties ifNil: [methodProperties := MethodProperties  new]! !

!RBMethodNode methodsFor: 'accessing' stamp: 'md 4/1/2007 13:32'!
properties: aMethodeProperties 
	methodProperties := aMethodeProperties! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^body references: aVariableName! !

!RBMethodNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	aNode == body ifTrue: [self body: anotherNode].
	self arguments: (arguments 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBMethodNode methodsFor: 'accessing' stamp: 'md 4/7/2007 10:20'!
selector
	^selector isNil
		ifTrue: [selector := self buildSelector]
		ifFalse: [selector]! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
selector: aSelector 
	| keywords numArgs |
	keywords := aSelector keywords.
	numArgs := aSelector numArgs.
	numArgs == arguments size 
		ifFalse: 
			[self 
				error: 'Attempting to assign selector with wrong number of arguments.'].
	selectorParts := numArgs == 0 
				ifTrue: [Array with: (RBIdentifierToken value: keywords first start: nil)]
				ifFalse: 
					[keywords first last == $: 
						ifTrue: [keywords collect: [:each | RBKeywordToken value: each start: nil]]
						ifFalse: [Array with: (RBBinarySelectorToken value: aSelector start: nil)]].
	selector := aSelector! !

!RBMethodNode methodsFor: 'private' stamp: ''!
selectorParts
	^selectorParts! !

!RBMethodNode methodsFor: 'private' stamp: ''!
selectorParts: tokenCollection 
	selectorParts := tokenCollection! !

!RBMethodNode methodsFor: 'initialize-release' stamp: ''!
selectorParts: tokenCollection arguments: variableNodes 
	selectorParts := tokenCollection.
	self arguments: variableNodes! !

!RBMethodNode methodsFor: 'accessing' stamp: 'md 4/7/2007 11:31'!
source
	^source! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
source: anObject
	source := anObject! !

!RBMethodNode methodsFor: 'printing' stamp: 'ajh 2/27/2003 22:44'!
sourceText

	^ (self source ifNil: [self formattedCode]) asText! !

!RBMethodNode methodsFor: 'accessing' stamp: ''!
start
	^1! !

!RBMethodNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:22'!
stop
	^self source size! !

!RBMethodNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	^body == aNode and: [aNode lastIsReturn]! !

RBMethodNode subclass: #RBPatternMethodNode
	instanceVariableNames: 'isList'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBPatternMethodNode commentStamp: 'md 8/9/2005 14:59' prior: 0!
RBPatternMethodNode is a RBMethodNode that will match other method nodes without their selectors being equal. 

Instance Variables:
	isList	<Boolean>	are we matching each keyword or matching all keywords together (e.g., `keyword1: would match a one argument method whereas `@keywords: would match 0 or more arguments)

!

!RBPatternMethodNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:32'!
basicLastToken
	self arguments ifEmpty: [^self selectorParts last] ifNotEmpty: [ ^self arguments last token]! !

!RBPatternMethodNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	| selectors |
	selectors := self isSelectorList 
				ifTrue: [(aDictionary at: selectorParts first value) keywords]
				ifFalse: [selectorParts collect: [:each | aDictionary at: each value]].
	^(RBMethodNode new)
		selectorParts: (selectors collect: 
						[:each | 
						(each last == $: ifTrue: [RBKeywordToken] ifFalse: [RBIdentifierToken]) 
							value: each
							start: nil]);
		arguments: (self copyList: arguments inContext: aDictionary);
		body: (body copyInContext: aDictionary);
		source: (aDictionary at: '-source-');
		yourself! !

!RBPatternMethodNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^true! !

!RBPatternMethodNode methodsFor: 'testing' stamp: ''!
isSelectorList
	^isList! !

!RBPatternMethodNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	aNode class == self matchingClass ifFalse: [^false].
	aDictionary at: '-source-' put: aNode source.
	self isSelectorList ifTrue: 
			[^(aDictionary at: selectorParts first value ifAbsentPut: [aNode selector])
				= aNode selector and: 
						[(aDictionary at: arguments first ifAbsentPut: [aNode arguments])
							= aNode arguments and: [body match: aNode body inContext: aDictionary]]].
	^(self matchArgumentsAgainst: aNode inContext: aDictionary)
		and: [body match: aNode body inContext: aDictionary]! !

!RBPatternMethodNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:45'!
matchArgumentsAgainst: aNode inContext: aDictionary 
	self arguments size == aNode arguments size ifFalse: [^false].
	(self matchSelectorAgainst: aNode inContext: aDictionary) 
		ifFalse: [^false].
	self arguments with: aNode arguments do: [ :first :second |
		(first match: second inContext: aDictionary)
			ifFalse: [^false]].
	^true! !

!RBPatternMethodNode methodsFor: 'matching' stamp: ''!
matchSelectorAgainst: aNode inContext: aDictionary 
	| keyword |
	1 to: selectorParts size
		do: 
			[:i | 
			keyword := selectorParts at: i.
			(aDictionary at: keyword value
				ifAbsentPut: 
					[keyword isPatternVariable 
						ifTrue: [(aNode selectorParts at: i) value]
						ifFalse: [keyword value]]) 
					= (aNode selectorParts at: i) value ifFalse: [^false]].
	^true! !

!RBPatternMethodNode methodsFor: 'private' stamp: ''!
matchingClass
	^RBMethodNode! !

!RBPatternMethodNode methodsFor: 'initialize-release' stamp: ''!
selectorParts: tokenCollection arguments: variableNodes 
	super selectorParts: tokenCollection arguments: variableNodes.
	isList := (tokenCollection first value at: 2) == self listCharacter! !

RBProgramNode subclass: #RBPragmaNode
	instanceVariableNames: 'leftBrace rightBrace selector selectorParts arguments'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBPragmaNode class methodsFor: 'instance creation' stamp: 'lr 10/13/2009 14:21'!
selectorParts: keywordTokens arguments: valueNodes 
	^ self new selectorParts: keywordTokens arguments: valueNodes ! !

!RBPragmaNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 15:49'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	self selector = anObject selector ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPragmaNode methodsFor: 'visitor' stamp: 'lr 10/13/2009 14:01'!
acceptVisitor: aProgramNodeVisitor 
	^ aProgramNodeVisitor acceptPragmaNode: self! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 12:14'!
arguments
	^ arguments ifNil: [ #() ]! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/13/2009 14:01'!
arguments: aLiteralCollection 
	arguments := aLiteralCollection.
	arguments do: [ :each | each parent: self ]! !

!RBPragmaNode methodsFor: 'querying' stamp: 'lr 10/13/2009 13:53'!
bestNodeFor: anInterval 
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	selectorParts do: 
			[:each | 
			((anInterval first between: each start and: each stop) 
				or: [each start between: anInterval first and: anInterval last]) 
					ifTrue: [^self]].
	self children do: 
			[:each | 
			| node |
			node := each bestNodeFor: anInterval.
			node notNil ifTrue: [^node]]! !

!RBPragmaNode methodsFor: 'private' stamp: 'lr 10/13/2009 13:54'!
buildSelector
	| selectorStream |
	selectorStream := WriteStream on: (String new: 50).
	selectorParts do: [:each | selectorStream nextPutAll: each value].
	^selectorStream contents asSymbol! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/13/2009 13:54'!
children
	^ Array withAll: self arguments! !

!RBPragmaNode methodsFor: 'matching' stamp: 'lr 10/13/2009 13:58'!
copyInContext: aDictionary 
	^ self class new
		selectorParts: (selectorParts collect: [ :each | each removePositions ]);
		arguments: (arguments collect: [ :each | each copyInContext: aDictionary ]);
		yourself! !

!RBPragmaNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 15:43'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [ ^ false ].
	self selector = anObject selector ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		(first equalTo: second	withMapping: aDictionary) 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBPragmaNode methodsFor: 'comparing' stamp: 'lr 10/13/2009 13:57'!
hash
	^ self selector hash bitXor: self arguments hash! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/13/2009 14:00'!
isBinary
	^ (self isUnary or: [self isKeyword]) not! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/13/2009 14:00'!
isKeyword
	^ selectorParts first value last == $:! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/13/2009 14:00'!
isPragma
	^ true! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/18/2009 12:26'!
isPrimitive
	^ #(primitive: primitive:module:) includes: self selector! !

!RBPragmaNode methodsFor: 'testing' stamp: 'lr 10/13/2009 14:01'!
isUnary
	^ arguments isEmpty! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/13/2009 14:22'!
leftBrace
	^ leftBrace! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 12:13'!
leftBrace: anInteger
	leftBrace := anInteger! !

!RBPragmaNode methodsFor: 'matching' stamp: 'lr 10/18/2009 15:32'!
match: aNode inContext: aDictionary 
	aNode class = self class ifFalse: [ ^ false ].
	self selector = aNode selector ifFalse: [ ^ false ].
	1 to: arguments size do: [ :index | 
		((arguments at: index) match: (aNode arguments at: index)
			inContext: aDictionary) ifFalse: [ ^ false ] ].
	^ true! !

!RBPragmaNode methodsFor: 'copying' stamp: 'lr 10/13/2009 13:57'!
postCopy
	super postCopy.
	self arguments: (self arguments
		collect: [ :each | each copy ])! !

!RBPragmaNode methodsFor: 'replacing' stamp: 'lr 10/13/2009 14:00'!
replaceNode: aNode withNode: anotherNode 
	self arguments: (arguments collect: [ :each | 
		each == aNode 
			ifTrue: [ anotherNode ]
			ifFalse: [ each ] ])! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/13/2009 14:22'!
rightBrace
	^ rightBrace! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 12:13'!
rightBrace: anInteger
	rightBrace := anInteger! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/13/2009 13:55'!
selector
	^ selector ifNil: [ selector := self buildSelector ]! !

!RBPragmaNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:44'!
selector: aSelector 
	| keywords numArgs |
	keywords := aSelector keywords.
	numArgs := aSelector numArgs.
	numArgs == arguments size 
		ifFalse: 
			[self 
				error: 'Attempting to assign selector with wrong number of arguments.'].
	selectorParts := numArgs == 0 
				ifTrue: [Array with: (RBIdentifierToken value: keywords first start: nil)]
				ifFalse: 
					[keywords first last == $: 
						ifTrue: [keywords collect: [:each | RBKeywordToken value: each start: nil]]
						ifFalse: [Array with: (RBBinarySelectorToken value: aSelector start: nil)]].
	selector := aSelector! !

!RBPragmaNode methodsFor: 'private' stamp: 'lr 10/13/2009 13:54'!
selectorParts
	^selectorParts! !

!RBPragmaNode methodsFor: 'private' stamp: 'lr 10/13/2009 13:54'!
selectorParts: tokenCollection 
	selectorParts := tokenCollection! !

!RBPragmaNode methodsFor: 'initialize-release' stamp: 'lr 10/13/2009 14:21'!
selectorParts: keywordTokens arguments: valueNodes 
	selectorParts := keywordTokens.
	self arguments: valueNodes! !

!RBProgramNode class methodsFor: 'accessing' stamp: 'nk 1/29/2005 10:25'!
colorFormatterClass
	^Smalltalk at: #RBColorFormatter ifAbsent: [ self formatterClass ]! !

!RBProgramNode class methodsFor: 'accessing' stamp: ''!
formatterClass
	^FormatterClass isNil ifTrue: [RBFormatter] ifFalse: [FormatterClass]! !

!RBProgramNode class methodsFor: 'accessing' stamp: ''!
formatterClass: aClass 
	FormatterClass := aClass! !

!RBProgramNode class methodsFor: 'accessing' stamp: 'md 10/11/2005 15:08'!
initialize
	"self initialize"

	Preferences 
		addPreference: #useRBASTForPrettyPrint
		categories: #(#browsing )
		default: false
		balloonHelp: 'if set, the RB AST formatter will be used for pretty-printing'! !

!RBProgramNode class methodsFor: 'accessing' stamp: 'lr 2/28/2009 21:57'!
optimizedSelectors
	^ #( and: caseOf: caseOf:otherwise: ifFalse: ifFalse:ifTrue: ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: ifTrue: ifTrue:ifFalse: or: to:by:do: to:do: whileFalse whileFalse: whileTrue whileTrue: )
	
! !

!RBProgramNode class methodsFor: 'accessing' stamp: 'md 10/11/2005 15:09'!
unload
	Preferences removePreference: #useRBASTForPrettyPrint ! !

!RBProgramNode methodsFor: 'visitor' stamp: 'rr 4/10/2004 16:54'!
acceptVisitor: aProgramNodeVisitor 
	"self subclassResponsibility"! !

!RBProgramNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:09'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	self children do: [:node |
		node adjustPositionsAfter: sourcePos by: delta]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
allArgumentVariables
	| children |
	children := self children.
	children isEmpty ifTrue: [^#()].
	^children inject: OrderedCollection new
		into: 
			[:vars :each | 
			vars
				addAll: each allArgumentVariables;
				yourself]! !

!RBProgramNode methodsFor: 'iterating' stamp: 'bh 3/13/2000 01:48'!
allChildren

	^self children inject:(OrderedCollection new addAll:self children; yourself) into:[:answer :child| answer addAll:child allChildren; yourself].! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	| children |
	children := self children.
	children isEmpty ifTrue: [^#()].
	^children inject: OrderedCollection new
		into: 
			[:vars :each | 
			vars addAll: each allDefinedVariables;
				yourself]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
allTemporaryVariables
	| children |
	children := self children.
	children isEmpty ifTrue: [^#()].
	^children inject: OrderedCollection new
		into: 
			[:vars :each | 
			vars
				addAll: each allTemporaryVariables;
				yourself]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
asReturn
	"Change the current node to a return node."

	parent isNil ifTrue: [self error: 'Cannot change to a return without a parent node.'].
	parent isSequence ifFalse: [self error: 'Parent node must be a sequence node.'].
	(parent isLast: self)
		ifFalse: [self error: 'Return node must be last.'].
	^parent addReturn! !

!RBProgramNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:20'!
assigns: aVariableName 
	^self children anySatisfy: [:each | each assigns: aVariableName]! !

!RBProgramNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:28'!
basicFirstToken

	^self subclassResponsibility! !

!RBProgramNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:29'!
basicLastToken

	^self subclassResponsibility! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
bestNodeFor: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	selectedChildren := self children 
				select: [:each | each intersectsInterval: anInterval].
	^selectedChildren size == 1 
		ifTrue: [selectedChildren first bestNodeFor: anInterval]
		ifFalse: [self]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
blockVariables
	^parent isNil
		ifTrue: [#()]
		ifFalse: [parent blockVariables]! !

!RBProgramNode methodsFor: 'testing-matching' stamp: 'pmm 7/12/2006 16:06'!
canMatchMethod: aCompiledMethod 
	^self sentMessages allSatisfy: [:each | 
		(self class optimizedSelectors includes: each) 
			or: [aCompiledMethod refersToLiteral: each]].! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
cascadeListCharacter
	^$;! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
children
	^#()! !

!RBProgramNode methodsFor: 'enumeration' stamp: ''!
collect: aBlock 
	"Hacked to fit collection protocols"

	^aBlock value: self! !

!RBProgramNode methodsFor: 'accessing' stamp: 'nk 1/29/2005 10:24'!
colorFormatterClass
	^self class colorFormatterClass! !

!RBProgramNode methodsFor: 'accessing' stamp: 'nk 1/29/2005 10:23'!
colorizedFormattedCode
	^self colorFormatterClass new format: self! !

!RBProgramNode methodsFor: 'accessing' stamp: 'md 4/6/2007 20:02'!
comment
	
	^ self comments isEmpty
		ifTrue: [nil]
		ifFalse: [self comments first]! !

!RBProgramNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:19'!
comments
	^ comments ifNil: [ #() ]! !

!RBProgramNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:19'!
comments: aCollection
	comments := aCollection! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
containedBy: anInterval 
	^anInterval first <= self start and: [anInterval last >= self stop]! !

!RBProgramNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:21'!
containsReturn
	^self children anySatisfy: [:each | each containsReturn]! !

!RBProgramNode methodsFor: 'copying' stamp: ''!
copyCommentsFrom: aNode 
	"Add all comments from aNode to us. If we already have the comment, then don't add it."

	| newComments |
	newComments := OrderedCollection new.
	aNode nodesDo: [:each | newComments addAll: each comments].
	self nodesDo: 
			[:each | 
			each comments do: [:comment | newComments remove: comment ifAbsent: []]].
	newComments isEmpty ifTrue: [^self].
	newComments := newComments asSortedCollection: [:a :b | a first < b first].
	self comments: newComments! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary
	^self copy! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
copyList: matchNodes inContext: aDictionary 
	| newNodes |
	newNodes := OrderedCollection new.
	matchNodes do: 
			[:each | 
			| object |
			object := each copyInContext: aDictionary.
			newNodes addAll: object].
	^newNodes! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:17'!
debugHighlightStart

	^ self start! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:18'!
debugHighlightStop

	^ self stop! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/15/2003 14:57'!
decompileString

	^ self formattedCode! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
defines: aName
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode
	^true! !

!RBProgramNode methodsFor: 'enumeration' stamp: ''!
do: aBlock 
	"Hacked to fit collection protocols"

	aBlock value: self! !

!RBProgramNode methodsFor: 'comparing' stamp: ''!
equalTo: aNode exceptForVariables: variableNameCollection 
	| dictionary |
	dictionary := Dictionary new.
	(self equalTo: aNode withMapping: dictionary) ifFalse: [^false].
	dictionary keysAndValuesDo: 
			[:key :value | 
			(key = value or: [variableNameCollection includes: key]) ifFalse: [^false]].
	^true! !

!RBProgramNode methodsFor: 'comparing' stamp: ''!
equalTo: aNode withMapping: aDictionary 
	^self = aNode! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
evaluatedFirst: aNode 
	self children do: 
			[:each | 
			each == aNode ifTrue: [^true].
			each isImmediate ifFalse: [^false]].
	^false! !

!RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'!
firstToken

	^self propertyAt: #firstToken ifAbsent: [self basicFirstToken].! !

!RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'!
firstToken: aToken

	self propertyAt: #firstToken put: aToken.! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
formattedCode
	^self formatterClass new format: self! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
formatterClass
	^self class formatterClass! !

!RBProgramNode methodsFor: 'testing' stamp: 'pmm 9/24/2005 10:53'!
hasParent
	^self parent notNil! !

!RBProgramNode methodsFor: 'properties' stamp: 'lr 10/18/2009 17:19'!
hasProperty: aKey
	"Test if the property aKey is present."
	
	^ properties notNil and: [ properties includesKey: aKey ]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
intersectsInterval: anInterval 
	^(anInterval first between: self start and: self stop) 
		or: [self start between: anInterval first and: anInterval last]! !

!RBProgramNode methodsFor: 'testing' stamp: 'ajh 2/25/2003 14:34'!
isArray
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isAssignment
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isBlock
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isCascade
	^false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/4/2003 00:50'!
isCaseBranch

	^ false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isDirectlyUsed
	"This node is directly used as an argument, receiver, or part of an assignment."

	^parent isNil
		ifTrue: [false]
		ifFalse: [parent directlyUses: self]! !

!RBProgramNode methodsFor: 'testing' stamp: 'ajh 6/29/2004 14:12'!
isDoIt

	^ false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'!
isDup

	^ false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isEvaluatedFirst
	"Return true if we are the first thing evaluated in this statement."

	^parent isNil or: [parent isSequence or: [parent evaluatedFirst: self]]! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'!
isGoto

	^ false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/1/2003 20:12'!
isIf

	^ false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isImmediate
	^false! !

!RBProgramNode methodsFor: 'inline' stamp: 'ajh 2/25/2003 19:48'!
isInline

	^ false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'!
isLabel

	^ false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	| children |
	children := self children.
	^children isEmpty not and: [children last == aNode]! !

!RBProgramNode methodsFor: 'testing-matching' stamp: ''!
isList
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isLiteral
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: 'ajh 3/3/2003 22:28'!
isLiteral: valueTestBlock
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isMessage
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isMethod
	^false! !

!RBProgramNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/2/2003 23:22'!
isPop

	^ false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/3/2003 18:42'!
isPseudo

	^ false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ajh 3/23/2003 22:23'!
isPseudoSend

	^ false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isReturn
	^false! !

!RBProgramNode methodsFor: 'decompiling' stamp: 'ms 7/12/2007 13:19'!
isSend

	^ false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isSequence
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: 'ms 8/6/2007 08:08'!
isTemp

	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isUsed
	"Answer true if this node could be used as part of another expression. For example, you could use the 
	result of this node as a receiver of a message, an argument, the right part of an assignment, or the 
	return value of a block. This differs from isDirectlyUsed in that it is conservative since it also includes 
	return values of blocks."

	^parent isNil
		ifTrue: [false]
		ifFalse: [parent uses: self]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isValue
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
isVariable
	^false! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
lastIsReturn
	^self isReturn! !

!RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'!
lastToken

	^self propertyAt: #lastToken ifAbsent: [self basicLastToken].! !

!RBProgramNode methodsFor: 'accessing-token' stamp: 'md 4/6/2007 20:14'!
lastToken: aToken

	self propertyAt: #lastToken put: aToken.! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
listCharacter
	^$@! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
literalCharacter
	^$#! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	^self = aNode! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
matchList: matchNodes against: programNodes inContext: aDictionary 
	^self
		matchList: matchNodes
		index: 1
		against: programNodes
		index: 1
		inContext: aDictionary! !

!RBProgramNode methodsFor: 'matching' stamp: ''!
matchList: matchNodes index: matchIndex against: programNodes index: programIndex inContext: aDictionary 
	| node currentIndex currentDictionary nodes |
	matchNodes size < matchIndex ifTrue: [^programNodes size < programIndex].
	node := matchNodes at: matchIndex.
	node isList 
		ifTrue: 
			[currentIndex := programIndex - 1.
			
			[currentDictionary := aDictionary copy.
			programNodes size < currentIndex or: 
					[nodes := programNodes copyFrom: programIndex to: currentIndex.
					(currentDictionary at: node ifAbsentPut: [nodes]) = nodes and: 
							[(self 
								matchList: matchNodes
								index: matchIndex + 1
								against: programNodes
								index: currentIndex + 1
								inContext: currentDictionary) 
									ifTrue: 
										[currentDictionary keysAndValuesDo: [:key :value | aDictionary at: key put: value].
										^true].
							false]]] 
					whileFalse: [currentIndex := currentIndex + 1].
			^false].
	programNodes size < programIndex ifTrue: [^false].
	(node match: (programNodes at: programIndex) inContext: aDictionary) 
		ifFalse: [^false].
	^self 
		matchList: matchNodes
		index: matchIndex + 1
		against: programNodes
		index: programIndex + 1
		inContext: aDictionary! !

!RBProgramNode methodsFor: 'querying' stamp: 'nk 2/24/2005 14:28'!
methodNode
	(parent isNil or: [self isMethod]) ifTrue: [^self].
	^parent methodNode! !

!RBProgramNode methodsFor: 'iterating' stamp: ''!
nodesDo: aBlock 
	aBlock value: self.
	self children do: [:each | each nodesDo: aBlock]! !

!RBProgramNode methodsFor: 'semantics' stamp: 'ajh 6/30/2004 14:08'!
owningBlock

	^ parent owningBlock! !

!RBProgramNode methodsFor: 'semantics' stamp: 'ajh 3/13/2003 04:19'!
owningScope

	^ parent owningScope! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
parent
	^parent! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
parent: anObject
	parent := anObject! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
precedence
	^6! !

!RBProgramNode methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream nextPutAll: self class name;
		nextPut: $(;
		nextPutAll: self formattedCode;
		nextPut: $)! !

!RBProgramNode methodsFor: 'properties' stamp: 'md 3/29/2007 14:48'!
propertyAt: aKey
	"Answer the property value associated with aKey."
	
	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ].! !

!RBProgramNode methodsFor: 'properties' stamp: 'lr 10/18/2009 17:19'!
propertyAt: aKey ifAbsent: aBlock
	"Answer the property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
	
	properties isNil ifTrue: [ ^ aBlock value ].
	^ properties at: aKey ifAbsent: aBlock! !

!RBProgramNode methodsFor: 'properties' stamp: 'md 3/29/2007 14:48'!
propertyAt: aKey ifAbsentPut: aBlock
	"Answer the property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
	
	^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ].! !

!RBProgramNode methodsFor: 'properties' stamp: 'lr 10/18/2009 17:18'!
propertyAt: aKey put: anObject
	"Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."

	properties ifNil: [ properties :=  RBSmallIdentityDictionary new: 1 ].
	^ properties at: aKey put: anObject! !

!RBProgramNode methodsFor: 'testing-matching' stamp: ''!
recurseInto
	^false! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
recurseIntoCharacter
	^$`! !

!RBProgramNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:21'!
references: aVariableName 
	^self children anySatisfy: [:each | each references: aVariableName]! !

!RBProgramNode methodsFor: 'replacing' stamp: ''!
removeDeadCode
	self children do: [:each | each removeDeadCode]! !

!RBProgramNode methodsFor: 'properties' stamp: 'md 3/29/2007 14:51'!
removeProperty: aKey
	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
	
	^ self removeProperty: aKey ifAbsent: [ self error: 'Property not found' ].! !

!RBProgramNode methodsFor: 'properties' stamp: 'lr 10/18/2009 17:19'!
removeProperty: aKey ifAbsent: aBlock
	"Remove the property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
	
	| answer |
	properties isNil ifTrue: [ ^ aBlock value ].
	answer := properties removeKey: aKey ifAbsent: aBlock.
	properties isEmpty ifTrue: [ properties := nil ].
	^ answer! !

!RBProgramNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	self error: 'I don''t store other nodes'! !

!RBProgramNode methodsFor: 'replacing' stamp: ''!
replaceWith: aNode 
	parent isNil ifTrue: [self error: 'This node doesn''t have a parent'].
	parent replaceNode: self withNode: aNode! !

!RBProgramNode methodsFor: 'querying' stamp: 'ajh 2/27/2003 22:40'!
root

	^ parent
		ifNil: [self]
		ifNotNil: [parent root]! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
selfMessages
	| searcher |
	searcher := ParseTreeSearcher new.
	searcher matches: 'self `@msg: ``@args'
		do: 
			[:aNode :answer | 
			answer
				add: aNode selector;
				yourself].
	^searcher executeTree: self initialAnswer: Set new! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
sentMessages
	| messages |
	messages := Set new.
	self children do: [:each | messages addAll: each sentMessages].
	^messages! !

!RBProgramNode methodsFor: 'accessing' stamp: 'ms 6/17/2007 02:45'!
sequenceDefinedIn
	^ self parent sequenceDefinedIn! !

!RBProgramNode methodsFor: 'printing' stamp: 'md 7/28/2006 15:25'!
shortPrintOn: aStream 
		aStream nextPutAll: self formattedCode.! !

!RBProgramNode methodsFor: 'enumeration' stamp: ''!
size
	"Hacked to fit collection protocols"

	^1! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
source
	^parent notNil ifTrue: [parent source] ifFalse: [nil]! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
sourceInterval
	^self start to: self stop! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
start
	self subclassResponsibility! !

!RBProgramNode methodsFor: 'meta variable-accessing' stamp: ''!
statementCharacter
	^$.! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
statementNode
	"Return your topmost node that is contained by a sequence node."

	(parent isNil or: [parent isSequence]) ifTrue: [^self].
	^parent statementNode! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
stop
	self subclassResponsibility! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
superMessages
	| searcher |
	searcher := ParseTreeSearcher new.
	searcher matches: 'super `@msg: ``@args'
		do: 
			[:aNode :answer | 
			answer
				add: aNode selector;
				yourself].
	^searcher executeTree: self initialAnswer: Set new! !

!RBProgramNode methodsFor: 'accessing' stamp: ''!
temporaryVariables
	^parent isNil
		ifTrue: [#()]
		ifFalse: [parent temporaryVariables]! !

!RBProgramNode methodsFor: 'testing' stamp: ''!
uses: aNode
	^true! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
whichNodeIsContainedBy: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	selectedChildren := self children 
				select: [:each | each intersectsInterval: anInterval].
	^selectedChildren size == 1 
		ifTrue: [selectedChildren first whichNodeIsContainedBy: anInterval]
		ifFalse: [nil]! !

!RBProgramNode methodsFor: 'querying' stamp: ''!
whoDefines: aName 
	^(self defines: aName)
		ifTrue: [self]
		ifFalse: [parent notNil
				ifTrue: [parent whoDefines: aName]
				ifFalse: [nil]]! !

RBProgramNode subclass: #RBPseudoNode
	instanceVariableNames: 'mapInstr'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoNode commentStamp: 'ajh 6/27/2004 15:13' prior: 0!
Used by IRDecompiler to represent intermediate nodes that eventually get reduced to real parse nodes.!

RBPseudoNode subclass: #RBPseudoBlockNode
	instanceVariableNames: 'block successor arguments'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 11/17/2004 12:20'!
arguments
	^arguments! !

!RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 11/17/2004 12:20'!
arguments: aCollection
	arguments := aCollection! !

!RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:58'!
block
	^ block.! !

!RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:59'!
block: aSeqNum
	block := aSeqNum.! !

!RBPseudoBlockNode methodsFor: 'testing' stamp: 'md 10/21/2004 15:01'!
isBlock
	^true.! !

!RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:59'!
successor
	^successor.! !

!RBPseudoBlockNode methodsFor: 'accessing' stamp: 'md 10/21/2004 14:59'!
successor: aSeqNum
	successor := aSeqNum.! !

RBPseudoNode subclass: #RBPseudoDupNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoDupNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:24'!
isDup

	^ true! !

RBPseudoNode subclass: #RBPseudoGotoNode
	instanceVariableNames: 'destination forValue'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'!
destination

	^ destination! !

!RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/9/2003 13:44'!
destination: seqNum

	destination := seqNum! !

!RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/20/2003 01:16'!
forValue
	"true if sequence before me is for value, false if for effect"

	^ forValue and: [self isRet not]! !

!RBPseudoGotoNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/4/2003 22:18'!
forValue: boolean
	"true if sequence before me is for value, false if for effect"

	forValue := boolean! !

!RBPseudoGotoNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:23'!
isGoto

	^ true! !

!RBPseudoGotoNode methodsFor: 'testing' stamp: 'ajh 3/20/2003 19:05'!
isRet
	"is return"

	^ self destination = #return! !

RBPseudoNode subclass: #RBPseudoIfNode
	instanceVariableNames: 'boolean destination otherwise'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'!
boolean

	^ boolean! !

!RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/1/2003 23:08'!
boolean: bool

	boolean := bool! !

!RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'!
destination

	^ destination! !

!RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/9/2003 13:45'!
destination: seqNum

	destination := seqNum! !

!RBPseudoIfNode methodsFor: 'testing' stamp: 'ajh 3/1/2003 20:13'!
isIf

	^ true! !

!RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:20'!
otherwise

	^ otherwise! !

!RBPseudoIfNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/2/2003 23:19'!
otherwise: instructionSequence

	otherwise := instructionSequence! !

RBPseudoNode subclass: #RBPseudoLabelNode
	instanceVariableNames: 'destination'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoLabelNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/3/2003 21:21'!
destination

	^ destination! !

!RBPseudoLabelNode methodsFor: 'as yet unclassified' stamp: 'ajh 3/9/2003 13:45'!
destination: seqNum

	destination := seqNum! !

!RBPseudoLabelNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:23'!
isLabel

	^ true! !

!RBPseudoNode methodsFor: 'visitor' stamp: 'ajh 3/17/2003 00:25'!
acceptVisitor: aProgramNodeVisitor
	^ aProgramNodeVisitor acceptPseudoNode: self! !

!RBPseudoNode methodsFor: 'testing' stamp: 'md 10/21/2004 15:01'!
isBlock
	^false.! !

!RBPseudoNode methodsFor: 'testing' stamp: 'ajh 3/3/2003 18:41'!
isPseudo

	^ true! !

!RBPseudoNode methodsFor: 'accessing' stamp: 'ajh 3/20/2003 17:20'!
mapInstr

	^ mapInstr! !

!RBPseudoNode methodsFor: 'accessing' stamp: 'ajh 3/20/2003 17:19'!
mapInstr: irInstr

	mapInstr := irInstr! !

RBPseudoNode subclass: #RBPseudoPopNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoPopNode methodsFor: 'testing' stamp: 'ajh 3/2/2003 23:23'!
isPop

	^ true! !

RBPseudoNode subclass: #RBPseudoSendNode
	instanceVariableNames: 'selector arguments'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-NodesExt'!

!RBPseudoSendNode methodsFor: 'accessing' stamp: 'md 11/15/2004 18:07'!
arguments
	^arguments! !

!RBPseudoSendNode methodsFor: 'accessing' stamp: 'md 11/15/2004 18:07'!
arguments: aCollection
	arguments:= aCollection.! !

!RBPseudoSendNode methodsFor: 'testing' stamp: 'ajh 3/23/2003 22:23'!
isPseudoSend

	^ true! !

!RBPseudoSendNode methodsFor: 'testing' stamp: 'ms 7/12/2007 13:20'!
isSend

	^ true! !

!RBPseudoSendNode methodsFor: 'accessing' stamp: 'ajh 3/23/2003 22:23'!
selector

	^ selector! !

!RBPseudoSendNode methodsFor: 'accessing' stamp: 'ajh 3/23/2003 22:23'!
selector: aSelector

	selector := aSelector! !

RBProgramNode subclass: #RBReturnNode
	instanceVariableNames: 'return value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBReturnNode commentStamp: 'md 7/6/2007 11:56' prior: 0!
RBReturnNode is an AST node that represents a return expression.

Instance Variables:
	value	<RBValueNode>	the value that is being returned

properties:

	#return	<Integer>	the position of the ^ character
!

!RBReturnNode class methodsFor: 'instance creation' stamp: ''!
return: returnInteger value: aValueNode 
	^self new return: returnInteger value: aValueNode! !

!RBReturnNode class methodsFor: 'instance creation' stamp: ''!
value: aNode
	^self return: nil value: aNode! !

!RBReturnNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:02'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	^ self value = anObject value! !

!RBReturnNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptReturnNode: self! !

!RBReturnNode methodsFor: 'replacing' stamp: 'md 7/6/2007 11:59'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	self return: self return + delta.
	super adjustPositionsAfter: sourcePos by: delta.
! !

!RBReturnNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:34'!
basicFirstToken
	
	^self value firstToken! !

!RBReturnNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:34'!
basicLastToken
	
	^self value lastToken! !

!RBReturnNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:57'!
binding

	^  self homeBinding! !

!RBReturnNode methodsFor: 'accessing' stamp: ''!
children
	^Array with: value! !

!RBReturnNode methodsFor: 'testing' stamp: ''!
containsReturn
	^true! !

!RBReturnNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	^(self class new) value: (value copyInContext: aDictionary); yourself! !

!RBReturnNode methodsFor: 'comparing' stamp: ''!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	^self value equalTo: anObject value withMapping: aDictionary! !

!RBReturnNode methodsFor: 'comparing' stamp: ''!
hash
	^self value hash! !

!RBReturnNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:41'!
homeBinding

	^ self propertyAt: #binding ifAbsent: [nil].! !

!RBReturnNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:42'!
homeBinding: aSemVar

	aSemVar ifNil: [^self removeProperty: #binding ifAbsent: []].
	self propertyAt: #binding put: aSemVar.! !

!RBReturnNode methodsFor: 'testing' stamp: ''!
isReturn
	^true! !

!RBReturnNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	aNode class == self class ifFalse: [^false].
	^value match: aNode value inContext: aDictionary! !

!RBReturnNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:34'!
postCopy
	super postCopy.
	self value: self value copy! !

!RBReturnNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	value == aNode ifTrue: [self value: anotherNode]! !

!RBReturnNode methodsFor: 'initialize-release' stamp: 'lr 10/18/2009 15:35'!
return: returnInteger value: aValueNode 
	return := returnInteger.
	self value: aValueNode! !

!RBReturnNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 15:36'!
start
	^ return! !

!RBReturnNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 15:36'!
stop
	^ value stop! !

!RBReturnNode methodsFor: 'accessing' stamp: ''!
value
	^value! !

!RBReturnNode methodsFor: 'accessing' stamp: ''!
value: valueNode 
	value := valueNode.
	value parent: self! !

RBProgramNode subclass: #RBSequenceNode
	instanceVariableNames: 'leftBar rightBar statements periods temporaries'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBSequenceNode commentStamp: 'md 4/7/2007 20:30' prior: 0!
RBSequenceNode is an AST node that represents a sequence of statements. Both RBBlockNodes and RBMethodNodes contain these.

Instance Variables:
	statements	<SequenceableCollection of: RBStatementNode>	the statement nodes
	temporaries	<SequenceableCollection of: RBVariableNode>	the temporaries defined
			
Properties:
	leftBar	<Integer | nil>	the position of the left | in the temporaries definition
	rightBar	<Integer | nil>	the position of the right | in the temporaries definition
	periods	<SequenceableCollection of: Integer>	the positions of all the periods that separate the statements

!

!RBSequenceNode class methodsFor: 'instance creation' stamp: ''!
leftBar: leftInteger temporaries: variableNodes rightBar: rightInteger 
	^self new
		leftBar: leftInteger
		temporaries: variableNodes
		rightBar: rightInteger! !

!RBSequenceNode class methodsFor: 'instance creation' stamp: ''!
statements: statementNodes 
	^self temporaries: #() statements: statementNodes! !

!RBSequenceNode class methodsFor: 'instance creation' stamp: ''!
temporaries: variableNodes statements: statementNodes 
	^(self new)
		temporaries: variableNodes;
		statements: statementNodes;
		yourself! !

!RBSequenceNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:02'!
= anObject 
	"Can't send = to the temporaries and statements collection since they might change from arrays to OCs"

	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	self temporaries size = anObject temporaries size ifFalse: [ ^ false ].
	self statements size = anObject statements size ifFalse: [ ^ false ].
	self temporaries with: anObject temporaries do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	self statements with: anObject statements do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBSequenceNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptSequenceNode: self! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addNode: aNode 
	aNode parent: self.
	(statements isEmpty not and: [statements last isReturn])
		ifTrue: [self error: 'Cannot add statement after return node'].
	statements := statements asOrderedCollection add: aNode; yourself! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'pmm 9/19/2005 17:54'!
addNode: aNode after: anotherNode 
	| index |
	index := self indexOfNode: anotherNode.
	index = 0 ifTrue: [^self addNode: aNode].
	statements := (statements asOrderedCollection)
				add: aNode afterIndex: index;
				yourself.
	aNode parent: self! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addNode: aNode before: anotherNode 
	| index |
	index := self indexOfNode: anotherNode.
	index = 0 ifTrue: [^self addNode: aNode].
	statements := (statements asOrderedCollection)
				add: aNode beforeIndex: index;
				yourself.
	aNode parent: self! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addNodeFirst: aNode 
	aNode parent: self.
	statements := (statements asOrderedCollection)
				addFirst: aNode;
				yourself! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addNodes: aCollection 
	aCollection do: [:each | each parent: self].
	(statements isEmpty not and: [statements last isReturn]) 
		ifTrue: [self error: 'Cannot add statement after return node'].
	statements := (statements asOrderedCollection)
				addAll: aCollection;
				yourself! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'pmm 9/24/2005 10:52'!
addNodes: aCollection after: anotherNode 
	aCollection inject: anotherNode into: [ :node :each |
		self addNode: each after: node.
		each ]! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addNodes: aCollection before: anotherNode 
	aCollection do: [:each | self addNode: each before: anotherNode]! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addNodesFirst: aCollection 
	aCollection do: [:each | each parent: self].
	statements := (statements asOrderedCollection)
				addAllFirst: aCollection;
				yourself! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
addReturn
	| node |
	statements isEmpty ifTrue: [^nil].
	statements last isReturn ifTrue: [^statements last].
	node := RBReturnNode value: statements last.
	statements at: statements size put: node.
	node parent: self.
	^node! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addSelfReturn
	| node |
	self lastIsReturn ifTrue: [^self].
	node := RBReturnNode value: (RBVariableNode named: 'self').
	self addNode: node! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: ''!
addTemporariesNamed: aCollection 
	aCollection do: [:each | self addTemporaryNamed: each]! !

!RBSequenceNode methodsFor: 'adding nodes' stamp: 'md 4/14/2007 00:59'!
addTemporaryNamed: aString 
	| variableNode |
	variableNode := RBVariableNode named: aString.
	variableNode parent: self.
	temporaries := self temporaries copyWith: variableNode! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	^(self temporaryNames asOrderedCollection) addAll: super allDefinedVariables;
		yourself! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
allTemporaryVariables
	^(self temporaryNames asOrderedCollection)
		addAll: super allTemporaryVariables;
		yourself! !

!RBSequenceNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:35'!
basicFirstToken
	
	self temporaries 
			ifEmpty: [self statements 
							ifEmpty:[^nil] 
							ifNotEmpty:[| stat | 
				     					stat := OrderedCollection newFrom: self statements.
					 					[stat first firstToken = nil] 
												whileTrue: [stat removeFirst.
															stat ifEmpty:[^nil]].
										^stat first firstToken]]
			ifNotEmpty: [^self temporaries first firstToken]! !

!RBSequenceNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:36'!
basicLastToken
	
	self statements 
		ifEmpty:[self temporaries 
						ifEmpty:[^nil]
						ifNotEmpty:[^self temporaries last lastToken]] 
		ifNotEmpty:[ | stat | 
				      stat := OrderedCollection newFrom: self statements.
					 [stat last lastToken = nil] 
							whileTrue: [stat removeLast.
										stat ifEmpty:[self temporaries 
														ifEmpty:[^nil]
														ifNotEmpty:[^self temporaries last lastToken]]].
					^stat last lastToken]! !

!RBSequenceNode methodsFor: 'querying' stamp: 'md 4/14/2007 00:57'!
bestNodeFor: anInterval 
	| node |
	node := super bestNodeFor: anInterval.
	node == self 
		ifTrue: 
			[(self temporaries isEmpty and: [statements size == 1]) 
				ifTrue: [^statements first]].
	^node! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
children
	^(OrderedCollection new) addAll: self temporaries;
		addAll: self statements;
		yourself! !

!RBSequenceNode methodsFor: 'matching' stamp: 'md 4/14/2007 00:59'!
copyInContext: aDictionary 
	^(self class new)
		temporaries: (self copyList: self temporaries inContext: aDictionary);
		statements: (self copyList: statements inContext: aDictionary);
		yourself! !

!RBSequenceNode methodsFor: 'testing' stamp: 'md 4/14/2007 00:58'!
defines: aName 
	^self temporaries anySatisfy: [:each | each name = aName]! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^false! !

!RBSequenceNode methodsFor: 'comparing' stamp: 'pmm 7/13/2006 18:38'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	self statements size == anObject statements size ifFalse: [^false].
	self statements with: anObject statements do: [ :first :second |
		(first equalTo: second withMapping: aDictionary)
			ifFalse: [^false]].
	aDictionary values asSet size = aDictionary size ifFalse: [^false].	"Not a one-to-one mapping"
	self temporaries
		do: [:each | aDictionary removeKey: each name ifAbsent: []].
	^true! !

!RBSequenceNode methodsFor: 'comparing' stamp: ''!
hash
	^self temporaries hash bitXor: (self statements isEmpty
			ifTrue: [0]
			ifFalse: [self statements first hash])! !

!RBSequenceNode methodsFor: 'private' stamp: ''!
indexOfNode: aNode 
	"Try to find the node by first looking for ==, and then for ="

	^(1 to: statements size) detect: [:each | (statements at: each) == aNode]
		ifNone: [statements indexOf: aNode]! !

!RBSequenceNode methodsFor: 'initialize-release' stamp: 'lr 4/8/2009 14:45'!
initialize
	super initialize.
	self temporaries: #().
	self statements: #()! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'ms 9/4/2007 01:50'!
isEmpty

	^self statements isEmpty 
		or:[self statements size = 1 
			and:[self statements first isLiteral]
			and:[self statements first value = nil]]! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	| last |
	statements isEmpty ifTrue: [^false].
	last := statements last.
	^last == aNode or: [last isMessage and: [(#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: last selector)
				and: [last arguments inject: false into: [:bool :each | bool or: [each isLast: aNode]]]]]! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
isSequence
	^true! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
lastIsReturn
	^statements isEmpty not and: [statements last lastIsReturn]! !

!RBSequenceNode methodsFor: 'initialize-release' stamp: 'lr 10/18/2009 15:07'!
leftBar: leftToken temporaries: variableNodes rightBar: rightToken
	leftBar := leftToken.
	self temporaries: variableNodes.
	rightBar := rightToken! !

!RBSequenceNode methodsFor: 'matching' stamp: 'md 4/6/2007 22:49'!
match: aNode inContext: aDictionary 
	self class == aNode class ifFalse: [^false].
	^(self matchList: self temporaries
		against: aNode temporaries
		inContext: aDictionary) and: 
				[self matchList: statements
					against: aNode statements
					inContext: aDictionary]! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 15:06'!
periods: aCollection
	periods := aCollection! !

!RBSequenceNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:40'!
postCopy
	super postCopy.
	self temporaries: (self temporaries 
		collect: [ :each | each copy ]).
	self statements: (statements
		collect: [ :each | each copy ])! !

!RBSequenceNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:21'!
references: aVariableName 
	^statements anySatisfy: [:each | each references: aVariableName]! !

!RBSequenceNode methodsFor: 'replacing' stamp: 'md 8/2/2005 22:25'!
removeDeadCode
	(self isUsed ifTrue: [statements size - 1] ifFalse: [statements size]) 
		to: 1
		by: -1
		do: [:i | (statements at: i) isImmediate ifTrue: [statements removeAt: i]].
	super removeDeadCode! !

!RBSequenceNode methodsFor: 'replacing' stamp: ''!
removeNode: aNode
	self replaceNode: aNode withNodes: #()! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/14/2007 01:00'!
removeTemporaryNamed: aName 
	temporaries := temporaries reject: [:each | each name = aName].
	temporaries isEmpty ifTrue: [temporaries := nil].! !

!RBSequenceNode methodsFor: 'replacing' stamp: 'md 4/14/2007 00:57'!
replaceNode: aNode withNode: anotherNode 
	self statements: (statements 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]]).
	self temporaries: (self temporaries 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]]).
	anotherNode parent: self! !

!RBSequenceNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNodes: aCollection 
	| index newStatements |
	index := self indexOfNode: aNode.
	newStatements := OrderedCollection new: statements size + aCollection size.
	1 to: index - 1 do: [:i | newStatements add: (statements at: i)].
	newStatements addAll: aCollection.
	index + 1 to: statements size
		do: [:i | newStatements add: (statements at: i)].
	aCollection do: [:each | each parent: self].
	statements := newStatements! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'ms 6/17/2007 02:44'!
sequenceDefinedIn

	^self! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 15:08'!
start
	^leftBar isNil 
		ifTrue: [statements isEmpty ifTrue: [1] ifFalse: [statements first start]]
		ifFalse: [leftBar]! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
statements
	^statements! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
statements: stmtCollection 
	statements := stmtCollection.
	statements do: [:each | each parent: self]! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 15:08'!
stop
	^(periods isEmpty
		ifTrue: [0]
		ifFalse: [periods last])
		max: (statements isEmpty
				ifTrue: [0]
				ifFalse: [statements last stop])! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/6/2007 14:03'!
temporaries
	^temporaries ifNil: [#()].! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
temporaries: tempCollection 
	temporaries := tempCollection.
	temporaries do: [:each | each parent: self]! !

!RBSequenceNode methodsFor: 'accessing' stamp: 'md 4/8/2007 17:50'!
temporaryNames
	^self temporaries collect: [:each | each name]! !

!RBSequenceNode methodsFor: 'accessing' stamp: ''!
temporaryVariables
	^(super temporaryVariables asOrderedCollection) addAll: self temporaryNames;
		yourself! !

!RBSequenceNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	statements isEmpty ifTrue: [^false].
	aNode == statements last ifFalse: [^false].
	^self isUsed! !

!RBSequenceNode methodsFor: 'querying' stamp: 'md 4/14/2007 00:57'!
whichNodeIsContainedBy: anInterval 
	| node |
	node := super whichNodeIsContainedBy: anInterval.
	node == self 
		ifTrue: 
			[(self temporaries isEmpty and: [statements size == 1]) 
				ifTrue: [^statements first]].
	^node! !

RBProgramNode subclass: #RBValueNode
	instanceVariableNames: 'parentheses'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBValueNode commentStamp: 'md 7/6/2007 14:22' prior: 0!
RBValueNode is an abstract class that represents a node that returns some value.

Subclasses must implement the following messages:
	accessing
		startWithoutParentheses
		stopWithoutParentheses
	testing
		needsParenthesis

Properties:
	#parentheses	<SequenceableCollection of: Inteval>	the positions of the parethesis around this node. We need a collection of intervals for stupid code such as "((3 + 4))" that has multiple parethesis around the same expression.

!

RBValueNode subclass: #RBArrayNode
	instanceVariableNames: 'leftBrace rightBrace statements'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBArrayNode class methodsFor: 'instance creation' stamp: 'ls 1/23/2000 23:56'!
leftBrace: leftBrace  rightBrace: rightBrace  statements: statements
	^self new leftBrace: leftBrace  rightBrace: rightBrace  statements: statements! !

!RBArrayNode class methodsFor: 'instance creation' stamp: 'ajh 3/4/2003 02:03'!
statements: statements
	^ self new statements: statements! !

!RBArrayNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:07'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	self statements size = anObject statements size ifFalse: [ ^ false ].
	self statements with: anObject statements do: [ :first :second |
		first = second
			ifFalse: [ ^ false ] ].
	^ true! !

!RBArrayNode methodsFor: 'visitor' stamp: 'ajh 3/17/2003 00:25'!
acceptVisitor: aProgramNodeVisitor
	^ aProgramNodeVisitor acceptArrayNode: self! !

!RBArrayNode methodsFor: 'replacing' stamp: 'md 4/7/2007 21:03'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	self leftBrace: self leftBrace + delta.
	self rightBrace: self rightBrace + delta.
	super adjustPositionsAfter: sourcePos by: delta.
! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:36'!
basicFirstToken

	self statements 
		ifEmpty:[^nil] 
		ifNotEmpty:[| stat | 
		     		stat := self statements copy.
			 		[stat first firstToken = nil] 
							whileTrue: [stat removeFirst.
										stat ifEmpty:[^nil]].
					^stat first firstToken]! !

!RBArrayNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:37'!
basicLastToken

	self statements 
		ifEmpty:[^nil] 
		ifNotEmpty:[ | stat | 
				      stat := OrderedCollection newFrom: self statements.
					 [stat last lastToken = nil] 
							whileTrue: [stat removeLast.
										stat ifEmpty:[^nil]].
					^stat last lastToken]! !

!RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:00'!
children
	^statements! !

!RBArrayNode methodsFor: 'matching' stamp: 'lr 10/18/2009 16:16'!
copyInContext: aDictionary 
	^ self class statements: (self copyList: statements inContext: aDictionary)! !

!RBArrayNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:15'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class 
		ifFalse: [ ^ false ].
	self statements size = anObject statements size 
		ifFalse: [ ^ false ].
	self statements with: anObject statements do: [ :first :second |
		(first equalTo: second withMapping: aDictionary)
			ifFalse: [ ^ false ] ].
	aDictionary values asSet size = aDictionary size 
		ifFalse: [ ^ false ].
	^ true! !

!RBArrayNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:14'!
hash
	^ self statements isEmpty ifTrue: [ 0 ] ifFalse: [ self statements first hash ]! !

!RBArrayNode methodsFor: 'testing' stamp: 'lr 10/18/2009 16:11'!
isArray
	^ true! !

!RBArrayNode methodsFor: 'testing' stamp: 'ls 1/24/2000 00:28'!
lastIsReturn
	statements isEmpty ifTrue:[ ^false ].
	^statements last lastIsReturn! !

!RBArrayNode methodsFor: 'initialization' stamp: 'lr 10/18/2009 16:49'!
leftBrace: leftBrace0  rightBrace: rightBrace0
	leftBrace := leftBrace0.
	rightBrace := rightBrace0! !

!RBArrayNode methodsFor: 'initialization' stamp: 'lr 10/18/2009 16:47'!
leftBrace: leftBrace0  rightBrace: rightBrace0  statements: statements0
	leftBrace := leftBrace0.
	rightBrace := rightBrace0.
	self statements: statements0.! !

!RBArrayNode methodsFor: 'matching' stamp: 'lr 10/18/2009 16:16'!
match: aNode inContext: aDictionary 
	aNode class == self class ifFalse: [ ^ false ].
	^ self matchList: statements against: aNode statements inContext: aDictionary! !

!RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:02'!
periods: periods
	"ignored"! !

!RBArrayNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:38'!
postCopy
	super postCopy.
	self statements: (self statements
		collect: [ :each | each copy ])! !

!RBArrayNode methodsFor: 'accessing' stamp: 'nk 3/3/2005 09:47'!
precedence
	^0! !

!RBArrayNode methodsFor: 'replacing' stamp: 'lr 6/6/2008 16:15'!
replaceNode: oldNode  withNode: newNode
	self statements: (statements collect: [ :statement |
		statement == oldNode 
			ifTrue: [ newNode ]
			ifFalse: [ statement ] ])! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 16:47'!
start
	^ leftBrace! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 16:48'!
startWithoutParentheses 
	^ self start! !

!RBArrayNode methodsFor: 'accessing' stamp: 'ls 1/24/2000 00:32'!
statements
	^statements! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 6/6/2008 16:16'!
statements: statements0 
	statements := statements0.
	statements do: [:statement | statement parent: self]! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 16:47'!
stop
	^ rightBrace! !

!RBArrayNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 16:48'!
stopWithoutParentheses 
	^ self stop! !

RBValueNode subclass: #RBAssignmentNode
	instanceVariableNames: 'variable position value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBAssignmentNode commentStamp: 'md 7/6/2007 11:55' prior: 0!
RBAssignmentNode is an AST node for assignment statements

Instance Variables:
	value	<RBValueNode>	the value that we're assigning
	variable	<RBVariableNode>	the variable being assigned

properties:

	#position	<Integer>	position of the :=
!

!RBAssignmentNode class methodsFor: 'accessing default' stamp: 'ms 7/27/2007 15:07'!
defaultAssignmentOperator

	^':='! !

!RBAssignmentNode class methodsFor: 'instance creation' stamp: ''!
variable: aVariableNode value: aValueNode 
	^self 
		variable: aVariableNode
		value: aValueNode
		position: nil! !

!RBAssignmentNode class methodsFor: 'instance creation' stamp: ''!
variable: aVariableNode value: aValueNode position: anInteger 
	^self new
		variable: aVariableNode
		value: aValueNode
		position: anInteger! !

!RBAssignmentNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:06'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	^ self variable = anObject variable and: [ self value = anObject value ]! !

!RBAssignmentNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptAssignmentNode: self! !

!RBAssignmentNode methodsFor: 'accessing' stamp: 'ms 7/27/2007 15:46'!
assignmentOperator

	^ self firstToken 
		ifNotNil:[self firstToken next 
			ifNotNil:[ self firstToken next next value] 
			ifNil:[self defaultAssignmentOperator]] 
		ifNil:[self defaultAssignmentOperator].! !

!RBAssignmentNode methodsFor: 'testing' stamp: ''!
assigns: aVariableName 
	^variable name = aVariableName or: [value assigns: aVariableName]! !

!RBAssignmentNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:38'!
basicFirstToken
	
	^self variable firstToken! !

!RBAssignmentNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:38'!
basicLastToken
	
	^self value lastToken! !

!RBAssignmentNode methodsFor: 'querying' stamp: 'md 7/6/2007 11:49'!
bestNodeFor: anInterval 
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	self position isNil ifTrue: [^super bestNodeFor: anInterval].
	((anInterval first between: self position and: self position + 1) 
		or: [self position between: anInterval first and: anInterval last]) 
			ifTrue: [^self].
	self children do: 
			[:each | 
			| node |
			node := each bestNodeFor: anInterval.
			node notNil ifTrue: [^node]]! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
children
	^Array with: value with: variable! !

!RBAssignmentNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	^(self class new) variable: (variable copyInContext: aDictionary);
		value: (value copyInContext: aDictionary);
		yourself! !

!RBAssignmentNode methodsFor: 'accessing default' stamp: 'ms 7/27/2007 15:06'!
defaultAssignmentOperator

	^self class defaultAssignmentOperator! !

!RBAssignmentNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^aNode = value ifTrue: [true] ifFalse: [self isDirectlyUsed]! !

!RBAssignmentNode methodsFor: 'comparing' stamp: ''!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	^(self variable equalTo: anObject variable withMapping: aDictionary)
		and: [self value equalTo: anObject value withMapping: aDictionary]! !

!RBAssignmentNode methodsFor: 'comparing' stamp: ''!
hash
	^self variable hash bitXor: self value hash! !

!RBAssignmentNode methodsFor: 'testing' stamp: ''!
isAssignment
	^true! !

!RBAssignmentNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	aNode class == self class ifFalse: [^false].
	^(variable match: aNode variable inContext: aDictionary)
		and: [value match: aNode value inContext: aDictionary]! !

!RBAssignmentNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:24'!
position
	^ position! !

!RBAssignmentNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:38'!
postCopy
	super postCopy.
	self variable: self variable copy.
	self value: self value copy! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
precedence
	^5! !

!RBAssignmentNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	value == aNode ifTrue: [self value: anotherNode].
	variable == aNode ifTrue: [self variable: anotherNode]! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^variable start! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
stopWithoutParentheses
	^value stop! !

!RBAssignmentNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	^aNode = value ifTrue: [true] ifFalse: [self isUsed]! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
value
	^value! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
value: aValueNode 
	value := aValueNode.
	value parent: self! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
variable
	^variable! !

!RBAssignmentNode methodsFor: 'accessing' stamp: ''!
variable: varNode 
	variable := varNode.
	variable parent: self! !

!RBAssignmentNode methodsFor: 'initialize-release' stamp: 'lr 10/18/2009 17:23'!
variable: aVariableNode value: aValueNode position: anInteger 
	self variable: aVariableNode.
	self value: aValueNode.
	position := anInteger! !

RBValueNode subclass: #RBBlockNode
	instanceVariableNames: 'left right colons body arguments bar'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBBlockNode commentStamp: 'md 4/7/2007 21:09' prior: 0!
RBBlockNode is an AST node that represents a block "[...]".

Instance Variables:
	arguments	<SequenceableCollection of: RBVariableNode>	the arguments for the block
	body	<RBSequenceNode>	the code inside the block

		
Properties: 
	bar	<Integer | nil>	position of the | after the arguments
	colons	<SequenceableCollection of: Integer>	positions of each : before each argument
	left	<Integer>	position of [
	right	<Integer>	position of ]
		

!

!RBBlockNode class methodsFor: 'instance creation' stamp: ''!
arguments: argNodes body: sequenceNode 
	^(self new)
		arguments: argNodes;
		body: sequenceNode;
		yourself! !

!RBBlockNode class methodsFor: 'instance creation' stamp: ''!
body: sequenceNode 
	^self arguments: #() body: sequenceNode! !

!RBBlockNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:06'!
= anObject
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	self arguments size = anObject arguments size 	ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		first = second
			ifFalse: [ ^ false ] ].
	^ self body = anObject body ! !

!RBBlockNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptBlockNode: self! !

!RBBlockNode methodsFor: 'replacing' stamp: 'md 4/7/2007 20:20'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	self left: self left + delta.
	self right: self right + delta.
	super adjustPositionsAfter: sourcePos by: delta.
! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
allArgumentVariables
	^(self argumentNames asOrderedCollection)
		addAll: super allArgumentVariables;
		yourself! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
allDefinedVariables
	^(self argumentNames asOrderedCollection) addAll: super allDefinedVariables;
		yourself! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
argumentNames
	^self arguments collect: [:each | each name]! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
arguments
	^arguments! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
arguments: argCollection 
	arguments := argCollection.
	arguments do: [:each | each parent: self]! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:11'!
bar
	^ bar! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:11'!
bar: anInteger
	bar := anInteger! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'!
basicFirstToken
	
	self arguments ifEmpty: [^self body firstToken] ifNotEmpty: [^self arguments first firstToken]! !

!RBBlockNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'!
basicLastToken
	
	^self body lastToken ifNil:[ self arguments ifEmpty:[^nil] ifNotEmpty:[^self arguments last firstToken]]! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
blockVariables
	| vars |
	vars := super blockVariables asOrderedCollection.
	vars addAll: self argumentNames.
	^vars! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
body
	^body! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
body: stmtsNode 
	body := stmtsNode.
	body parent: self! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
children
	^self arguments copyWith: self body! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:12'!
colons: anObject
	colons := anObject! !

!RBBlockNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	^(self class new)
		arguments: (self copyList: arguments inContext: aDictionary);
		body: (body copyInContext: aDictionary);
		yourself! !

!RBBlockNode methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:17'!
defines: aName 
	^arguments anySatisfy: [:each | each name = aName]! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^false! !

!RBBlockNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:39'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	self arguments size = anObject arguments size ifFalse: [^false].
	self arguments with: anObject arguments do: [ :first :second |
		(first equalTo: second withMapping: aDictionary)
			ifFalse: [^false]].
	(self body equalTo: anObject body withMapping: aDictionary)
		ifFalse: [^false].
	self arguments do: [:each | aDictionary removeKey: each name].
	^true! !

!RBBlockNode methodsFor: 'semantics' stamp: 'ajh 7/8/2004 20:56'!
freeNames
	"Filter out hidden ones that have space in there name such as 'top env'"

	^ ((self freeVars collect: [:var | var name])
		reject: [:name | name includes: $ ]) asSortedCollection! !

!RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:43'!
freeVars
	"Return children variable node bindings that refer to variables outside my scope (ignoring global vars)"

	| freeVars |
	freeVars := Set new.
	self scope: self owningScope.
	self nodesDo: [:node | | var |
		(node isVariable or: [node isReturn and: [node binding notNil]]) ifTrue: [
			var := node binding.
			(self scope hasOuter: var scope) ifTrue: [
				var isGlobal ifFalse: [
					freeVars add: var]]]].
	^ freeVars! !

!RBBlockNode methodsFor: 'comparing' stamp: ''!
hash
	^self arguments hash bitXor: self body hash! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
isBlock
	^true! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
isImmediate
	^true! !

!RBBlockNode methodsFor: 'inline' stamp: 'ajh 3/13/2003 02:43'!
isInlined

	(parent isMessage and: [parent isInlineAndOr]) ifTrue: [^ true].
	(parent isMessage and: [parent isInlineIf]) ifTrue: [^ true].
	(parent isMessage and: [parent isInlineIfNil]) ifTrue: [^ true].
	(parent isMessage and: [parent isInlineToDo]) ifTrue: [^ true].
	(parent isMessage and: [parent isInlineWhile]) ifTrue: [^ true].
	(parent isMessage and: [parent parent isArray and: [parent parent parent isMessage and: [parent parent parent isInlineCase]]]) ifTrue: [^ true].
	(parent isMessage and: [parent isInlineCase]) ifTrue: [^ true].  "otherwise branch"
	^ false! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
isLast: aNode 
	^body isLast: aNode! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:12'!
left
	^ left! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:12'!
left: anInteger
	left := anInteger! !

!RBBlockNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	aNode class == self class ifFalse: [^false].
	^(self matchList: arguments
		against: aNode arguments
		inContext: aDictionary)
			and: [body match: aNode body inContext: aDictionary]! !

!RBBlockNode methodsFor: 'semantics' stamp: 'ajh 6/30/2004 14:07'!
owningBlock

	^ self! !

!RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:44'!
owningScope

	^ self scope ifNil: ["inlined" ^ parent owningScope]! !

!RBBlockNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:39'!
postCopy
	super postCopy.
	self arguments: (self arguments
		collect: [ :each | each copy ]).
	self body: self body copy! !

!RBBlockNode methodsFor: 'accessing' stamp: ''!
precedence
	^0! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^body references: aVariableName! !

!RBBlockNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	body == aNode ifTrue: [self body: anotherNode].
	self arguments: (arguments 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:12'!
right
	^ right! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:12'!
right: anInteger
	right := anInteger! !

!RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:44'!
scope

	^ self propertyAt: #scope ifAbsent: [nil].! !

!RBBlockNode methodsFor: 'semantics' stamp: 'md 4/3/2007 13:44'!
scope: aSemClosureScope

	aSemClosureScope ifNil: [^self removeProperty: #scope ifAbsent: []].
	self propertyAt: #scope put: aSemClosureScope.! !

!RBBlockNode methodsFor: 'debugging' stamp: 'ms 11/22/2007 00:20'!
sourceMap
	"Return a mapping from bytecode pcs to source code ranges"

	^ self ir sourceMap asSortedCollection! !

!RBBlockNode methodsFor: 'printing' stamp: 'ajh 3/17/2003 09:12'!
sourceText

	| text |
	self parent ifNil: [^ self formattedCode asText].
	text := [self root sourceText]
		on: Error
		do: [^ self formattedCode asText].
	text addAttribute: TextColor gray from: 1 to: self start - 1.
	text addAttribute: TextColor gray from: self stop + 1 to: text size.
	^ text! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:12'!
startWithoutParentheses
	^ left! !

!RBBlockNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:12'!
stopWithoutParentheses
	^ right! !

!RBBlockNode methodsFor: 'debugging' stamp: 'md 4/6/2007 11:06'!
tempNames
	"All temp names in context order"

	^self scope isNil
		ifFalse: [ self scope tempVars allButFirst "without self" collect: [:var | var name] ]
		ifTrue: [ #() ]! !

!RBBlockNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	aNode = body ifFalse: [^false].
	^parent isMessage
		ifTrue: [(#(#ifTrue:ifFalse: #ifTrue: #ifFalse: #ifFalse:ifTrue:) includes: parent selector) not or: [parent isUsed]]
		ifFalse: [self isUsed]! !

RBBlockNode subclass: #RBPatternBlockNode
	instanceVariableNames: 'valueBlock'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBPatternBlockNode commentStamp: 'md 8/9/2005 14:56' prior: 0!
RBPatternBlockNode is the node in matching parse trees (it never occurs in normal Smalltalk code) that executes a block to determine if a match occurs. valueBlock takes two arguments, the first is the actual node that we are trying to match against, and second node is the dictionary that contains all the metavariable bindings that the matcher has made thus far.

Instance Variables:
	valueBlock	<BlockClosure>	The block to execute when attempting to match this to a node.

!

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
addArgumentWithNameBasedOn: aString 
	| name index vars |
	name := aString.
	vars := self allDefinedVariables.
	index := 0.
	[vars includes: name] whileTrue: 
			[index := index + 1.
			name := name , index printString].
	arguments := arguments copyWith: (RBVariableNode named: name)! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	^self replacingBlock value: aDictionary! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'nk 2/26/2005 11:05'!
createBlock
	| source |
	source := self formattedCode.
	^Compiler evaluate: source for: self logged: false! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:25'!
createMatchingBlock
	self arguments size > 2 
		ifTrue: 
			[self 
				error: 'Search blocks can only contain arguments for the node and matching dictionary'].
	self arguments isEmpty 
		ifTrue: [self error: 'Search blocks must contain one argument for the node'].
	self arguments size = 1 
		ifTrue: [self addArgumentWithNameBasedOn: 'aDictionary'].
	^self createBlock! !

!RBPatternBlockNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:25'!
createReplacingBlock
	self arguments size > 1 
		ifTrue: 
			[self 
				error: 'Replace blocks can only contain an argument for the matching dictionary'].
	self arguments isEmpty 
		ifTrue: [self addArgumentWithNameBasedOn: 'aDictionary'].
	^self createBlock! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	^self matchingBlock value: aNode value: aDictionary! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
matchingBlock
	^valueBlock isNil 
		ifTrue: [valueBlock := self createMatchingBlock]
		ifFalse: [valueBlock]! !

!RBPatternBlockNode methodsFor: 'matching' stamp: ''!
replacingBlock
	^valueBlock isNil 
		ifTrue: [valueBlock := self createReplacingBlock]
		ifFalse: [valueBlock]! !

!RBPatternBlockNode methodsFor: 'accessing' stamp: ''!
sentMessages
	^OrderedCollection new! !

RBValueNode subclass: #RBCascadeNode
	instanceVariableNames: 'messages semicolons'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBCascadeNode commentStamp: 'md 4/7/2007 12:56' prior: 0!
RBCascadeNode is an AST node for cascaded messages (e.g., "self print1 ; print2").

Instance Variables:
	messages	<SequenceableCollection of: RBMessageNode>	the messages 

Properties:			
   #semicolons <SequenceableCollection of: Integer>	positions of the ; between messages

!

!RBCascadeNode class methodsFor: 'instance creation' stamp: ''!
messages: messageNodes 
	^self new messages: messageNodes! !

!RBCascadeNode class methodsFor: 'instance creation' stamp: ''!
messages: messageNodes semicolons: integerCollection 
	^self new messages: messageNodes semicolons: integerCollection! !

!RBCascadeNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:04'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	^ self messages = anObject messages! !

!RBCascadeNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptCascadeNode: self! !

!RBCascadeNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'!
basicFirstToken
	
	^self messages first firstToken! !

!RBCascadeNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:39'!
basicLastToken
	
	^self messages last lastToken! !

!RBCascadeNode methodsFor: 'querying' stamp: ''!
bestNodeFor: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	messages 
		reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]].
	selectedChildren := (messages 
				collect: [:each | each bestNodeFor: anInterval]) 
					reject: [:each | each isNil].
	^selectedChildren detect: [:each | true] ifNone: [nil]! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
children
	^self messages! !

!RBCascadeNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	^(self class new) messages: (self copyList: messages inContext: aDictionary);
		yourself! !

!RBCascadeNode methodsFor: 'testing' stamp: ''!
directlyUses: aNode 
	^messages last = aNode and: [self isDirectlyUsed]! !

!RBCascadeNode methodsFor: 'comparing' stamp: 'pmm 7/13/2006 18:38'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	self messages size == anObject messages size ifFalse: [^false].
	self messages with: anObject messages do: [ :first :second |
		(first equalTo: second withMapping: aDictionary)
			ifFalse: [^false]].
	^true! !

!RBCascadeNode methodsFor: 'comparing' stamp: 'bh 4/10/2001 15:59'!
hash
	^self messages asArray hash! !

!RBCascadeNode methodsFor: 'testing' stamp: ''!
isCascade
	^true! !

!RBCascadeNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	aNode class == self class ifFalse: [^false].
	^self matchList: messages
		against: aNode messages
		inContext: aDictionary! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
messages
	^messages! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
messages: messageNodeCollection 
	messages := messageNodeCollection.
	messages do: [:each | each parent: self]! !

!RBCascadeNode methodsFor: 'initialize-release' stamp: 'lr 10/18/2009 17:13'!
messages: messageNodes semicolons: integerCollection 
	self messages: messageNodes.
	semicolons := integerCollection! !

!RBCascadeNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:39'!
postCopy
	super postCopy.
	self messages: (self messages
		collect: [ :each | each copy ])! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
precedence
	^4! !

!RBCascadeNode methodsFor: 'accessing' stamp: 'ajh 2/25/2003 01:12'!
receiver

	^ self messages first receiver! !

!RBCascadeNode methodsFor: 'replacing' stamp: ''!
replaceNode: aNode withNode: anotherNode 
	self messages: (messages 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^messages first start! !

!RBCascadeNode methodsFor: 'accessing' stamp: ''!
stopWithoutParentheses
	^messages last stop! !

!RBCascadeNode methodsFor: 'testing' stamp: ''!
uses: aNode 
	^messages last = aNode and: [self isUsed]! !

!RBCascadeNode methodsFor: 'querying' stamp: ''!
whichNodeIsContainedBy: anInterval 
	| selectedChildren |
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	messages 
		reverseDo: [:each | (each containedBy: anInterval) ifTrue: [^each]].
	selectedChildren := (messages 
				collect: [:each | each whichNodeIsContainedBy: anInterval]) 
					reject: [:each | each isNil].
	^selectedChildren detect: [:each | true] ifNone: [nil]! !

RBValueNode subclass: #RBLiteralNode
	instanceVariableNames: 'token'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBLiteralNode commentStamp: 'md 8/9/2005 14:58' prior: 0!
RBLiteralNode is an AST node that represents literals (e.g., #foo, #(1 2 3), true, etc.).

Instance Variables:
	token	<RBLiteralToken>	the token that contains the literal value as well as its source positions

!

!RBLiteralNode class methodsFor: 'instance creation' stamp: 'lr 10/18/2009 17:17'!
literalToken: aLiteralToken 
	^self new literalToken: aLiteralToken! !

!RBLiteralNode class methodsFor: 'instance creation' stamp: 'lr 10/18/2009 17:16'!
value: aValue 
	^self literalToken: (RBLiteralToken value: aValue)! !

!RBLiteralNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:04'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class == anObject class ifFalse: [ ^ false ].
	self value class == anObject value class ifFalse: [ ^ false ].
	^ self value = anObject value! !

!RBLiteralNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptLiteralNode: self! !

!RBLiteralNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:11'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	token start > sourcePos ifTrue: [
		token start: token start + delta]! !

!RBLiteralNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:40'!
basicFirstToken
	
	^self token! !

!RBLiteralNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:40'!
basicLastToken
	
	^self token! !

!RBLiteralNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary
	^self class literalToken: token removePositions! !

!RBLiteralNode methodsFor: 'comparing' stamp: ''!
hash
	^self value hash! !

!RBLiteralNode methodsFor: 'testing' stamp: ''!
isImmediate
	^true! !

!RBLiteralNode methodsFor: 'testing' stamp: ''!
isLiteral
	^true! !

!RBLiteralNode methodsFor: 'testing' stamp: 'ajh 3/3/2003 22:29'!
isLiteral: valueTestBlock

	^ valueTestBlock value: self value! !

!RBLiteralNode methodsFor: 'initialize-release' stamp: ''!
literalToken: aLiteralToken 
	token := aLiteralToken! !

!RBLiteralNode methodsFor: 'accessing' stamp: ''!
precedence
	^0! !

!RBLiteralNode methodsFor: 'accessing' stamp: 'ms 3/31/2007 20:41'!
startWithoutParentheses
	^self firstToken start! !

!RBLiteralNode methodsFor: 'accessing' stamp: 'ms 3/31/2007 20:42'!
stopWithoutParentheses
	^self lastToken stop! !

!RBLiteralNode methodsFor: 'accessing' stamp: ''!
token
	^token! !

!RBLiteralNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:15'!
value
	^ token realValue! !

RBValueNode subclass: #RBMessageNode
	instanceVariableNames: 'receiver selector selectorParts arguments'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBMessageNode commentStamp: 'md 8/9/2005 14:58' prior: 0!
RBMessageNode is an AST node that represents a message send.

Instance Variables:
	arguments	<SequenceableCollection of: RBValueNode>	our argument nodes
	receiver	<RBValueNode>	the receiver's node
	selector	<Symbol | nil>	the selector we're sending (cached)
	selectorParts	<SequenceableCollection of: RBValueToken>	the tokens for each keyword

!

!RBMessageNode class methodsFor: 'instance creation' stamp: ''!
receiver: aValueNode selector: aSymbol 
	^self 
		receiver: aValueNode
		selector: aSymbol
		arguments: #()! !

!RBMessageNode class methodsFor: 'instance creation' stamp: ''!
receiver: aValueNode selector: aSymbol arguments: valueNodes 
	^(self new)
		receiver: aValueNode;
		arguments: valueNodes;
		selector: aSymbol;
		yourself! !

!RBMessageNode class methodsFor: 'instance creation' stamp: 'pmm 7/12/2006 15:18'!
receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes 
	^((keywordTokens anySatisfy: [:each | each isPatternVariable])
		ifTrue: [RBPatternMessageNode] ifFalse: [RBMessageNode]) 
		new 
			receiver: aValueNode
			selectorParts: keywordTokens
			arguments: valueNodes! !

!RBMessageNode methodsFor: 'comparing' stamp: 'lr 7/1/2008 09:39'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	(self receiver = anObject receiver and: [ self selector = anObject selector ]) 
		ifFalse: [ ^ false ].
	self arguments with: anObject arguments do: [ :first :second |
		first = second 
			ifFalse: [ ^ false ] ].
	^ true! !

!RBMessageNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptMessageNode: self! !

!RBMessageNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:12'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	selectorParts do: [:token |
		token start > sourcePos ifTrue: [
			token start: token start + delta]
	].
	super adjustPositionsAfter: sourcePos by: delta.
! !

!RBMessageNode methodsFor: 'accessing' stamp: 'md 4/8/2007 17:52'!
arguments
	^arguments ifNil: [#()]! !

!RBMessageNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:12'!
arguments: argCollection 
	arguments := argCollection.
	arguments isEmptyOrNil ifTrue: [arguments := nil. ^self].
	arguments do: [:each | each parent: self]! !

!RBMessageNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:44'!
basicFirstToken
	
	^self receiver firstToken! !

!RBMessageNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:44'!
basicLastToken
	
	self arguments ifEmpty:[^self selectorParts last] ifNotEmpty: [^self arguments last lastToken]! !

!RBMessageNode methodsFor: 'querying' stamp: ''!
bestNodeFor: anInterval 
	(self intersectsInterval: anInterval) ifFalse: [^nil].
	(self containedBy: anInterval) ifTrue: [^self].
	selectorParts do: 
			[:each | 
			((anInterval first between: each start and: each stop) 
				or: [each start between: anInterval first and: anInterval last]) 
					ifTrue: [^self]].
	self children do: 
			[:each | 
			| node |
			node := each bestNodeFor: anInterval.
			node notNil ifTrue: [^node]]! !

!RBMessageNode methodsFor: 'private' stamp: ''!
buildSelector
	| selectorStream |
	selectorStream := WriteStream on: (String new: 50).
	selectorParts do: [:each | selectorStream nextPutAll: each value].
	^selectorStream contents asSymbol! !

!RBMessageNode methodsFor: 'replacing' stamp: 'ajh 3/17/2003 13:11'!
changeSelectorParts: tokenCollection

	| root oldToken newToken |
	root := self root.
	1 to: selectorParts size do: [:i |
		oldToken := selectorParts at: i.
		newToken := tokenCollection at: i.
		root adjustPositionsAfter: oldToken stop
			by: newToken stop - oldToken stop.
		selectorParts at: i put: newToken.
	].
	selector := nil.
! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
children
	^(OrderedCollection with: self receiver) addAll: self arguments;
		yourself! !

!RBMessageNode methodsFor: 'matching' stamp: 'md 4/6/2007 11:13'!
copyInContext: aDictionary 
	^(self class new) receiver: (receiver copyInContext: aDictionary);
		selectorParts: (selectorParts collect: [:each | each removePositions]);
		arguments: (self arguments collect: [:each | each copyInContext: aDictionary]);
		yourself! !

!RBMessageNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:18'!
debugHighlightStart

	^ self selectorParts first start! !

!RBMessageNode methodsFor: 'accessing' stamp: 'ajh 3/15/2003 15:19'!
debugHighlightStop

	^ self stopWithoutParentheses! !

!RBMessageNode methodsFor: 'comparing' stamp: 'pmm 7/12/2006 15:40'!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	((self receiver equalTo: anObject receiver withMapping: aDictionary)
		and: [self selector = anObject selector]) ifFalse: [^false].
	self arguments with: anObject arguments do: [ :first :second |
		(first equalTo: second withMapping: aDictionary)
			ifFalse: [^false]].
	^true! !

!RBMessageNode methodsFor: 'comparing' stamp: ''!
hash
	^(self receiver hash bitXor: self selector hash)
		bitXor: (self arguments isEmpty ifTrue: [0] ifFalse: [self arguments first hash])! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isBinary
	^(self isUnary or: [self isKeyword]) not! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isCascaded
	^parent notNil and: [parent isCascade]! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isFirstCascaded
	^self isCascaded and: [parent messages first == self]! !

!RBMessageNode methodsFor: 'inline' stamp: 'ajh 2/25/2003 19:47'!
isInline

	self isInlineAndOr ifTrue: [^ true].
	self isInlineCase ifTrue: [^ true].
	self isInlineIf ifTrue: [^ true].
	self isInlineIfNil ifTrue: [^ true].
	self isInlineToDo ifTrue: [^ true].
	self isInlineWhile ifTrue: [^ true].
	^ false! !

!RBMessageNode methodsFor: 'inline' stamp: 'pmm 7/24/2006 21:57'!
isInlineAndOr
	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(self selectorParts allSatisfy: [ :each |
		| value |
		value := each isRBToken
			ifTrue: [each realValue]
			ifFalse: [each value].
		#(and: or:) includes: value ]) ifFalse: [^ false].
	(self arguments allSatisfy: [ :each | each isBlock ])  ifFalse: [^ false].
	(self arguments allSatisfy: [ :each | each arguments isEmpty ])
			ifFalse: [
				self notify: 'and: (or:) takes zero-arg block'.
				^ false ].
	^ true! !

!RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:39'!
isInlineCase

	self isCascaded ifTrue: [^ false].
	(#(caseOf: caseOf:otherwise:) includes: self selector) ifFalse: [^ false].
	self arguments size = 2 ifTrue: [  "otherwise block"
		self arguments last isBlock ifFalse: [^ false]].
	self arguments first isArray ifFalse: [^ false].
	self arguments first statements do: [:assoc |
		(assoc isMessage and: [assoc selector == #->]) ifFalse: [^ false].
		assoc receiver isBlock ifFalse: [^ false].
		assoc receiver arguments isEmpty ifFalse: [self notify: 'caseOf: takes zero-arg blocks'. ^ false].
		assoc arguments first isBlock ifFalse: [^ false].
		assoc arguments first arguments isEmpty ifFalse: [self notify: 'caseOf: takes zero-arg blocks'].
	].
	^ true! !

!RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'!
isInlineIf

	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: self selector) ifFalse: [^ false].
	self arguments do: [:node | node isBlock ifFalse: [^ false]].
	self arguments do: [:block |
		block arguments isEmpty ifFalse: [
			self notify: 'ifTrue:ifFalse: takes zero-arg blocks'.
			^ false
		]
	].
	^ true! !

!RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'!
isInlineIfNil

	| assertNone assertOneOrNone |
	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(#(ifNil: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil: ifNotNilDo:) includes: self selector) ifFalse: [^ false].
	self arguments do: [:node | node isBlock ifFalse: [^ false]].
	assertNone := [:block | 
		block arguments isEmpty ifFalse: [self notify: 'ifNil: takes zero-arg block'. ^ false]
	].
	assertOneOrNone := [:block | 
		block arguments size > 1 ifTrue: [self notify: 'ifNotNil: takes zero- or one-arg block'. ^ false]
	].
	self selector caseOf: {
		[#ifNil:] 		 	-> [assertNone value: self arguments first].
		[#ifNil:ifNotNil:] 	-> [assertNone value: self arguments first. 
							   assertOneOrNone value: self arguments last].
		[#ifNotNil:] 		  	-> [assertOneOrNone value: self arguments first].
		[#ifNotNilDo:] 		  	-> [assertOneOrNone value: self arguments first].
		[#ifNotNil:ifNil:] 	-> [assertOneOrNone value: self arguments first. 
							   assertNone value: self arguments last]
	}.
	^ true! !

!RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'!
isInlineToDo

	| block step |
	self receiver isBlock ifTrue: [^ false].
	self isCascaded ifTrue: [^ false].
	(#(to:do: to:by:do:) includes: self selector) ifFalse: [^ false].
	self arguments first isBlock ifTrue: [^ false].
	block := self arguments last.
	block isBlock ifFalse: [^ false].
	block arguments size = 1 ifFalse: [
		self notify: 'to:do: block must take one arg'. ^ false].
	(ParseTreeSearcher new
		matches: block arguments first name , ' := `@object' do: [:n :a | true];
		executeTree: block initialAnswer: false) ifTrue: [^ false].
	self arguments size = 3 "to:by:do:" ifTrue: [
		step := self arguments second.
		step isLiteral ifFalse: [^ false].
		step value = 0 ifTrue: [self notify: 'by: step can''t be zero'. ^ false].
	].
	^ true! !

!RBMessageNode methodsFor: 'inline' stamp: 'md 4/14/2007 00:38'!
isInlineWhile

	self isCascaded ifTrue: [^ false].
	(#(whileFalse: whileTrue: whileFalse whileTrue) includes: self selector) ifFalse: [^ false].
	self receiver isBlock ifFalse: [^ false].
	self receiver arguments isEmpty ifFalse: [self notify: 'while receiver block must have no arguments'. ^ false].
	self arguments isEmpty ifFalse: [
		self arguments first isBlock ifFalse: [^ false].
		self arguments first arguments isEmpty ifFalse: [self notify: 'while takes a zero-arg block as its argument'. ^ false].
	].
	^ true! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isKeyword
	^selectorParts first value last == $:! !

!RBMessageNode methodsFor: 'testing' stamp: ''!
isMessage
	^true! !

!RBMessageNode methodsFor: 'testing' stamp: 'pmm 1/9/2006 12:05'!
isSelfSend
	^(self receiver isVariable)
		and: [ self receiver name = 'self' ]! !

!RBMessageNode methodsFor: 'decompiling' stamp: 'ms 7/12/2007 13:19'!
isSend
	^true! !

!RBMessageNode methodsFor: 'testing' stamp: 'pmm 4/24/2006 22:30'!
isSuperSend
	^receiver isVariable
		and: [ receiver name = 'super' ]
		and: [ receiver binding name = 'self']! !

!RBMessageNode methodsFor: 'testing' stamp: 'md 4/6/2007 11:15'!
isUnary
	^self arguments isEmpty! !

!RBMessageNode methodsFor: 'testing' stamp: 'md 4/6/2007 11:15'!
lastIsReturn

	^ ((#(ifTrue:ifFalse: ifFalse:ifTrue: ifNil:ifNotNil: ifNotNil:ifNil:) includes: self selector)
		and: [self arguments first isBlock and: 
			[self arguments first body lastIsReturn
				and: [self arguments last isBlock and: [self arguments last body lastIsReturn]]]])
	  or: [(#(caseOf: caseOf:otherwise:) includes: self selector)
		and: [self arguments first isArray and: [self arguments first statements allSatisfy: [:assocMessage | assocMessage arguments first isBlock and: [assocMessage arguments first body lastIsReturn]]]
			and: [selector == #caseOf: or: [self arguments second isBlock and: [self arguments second body lastIsReturn]]]]]! !

!RBMessageNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:41'!
match: aNode inContext: aDictionary 
	aNode class == self class ifFalse: [^false].
	self selector == aNode selector ifFalse: [^false].
	(receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false].
	self arguments with: aNode arguments do: [ :first :second |
		(first match: second inContext: aDictionary)
			ifFalse: [^false]].
	^true! !

!RBMessageNode methodsFor: 'copying' stamp: 'lr 10/18/2009 15:39'!
postCopy
	super postCopy.
	self receiver: self receiver copy.
	self arguments: (self arguments 
		collect: [ :each | each copy ])! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
precedence
	^self isUnary ifTrue: [1] ifFalse: [self isKeyword ifTrue: [3] ifFalse: [2]]! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
receiver
	^receiver! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
receiver: aValueNode 
	receiver := aValueNode.
	receiver parent: self! !

!RBMessageNode methodsFor: 'initialize-release' stamp: ''!
receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes 
	self receiver: aValueNode.
	selectorParts := keywordTokens.
	self arguments: valueNodes! !

!RBMessageNode methodsFor: 'replacing' stamp: 'md 4/8/2007 17:53'!
replaceNode: aNode withNode: anotherNode 
	"If we're inside a cascade node and are changing the receiver, change all the receivers"

	receiver == aNode 
		ifTrue: 
			[self receiver: anotherNode.
			(parent notNil and: [parent isCascade]) 
				ifTrue: [parent messages do: [:each | each receiver: anotherNode]]].
	self arguments: (self arguments 
				collect: [:each | each == aNode ifTrue: [anotherNode] ifFalse: [each]])! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
selector
	^selector isNil
		ifTrue: [selector := self buildSelector]
		ifFalse: [selector]! !

!RBMessageNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:17'!
selector: aSelector 
	| keywords numArgs |
	keywords := aSelector keywords.
	numArgs := aSelector numArgs.
	numArgs == self arguments size 
		ifFalse: 
			[self 
				error: 'Attempting to assign selector with wrong number of arguments.'].
	selectorParts := numArgs == 0 
				ifTrue: [Array with: (RBIdentifierToken value: keywords first start: nil)]
				ifFalse: 
					[keywords first last == $: 
						ifTrue: [keywords collect: [:each | RBKeywordToken value: each start: nil]]
						ifFalse: [Array with: (RBBinarySelectorToken value: aSelector start: nil)]].
	selector := aSelector! !

!RBMessageNode methodsFor: 'private' stamp: ''!
selectorParts
	^selectorParts! !

!RBMessageNode methodsFor: 'private' stamp: 'ajh 3/11/2003 23:40'!
selectorParts: tokenCollection 
	selectorParts := tokenCollection.
	selector := nil.
! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
sentMessages
	^(super sentMessages)
		add: self selector;
		yourself! !

!RBMessageNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^receiver start! !

!RBMessageNode methodsFor: 'accessing' stamp: 'md 4/6/2007 11:17'!
stopWithoutParentheses
	^self arguments isEmpty 
		ifTrue: [selectorParts first stop]
		ifFalse: [self arguments last stop]! !

RBMessageNode subclass: #RBPatternMessageNode
	instanceVariableNames: 'isList isCascadeList'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBPatternMessageNode commentStamp: 'md 8/9/2005 14:58' prior: 0!
RBPatternMessageNode is a RBMessageNode that will match other message nodes without their selectors being equal. 

Instance Variables:
	isCascadeList	<Boolean>	are we matching a list of message nodes in a cascaded message
	isList	<Boolean>	are we matching each keyword or matching all keywords together (e.g., `keyword1: would match a one argument method whereas `@keywords: would match 0 or more arguments)!

!RBPatternMessageNode methodsFor: 'matching' stamp: 'lr 2/28/2009 18:18'!
copyInContext: aDictionary 
	| selectors |
	self isList ifTrue: [^aDictionary at: self].
	selectors := self isSelectorList 
				ifTrue: [(aDictionary at: selectorParts first value) keywords]
				ifFalse: [selectorParts collect: [:each | aDictionary at: each value]].
	^(RBMessageNode new)
		receiver: (receiver copyInContext: aDictionary);
		selectorParts: (selectors collect: 
						[:each | 
						(each last == $: ifTrue: [RBKeywordToken] ifFalse: [RBIdentifierToken]) 
							value: each
							start: nil]);
		arguments: (self copyList: self arguments inContext: aDictionary);
		yourself! !

!RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''!
isList
	^isCascadeList and: [parent notNil and: [parent isCascade]]! !

!RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^true! !

!RBPatternMessageNode methodsFor: 'testing-matching' stamp: ''!
isSelectorList
	^isList! !

!RBPatternMessageNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	aNode class == self matchingClass ifFalse: [^false].
	(receiver match: aNode receiver inContext: aDictionary) ifFalse: [^false].
	self isSelectorList ifTrue: 
			[^(aDictionary at: selectorParts first value ifAbsentPut: [aNode selector])
				== aNode selector and: 
						[(aDictionary at: arguments first ifAbsentPut: [aNode arguments])
							= aNode arguments]].
	^self matchArgumentsAgainst: aNode inContext: aDictionary! !

!RBPatternMessageNode methodsFor: 'matching' stamp: 'pmm 7/12/2006 15:44'!
matchArgumentsAgainst: aNode inContext: aDictionary 
	self arguments size == aNode arguments size ifFalse: [^false].
	(self matchSelectorAgainst: aNode inContext: aDictionary) 
		ifFalse: [^false].
	self arguments with: aNode arguments do: [ :first :second |
		(first match: second inContext: aDictionary)
			ifFalse: [^false]].
	^true! !

!RBPatternMessageNode methodsFor: 'matching' stamp: ''!
matchSelectorAgainst: aNode inContext: aDictionary 
	| keyword |
	1 to: selectorParts size
		do: 
			[:i | 
			keyword := selectorParts at: i.
			(aDictionary at: keyword value
				ifAbsentPut: 
					[keyword isPatternVariable 
						ifTrue: [(aNode selectorParts at: i) value]
						ifFalse: [keyword value]]) 
					= (aNode selectorParts at: i) value ifFalse: [^false]].
	^true! !

!RBPatternMessageNode methodsFor: 'private' stamp: ''!
matchingClass
	^RBMessageNode! !

!RBPatternMessageNode methodsFor: 'initialize-release' stamp: ''!
receiver: aValueNode selectorParts: keywordTokens arguments: valueNodes 
	| message |
	super 
		receiver: aValueNode
		selectorParts: keywordTokens
		arguments: valueNodes.
	isCascadeList := isList := false.
	message := keywordTokens first value.
	2 to: message size
		do: 
			[:i | 
			| character |
			character := message at: i.
			character == self listCharacter 
				ifTrue: [isList := true]
				ifFalse: 
					[character == self cascadeListCharacter 
						ifTrue: [isCascadeList := true]
						ifFalse: [^self]]]! !

!RBPatternMessageNode methodsFor: 'accessing' stamp: ''!
sentMessages
	^(super sentMessages)
		remove: self selector ifAbsent: [];
		yourself! !

!RBValueNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:10'!
addParenthesis: anInterval 
	parentheses isNil ifTrue: [ parentheses := OrderedCollection new: 1 ].
	parentheses add: anInterval! !

!RBValueNode methodsFor: 'testing' stamp: ''!
containedBy: anInterval 
	^anInterval first <= self startWithoutParentheses 
		and: [anInterval last >= self stopWithoutParentheses]! !

!RBValueNode methodsFor: 'testing' stamp: ''!
hasParentheses
	^self parentheses isEmpty not! !

!RBValueNode methodsFor: 'testing' stamp: ''!
isValue
	^true! !

!RBValueNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:10'!
parentheses
	^ parentheses ifNil: [ #() ]! !

!RBValueNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:10'!
start
	^parentheses isNil 
		ifTrue: [self startWithoutParentheses]
		ifFalse: [parentheses last first]! !

!RBValueNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^self subclassResponsibility! !

!RBValueNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:10'!
stop
	^parentheses isNil
		ifTrue: [self stopWithoutParentheses]
		ifFalse: [parentheses last last]! !

!RBValueNode methodsFor: 'accessing' stamp: ''!
stopWithoutParentheses
	^self subclassResponsibility! !

RBValueNode subclass: #RBVariableNode
	instanceVariableNames: 'token'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBVariableNode commentStamp: 'md 8/9/2005 15:00' prior: 0!
RBVariableNode is an AST node that represent a variable (global, inst var, temp, etc.).

Instance Variables:
	token	<RBValueToken>	the token that contains our name and position

!

RBVariableNode subclass: #RBPatternVariableNode
	instanceVariableNames: 'recurseInto isList isLiteral isStatement isAnything'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Nodes'!

!RBPatternVariableNode commentStamp: 'md 8/9/2005 14:59' prior: 0!
RBPatternVariableNode is an AST node that is used to match several other types of nodes (literals, variables, value nodes, statement nodes, and sequences of statement nodes).

The different types of matches are determined by the name of the node. If the name contains a # character, then it will match a literal. If it contains, a . then it matches statements. If it contains no extra characters, then it matches only variables. These options are mutually exclusive.

The @ character can be combined with the name to match lists of items. If combined with the . character, then it will match a list of statement nodes (0 or more). If used without the . or # character, then it matches anything except for list of statements. Combining the @ with the # is not supported.

Adding another ` in the name will cause the search/replace to look for more matches inside the node that this node matched. This option should not be used for top level expressions since that would cause infinite recursion (e.g., searching only for "``@anything").

Instance Variables:
	isAnything	<Boolean>	can we match any type of node
	isList	<Boolean>	can we match a list of items (@)
	isLiteral	<Boolean>	only match a literal node (#)
	isStatement	<Boolean>	only match statements (.)
	recurseInto	<Boolean>	search for more matches in the node we match (`)

!

!RBPatternVariableNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	^aDictionary at: self! !

!RBPatternVariableNode methodsFor: 'initialize-release' stamp: ''!
identifierToken: anIdentifierToken 
	super identifierToken: anIdentifierToken.
	self initializePatternVariables! !

!RBPatternVariableNode methodsFor: 'initialize-release' stamp: ''!
initializePatternVariables
	| name |
	name := self name.
	isAnything := isList := isLiteral := isStatement := recurseInto := false.
	2 to: name size
		do: 
			[:i | 
			| character |
			character := name at: i.
			character == self listCharacter 
				ifTrue: [isAnything := isList := true]
				ifFalse: 
					[character == self literalCharacter 
						ifTrue: [isLiteral := true]
						ifFalse: 
							[character == self statementCharacter 
								ifTrue: [isStatement := true]
								ifFalse: 
									[character == self recurseIntoCharacter 
										ifTrue: [recurseInto := true]
										ifFalse: [^self]]]]]! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isAnything
	^isAnything! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isList
	^isList! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isLiteral
	^isLiteral! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isPatternNode
	^true! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
isStatement
	^isStatement! !

!RBPatternVariableNode methodsFor: 'matching' stamp: ''!
match: aNode inContext: aDictionary 
	self isAnything ifTrue: [^(aDictionary at: self ifAbsentPut: [aNode]) = aNode].
	self isLiteral ifTrue: [^self matchLiteral: aNode inContext: aDictionary].
	self isStatement
		ifTrue: [^self matchStatement: aNode inContext: aDictionary].
	aNode class == self matchingClass ifFalse: [^false].
	^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! !

!RBPatternVariableNode methodsFor: 'matching' stamp: ''!
matchLiteral: aNode inContext: aDictionary 
	^aNode class == RBLiteralNode 
		and: [(aDictionary at: self ifAbsentPut: [aNode]) = aNode]! !

!RBPatternVariableNode methodsFor: 'matching' stamp: ''!
matchStatement: aNode inContext: aDictionary 
	(aNode parent notNil and: [aNode parent isSequence]) ifFalse: [^false].
	^(aDictionary at: self ifAbsentPut: [aNode]) = aNode! !

!RBPatternVariableNode methodsFor: 'private' stamp: ''!
matchingClass
	^RBVariableNode! !

!RBPatternVariableNode methodsFor: 'accessing' stamp: ''!
parent: aBRProgramNode 
	"Fix the case where '``@node' should match a single node, not a sequence node."

	super parent: aBRProgramNode.
	parent isSequence 
		ifTrue: 
			[(self isStatement or: [parent temporaries includes: self]) 
				ifFalse: [isList := false]]! !

!RBPatternVariableNode methodsFor: 'testing-matching' stamp: ''!
recurseInto
	^recurseInto! !

!RBVariableNode class methodsFor: 'instance creation' stamp: ''!
identifierToken: anIdentifierToken 
	^(anIdentifierToken isPatternVariable 
		ifTrue: [RBPatternVariableNode]
		ifFalse: [RBVariableNode]) new 
		identifierToken: anIdentifierToken! !

!RBVariableNode class methodsFor: 'instance creation' stamp: ''!
named: aString 
	^self identifierToken: (RBIdentifierToken value: aString start: 0)! !

!RBVariableNode methodsFor: 'comparing' stamp: 'lr 10/18/2009 16:03'!
= anObject 
	self == anObject ifTrue: [ ^ true ].
	self class = anObject class ifFalse: [ ^ false ].
	^ self name = anObject name! !

!RBVariableNode methodsFor: 'visitor' stamp: ''!
acceptVisitor: aProgramNodeVisitor 
	^aProgramNodeVisitor acceptVariableNode: self! !

!RBVariableNode methodsFor: 'replacing' stamp: 'ajh 3/13/2003 16:13'!
adjustPositionsAfter: sourcePos by: delta
	"Slide token positions after sourcePos by delta"

	token start > sourcePos ifTrue: [
		token start: token start + delta]! !

!RBVariableNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:44'!
basicFirstToken
	
	^self token! !

!RBVariableNode methodsFor: 'accessing-token' stamp: 'ms 9/18/2006 17:45'!
basicLastToken
	
	^self token! !

!RBVariableNode methodsFor: 'semantics' stamp: 'md 4/2/2007 08:07'!
binding

	^ self propertyAt: #binding ifAbsent: [nil].! !

!RBVariableNode methodsFor: 'semantics' stamp: 'md 4/2/2007 08:07'!
binding: aSemVar
	aSemVar ifNil: [^self removeProperty: #binding ifAbsent: []].
	self propertyAt: #binding put: aSemVar.! !

!RBVariableNode methodsFor: 'replacing' stamp: 'ajh 3/17/2003 13:12'!
changeToken: newToken

	self root adjustPositionsAfter: token stop by: newToken stop - token stop.
	token := newToken.
! !

!RBVariableNode methodsFor: 'matching' stamp: ''!
copyInContext: aDictionary 
	^self class identifierToken: token removePositions! !

!RBVariableNode methodsFor: 'comparing' stamp: ''!
equalTo: anObject withMapping: aDictionary 
	self class = anObject class ifFalse: [^false].
	^(aDictionary at: self name ifAbsentPut: [anObject name]) = anObject name! !

!RBVariableNode methodsFor: 'comparing' stamp: ''!
hash
	^self name hash! !

!RBVariableNode methodsFor: 'initialize-release' stamp: 'lr 10/18/2009 17:14'!
identifierToken: anIdentifierToken 
	token := anIdentifierToken! !

!RBVariableNode methodsFor: 'testing' stamp: 'ms 8/2/2007 10:19'!
isArg

	^self binding isArg! !

!RBVariableNode methodsFor: 'testing' stamp: 'pmm 10/8/2005 11:21'!
isGlobal
	^self binding isGlobal! !

!RBVariableNode methodsFor: 'testing' stamp: ''!
isImmediate
	^true! !

!RBVariableNode methodsFor: 'testing' stamp: 'pmm 10/8/2005 11:57'!
isInstance
	^self binding isInstance! !

!RBVariableNode methodsFor: 'testing' stamp: 'pmm 2/6/2006 12:31'!
isRead
	^self isWrite not! !

!RBVariableNode methodsFor: 'testing' stamp: 'pmm 10/8/2005 11:21'!
isTemp
	^self binding isTemp! !

!RBVariableNode methodsFor: 'testing' stamp: ''!
isVariable
	^true! !

!RBVariableNode methodsFor: 'testing' stamp: 'pmm 2/6/2006 12:31'!
isWrite
	^self parent isAssignment
		and: [ self parent variable == self ]! !

!RBVariableNode methodsFor: 'accessing' stamp: 'lr 10/18/2009 17:15'!
name
	^ token value! !

!RBVariableNode methodsFor: 'accessing' stamp: ''!
precedence
	^0! !

!RBVariableNode methodsFor: 'testing' stamp: ''!
references: aVariableName 
	^self name = aVariableName! !

!RBVariableNode methodsFor: 'accessing' stamp: ''!
startWithoutParentheses
	^token start! !

!RBVariableNode methodsFor: 'accessing' stamp: ''!
stopWithoutParentheses
	^token stop! !

!RBVariableNode methodsFor: 'accessing' stamp: 'ajh 3/13/2003 15:17'!
token

	^ token! !

Object subclass: #RBProgramNodeVisitor
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Visitors'!

!RBProgramNodeVisitor commentStamp: '<historical>' prior: 0!
RBProgramNodeVisitor is an abstract visitor for the RBProgramNodes.

Here is a short Tutorial.

We want to parse an expression:

tree := RBParser parseExpression: '3 + 4'

Now we have the AST (Abstrakt syntax tree). Have a look at it with the ObjectExplorerer:

tree explore

We can easyly walk across the tree using the RBProgramNodeVisitor:

RBProgramNodeVisitor new visitNode: tree.

Of course, nothing happens, as all the visitor-methods are only stubs in this class.
So you need to subclass that to do anything usefull.
As an example, we would like to walk the tree and get all Literals back.

So we make a subclass:

RBProgramNodeVisitor subclass: #TestVisitor
	instanceVariableNames: 'literals'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-AST-Visitors'

initialize
	literals := Set new.

literals
	^literals

acceptLiteralNode: aLiteralNode
	literals add: aLiteralNode value.
	 

(TestVisitor new visitNode: tree) literals
!

RBProgramNodeVisitor subclass: #ParseTreeSearcher
	instanceVariableNames: 'searches answer argumentSearches context messages'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!ParseTreeSearcher commentStamp: 'md 8/9/2005 14:55' prior: 0!
ParseTreeSearcher walks over a normal source code parse tree using the visitor pattern, and then matches these nodes against the meta-nodes using the match:inContext: methods defined for the meta-nodes.

Instance Variables:
	answer	<Object>	the "answer" that is propagated between matches
	argumentSearches	<Collection of: (Association key: RBProgramNode value: BlockClosure)>	argument searches (search for the BRProgramNode and perform the BlockClosure when its found)
	context	<RBSmallDictionary>	a dictionary that contains what each meta-node matches against. This could be a normal Dictionary that is created for each search, but is created once and reused (efficiency).
	messages	<Collection>	the sent messages in our searches
	searches	<Collection of: (Association key: RBProgramNode value: BlockClosure)>	non-argument searches (search for the BRProgramNode and perform the BlockClosure when its found)!

ParseTreeSearcher subclass: #ParseTreeRewriter
	instanceVariableNames: 'tree'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!ParseTreeRewriter commentStamp: 'md 8/9/2005 14:55' prior: 0!
ParseTreeRewriter walks over and transforms its RBProgramNode (tree). If the tree is modified, then answer is set to true, and the modified tree can be retrieved by the #tree method.

Instance Variables:
	tree	<RBProgramNode>	the parse tree we're transforming!

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
classVariable: aVarName getter: getMethod setter: setMethod 
	^self 
		variable: aVarName
		getter: getMethod
		setter: setMethod
		receiver: 'self class'! !

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
removeTemporaryNamed: aName 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule replace: '| `@temps1 ' , aName , ' `@temps2 | ``@.Statements'
		with: '| `@temps1  `@temps2 | ``@.Statements'.
	^rewriteRule! !

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
rename: varName to: newVarName 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule
		replace: varName with: newVarName;
		replaceArgument: varName with: newVarName.
	^rewriteRule! !

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
rename: varName to: newVarName handler: aBlock 
	"Rename varName to newVarName, evaluating aBlock if there is a 
	temporary variable with the same name as newVarName. This 
	does not change temporary variables with varName."

	| rewriteRule |
	rewriteRule := self new.
	rewriteRule
		replace: varName with: newVarName;
		replaceArgument: newVarName
			withValueFrom: 
				[:aNode | 
				aBlock value.
				aNode].
	^rewriteRule! !

!ParseTreeRewriter class methodsFor: 'accessing' stamp: ''!
replace: code with: newCode in: aParseTree 
	^(self 
		replace: code
		with: newCode
		method: false)
		executeTree: aParseTree;
		tree! !

!ParseTreeRewriter class methodsFor: 'accessing' stamp: ''!
replace: code with: newCode in: aParseTree onInterval: anInterval 
	| rewriteRule |
	rewriteRule := self new.
	^rewriteRule
		replace: code
			with: newCode
			when: [:aNode | aNode intersectsInterval: anInterval];
		executeTree: aParseTree;
		tree! !

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
replace: code with: newCode method: aBoolean 
	| rewriteRule |
	rewriteRule := self new.
	aBoolean 
		ifTrue: [rewriteRule replaceMethod: code with: newCode]
		ifFalse: [rewriteRule replace: code with: newCode].
	^rewriteRule! !

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
replaceLiteral: literal with: newLiteral 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule 
		replace: '`#literal'
		withValueFrom: [:aNode | aNode]
		when: 
			[:aNode | 
			self 
				replaceLiteral: literal
				with: newLiteral
				inToken: aNode token].
	^rewriteRule! !

!ParseTreeRewriter class methodsFor: 'private' stamp: ''!
replaceLiteral: literal with: newLiteral inToken: literalToken 
	| value |
	value := literalToken realValue.
	(value class = literal class and: [value = literal]) 
		ifTrue: 
			[literalToken 
				value: newLiteral
				start: nil
				stop: nil.
			^true].
	^value class == Array and: 
			[literalToken value inject: false
				into: 
					[:bool :each | 
					bool | (self 
								replaceLiteral: literal
								with: newLiteral
								inToken: each)]]! !

!ParseTreeRewriter class methodsFor: 'accessing' stamp: ''!
replaceStatements: code with: newCode in: aParseTree onInterval: anInterval 
	| tree searchStmt replaceStmt |
	tree := self buildTree: code method: false.
	tree lastIsReturn
		ifTrue: 
			[searchStmt := '| `@temps | `@.Statements. ' , code.
			replaceStmt := '| `@temps | `@.Statements. ^' , newCode]
		ifFalse: 
			[searchStmt := '| `@temps | `@.Statements1. ' , code , '.  `@.Statements2'.
			replaceStmt := '| `@temps | `@.Statements1. ' , newCode , '.  `@.Statements2'].
	^self
		replace: searchStmt
		with: replaceStmt
		in: aParseTree
		onInterval: anInterval! !

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
variable: aVarName getter: getMethod setter: setMethod 
	^self 
		variable: aVarName
		getter: getMethod
		setter: setMethod
		receiver: 'self'! !

!ParseTreeRewriter class methodsFor: 'instance creation' stamp: ''!
variable: aVarName getter: getMethod setter: setMethod receiver: aString 
	| rewriteRule |
	rewriteRule := self new.
	rewriteRule
		replace: aVarName , ' := ``@object'
			with: aString , ' ' , setMethod , ' ``@object';
		replace: aVarName with: aString , ' ' , getMethod.
	^rewriteRule! !

!ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''!
acceptAssignmentNode: anAssignmentNode 
	anAssignmentNode variable: (self visitNode: anAssignmentNode variable).
	anAssignmentNode value: (self visitNode: anAssignmentNode value)! !

!ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'!
acceptBlockNode: aBlockNode 
	aBlockNode arguments: (self visitBlockArguments: aBlockNode arguments).
	aBlockNode body: (self visitNode: aBlockNode body)! !

!ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''!
acceptCascadeNode: aCascadeNode 
	| newMessages notFound |
	newMessages := OrderedCollection new: aCascadeNode messages size.
	notFound := OrderedCollection new: aCascadeNode messages size.
	aCascadeNode messages do: 
			[:each | 
			| newNode |
			newNode := self performSearches: searches on: each.
			newNode isNil 
				ifTrue: 
					[newNode := each.
					notFound add: newNode].
			newNode isMessage 
				ifTrue: [newMessages add: newNode]
				ifFalse: 
					[newNode isCascade 
						ifTrue: [newMessages addAll: newNode messages]
						ifFalse: 
							[Transcript
								show: 'Cannot replace message node inside of cascaded node with non-message node.';
								cr.
							newMessages add: each]]].
	notFound size == aCascadeNode messages size 
		ifTrue: 
			[| receiver |
			receiver := self visitNode: aCascadeNode messages first receiver.
			newMessages do: [:each | each receiver: receiver]].
	notFound 
		do: [:each | each arguments: (each arguments collect: [:arg | self visitNode: arg])].
	aCascadeNode messages: newMessages! !

!ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''!
acceptMessageNode: aMessageNode 
	aMessageNode receiver: (self visitNode: aMessageNode receiver).
	aMessageNode 
		arguments: (aMessageNode arguments collect: [:each | self visitNode: each])! !

!ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'!
acceptMethodNode: aMethodNode 
	aMethodNode arguments: (self visitMethodArguments: aMethodNode arguments).
	aMethodNode body: (self visitNode: aMethodNode body)! !

!ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: ''!
acceptReturnNode: aReturnNode 
	aReturnNode value: (self visitNode: aReturnNode value)! !

!ParseTreeRewriter methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'!
acceptSequenceNode: aSequenceNode 
	aSequenceNode temporaries: (self visitTemporaryVariables: aSequenceNode temporaries).
	aSequenceNode statements: (aSequenceNode statements collect: [:each | self visitNode: each])! !

!ParseTreeRewriter methodsFor: 'accessing' stamp: ''!
executeTree: aParseTree 
	| oldContext |
	oldContext := context.
	context := RBSmallDictionary new.
	answer := false.
	tree := self visitNode: aParseTree.
	context := oldContext.
	^answer! !

!ParseTreeRewriter methodsFor: 'private' stamp: ''!
foundMatch
	answer := true! !

!ParseTreeRewriter methodsFor: 'private' stamp: ''!
lookForMoreMatchesInContext: oldContext 
	oldContext keysAndValuesDo: 
			[:key :value | 
			(key isString not and: [key recurseInto]) 
				ifTrue: 
					[oldContext at: key put: (value collect: [:each | self visitNode: each])]]! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString with: replaceString 
	self addRule: (RBStringReplaceRule searchFor: searchString
				replaceWith: replaceString)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString with: replaceString when: aBlock 
	self addRule: (RBStringReplaceRule 
				searchFor: searchString
				replaceWith: replaceString
				when: aBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString withValueFrom: replaceBlock 
	self addRule: (RBBlockReplaceRule searchFor: searchString
				replaceWith: replaceBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replace: searchString withValueFrom: replaceBlock when: conditionBlock 
	self addRule: (RBBlockReplaceRule 
				searchFor: searchString
				replaceWith: replaceBlock
				when: conditionBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString with: replaceString 
	self addArgumentRule: (RBStringReplaceRule searchFor: searchString
				replaceWith: replaceString)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString with: replaceString when: aBlock 
	self addArgumentRule: (RBStringReplaceRule 
				searchFor: searchString
				replaceWith: replaceString
				when: aBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString withValueFrom: replaceBlock 
	self addArgumentRule: (RBBlockReplaceRule searchFor: searchString
				replaceWith: replaceBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceArgument: searchString withValueFrom: replaceBlock when: conditionBlock 
	self addArgumentRule: (RBBlockReplaceRule 
				searchFor: searchString
				replaceWith: replaceBlock
				when: conditionBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString with: replaceString 
	self addRule: (RBStringReplaceRule searchForMethod: searchString
				replaceWith: replaceString)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString with: replaceString when: aBlock 
	self addRule: (RBStringReplaceRule 
				searchForMethod: searchString
				replaceWith: replaceString
				when: aBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString withValueFrom: replaceBlock 
	self addRule: (RBBlockReplaceRule searchForMethod: searchString
				replaceWith: replaceBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceMethod: searchString withValueFrom: replaceBlock when: conditionBlock 
	self addRule: (RBBlockReplaceRule 
				searchForMethod: searchString
				replaceWith: replaceBlock
				when: conditionBlock)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceTree: searchTree withTree: replaceTree 
	self addRule: (RBStringReplaceRule searchForTree: searchTree
				replaceWith: replaceTree)! !

!ParseTreeRewriter methodsFor: 'replacing' stamp: ''!
replaceTree: searchTree withTree: replaceTree when: aBlock 
	self addRule: (RBStringReplaceRule 
				searchForTree: searchTree
				replaceWith: replaceTree
				when: aBlock)! !

!ParseTreeRewriter methodsFor: 'accessing' stamp: ''!
tree
	^tree! !

!ParseTreeRewriter methodsFor: 'visiting' stamp: ''!
visitArguments: aNodeCollection 
	^aNodeCollection collect: [:each | self visitArgument: each]! !

!ParseTreeRewriter methodsFor: 'visiting' stamp: 'nk 2/23/2005 15:20'!
visitBlockArguments: aNodeCollection 
	^aNodeCollection collect: [:each | self visitBlockArgument: each]! !

!ParseTreeRewriter methodsFor: 'visiting' stamp: 'nk 2/23/2005 15:21'!
visitMethodArguments: aNodeCollection 
	^aNodeCollection collect: [:each | self visitMethodArgument: each]! !

!ParseTreeRewriter methodsFor: 'visiting' stamp: 'nk 2/23/2005 15:22'!
visitTemporaryVariables: aNodeCollection 
	^aNodeCollection collect: [:each | self visitTemporaryVariable: each]! !

!ParseTreeSearcher class methodsFor: 'private' stamp: ''!
buildSelectorString: aSelector 
	| stream keywords |
	aSelector numArgs = 0 ifTrue: [^aSelector].
	stream := WriteStream on: String new.
	keywords := aSelector keywords.
	1 to: keywords size
		do: 
			[:i | 
			stream nextPutAll: (keywords at: i);
				nextPutAll: ' ``@arg';
				nextPutAll: i printString;
				nextPut: $ ].
	^stream contents! !

!ParseTreeSearcher class methodsFor: 'private' stamp: ''!
buildSelectorTree: aSelector 
	aSelector isEmpty ifTrue: [^nil].
	^RBParser parseRewriteExpression: '``@receiver ' 
				, (self buildSelectorString: aSelector)
		onError: [:err :pos | ^nil]! !

!ParseTreeSearcher class methodsFor: 'private' stamp: ''!
buildTree: aString method: aBoolean 
	^aBoolean 
		ifTrue: [RBParser parseRewriteMethod: aString]
		ifFalse: [RBParser parseRewriteExpression: aString]! !

!ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''!
getterMethod: aVarName 
	^(self new)
		matchesMethod: '`method ^' , aVarName do: [:aNode :ans | aNode selector];
		yourself! !

!ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''!
justSendsSuper
	^(self new)
		matchesAnyMethodOf: 
				#('`@method: `@Args ^super `@method: `@Args' 
				'`@method: `@Args super `@method: `@Args')
			do: [:aNode :ans | true];
		yourself! !

!ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''!
returnSetterMethod: aVarName 
	^(self new)
		matchesMethod: '`method: `Arg ^' , aVarName , ' := `Arg'
			do: [:aNode :ans | aNode selector];
		yourself! !

!ParseTreeSearcher class methodsFor: 'instance creation' stamp: ''!
setterMethod: aVarName 
	^(self new)
		matchesAnyMethodOf: (Array with: '`method: `Arg ' , aVarName , ' := `Arg'
					with: '`method: `Arg ^' , aVarName , ' := `Arg')
			do: [:aNode :ans | aNode selector];
		yourself! !

!ParseTreeSearcher class methodsFor: 'accessing' stamp: ''!
treeMatching: aString in: aParseTree 
	(self new)
		matches: aString do: [:aNode :answer | ^aNode];
		executeTree: aParseTree.
	^nil! !

!ParseTreeSearcher class methodsFor: 'accessing' stamp: ''!
treeMatchingStatements: aString in: aParseTree 
	| notifier tree lastIsReturn |
	notifier := self new.
	tree := RBParser parseExpression: aString.
	lastIsReturn := tree lastIsReturn.
	notifier matches: (lastIsReturn 
				ifTrue: ['| `@temps | `@.S1. ' , tree formattedCode]
				ifFalse: ['| `@temps | `@.S1. ' , tree formattedCode , '. `@.S2'])
		do: [:aNode :answer | ^tree].
	notifier executeTree: aParseTree.
	^nil! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addArgumentRule: aParseTreeRule 
	argumentSearches add: aParseTreeRule.
	aParseTreeRule owner: self! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addArgumentRules: ruleCollection 
	ruleCollection do: [:each | self addArgumentRule: each]! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addRule: aParseTreeRule 
	searches add: aParseTreeRule.
	aParseTreeRule owner: self! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
addRules: ruleCollection 
	ruleCollection do: [:each | self addRule: each]! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
answer
	^answer! !

!ParseTreeSearcher methodsFor: 'initialize-release' stamp: ''!
answer: anObject
	answer := anObject! !

!ParseTreeSearcher methodsFor: 'testing' stamp: 'pmm 7/12/2006 15:17'!
canMatchMethod: aCompiledMethod 
	^self messages isEmpty
		or: [ self messages anySatisfy: [:each | aCompiledMethod sendsSelector: each] ]! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
context
	^context! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
executeMethod: aParseTree initialAnswer: anObject 
	answer := anObject.
	searches detect: [:each | (each performOn: aParseTree) notNil] ifNone: [].
	^answer! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
executeTree: aParseTree 
	"Save our current context, in case someone is performing another search inside a match."

	| oldContext |
	oldContext := context.
	context := RBSmallDictionary new.
	self visitNode: aParseTree.
	context := oldContext.
	^answer! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
executeTree: aParseTree initialAnswer: aValue 
	answer := aValue.
	^self executeTree: aParseTree! !

!ParseTreeSearcher methodsFor: 'private' stamp: ''!
foundMatch! !

!ParseTreeSearcher methodsFor: 'initialize-release' stamp: ''!
initialize
	super initialize.
	context := RBSmallDictionary new.
	searches := OrderedCollection new.
	argumentSearches := OrderedCollection new: 0.
	answer := nil! !

!ParseTreeSearcher methodsFor: 'private' stamp: ''!
lookForMoreMatchesInContext: oldContext 
	oldContext keysAndValuesDo: 
			[:key :value | 
			(key isString not and: [key recurseInto]) 
				ifTrue: [value do: [:each | self visitNode: each]]]! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matches: aString do: aBlock 
	self addRule: (RBSearchRule searchFor: aString thenDo: aBlock)! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyArgumentOf: stringCollection do: aBlock 
	stringCollection do: [:each | self matchesArgument: each do: aBlock]! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyMethodOf: aStringCollection do: aBlock 
	aStringCollection do: [:each | self matchesMethod: each do: aBlock]! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyOf: aStringCollection do: aBlock 
	aStringCollection do: [:each | self matches: each do: aBlock]! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesAnyTreeOf: treeCollection do: aBlock 
	treeCollection do: [:each | self matchesTree: each do: aBlock]! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesArgument: aString do: aBlock 
	self addArgumentRule: (RBSearchRule searchFor: aString thenDo: aBlock)! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesArgumentTree: aBRProgramNode do: aBlock 
	self 
		addArgumentRule: (RBSearchRule searchForTree: aBRProgramNode thenDo: aBlock)! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesMethod: aString do: aBlock 
	self addRule: (RBSearchRule searchForMethod: aString thenDo: aBlock)! !

!ParseTreeSearcher methodsFor: 'searching' stamp: ''!
matchesTree: aBRProgramNode do: aBlock 
	self addRule: (RBSearchRule searchForTree: aBRProgramNode thenDo: aBlock)! !

!ParseTreeSearcher methodsFor: 'accessing' stamp: ''!
messages
	messages notNil ifTrue: [^messages].
	argumentSearches isEmpty ifFalse: [^messages := #()].
	messages := Set new.
	searches do: 
			[:each | 
			| searchMessages |
			searchMessages := each sentMessages.
			RBProgramNode optimizedSelectors 
				do: [:sel | searchMessages remove: sel ifAbsent: []].
			searchMessages isEmpty ifTrue: [^messages := #()].
			messages addAll: searchMessages].
	^messages := messages asArray! !

!ParseTreeSearcher methodsFor: 'private' stamp: 'pmm 7/12/2006 15:35'!
performSearches: aSearchCollection on: aNode 
	| value |
	 aSearchCollection do: [ :each |
			value := each performOn: aNode.
			value notNil ifTrue: [
				self foundMatch.
				^value ] ].
	^nil! !

!ParseTreeSearcher methodsFor: 'private' stamp: ''!
recusivelySearchInContext
	"We need to save the matched context since the other searches might overwrite it."

	| oldContext |
	oldContext := context.
	context := RBSmallDictionary new.
	self lookForMoreMatchesInContext: oldContext.
	context := oldContext! !

!ParseTreeSearcher methodsFor: 'visiting' stamp: ''!
visitArgument: aNode 
	| value |
	value := self performSearches: argumentSearches on: aNode.
	^value isNil 
		ifTrue: 
			[aNode acceptVisitor: self.
			aNode]
		ifFalse: [value]! !

!ParseTreeSearcher methodsFor: 'visiting' stamp: ''!
visitNode: aNode 
	| value |
	value := self performSearches: searches on: aNode.
	^value isNil 
		ifTrue: 
			[aNode acceptVisitor: self.
			aNode]
		ifFalse: [value]! !

RBProgramNodeVisitor subclass: #RBFormatter
	instanceVariableNames: 'codeStream lineStart firstLineLength tabs positionDelta'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Visitors'!

!RBFormatter commentStamp: 'md 8/9/2005 14:50' prior: 0!
RBFormatter formats a parse tree. It is an example of a Visitor. This is rarely called directly. Sending 'formattedCode' to a parse tree uses this algorithm to return a pretty-printed version.

Instance Variables:
	codeStream	<PositionableStream>	The buffer where the output is accumulated.
	firstLineLength	<Integer>	The length of the first line of a message send.
	lineStart	<Integer>	The position of the current line's start.
	tabs	<Integer>	The number of tabs currently indented.

!

RBFormatter subclass: #RBColorFormatter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Visitors'!

!RBColorFormatter commentStamp: '<historical>' prior: 0!
I am a specialization of RBFormatter that produces a colorized Text instead of a String as my formatted output.!

!RBColorFormatter methodsFor: 'visitor-double dispatching' stamp: 'nk 3/3/2005 10:50'!
acceptLiteralNode: aNode
	codeStream withStyleFor: #literal do: [ super acceptLiteralNode: aNode ]! !

!RBColorFormatter methodsFor: 'visitor-double dispatching' stamp: 'nk 3/3/2005 11:21'!
acceptVariableNode: aNode
	| definer usage |
	definer := aNode whoDefines: aNode name.
	usage := #variable.
	definer ifNotNil: [
		definer isBlock ifTrue: [ usage := #blockArgument ].
		definer isMethod ifTrue: [ usage := #methodArgument ].
		definer isSequence ifTrue: [ usage := #temporaryVariable ].
	].
	^codeStream withStyleFor: usage do: [ super acceptVariableNode: aNode ]! !

!RBColorFormatter methodsFor: 'private-formatting' stamp: 'nk 3/3/2005 10:51'!
formatMessageSelectorPart: part
	^codeStream withStyleFor: #keyword do: [ super formatMessageSelectorPart: part ]
	! !

!RBColorFormatter methodsFor: 'private-formatting' stamp: 'nk 3/3/2005 10:55'!
formatStatementCommentFor: aNode
	^codeStream withStyleFor: #comment do: [ super formatStatementCommentFor: aNode ]
	! !

!RBColorFormatter methodsFor: 'initialize-release' stamp: 'md 9/1/2005 13:50'!
initialize
	super initialize.
	codeStream := ColoredCodeStream on: (Text new: 400).! !

!RBColorFormatter methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:15'!
visitBlockArgument: aNode
	^codeStream withStyleFor: #blockArgument do: [ super visitBlockArgument: aNode ]! !

!RBColorFormatter methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:15'!
visitMethodArgument: aNode
	^codeStream withStyleFor: #methodArgument do: [ super visitMethodArgument: aNode ]! !

!RBColorFormatter methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:15'!
visitTemporaryVariable: aNode
	^codeStream withStyleFor: #temporaryVariable do: [ super visitTemporaryVariable: aNode ]! !

!RBFormatter class methodsFor: 'as yet unclassified' stamp: 'md 2/26/2006 15:18'!
assignmentOperator
		^':='! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'cmm 3/10/2006 17:27'!
acceptArrayNode: anArrayNode 
	self maybeJoinLinesFrom: [
		codeStream nextPutAll: '{ '.
		self indent: 1 while: [
			self indent.
			self formatStatementsFor: anArrayNode.
		].
		self indent.
		codeStream nextPutAll: ' }'.
	]! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'cmm 10/21/2007 12:13'!
acceptAssignmentNode: anAssignmentNode 
	self visitNode: anAssignmentNode variable.
	codeStream
		space ;
		nextPutAll: anAssignmentNode assignmentOperator ;
		space.
	self visitNode: anAssignmentNode value! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'lr 3/1/2008 16:41'!
acceptBlockNode: aBlockNode 
	| seqNode multiline formattedBody formatter |
	seqNode := aBlockNode body.
	formatter := (self copy) lineStart: 0;
				yourself.
	formattedBody := formatter format: seqNode.
	multiline := self lineLength + formattedBody size > self maxLineSize
				or: [formatter isMultiLine].
	multiline ifTrue: [self indent].
	codeStream nextPutAll: '[ '.
	aBlockNode arguments do: 
			[:each | 
			codeStream nextPut: $:.
			self visitBlockArgument: each.
			codeStream nextPut: $ ].
	aBlockNode arguments isEmpty ifFalse: 
			[codeStream nextPutAll: '| '.
			multiline ifTrue: [self indent]].
	codeStream nextPutAll: formattedBody;
		nextPutAll: ' ]'! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'lr 3/1/2008 16:40'!
acceptCascadeNode: aCascadeNode 
	| messages |
	messages := aCascadeNode messages.
	self visitNode: messages first receiver.
	self indentWhile: 
			[messages do: 
					[:each | 
					self
						indent;
						indentWhile: [self formatMessage: each cascade: true]]
				separatedBy: [codeStream nextPut: $;]]! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ms 4/22/2007 17:29'!
acceptDoItNode: aDoItNode 
	codeStream nextPutAll: 'DoIt'.
	self indentWhile: [
			self indent.
			self tagBeforeTemporaries ifTrue: [self formatTagFor: aDoItNode].
			aDoItNode body statements isEmpty 
				ifFalse: [self visitNode: aDoItNode body]]
! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'lr 1/4/2007 10:11'!
acceptLiteralNode: aLiteralNode
	| start |
	start := self fullPosition + 1.
	self formatLiteral: aLiteralNode value.
	aLiteralNode token start 
		ifNil: [ aLiteralNode token start: start ]! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'cmm 3/12/2006 13:24'!
acceptMessageNode: aMessageNode 
	| newFormatter code |
	newFormatter := self copy.
	code := newFormatter format: aMessageNode receiver.
	codeStream nextPutAll: code.
	codeStream nextPut: $ .
	newFormatter isMultiLine
		ifTrue: [lineStart := codeStream position - newFormatter lastLineLength].
	self indent: ((self shouldIndent: aMessageNode selector) ifTrue: [1] ifFalse: [0]) 
		while: [self formatMessage: aMessageNode cascade: false]! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'lr 10/18/2009 12:37'!
acceptMethodNode: aMethodNode 
	self formatMethodPatternFor: aMethodNode.
	self indentWhile: [
			self formatMethodCommentFor: aMethodNode indentBefore: true.
			self indent.
			aMethodNode pragmas
				do: [ :node | self visitNode: node ].
			aMethodNode body statements isEmpty 
				ifFalse: [ self visitNode: aMethodNode body ] ]
! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'lr 10/18/2009 12:40'!
acceptPragmaNode: aPragmaNode
	codeStream nextPut: $<.
	self formatMessage: aPragmaNode cascade: false.	
	codeStream nextPut: $>.	
	self indent! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/24/2003 13:15'!
acceptPseudoNode: aPseudoNode

	aPseudoNode isLabel ifTrue: [
		codeStream nextPut: $L.
		aPseudoNode destination printOn: codeStream.
		^ self].
	aPseudoNode isGoto ifTrue: [
		codeStream nextPut: $G.
		aPseudoNode destination printOn: codeStream.
		^ self].
	aPseudoNode isIf ifTrue: [
		codeStream nextPutAll: 'If '.
		codeStream nextPut: (aPseudoNode boolean ifTrue: [$t] ifFalse: [$f]).
		codeStream space.
		aPseudoNode destination printOn: codeStream.
		codeStream space.
		aPseudoNode otherwise printOn: codeStream.
		^ self].
! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'cmm 3/10/2006 17:05'!
acceptReturnNode: aReturnNode 
	codeStream nextPutAll: '^ '.
	self visitNode: aReturnNode value! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'lr 10/18/2009 12:41'!
acceptSequenceNode: aSequenceNode 
	self formatMethodCommentFor: aSequenceNode indentBefore: false.
	self formatTemporariesFor: aSequenceNode.
	self formatStatementsFor: aSequenceNode! !

!RBFormatter methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/19/2003 14:13'!
acceptVariableNode: aVariableNode

	aVariableNode token start ifNil: [
		aVariableNode token start: self fullPosition + 1].
	codeStream nextPutAll: aVariableNode name! !

!RBFormatter methodsFor: 'accessing' stamp: ''!
firstLineLength
	^firstLineLength isNil
		ifTrue: [codeStream position]
		ifFalse: [firstLineLength]! !

!RBFormatter methodsFor: 'accessing' stamp: ''!
format: aNode 
	self visitNode: aNode.
	^codeStream contents! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'md 2/26/2006 15:03'!
formatLiteral: aValue 
	| isArray |
	(isArray := aValue class == Array) | (aValue class == ByteArray) ifTrue: 
			[codeStream nextPutAll: (isArray ifTrue: ['#('] ifFalse: ['#[']).
			self maybeJoinLinesFrom: 
					[self indent: 1 while: 
							[aValue do: [:each | 
									self indent; formatLiteral: each]].
					self indent.
					codeStream nextPut: (isArray ifTrue: [$)] ifFalse: [$]])].
			^self].
	aValue isSymbol ifTrue:  [self formatSymbol: aValue. ^self].
	aValue class == Character ifTrue: 
			[codeStream nextPut: $$;
				nextPut: aValue.
			^self].
	aValue isVariableBinding ifTrue: [
		codeStream nextPutAll: '##'; nextPutAll: aValue key.
		^ self].
	aValue storeOn: codeStream! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'lr 7/3/2009 22:34'!
formatMessage: aMessageNode cascade: cascadeBoolean 
	| selectorParts arguments multiLine formattedArgs indentFirst length |
	selectorParts := aMessageNode selectorParts.
	arguments := aMessageNode arguments.
	formattedArgs := OrderedCollection new.
	multiLine := aMessageNode selector numArgs > self maximumArgumentsPerLine or: [ self selectorsToStartOnNewLine includes: aMessageNode selector ].
	length := aMessageNode selector size + arguments size + 1.
	1 
		to: arguments size
		do: 
			[ :i | 
			| formatter string |
			formatter := self copy
				lineStart: (selectorParts at: i) length negated;
				yourself.
			string := formatter format: (arguments at: i).
			(multiLine and: [ formatter isMultiLine ]) ifTrue: 
				[ "redo it with a pre-indent first"
				formatter := self copy
					lineStart: (selectorParts at: i) length negated;
					yourself.
				formatter indentWhile: [ string := formatter format: (arguments at: i) ] ].
			formattedArgs add: string.
			length := length + string size.
			multiLine := multiLine or: [ formatter isMultiLine ] ].
	multiLine := multiLine or: [ length + self lineLength > self maxLineSize ].
	indentFirst := cascadeBoolean not and: [ multiLine ].
	(indentFirst and: [ aMessageNode selector numArgs > self maximumArgumentsPerLine ]) ifTrue: [ self indent ].
	self 
		formatMessageSelector: selectorParts
		withArguments: formattedArgs
		multiline: multiLine! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'md 2/26/2006 15:19'!
formatMessageSelector: selectorParts withArguments: formattedArgs multiline: multiLine

	| selectorPart argStarts |
	argStarts := Array new: formattedArgs size.
	formattedArgs isEmpty 
		ifTrue: [
			selectorParts first start ifNil: [
				selectorParts first start: self fullPosition + 1].
			codeStream nextPutAll: selectorParts first value]
		ifFalse: [1 to: formattedArgs size do: [:i | 
					i ~~ 1 & multiLine not ifTrue: [codeStream nextPut: $ ].
					selectorPart := selectorParts at: i.
					selectorPart start ifNil: [selectorPart start: self fullPosition + 1].
					self formatMessageSelectorPart: selectorPart.
					codeStream nextPut: $ .
					argStarts at: i put: self fullPosition.
					codeStream nextPutAll: (formattedArgs at: i).
					(multiLine and: [i < formattedArgs size]) ifTrue: [self indent]]].
	^ argStarts! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'nk 1/29/2005 11:22'!
formatMessageSelectorPart: part
	codeStream nextPutAll: part value.
! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'cmm 3/10/2006 17:24'!
formatMethodCommentFor: aNode indentBefore: aBoolean 
	| source |
	source := aNode source.
	source isNil ifTrue: [^self].
	aNode comments do: 
			[:each | 
			aBoolean ifTrue: [self indent].
			codeStream nextPutAll: (aNode source copyFrom: each first to: each last).
			aBoolean ifFalse: [self indent]]! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'md 8/5/2005 11:08'!
formatMethodPatternFor: aMethodNode 
	| selectorParts arguments |
	selectorParts := aMethodNode selectorParts.
	arguments := aMethodNode arguments.
	arguments isEmpty
		ifTrue: [
			selectorParts first start ifNil: [selectorParts first start: self fullPosition + 1].
			codeStream nextPutAll: selectorParts first value]
		ifFalse: 
			[selectorParts with: arguments
				do: 
					[:selector :arg | 
					selector start ifNil: [selector start: self fullPosition + 1].
					codeStream nextPutAll: selector value;
						nextPut: $ .
					self visitMethodArgument: arg.
					codeStream nextPut: $ ]]! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'damiencassou 4/17/2009 15:40'!
formatPragmasFor: aNode
	aNode pragmas 
		do: [ :each |
			self indent.
			self visitNode: each ]! !

!RBFormatter methodsFor: 'private-formatting' stamp: ''!
formatStatementCommentFor: aNode 
	| source |
	source := aNode source.
	source isNil ifTrue: [^self].
	aNode comments do: 
			[:each | 
			| crs |
			crs := self newLinesFor: source startingAt: each first.
			(crs - 1 max: 0) timesRepeat: [codeStream cr].
			crs == 0 ifTrue: [codeStream tab] ifFalse: [self indent].
			codeStream nextPutAll: (source copyFrom: each first to: each last)]! !

!RBFormatter methodsFor: 'private-formatting' stamp: ''!
formatStatementsFor: aSequenceNode 
	| statements |
	statements := aSequenceNode statements.
	statements isEmpty ifTrue: [^self].
	1 to: statements size - 1
		do: 
			[:i | 
			self visitNode: (statements at: i).
			codeStream nextPut: $..
			self formatStatementCommentFor: (statements at: i).
			self indent].
	self visitNode: statements last.
	self formatStatementCommentFor: statements last! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'md 8/26/2004 18:34'!
formatSymbol: aSymbol 
	"Format the symbol, if its not a selector then we must put quotes around it. The and: case below, 
	handles the VisualWorks problem of not accepting two bars as a symbol."

	codeStream nextPut: $#.
	((Scanner isLiteralSymbol: aSymbol) and: [aSymbol ~~ #'||']) 
		ifTrue: [codeStream nextPutAll: aSymbol]
		ifFalse: [aSymbol asString printOn: codeStream]
	

"	((RBScanner isSelector: aSymbol) and: [aSymbol ~~ #'||']) 
		ifTrue: [codeStream nextPutAll: aSymbol]
		ifFalse: [aSymbol asString printOn: codeStream]"! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'nk 1/29/2005 11:30'!
formatTemporariesFor: aSequenceNode 
	| temps |
	temps := aSequenceNode temporaries.
	temps isEmpty ifTrue: [^self].
	codeStream nextPutAll: '| '.
	temps do: 
			[:each | 
			self visitTemporaryVariable: each.
			codeStream nextPut: $ ].
	codeStream nextPut: $|.
	self indent! !

!RBFormatter methodsFor: 'position fill' stamp: 'ajh 3/19/2003 14:12'!
fullPosition

	^ positionDelta + codeStream position! !

!RBFormatter methodsFor: 'private' stamp: ''!
indent
	firstLineLength isNil ifTrue: [firstLineLength := codeStream position].
	codeStream cr.
	tabs timesRepeat: [codeStream tab].
	lineStart := codeStream position! !

!RBFormatter methodsFor: 'private' stamp: ''!
indent: anInteger while: aBlock 
	tabs := tabs + anInteger.
	aBlock value.
	tabs := tabs - anInteger! !

!RBFormatter methodsFor: 'private' stamp: ''!
indentWhile: aBlock 
	self indent: 1 while: aBlock! !

!RBFormatter methodsFor: 'initialize-release' stamp: 'md 2/26/2006 15:01'!
initialize
	super initialize.
	codeStream := WriteStream on: (String new: 60).
	tabs := 0.
	lineStart := 0.
	positionDelta := 0.
! !

!RBFormatter methodsFor: 'accessing' stamp: ''!
isMultiLine
	^firstLineLength notNil! !

!RBFormatter methodsFor: 'accessing' stamp: ''!
lastLineLength
	^codeStream position - (lineStart max: 0)! !

!RBFormatter methodsFor: 'private' stamp: ''!
lineLength
	^codeStream position - lineStart! !

!RBFormatter methodsFor: 'private' stamp: ''!
lineStart: aPosition 
	lineStart := aPosition! !

!RBFormatter methodsFor: 'private' stamp: ''!
maxLineSize
	^75! !

!RBFormatter methodsFor: 'private' stamp: 'cmm 3/10/2006 16:58'!
maximumArgumentsPerLine
	^ 1! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'apl 3/26/2005 14:51'!
maybeJoinLinesFrom: aBlock 
	| statementBegin statementEnd statementText statementLines initialLineLength |
	initialLineLength := self lineLength.
	statementBegin := codeStream position.
	aBlock value.
	statementEnd := codeStream position.
	statementText := codeStream contents copyFrom: statementBegin + 1
				to: statementEnd.
	initialLineLength + statementText size < self maxLineSize 
		ifTrue: 
			[statementLines := statementText asString 
						findTokens: String cr , String tab.
			codeStream position: statementBegin.
			statementLines do: [:line | codeStream nextPutAll: line]
				separatedBy: [codeStream space]]! !

!RBFormatter methodsFor: 'private' stamp: 'lr 7/3/2009 22:34'!
needsParenthesisFor: aNode 
	| parent |
	aNode isValue ifFalse: [ ^ false ].
	parent := aNode parent.
	parent isNil ifTrue: [ ^ false ].
	"	(aNode isMessage and: [parent isMessage and: [parent receiver == aNode]])
		ifTrue: 
			[grandparent _ parent parent.
			(grandparent notNil and: [grandparent isCascade]) ifTrue: [^true]]."
	aNode precedence < parent precedence ifTrue: [ ^ false ].
	aNode isAssignment & parent isAssignment ifTrue: [ ^ false ].
	aNode isAssignment | aNode isCascade ifTrue: [ ^ true ].
	aNode precedence == 0 ifTrue: [ ^ false ].
	aNode isMessage ifFalse: [ ^ true ].
	aNode precedence = parent precedence ifFalse: [ ^ true ].
	aNode isUnary ifTrue: [ ^ false ].
	aNode isKeyword ifTrue: [ ^ true ].
	parent receiver == aNode ifFalse: [ ^ true ].
	^ self 
		precedenceOf: parent selector
		greaterThan: aNode selector! !

!RBFormatter methodsFor: 'private-formatting' stamp: ''!
newLinesFor: aString startingAt: anIndex 
	| count cr lf index char |
	cr := Character value: 13.
	lf := Character value: 10.
	count := 0.
	index := anIndex - 1.
	[index > 0 and: 
			[char := aString at: index.
			char isSeparator]] 
		whileTrue: 
			[char == lf 
				ifTrue: 
					[count := count + 1.
					(aString at: (index - 1 max: 1)) == cr ifTrue: [index := index - 1]].
			char == cr ifTrue: [count := count + 1].
			index := index - 1].
	^count! !

!RBFormatter methodsFor: 'copying' stamp: 'pmm 2/24/2006 11:01'!
postCopy
	super postCopy.
	positionDelta := positionDelta + codeStream position.
	lineStart := self lineLength negated.
	codeStream := (codeStream ifNil: [ WriteStream on: (String new: 60) ]
		ifNotNil: [ codeStream class on: (codeStream contents class new: 60) ]).
	firstLineLength := nil! !

!RBFormatter methodsFor: 'private' stamp: ''!
precedenceOf: parentSelector greaterThan: childSelector 
	"Put parenthesis around things that are preceived to have 'lower' precedence. For example, 'a + b * c' 
	-> '(a + b) * c' but 'a * b + c' -> 'a * b + c'"

	| childIndex parentIndex operators |
	operators := #(#($| $& $?) #($= $~ $< $>) #($- $+) #($* $/ $% $\) #($@)).
	childIndex := 0.
	parentIndex := 0.
	1 to: operators size
		do: 
			[:i | 
			((operators at: i) includes: parentSelector first) ifTrue: [parentIndex := i].
			((operators at: i) includes: childSelector first) ifTrue: [childIndex := i]].
	^childIndex < parentIndex! !

!RBFormatter methodsFor: 'private' stamp: 'cmm 3/10/2006 16:58'!
selectorsToLeaveOnLine
	^#()! !

!RBFormatter methodsFor: 'private' stamp: 'cmm 3/14/2006 21:13'!
selectorsToStartOnNewLine
	^#(and: or:)! !

!RBFormatter methodsFor: 'private-formatting' stamp: 'cmm 3/12/2006 13:30'!
shouldIndent: selectorSymbol
	^ (#(and: or:) includes: selectorSymbol) not! !

!RBFormatter methodsFor: 'testing' stamp: ''!
startMessageSendOnNewLine: aMessageNode 
	(self selectorsToStartOnNewLine includes: aMessageNode selector) 
		ifTrue: [^true].
	(self selectorsToLeaveOnLine includes: aMessageNode selector) ifTrue: [^false].
	^aMessageNode selector numArgs > self maximumArgumentsPerLine! !

!RBFormatter methodsFor: 'testing' stamp: 'md 2/26/2006 15:00'!
tagBeforeTemporaries
	^false! !

!RBFormatter methodsFor: 'visiting' stamp: ''!
visitNode: aNode 
	| parenthesis |
	parenthesis := self needsParenthesisFor: aNode.
	parenthesis ifTrue: [codeStream nextPut: $(].
	aNode acceptVisitor: self.
	parenthesis ifTrue: [codeStream nextPut: $)]! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ls 1/24/2000 00:31'!
acceptArrayNode: anArrayNode 
	anArrayNode children do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''!
acceptAssignmentNode: anAssignmentNode 
	self visitNode: anAssignmentNode variable.
	self visitNode: anAssignmentNode value! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:10'!
acceptBlockNode: aBlockNode 
	self visitBlockArguments: aBlockNode arguments.
	self visitNode: aBlockNode body! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''!
acceptCascadeNode: aCascadeNode 
	aCascadeNode messages do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ajh 2/26/2003 18:34'!
acceptDoItNode: aDoItNode 
	self visitNode: aDoItNode body! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''!
acceptLiteralNode: aLiteralNode! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''!
acceptMessageNode: aMessageNode 
	(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
		ifTrue: [self visitNode: aMessageNode receiver].
	aMessageNode arguments do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ms 9/19/2006 14:45'!
acceptMethodNode: aMethodNode

	self visitMethodArguments: aMethodNode arguments.
	aMethodNode pragmas do: [:each | self visitNode: each].
	self visitNode: aMethodNode body! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'lr 10/18/2009 12:37'!
acceptPragmaNode: aPragmaNode
	aPragmaNode arguments do: [ :each | self visitNode: each ]! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/3/2003 12:43'!
acceptPseudoNode: aVariableNode! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''!
acceptReturnNode: aReturnNode 
	self visitNode: aReturnNode value! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: 'nk 1/29/2005 11:08'!
acceptSequenceNode: aSequenceNode 
	self visitTemporaryVariables: aSequenceNode temporaries.
	aSequenceNode statements do: [:each | self visitNode: each]! !

!RBProgramNodeVisitor methodsFor: 'visitor-double dispatching' stamp: ''!
acceptVariableNode: aVariableNode! !

!RBProgramNodeVisitor methodsFor: 'copying' stamp: ''!
postCopy! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitArgument: each 
	"Here to allow subclasses to detect arguments or temporaries."

	^self visitNode: each! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitArguments: aNodeCollection 
	^aNodeCollection do: [:each | self visitArgument: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:10'!
visitBlockArgument: each 
	"Here to allow subclasses to detect arguments or temporaries."

	^self visitArgument: each! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:09'!
visitBlockArguments: aNodeCollection 
	^aNodeCollection do: [:each | self visitBlockArgument: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:09'!
visitMethodArgument: each 
	"Here to allow subclasses to detect arguments or temporaries."

	^self visitArgument: each! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:09'!
visitMethodArguments: aNodeCollection 
	^aNodeCollection do: [:each | self visitMethodArgument: each]! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: ''!
visitNode: aNode 
	^aNode acceptVisitor: self! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:14'!
visitTemporaryVariable: aNode
	^self visitArgument: aNode! !

!RBProgramNodeVisitor methodsFor: 'visiting' stamp: 'nk 1/29/2005 11:07'!
visitTemporaryVariables: aNodeCollection 
	^aNodeCollection do: [:each | self visitTemporaryVariable: each]! !

RBProgramNodeVisitor subclass: #RBReadBeforeWrittenTester
	instanceVariableNames: 'read checkNewTemps scopeStack'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:48'!
isVariable: aString readBeforeWrittenIn: aBRProgramNode 
	^(self isVariable: aString writtenBeforeReadIn: aBRProgramNode) not! !

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:49'!
isVariable: aString writtenBeforeReadIn: aBRProgramNode 
	^(self readBeforeWritten: (Array with: aString) in: aBRProgramNode) 
		isEmpty! !

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:49'!
readBeforeWritten: varNames in: aParseTree 
	^(self new)
		checkNewTemps: false;
		initializeVars: varNames;
		executeTree: aParseTree;
		read! !

!RBReadBeforeWrittenTester class methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:49'!
variablesReadBeforeWrittenIn: aParseTree 
	^(self new)
		executeTree: aParseTree;
		read! !

!RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:45'!
acceptAssignmentNode: anAssignmentNode 
	self visitNode: anAssignmentNode value.
	self variableWritten: anAssignmentNode! !

!RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:46'!
acceptBlockNode: aBlockNode 
	self processBlock: aBlockNode.! !

!RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'pmm 7/12/2006 15:51'!
acceptMessageNode: aMessageNode 
	((#(#whileTrue: #whileFalse: #whileTrue #whileFalse) 
		includes: aMessageNode selector) and: [aMessageNode receiver isBlock]) 
		ifTrue: [self executeTree: aMessageNode receiver body]
		ifFalse: 
			[(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
				ifTrue: [self visitNode: aMessageNode receiver]].
	((#(#ifTrue:ifFalse: #ifFalse:ifTrue:) includes: aMessageNode selector) 
		and: 
			[ aMessageNode arguments allSatisfy: [:each | each isBlock] ]) 
			ifTrue: [^self processIfTrueIfFalse: aMessageNode].
	aMessageNode arguments do: [:each | self visitNode: each]! !

!RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:46'!
acceptSequenceNode: aSequenceNode 
	self processStatementNode: aSequenceNode! !

!RBReadBeforeWrittenTester methodsFor: 'visitor-double dispatching' stamp: 'bh 3/15/2000 16:47'!
acceptVariableNode: aVariableNode 
	self variableRead: aVariableNode! !

!RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: ''!
checkNewTemps: aBoolean 
	checkNewTemps := aBoolean! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:40'!
copyDictionary: aDictionary 
	"We could send aDictionary the copy message, but that doesn't copy the associations."

	| newDictionary |
	newDictionary := Dictionary new: aDictionary size.
	aDictionary
		keysAndValuesDo: [:key :value | newDictionary at: key put: value].
	^newDictionary! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
createScope
	scopeStack add: (self copyDictionary: scopeStack last)! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
currentScope
	^scopeStack last! !

!RBReadBeforeWrittenTester methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:39'!
executeTree: aParseTree 
	^self visitNode: aParseTree! !

!RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: 'bh 3/15/2000 16:37'!
initialize
	scopeStack := OrderedCollection with: Dictionary new.
	read := Set new.
	checkNewTemps := true.
! !

!RBReadBeforeWrittenTester methodsFor: 'initialize-release' stamp: ''!
initializeVars: varNames 
	varNames do: [:each | self currentScope at: each put: nil]! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:41'!
processBlock: aNode 
	| newScope |
	self createScope.
	self executeTree: aNode body.
	newScope := self removeScope.
	newScope keysAndValuesDo: 
			[:key :value | 
			(value == true and: [(self currentScope at: key) isNil]) 
				ifTrue: [self currentScope at: key put: value]]! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:42'!
processIfTrueIfFalse: aNode 
	| trueScope falseScope |
	self createScope.
	self executeTree: aNode arguments first body.
	trueScope := self removeScope.
	self createScope.
	self executeTree: aNode arguments last body.
	falseScope := self removeScope.
	self currentScope keysAndValuesDo: 
			[:key :value | 
			value isNil 
				ifTrue: 
					[(trueScope at: key) == (falseScope at: key) 
						ifTrue: [self currentScope at: key put: (trueScope at: key)]
						ifFalse: 
							[((trueScope at: key) == true or: [(falseScope at: key) == true]) 
								ifTrue: [self currentScope at: key put: true]]]]! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:42'!
processStatementNode: aNode 
	| temps |
	(checkNewTemps not or: [aNode temporaries isEmpty]) 
		ifTrue: 
			[aNode statements do: [:each | self executeTree: each].
			^self].
	self createScope.
	temps := aNode temporaries collect: [:each | each name].
	self initializeVars: temps.
	aNode statements do: [:each | self executeTree: each].
	self removeScope keysAndValuesDo: 
			[:key :value | 
			(temps includes: key) 
				ifTrue: [value == true ifTrue: [read add: key]]
				ifFalse: 
					[(self currentScope at: key) isNil 
						ifTrue: [self currentScope at: key put: value]]]! !

!RBReadBeforeWrittenTester methodsFor: 'accessing' stamp: 'bh 3/15/2000 16:39'!
read
	self currentScope
		keysAndValuesDo: [:key :value | value == true ifTrue: [read add: key]].
	^read! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: ''!
removeScope
	^scopeStack removeLast! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:44'!
variableRead: aNode 
	(self currentScope includesKey: aNode name) ifTrue: 
			[(self currentScope at: aNode name) isNil
				ifTrue: [self currentScope at: aNode name put: true]]! !

!RBReadBeforeWrittenTester methodsFor: 'private' stamp: 'bh 3/15/2000 16:45'!
variableWritten: aNode 
	(self currentScope includesKey: aNode variable name) ifTrue: 
			[(self currentScope at: aNode variable name) isNil
				ifTrue: [self currentScope at: aNode variable name put: false]]! !

Object subclass: #RBToken
	instanceVariableNames: 'sourcePointer next previous'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBToken commentStamp: 'md 8/9/2005 14:53' prior: 0!
RBToken is the abstract superclass of all of the RB tokens. These tokens (unlike the standard parser's) remember where they came from in the original source code.

Subclasses must implement the following messages:
	accessing
		length

Instance Variables:
	sourcePointer	<Integer>	The position in the original source code where this token began.
!

RBToken subclass: #RBAssignmentToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBAssignmentToken commentStamp: 'md 8/9/2005 14:51' prior: 0!
RBAssignmentToken is the first-class representation of the assignment token ':='
!

!RBAssignmentToken methodsFor: 'testing' stamp: ''!
isAssignment
	^true! !

!RBAssignmentToken methodsFor: 'private' stamp: 'ls 1/11/2000 07:00'!
length
	^2! !

RBAssignmentToken subclass: #RBShortAssignmentToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBShortAssignmentToken methodsFor: 'private' stamp: 'ls 1/11/2000 07:00'!
length
	^1! !

!RBToken class methodsFor: 'instance creation' stamp: ''!
start: anInterval 
	^self new start: anInterval! !

!RBToken methodsFor: 'testing' stamp: ''!
isAssignment
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isBinary
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isIdentifier
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isKeyword
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isLiteral
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isPatternBlock
	^false! !

!RBToken methodsFor: 'testing' stamp: ''!
isPatternVariable
	^false! !

!RBToken methodsFor: 'testing' stamp: 'md 9/1/2005 16:02'!
isRBToken
	^true.! !

!RBToken methodsFor: 'testing' stamp: ''!
isSpecial
	^false! !

!RBToken methodsFor: 'accessing' stamp: ''!
length
	^self subclassResponsibility! !

!RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:05'!
next

	^next! !

!RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:05'!
next: aToken

	next := aToken! !

!RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:04'!
previous

	^previous! !

!RBToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 02:05'!
previous: aToken

	aToken ifNotNil:[aToken next: self].
	previous := aToken! !

!RBToken methodsFor: 'printing' stamp: ''!
printOn: aStream 
	aStream
		nextPut: $ ;
		nextPutAll: self class name! !

!RBToken methodsFor: 'accessing' stamp: ''!
removePositions
	sourcePointer := nil! !

!RBToken methodsFor: 'accessing' stamp: ''!
start
	^sourcePointer! !

!RBToken methodsFor: 'initialize-release' stamp: ''!
start: anInteger 
	sourcePointer := anInteger! !

!RBToken methodsFor: 'accessing' stamp: ''!
stop
	^self start + self length - 1! !

RBToken subclass: #RBValueToken
	instanceVariableNames: 'value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBValueToken commentStamp: 'md 8/9/2005 14:53' prior: 0!
RBValueToken is the abstract superclass of all tokens that have additional information attached. For example, the BinarySelector token holds onto the actual character (e.g. $+).

Instance Variables:
	value	<String>	The value of this token!

RBValueToken subclass: #RBBinarySelectorToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBBinarySelectorToken commentStamp: 'md 8/9/2005 14:51' prior: 0!
RBBinarySelectorToken is the first-class representation of a binary selector (e.g. +)
!

!RBBinarySelectorToken methodsFor: 'testing' stamp: ''!
isBinary
	^true! !

RBValueToken subclass: #RBIdentifierToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBIdentifierToken commentStamp: 'md 8/9/2005 14:51' prior: 0!
RBIdentifierToken is the first class representation of an identifier token (e.g. Class)
!

!RBIdentifierToken methodsFor: 'testing' stamp: ''!
isIdentifier
	^true! !

!RBIdentifierToken methodsFor: 'testing' stamp: 'md 8/26/2004 18:36'!
isPatternVariable
	^value first == $`.
		"value first == RBScanner patternVariableCharacter"! !

RBValueToken subclass: #RBKeywordToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBKeywordToken commentStamp: 'md 8/9/2005 14:52' prior: 0!
RBKeywordToken is the first-class representation of a keyword token (e.g. add:)!

!RBKeywordToken methodsFor: 'testing' stamp: ''!
isKeyword
	^true! !

!RBKeywordToken methodsFor: 'testing' stamp: 'md 8/26/2004 18:37'!
isPatternVariable
		^value first == $`.
		"value first == RBScanner patternVariableCharacter"! !

RBValueToken subclass: #RBLiteralToken
	instanceVariableNames: 'stopPosition'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBLiteralToken commentStamp: 'md 8/9/2005 14:52' prior: 0!
RBLiteralToken is the first-class representation of a literal token (entire literals, even literal arrays, are a single token in the ST80 grammar.).

Instance Variables:
	stopPosition	<Integer>	The position within the source code where the token terminates.

!

!RBLiteralToken class methodsFor: 'instance creation' stamp: 'md 1/11/2008 14:24'!
value: anObject 
	| literal |
	literal := anObject class == Array 
				ifTrue: [anObject collect: [:each | self value: each]]
				ifFalse: [anObject].
	^self 
		value: literal
		start: 0
		stop: (literal isLiteral ifTrue: [anObject printString size] 
									    ifFalse: [1]).! !

!RBLiteralToken class methodsFor: 'instance creation' stamp: ''!
value: aString start: anInteger stop: stopInteger 
	^self new
		value: aString
		start: anInteger
		stop: stopInteger! !

!RBLiteralToken methodsFor: 'testing' stamp: ''!
isLiteral
	^true! !

!RBLiteralToken methodsFor: 'private' stamp: 'ms 6/14/2007 20:38'!
length
	^stopPosition ifNil: [value size] ifNotNil: [stopPosition - self start + 1]! !

!RBLiteralToken methodsFor: 'accessing' stamp: ''!
stop: anObject 
	stopPosition := anObject! !

!RBLiteralToken methodsFor: 'initialize-release' stamp: ''!
value: aString start: anInteger stop: stopInteger 
	value := aString.
	sourcePointer := anInteger.
	stopPosition := stopInteger! !

RBValueToken subclass: #RBPatternBlockToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBPatternBlockToken commentStamp: 'md 8/9/2005 14:52' prior: 0!
RBPatternBlockToken is the first-class representation of the pattern block token.

!

!RBPatternBlockToken methodsFor: 'testing' stamp: ''!
isPatternBlock
	^true! !

RBValueToken subclass: #RBSpecialCharacterToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Tokens'!

!RBSpecialCharacterToken commentStamp: 'md 8/9/2005 14:53' prior: 0!
RBSpecialCharacterToken is the first class representation of special characters.

!

!RBSpecialCharacterToken methodsFor: 'testing' stamp: ''!
isSpecial
	^true! !

!RBSpecialCharacterToken methodsFor: 'private' stamp: 'md 8/30/2006 17:21'!
length
	^1! !

!RBValueToken class methodsFor: 'instance creation' stamp: ''!
value: aString start: anInteger 
	^self new value: aString start: anInteger! !

!RBValueToken methodsFor: 'private' stamp: ''!
length
	^value size! !

!RBValueToken methodsFor: 'printing' stamp: ''!
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $(.
	value printOn: aStream.
	aStream nextPutAll: ')'! !

!RBValueToken methodsFor: 'accessing' stamp: 'pmm 7/31/2006 11:32'!
realValue
	^value class == Array
		ifTrue: [value collect: [:each | each realValue]]
		ifFalse: [value]! !

!RBValueToken methodsFor: 'accessing' stamp: ''!
value
	^value! !

!RBValueToken methodsFor: 'accessing' stamp: ''!
value: anObject
	value := anObject! !

!RBValueToken methodsFor: 'initialize-release' stamp: ''!
value: aString start: anInteger 
	value := aString.
	sourcePointer := anInteger! !

Dictionary subclass: #RBSmallDictionary
	instanceVariableNames: 'values'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBSmallDictionary commentStamp: 'md 4/1/2007 12:34' prior: 0!
RBSmallDictionary is a special dictionary optimized for small collections. In addition to the normal dictionary protocol, it also supports an #empty message which "empties" the collection but may hang on to the original elements (so it could collect garbage). Without #empty we would either need to create a new dictionary or explicitly remove everything from the dictionary. Both of these take more time and #empty.

Instance Variables:
array <Array of: Object> array of keys (we don't use Associations for our key value pairs)
tally <Integer> the size of the dictionary
values <Array of: Object> array of our values
!

!RBSmallDictionary class methodsFor: 'instance creation' stamp: 'md 3/31/2007 11:19'!
new
	^self basicNew initialize: 2! !

!RBSmallDictionary class methodsFor: 'instance creation' stamp: 'md 4/3/2007 12:09'!
new: aSize 

	^self basicNew initialize: aSize.! !

!RBSmallDictionary methodsFor: 'adding' stamp: ''!
add: anAssociation 
	self at: anAssociation key put: anAssociation value.
	^anAssociation! !

!RBSmallDictionary methodsFor: 'accessing' stamp: 'md 4/13/2007 11:47'!
associationAt: key ifAbsent: aBlock
	 
	| index |
	index := self findIndexFor: key.
	^index == 0 ifTrue: [aBlock value] ifFalse: [ key -> (values at: index)].! !

!RBSmallDictionary methodsFor: 'enumerating' stamp: ''!
associationsDo: aBlock 
	self keysAndValuesDo: [:key :value | aBlock value: key -> value]! !

!RBSmallDictionary methodsFor: 'accessing' stamp: ''!
at: key ifAbsent: aBlock 
	| index |
	index := self findIndexFor: key.
	^index == 0 ifTrue: [aBlock value] ifFalse: [values at: index]! !

!RBSmallDictionary methodsFor: 'accessing' stamp: ''!
at: key ifAbsentPut: aBlock 
	| index |
	index := self findIndexFor: key.
	^index == 0 
		ifTrue: [self privateAt: key put: aBlock value]
		ifFalse: [values at: index]! !

!RBSmallDictionary methodsFor: 'adding' stamp: ''!
at: key put: value 
	| index |
	index := self findIndexFor: key.
	^index == 0 
		ifTrue: [self privateAt: key put: value]
		ifFalse: [values at: index put: value]! !

!RBSmallDictionary methodsFor: 'copying' stamp: 'md 3/29/2007 23:26'!
copy
	^self shallowCopy postCopy! !

!RBSmallDictionary methodsFor: 'enumerating' stamp: 'md 3/30/2007 16:03'!
do: aBlock 
	1 to: tally do: [:i | aBlock value: (values at: i)]! !

!RBSmallDictionary methodsFor: 'accessing' stamp: 'md 3/30/2007 16:05'!
empty
	tally := 0! !

!RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:09'!
findIndexFor: aKey 
	1 to: tally do: [:i | (array at: i) = aKey ifTrue: [^i]].
	^0! !

!RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:04'!
growKeysAndValues
	self growTo: tally * 2! !

!RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:08'!
growTo: aSize 
	| newKeys newValues |
	newKeys := Array new: aSize.
	newValues := Array new: aSize.
	1 to: tally
		do: 
			[:i | 
			newKeys at: i put: (array at: i).
			newValues at: i put: (values at: i)].
	array := newKeys.
	values := newValues! !

!RBSmallDictionary methodsFor: 'testing' stamp: ''!
includesKey: aKey 
	^(self findIndexFor: aKey) ~~ 0! !

!RBSmallDictionary methodsFor: 'initialize-release' stamp: 'md 4/3/2007 12:10'!
initialize: size
	array := Array new: size.
	values := Array new: size.
	tally := 0! !

!RBSmallDictionary methodsFor: 'enumerating' stamp: 'md 3/30/2007 16:09'!
keysAndValuesDo: aBlock 
	1 to: tally do: [:i | aBlock value: (array at: i) value: (values at: i)]! !

!RBSmallDictionary methodsFor: 'enumerating' stamp: 'md 3/30/2007 16:08'!
keysDo: aBlock 
	1 to: tally do: [:i | aBlock value: (array at: i)]! !

!RBSmallDictionary methodsFor: 'adding' stamp: 'md 4/13/2007 11:49'!
noCheckAdd: anObject
	^self add: anObject! !

!RBSmallDictionary methodsFor: 'copying' stamp: 'md 3/30/2007 16:09'!
postCopy
	array := array copy.
	values := values copy! !

!RBSmallDictionary methodsFor: 'private' stamp: 'md 3/30/2007 16:08'!
privateAt: key put: value 
	tally == array size ifTrue: [self growKeysAndValues].
	tally := tally + 1.
	array at: tally put: key.
	^values at: tally put: value! !

!RBSmallDictionary methodsFor: 'private' stamp: 'md 4/13/2007 16:45'!
rehash
	"do nothing for now"! !

!RBSmallDictionary methodsFor: 'removing' stamp: 'md 3/29/2007 23:24'!
remove:anAssociation

	self removeKey: anAssociation key.! !

!RBSmallDictionary methodsFor: 'removing' stamp: ''!
remove: oldObject ifAbsent: anExceptionBlock 
	self removeKey: oldObject key ifAbsent: anExceptionBlock.
	^oldObject! !

!RBSmallDictionary methodsFor: 'removing' stamp: 'md 3/30/2007 16:09'!
removeKey: key ifAbsent: aBlock 
	| index value |
	index := self findIndexFor: key.
	index == 0 ifTrue: [^aBlock value].
	value := values at: index.
	index to: tally - 1 do: [:i | 
			array at: i put: (array at: i + 1).
			values at: i put: (values at: i + 1)].
	array at: tally put: nil.
	values at: tally put: nil.
	tally := tally - 1.
	^value! !

!RBSmallDictionary methodsFor: 'accessing' stamp: 'md 3/30/2007 16:04'!
size
	^tally! !

RBSmallDictionary subclass: #RBSmallIdentityDictionary
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'AST-Core-Matching'!

!RBSmallIdentityDictionary methodsFor: 'private' stamp: 'md 4/2/2007 08:21'!
findIndexFor: aKey 
	1 to: tally do: [:i | (array at: i) == aKey ifTrue: [^i]].
	^0! !

!RBSmallIdentityDictionary methodsFor: 'accessing' stamp: 'md 4/2/2007 08:27'!
keys
	"Answer a Set containing the receiver's keys."
	| aSet |
	aSet := IdentitySet new: self size.
	self keysDo: [:key | aSet add: key].
	^ aSet! !
RBScanner initialize!
ASTPrettyPrinting initialize!
RBProgramNode initialize!