--- /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
+! !
+