Portability: fixes for Smalltalk/X
* Do not use detect:ifFound: - not present in Smalltalk/X
* Removed leftover debugging code (Halt if:, ...)
* Do not use `aClass methods`, use `aClass methodDictionary values`
* Do not use #allPairsDo; - not present in Smalltalk/X
* Do not use #crShow: - not present in Smalltalk/X
* On Smalltalk?X use Filename - there's no FileReference in Smalltalk/X
* Do not use CharacterSet, use String
"{ Package: 'stx:goodies/petitparser/compiler' }"
"{ NameSpace: Smalltalk }"
PPCCodeGenerator subclass:#PPCTokenizingCodeGenerator
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Visitors'
!
!PPCTokenizingCodeGenerator methodsFor:'visiting'!
visitChoiceNode: node
" true ifTrue: [ ^ super visitChoiceNode: node ]."
"HACK alert: We are inside token..."
(node firstSetWithTokens contains: [ :e | e isTokenNode not ]) ifTrue: [ ^ super visitChoiceNode: node ].
node children do: [ :child |
| tokenMethodName |
child firstSetWithTokens do: [ :first |
"For each child, for each first compile this:"
tokenMethodName := compiler idFor: first.
compiler add: '(self currentTokenTypeIs: ', tokenMethodName storeString, ')'.
compiler addOnLine: ' ifTrue: ['.
compiler indent.
compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
compiler add: 'error ifFalse: ['.
compiler indent.
compiler codeReturn: self retvalVar.
compiler dedent.
compiler add: '] ifTrue: ['.
compiler indent.
compiler codeClearError.
compiler codeAssign: 'nil.' to: 'currentTokenType'.
compiler add: 'context position: currentTokenValue start - 1.'.
compiler dedent.
compiler add: ']'.
compiler dedent.
compiler add: '].'
]
].
compiler codeError: 'no choice found'.
"Modified: / 10-05-2015 / 07:37:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitDeterministicChoiceNode: node
| dictionary |
dictionary := IdentityDictionary new.
node children do: [ :child |
| firstSet |
firstSet := child firstSetWithTokens.
self assert: firstSet size = 1.
dictionary at: child
put: firstSet anyOne.
].
"Tokens are unique"
self assert: dictionary values asSet size = node children size.
" currentTokenVar := compiler allocateTemporaryVariableNamed: 'currentToken'.
compiler codeAssign: 'self currentTokenType.' to: currentTokenVar.
" node children do: [ :child |
| tokenMethodName |
tokenMethodName := compiler idFor: (dictionary at: child).
compiler add: '(self currentTokenTypeIs: ', tokenMethodName storeString, ')'.
compiler addOnLine: ' ifTrue: ['.
compiler indent.
compiler codeStoreValueOf: [ self visit: child ] intoVariable: self retvalVar.
compiler codeReturn: self retvalVar.
compiler dedent.
compiler add: '].'
].
compiler codeError: 'no choice found'.
!
visitTokenChoiceNode: node
| trimmingToken |
self assert: (node children allSatisfy: [ :e | e isMarkedForInline not ]).
trimmingToken := node children detect: [ :e | e isTrimmingTokenNode ] ifNone: [ nil ].
trimmingToken isNil ifFalse: [
compiler codeStoreValueOf: [ self visit: trimmingToken whitespace ] intoVariable: #whatever.
].
super visitChoiceNode: node.
!
visitTokenConsumeNode: node
compiler codeReturn: 'self consume: ', (compiler idFor: node child) storeString, '.'
!
visitTokenNode: node
| id startVar endVar |
startVar := compiler allocateTemporaryVariableNamed: 'start'.
endVar := compiler allocateTemporaryVariableNamed: 'end'.
id := compiler idFor: node.
compiler toTokenRememberStrategy.
compiler codeAssign: 'context position + 1.' to: startVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
compiler add: 'error ifFalse: [ '.
compiler indent.
compiler codeAssign: 'context position.' to: endVar.
compiler codeTranscriptShow: 'current token type: ', id storeString.
compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
compiler codeAssign: node tokenClass asString, ' on: (context collection)
start: ', startVar, '
stop: ', endVar, '
value: nil.'
to: 'currentTokenValue := ', self retvalVar.
compiler codeReturn.
compiler dedent.
compiler add: '].'.
compiler toNormalRememberStrategy.
!
visitTokenizingParserNode: node
self visit: node tokenizer.
" compiler codeNextToken."
compiler codeHaltIfShiftPressed.
compiler codeStoreValueOf: [ self visit: node parser ] intoVariable: self retvalVar.
compiler codeReturn.
!
visitTrimmingTokenNode: node
| id startVar endVar |
startVar := compiler allocateTemporaryVariableNamed: 'start'.
endVar := compiler allocateTemporaryVariableNamed: 'end'.
id := compiler idFor: node.
compiler toTokenRememberStrategy.
compiler addComment: 'Consume Whitespace:'.
compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
compiler nl.
compiler codeAssign: 'context position + 1.' to: startVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
compiler add: 'error ifFalse: [ '.
compiler indent.
compiler codeAssign: 'context position.' to: endVar.
compiler addComment: 'Consume Whitespace:'.
compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
compiler nl.
compiler codeTranscriptShow: 'current token type: ', id storeString.
compiler codeAssign: id storeString, '.' to: 'currentTokenType'.
compiler codeAssign: node tokenClass asString, ' on: (context collection)
start: ', startVar, '
stop: ', endVar, '
value: nil.'
to: 'currentTokenValue := ', self retvalVar.
compiler codeReturn.
compiler dedent.
compiler add: '].' .
compiler toNormalRememberStrategy.
! !