"{ Package: 'stx:goodies/petitparser/compiler' }"

PPCListNode subclass:#PPCTrimmingTokenNode

	instanceVariableNames:'tokenClass'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Nodes'

!

!PPCTrimmingTokenNode methodsFor:'accessing'!

child

	^ children at: 2

!

child: anObject

	children at: 2 put: anObject

!

compileFirstWhitespace: compiler

	compiler call: (self whitespace compileWith: compiler).

!

compileSecondWhitespace: compiler

	| root follow |

	root := compiler rootNode.

	follow := self followSetWithTokens.

	(follow allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [  

		compiler add: '"second water skipped because there are only trimming tokens in the follow"'

	] ifFalse: [  

		compiler add: '"second water compiled because some of the follow parsers are not trimming toknes"'.

		compiler call: (self whitespace compileWith: compiler).

	]

!

compileWhitespace: compiler

	compiler add: 'context atWs ifFalse: ['.

	compiler indent.

		compiler call: (self whitespace compileWith: compiler).

		compiler add: 'context setWs.'.

	compiler dedent.

	compiler add: '].'.

!

initialize

	super initialize.

	children := Array new: 2

!

rewrite: changeStatus

	|  |

	super rewrite: changeStatus.

	(self allNodes anySatisfy: [ :node | node asFast ~= node ]) ifTrue: [  

		changeStatus change.

		self replace: self whitespace with: (self whitespace transform: [ :node | node asFast ]).

		self replace: self child with: (self child transform: [:node | node asFast]).

	]

!

tokenClass

	^ tokenClass

!

tokenClass: anObject

	tokenClass := anObject

!

whitespace

	^ children at: 1

!

whitespace: anObject

	(anObject name isNil and: [ self child name isNotNil ]) ifTrue: [ 

		anObject name: self child name, '_ws'.

	].

	children at: 1 put: anObject

! !

!PPCTrimmingTokenNode methodsFor:'analyzing'!

acceptsEpsilon

	^ self child acceptsEpsilonOpenSet: (IdentitySet with: self).

!

acceptsEpsilonOpenSet: set

	(set includes: self child) ifFalse: [ 

		set add: self child.

		^ self child acceptsEpsilonOpenSet: set 

	].

	^ false

!

firstSetSuchThat: block into: aCollection openSet: aSet

	(aSet includes: self) ifTrue: [ ^ aCollection ].

	aSet add: self.

	(block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].

	^ self child firstSetSuchThat: block into: aCollection openSet: aSet.

!

firstSets: aFirstDictionary into: aSet suchThat: aBlock

	"PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."

	(aBlock value: self) ifFalse: [ 

		aSet addAll: (aFirstDictionary at: self child)

	]

! !

!PPCTrimmingTokenNode methodsFor:'as yet unclassified'!

compileWith: compiler effect: effect id: id

	|  guard |

	compiler startMethod: id.

	compiler addVariable: 'start'.

	compiler addVariable: 'end'.

	"self compileFirstWhitespace: compiler."

	self compileWhitespace: compiler.

	(compiler guards and: [(guard := PPCGuard on: self) makesSense]) ifTrue: [ 

		compiler add: 'context atEnd ifTrue: [ ^ self error ].'.

		guard id: id, '_guard'.

		guard compileGuard: compiler.

		compiler addOnLine: 'ifFalse: [ ^ self error ].'

	].

	compiler add: 'start := context position + 1.'.

	compiler call: (self child compileWith: compiler).

	compiler add: 'error ifTrue: [ ^ self ].'.	

	compiler add: 'end := context position.'.

"	self compileSecondWhitespace: compiler."

	self compileWhitespace: compiler.

	compiler add: '^ ', tokenClass asString, ' on: (context collection) 

																start: start  

																stop: end

																value: nil'.

 ^ compiler stopMethod.	

!

prefix

	^ #token

! !

!PPCTrimmingTokenNode methodsFor:'comparing'!

= anotherNode

	super = anotherNode ifFalse: [ ^ false ].

	^ tokenClass = anotherNode tokenClass.

!

hash

	^ super hash bitXor: tokenClass hash

! !