Portability fixes
* do not use Object>>asString. Not all Smalltalks implement it.
* do not use Object>>name. Not all Smalltalks implement it.
* do not use Dictionary keysAndValuesRemove:. Not all Smalltalks implement it.
* do not use Class>>methods The semantics is different among Smalltalks.
Use `Class methodDictionary values` instead.
* do not modify dictionary in #at:ifAbsentPut: block!
"{ Package: 'stx:goodies/petitparser/compiler' }"
"{ NameSpace: Smalltalk }"
PPCCodeGen subclass:#PPCFSACodeGen
instanceVariableNames:'fsa backlinkStates compiler'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Scanner'
!
!PPCFSACodeGen methodsFor:'accessing'!
methodCategory
^ 'generated - scanning'
! !
!PPCFSACodeGen methodsFor:'coding'!
codeAbsoluteReturn: code
self add: '^ ', code
!
codeAssertPeek: t
| id |
self assert: (t isKindOf: PEGFsaTransition).
(t isPredicateTransition and: [t isEOF]) ifTrue: [
self addOnLine: 'currentChar isNil'.
^ self
].
(t isPredicateTransition) ifTrue: [
self addOnLine: t predicate asString, ' value: currentChar codePoint'.
^ self
].
(t isAny) ifTrue: [
self addOnLine: 'true'.
^ self
].
(t isSingleCharacter) ifTrue: [
self addOnLine: 'currentChar == ', t character storeString.
^ self
].
(t isNotSingleCharacter) ifTrue: [
self addOnLine: 'currentChar ~~ ', t notCharacter storeString.
^ self
].
(t isLetter) ifTrue: [
self addOnLine: 'currentChar isLetter'.
^ self
].
(t isWord) ifTrue: [
self addOnLine: 'currentChar isAlphaNumeric'.
^ self
].
(t isDigit) ifTrue: [
self addOnLine: 'currentChar isDigit'.
^ self
].
(t isSingleRange) ifTrue: [
| begin end |
begin := t beginOfRange.
end := t endOfRange.
self addOnLine: 'self peekBetween: ', begin asString, ' and: ', end asString.
^ self
].
id := idGen cachedSuchThat: [ :e | e = t characterSet ]
ifNone: [ self idFor: t characterSet defaultName: 'characterSet' ].
self addConstant: t characterSet as: id.
self addOnLine: '(currentChar isNotNil) and: [', id, ' at: currentChar codePoint ]'.
!
codeAssertPeek: transition ifFalse: falseBlock
self add: '('.
self codeAssertPeek: transition.
self addOnLine: ') ifFalse: [ '.
falseBlock value.
self addOnLine: ']'.
self codeDot.
!
codeAssertPeek: t ifTrue: block
self addOnLine: '('.
self codeAssertPeek: t.
self addOnLine: ') ifTrue: ['.
self indent.
self code: block.
self dedent.
self add: ']'.
!
codeAssertPeek: transition orReturn: priority
self error: 'deprecated'.
self add: '('.
self codeAssertPeek: transition.
self addOnLine: ') ifFalse: [ '.
self codeReturnResult: priority.
self addOnLine: ']'.
self codeDot.
!
codeAssertPeek: transition whileTrue: block
self add: '['.
self codeAssertPeek: transition.
self addOnLine: '] whileTrue: ['.
self indent.
self code: block.
self dedent.
self add: '].'.
self nl.
!
codeEndBlock
self dedent.
self add: ']'.
!
codeEndBlockWhileTrue
self dedent.
self add: '] whileTrue.'.
!
codeIfFalse
self addOnLine: ' ifFalse: ['.
!
codeNextChar
self add: 'self step.'
!
codeNl
self add: ''.
!
codeNlAssertPeek: characterSet
self add: ''.
self codeAssertPeek: characterSet.
!
codeNlReturnResult
self add: '^ self return.'
!
codeNlReturnResult: priority
priority isNil ifTrue: [
^ self codeNlReturnResult
].
self add: '^ self returnPriority: ', priority asString, '.'
!
codeRecordDistinctMatch: retval offset: value
self add: 'self recordDistinctMatch: ', retval storeString, ' offset: ', value storeString, '.'
!
codeRecordMatch: state priority: priority
priority isNil ifTrue: [
^ self codeRecordMatch: state
].
self add: 'self recordMatch: ', state storeString, ' priority: ', priority asString, '.'
!
codeReturnResult
self addOnLine: '^ self return.'
!
codeReturnResult: priority
priority isNil ifTrue: [
^ self codeReturnResult
].
self addOnLine: '^ self returnPriority: ', priority asString, '.'
!
codeStartBlock
self add: '['.
self indent.
! !
!PPCFSACodeGen methodsFor:'coding - results'!
codeRecordDistinctMatch: retval
self add: 'self recordDistinctMatch: ', retval storeString, '.'
!
codeRecordFailure: index
self assert: index isInteger.
self add: 'self recordFailure: ', index asString, '.'
!
codeRecordMatch: retval
self add: 'self recordMatch: ', retval storeString, '.'
!
codeRecordMatch: retval offset: offset
self add: 'self recordMatch: ', retval storeString, ' offset: ', offset storeString, '.'
!
codeReturn
self addOnLine: '^ self'
!
codeReturnDistinct
self addOnLine: '^ self returnDistinct.'
! !
!PPCFSACodeGen methodsFor:'intitialization'!
initialize
super initialize.
compiler := PPCCodeGen new.
backlinkStates := IdentityDictionary new.
! !