"{ Package: 'stx:goodies/petitparser/compiler' }"
"{ NameSpace: Smalltalk }"
Object subclass:#PPCGuard
instanceVariableNames:'classification id message'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Guards'
!
!PPCGuard class methodsFor:'as yet unclassified'!
on: aPPCNode
^ self new
initializeFor: aPPCNode;
yourself
!
on: aPPCNode id: id
^ self new
initializeFor: aPPCNode;
id: id;
yourself
! !
!PPCGuard methodsFor:'accessing'!
classification
^ classification
!
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) storeString, ')'
] 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, ')'
!
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
! !
!PPCGuard methodsFor:'initialization'!
initializeFor: node
message := #unknown.
id := nil.
"No Guards for trimming parser so far"
" ((node firstSetSuchThat: [ :e | e isKindOf: PPCTrimNode ]) isEmpty) ifFalse: [
^ self initializeForNoGuard
]."
(node acceptsEpsilon) ifTrue: [
^ self initializeForEpsilon
].
self classificationOn: [:char | node firstSet anySatisfy: [:e | (e firstCharSetCached value: char) ]]
" self classificationOn: [ :char | node firstSet anySatisfy: [ :e | (e firstCharParser parse: char asString) isPetitFailure not ] ]"
!
initializeForEpsilon
classification := nil
!
initializeForNoGuard
classification := nil
! !