--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCGuard.st	Sun Oct 26 01:03:31 2014 +0000
@@ -0,0 +1,150 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+Object subclass:#PPCGuard
+	instanceVariableNames:'node classification id message'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Core'
+!
+
+PPCGuard comment:''
+!
+
+!PPCGuard class methodsFor:'as yet unclassified'!
+
+on: aPPCNode
+	^ self new
+		initializeFor: aPPCNode;
+		yourself
+! !
+
+!PPCGuard methodsFor:'accessing'!
+
+id
+	
+	^ id
+!
+
+id: anObject
+	
+	id := anObject
+!
+
+message
+	(message == #unknown) ifTrue: [ 
+		(self testMessage: #isLetter) ifTrue: [ ^ message := #isLetter ].
+		(self testMessage: #isAlphaNumeric) ifTrue: [ ^ message := #isAlphaNumeric ].
+		(self testMessage: #isDigit) ifTrue: [ ^ message := #isDigit ].
+		
+		^ message := nil.
+	].
+	^ message
+! !
+
+!PPCGuard methodsFor:'as yet unclassified'!
+
+classificationOn: aBlock
+	classification := Array new: 255.
+	1 to: classification size do: [ :index |
+		classification at: index put: (aBlock
+			value: (Character value: index)) ].
+!
+
+compileAny: compiler
+	compiler add: '(context atEnd not)'.
+!
+
+compileCharacter: compiler
+	self assert: (classification select: [ :e | e ]) size = 1.
+	
+	classification keysAndValuesDo: [ :index :value | value ifTrue: [  
+		(index > 32 and: [ index < 127 ]) ifTrue: [ 
+			compiler add: '(context peek = ', (Character value: index) printString, ')'
+		] ifFalse: [ 
+			id := compiler idFor: (Character value: index) prefixed: #character.
+			compiler addConstant: (Character value: index) as: id.
+			compiler add: '(context peek = ', id, ')'.
+	 	] 
+	] ].
+
+!
+
+compileGuard: compiler id: symbol
+	self id: symbol.
+	^ self compileGuard: compiler
+!
+
+compileMessage: compiler
+	compiler add: '(context peek ', message, ')'
+!
+
+initializeFor: aPPCNode
+	node := aPPCNode.
+	message := #unknown.
+	id := nil.
+	
+	"No Guards for trimming parser so far"
+	((node firstSetSuchThat: [ :e | e isKindOf: PPCTrimNode ]) isEmpty not) ifTrue: [ 
+		^ self initializeForNoGuard 
+	].
+	(node acceptsEpsilon) ifTrue: [  
+		^ self initializeForEpsilon
+	].
+
+	self classificationOn: [:char | node firstSet anySatisfy: [:e | (e firstCharParser parse: char asString) isPetitFailure not ]]
+!
+
+initializeForEpsilon
+	classification := nil
+	
+!
+
+initializeForNoGuard
+	classification := nil
+	
+!
+
+testAny
+	^ classification allSatisfy: [ :e | e ].
+!
+
+testMessage: selector
+ 	classification keysAndValuesDo: [:index :element |
+		(element = ((Character value: index) perform: selector)) ifFalse: [ 
+			^ false 
+		]
+	].
+	^ true
+!
+
+testSingleCharacter
+	^ (classification select: [ :e | e ]) size = 1
+! !
+
+!PPCGuard methodsFor:'code generation'!
+
+compileArray: compiler
+	| array |
+	self assert: id isNotNil.
+
+	array := ((classification asOrderedCollection) addLast: false; yourself) asArray.
+	compiler addConstant: array as: id.
+	compiler add: '(', id, ' at: context peek asInteger)'.
+!
+
+compileGuard: compiler
+	self assert: self makesSense description: 'No Guard could be compiled'.
+	self assert: id notNil.
+	
+	
+	self message ifNotNil: [ ^ self compileMessage: compiler ].
+	self testAny ifTrue: [ ^ self compileAny: compiler ].
+	self testSingleCharacter ifTrue: [ ^ self compileCharacter: compiler ].
+	
+	^ self compileArray: compiler
+!
+
+makesSense
+	^ classification isNil not
+! !
+