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

PPCListNode subclass:#PPCTrimmingTokenNode

	instanceVariableNames:'tokenClass'

	classVariableNames:''

	poolDictionaries:''

	category:'PetitCompiler-Nodes'

!

PPCTrimmingTokenNode comment:''

!

!PPCTrimmingTokenNode methodsFor:'accessing'!

child

	^ children at: 2

!

child: anObject

	children at: 2 put: anObject

!

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, '_water'.

	].

	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.

! !

!PPCTrimmingTokenNode methodsFor:'as yet unclassified'!

compileWith: compiler effect: effect id: id

	|  guardSetId guardSet |

	compiler startMethod: id.

	compiler startTokenMode.

	compiler addVariable: 'start'.

	compiler addVariable: 'end'.

	self compileWhitespace: compiler.

	(compiler guards and: [ (guardSet := compiler guardCharSet: self) isNil not ]) ifTrue: [ 	

		guardSetId := id, '_guard'.

		compiler addConstant: guardSet as: guardSetId.

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

		compiler add: '(', guardSetId, ' value: context peek) 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 compileWhitespace: compiler.

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

																start: start  

																stop: end

																value: nil'.

	compiler stopTokenMode.

 ^ compiler stopMethod.	

!

prefix

	^ #token

! !