Ported PetitCompiler-(Tests).
Name: PetitCompiler-JanKurs.41
Author: JanKurs
Time: 25-10-2014, 03:30:28 AM
UUID: 105186d1-1187-4ca6-8d66-3d2d47def4d3
Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main
Name: PetitCompiler-Tests-JanKurs.4
Author: JanKurs
Time: 25-10-2014, 03:30:58 AM
UUID: 3e798fad-d5f6-4881-a583-f0bbffe27869
Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main
In addition, fixed some problems to make it compilable under Smalltalk/X:
* Fixed PPCTokenNode>>initialize - there's no children instvar, it's initialization removed.
* Fixed PPCContextMemento>>propertyAt:ifAbsent: - removed return-in-return, not compilable under Smalltalk/X (C issues)
* Fixed PPCContextMemento>>hash - there's no stream instvar, access to it removed.
* Fixed PPCAbstractCharacterNode>>compileWith:effect:id: - removed dot after method selector (stc does not like it)
"{ 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
! !