--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCTrimmingTokenNode.st	Sun Oct 26 01:03:31 2014 +0000
@@ -0,0 +1,132 @@
+"{ 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
+! !
+