Avoid using (obsolete) PPCMethod>>addVariable:, use allocateTemporaryVariableNamed: instead.
"{ Package: 'stx:goodies/petitparser/compiler' }"
"{ NameSpace: Smalltalk }"
PPCNodeVisitor subclass:#PPCCodeGenerator
instanceVariableNames:'compiler'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Visitors'
!
!PPCCodeGenerator class methodsFor:'as yet unclassified'!
on: aPPCCompiler
^ self new
compiler: aPPCCompiler;
yourself
! !
!PPCCodeGenerator methodsFor:'accessing'!
compiler: aPPCCompiler
compiler := aPPCCompiler
! !
!PPCCodeGenerator methodsFor:'hooks'!
afterAccept: node retval: retval
"return the method from compiler"
^ self stopMethodForNode: node.
!
beforeAccept: node
self startMethodForNode: node
!
closedDetected: node
^ node isMarkedForInline ifFalse: [
self error: 'Should not happen!!'
]
!
openDetected: node
^ compiler checkCache: (compiler idFor: node)
! !
!PPCCodeGenerator methodsFor:'support'!
addGuard: node
| guard firsts id |
(arguments guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ self].
id := compiler idFor: node.
firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
(firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
"If we start with trimming, we should invoke the whitespace parser"
self compileTokenWhitespace: firsts anyOne.
compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
guard id: id, '_guard'.
guard compileGuard: compiler.
compiler addOnLine: 'ifFalse: [ ^ self error ].'
].
(firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [
compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
guard id: id, '_guard'.
guard compileGuard: compiler.
compiler addOnLine: 'ifFalse: [ ^ self error ].'
].
!
compileTokenWhitespace: node
compiler add: 'context atWs ifFalse: ['.
compiler indent.
compiler call: (self visit: node whitespace).
compiler add: 'context setWs.'.
compiler dedent.
compiler add: '].'.
!
notCharSetPredicateBody: node
| classificationId classification |
self error: 'deprecated.'.
classification := node extendClassification: node predicate classification.
classificationId := (compiler idFor: classification prefixed: #classification).
compiler addConstant: classification as: classificationId.
compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
compiler indent.
compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
compiler add: ' ifFalse: [ nil ].'.
compiler dedent.
!
notMessagePredicateBody: node
self error: 'deprecated'.
compiler addOnLine: '(context peek ', node message, ')'.
compiler indent.
compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
compiler add: ' ifFalse: [ nil ].'.
compiler dedent.
!
predicateBody: node
| tmpId |
self error:'deprecated'.
tmpId := (compiler idFor: node predicate prefixed: #predicate).
compiler addConstant: node predicate as: tmpId.
compiler addOnLine: '(context atEnd not and: [ ', tmpId , ' value: context uncheckedPeek])'.
compiler indent.
compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
compiler add: 'ifTrue: [ context next ].'.
compiler dedent.
!
retvalVar
^ compiler currentReturnVariable
!
startMethodForNode:node
node isMarkedForInline ifTrue:[
compiler startInline: (compiler idFor: node).
compiler addComment: 'BEGIN inlined code of ' , node printString.
compiler indent.
] ifFalse:[
compiler startMethod: (compiler idFor: node).
compiler addComment: 'GENERATED by ' , node printString.
compiler allocateReturnVariable.
].
"Created: / 23-04-2015 / 15:51:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-04-2015 / 19:13:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
stopMethodForNode:aPPCNode
^ aPPCNode isMarkedForInline ifTrue:[
compiler dedent.
compiler add: '"END inlined code of ' , aPPCNode printString , '"'.
compiler stopInline.
] ifFalse:[
compiler stopMethod
].
"Created: / 23-04-2015 / 15:51:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-04-2015 / 18:35:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCCodeGenerator methodsFor:'traversing - caching'!
cache: node value: retval
"this is compiler thing, not mine"
!
cachedDetected: node
^ compiler checkCache: (compiler idFor: node)
!
isCached: node
^ (compiler checkCache: (compiler idFor: node)) isNil not
! !
!PPCCodeGenerator methodsFor:'visiting'!
visitActionNode: node
| elementVar |
compiler addConstant: node block as: (compiler idFor: node).
elementVar := compiler allocateTemporaryVariableNamed:'element'.
compiler add: elementVar,' := '.
compiler callOnLine: (self visit: node child).
compiler add: 'error ifFalse: [ ^ ', (compiler idFor: node), ' value: ',elementVar,' ].'.
compiler add: '^ failure'.
"Modified: / 05-05-2015 / 14:39:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAndNode: node
| mementoVar |
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler add: (compiler smartRemember: node child to: mementoVar).
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler add: (compiler smartRestore: node child from: mementoVar).
compiler codeReturn.
"Modified: / 23-04-2015 / 15:59:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAnyNode: node
compiler codeReturn: 'context next ifNil: [ error := true. ].'.
"Modified: / 23-04-2015 / 20:52:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitCharSetPredicateNode: node
| classification classificationId |
classification := node extendClassification: node predicate classification.
classificationId := compiler idFor: classification prefixed: #classification.
compiler addConstant: classification as: classificationId.
compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
compiler indent.
compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
compiler add: 'ifTrue: [ '.
compiler codeReturn: 'context next'.
compiler add: '].'.
compiler dedent.
!
visitCharacterNode: node
| chid |
node character ppcPrintable ifTrue: [
chid := node character storeString
] ifFalse: [
chid := compiler idFor: node character prefixed: #char.
compiler addConstant: (Character value: node character asInteger) as: chid .
].
compiler add: '(context peek == ', chid, ')'.
compiler indent.
compiler add: 'ifFalse: [ self error: ''', node character asInteger asString, ' expected'' at: context position ] '.
compiler add: 'ifTrue: [ '.
compiler codeReturn: 'context next'.
compiler add: '].'.
compiler dedent.
!
visitChild: child of: node
| |
(self isOpen: child) ifTrue: [
"already processing..."
^ nil
].
"TODO JK: this is is wrong,.. to tired now to fix this :("
" (self isCached: child) ifTrue: [
node replace: child with: (self cachedValue: child).
^ nil
].
"
^ self visit: child.
!
visitChoiceNode: node
| firsts guard whitespaceConsumed elementVar |
whitespaceConsumed := false.
firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
"If we start with trimming token, we should invoke the whitespace parser"
(firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
self compileTokenWhitespace: firsts anyOne.
whitespaceConsumed := true.
].
1 to: node children size do: [ :idx | |child allowGuard |
child := node children at: idx.
" allowGuard := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not.
"
allowGuard := whitespaceConsumed.
(allowGuard and: [arguments guards and: [ (guard := PPCGuard on: child) makesSense ]]) ifTrue: [
guard id: (compiler idFor: guard prefixed: #guard).
guard compileGuard: compiler.
compiler add: ' ifTrue: [ '.
compiler indent.
compiler add: 'self clearError.'.
compiler codeStoreValueOf: [self visit: child] intoVariable: elementVar.
compiler add: 'error ifFalse: [ ^ ',elementVar,' ].'.
compiler dedent.
compiler add: ' ].'.
] ifFalse: [
compiler add: 'self clearError.'.
compiler codeStoreValueOf: [self visit: child] intoVariable: elementVar.
compiler add: 'error ifFalse: [ ^ ',elementVar,' ].'.
]
].
compiler add: '^ self error: ''no choice suitable'''.
"Modified: / 05-05-2015 / 14:10:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitEndOfFileNode: node
compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'.
!
visitForwardNode: node
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler codeReturn.
!
visitLiteralNode: node
| positionVar encodedLiteral |
encodedLiteral := node encodeQuotes: node literal.
positionVar := compiler allocateTemporaryVariableNamed: 'position'.
compiler codeAssign: 'context position.' to: positionVar.
compiler add: '((context next: ', node literal size asString, ') = #''', encodedLiteral, ''') ifTrue: ['.
compiler codeReturn: '#''', encodedLiteral, ''' '.
compiler add: '] ifFalse: ['.
compiler add: ' context position: ', positionVar, '.'.
compiler add: ' self error: ''', encodedLiteral, ' expected'' at: position'.
compiler add: '].'.
!
visitMessagePredicateNode: node
compiler add: '(context peek ', node message, ') ifFalse: ['.
compiler add: ' self error: ''predicate not found'''.
compiler add: '] ifTrue: [ '.
compiler codeReturn: ' context next'.
compiler add: '].'.
"Modified: / 23-04-2015 / 18:39:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitNilNode: node
compiler codeReturn: 'nil.'.
!
visitNotCharSetPredicateNode: node
| classificationId classification |
classification := node extendClassification: node predicate classification.
classificationId := (compiler idFor: classification prefixed: #classification).
compiler addConstant: classification as: classificationId.
compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
compiler indent.
compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
compiler add: ' ifFalse: ['.
compiler codeReturn: 'nil'.
compiler add: '].'.
compiler dedent.
!
visitNotLiteralNode: node
| encodedLiteral size |
encodedLiteral := node encodeQuotes: node literal.
size := node literal size asString.
compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.
compiler indent.
compiler add: 'ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'.
compiler add: 'ifFalse: [ '.
compiler codeReturn: 'nil' .
compiler add: '].'.
compiler dedent.
!
visitNotMessagePredicateNode: node
compiler addOnLine: '(context peek ', node message, ')'.
compiler indent.
compiler add: ' ifTrue: [ '.
compiler codeError: 'predicate not expected'.
compiler add: '] ifFalse: ['.
compiler codeReturn: 'nil'.
compiler add: ' ].'.
compiler dedent.
!
visitNotNode: node
| mementoVar |
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler add: (compiler smartRemember: node child to: mementoVar ).
compiler call: (self visit: node child).
compiler add: (compiler smartRestore: node child from: mementoVar ).
compiler add: '^ error ifFalse: [ self error ] ifTrue: [ self clearError. nil ]'.
"Modified: / 05-05-2015 / 14:29:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitOptionalNode: node
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler add: 'error ifTrue: [ '.
compiler add: ' self clearError. '.
compiler codeAssign: 'nil.' to: self retvalVar.
compiler add: '].'.
compiler codeReturn.
!
visitPluggableNode: node
| blockId |
blockId := compiler idFor: node block prefixed: #block.
compiler addConstant: node block as: blockId.
compiler codeReturn: blockId, ' value: context.'.
!
visitPlusNode: node
| elementVar |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
compiler add: 'error ifTrue: [ self error: ''at least one occurence expected'' ] ifFalse: ['.
compiler indent.
compiler add: self retvalVar , ' add: ',elementVar , '.'.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
compiler add: '[ error ] whileFalse: ['.
compiler indent.
compiler add: self retvalVar , ' add: ',elementVar , '.'.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
compiler dedent.
compiler add: '].'.
compiler add: 'self clearError.'.
compiler codeReturn: self retvalVar , ' asArray.'.
compiler dedent.
compiler add: '].'.
"Modified (comment): / 23-04-2015 / 21:30:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitPredicateNode: node
| pid |
pid := (compiler idFor: node predicate prefixed: #predicate).
compiler addConstant: node predicate as: pid.
compiler add: '(context atEnd not and: [ ', pid , ' value: context uncheckedPeek])'.
compiler indent.
compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
compiler add: 'ifTrue: [ ', self retvalVar ,' := context next ].'.
compiler dedent.
compiler codeReturn.
"Modified: / 23-04-2015 / 21:48:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitSequenceNode: node
| elementVar mementoVar |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler add: (compiler smartRemember: node to: mementoVar).
compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
self addGuard: node.
1 to: (node children size) do: [ :idx | |child|
child := node children at: idx.
compiler codeStoreValueOf: [ self visit: child ] intoVariable: elementVar.
compiler add: 'error ifTrue: [ ', (compiler smartRestore: node) ,' ^ failure ].'.
compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'.
].
compiler codeReturn
"Modified: / 23-04-2015 / 22:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitStarAnyNode: node
| retvalVar sizeVar |
retvalVar := compiler allocateReturnVariable.
sizeVar := compiler allocateTemporaryVariableNamed: 'size'.
compiler add: sizeVar , ' := context size - context position.'.
compiler add: retvalVar,' := Array new: ',sizeVar,'.'.
compiler add: '(1 to: ',sizeVar,') do: [ :e | ',retvalVar,' at: e put: context next ].'.
compiler codeReturn.
"Modified: / 05-05-2015 / 14:13:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitStarCharSetPredicateNode: node
| classification classificationId |
classification := node extendClassification: node predicate classification.
classificationId := compiler idFor: classification prefixed: #classification.
compiler addConstant: classification as: classificationId.
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler add: '[ ', classificationId, ' at: context peek asInteger ] whileTrue: ['.
compiler indent.
compiler add: self retvalVar, ' add: context next.'.
compiler dedent.
compiler add: '].'.
compiler codeReturn: 'retval asArray'.
!
visitStarMessagePredicateNode: node
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler add: '[ context peek ', node message, ' ] whileTrue: ['.
compiler indent.
compiler add: self retvalVar, ' add: context next.'.
compiler dedent.
compiler add: '].'.
compiler codeReturn: 'retval asArray'.
!
visitStarNode: node
| elementVar |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
compiler add: '[ error ] whileFalse: ['.
compiler indent.
compiler add: self retvalVar, ' add: element.'.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
compiler dedent.
compiler add: '].'.
compiler codeClearError.
compiler codeReturn: self retvalVar, ' asArray'.
!
visitSymbolActionNode: node
| elementVar |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
compiler add: 'error ifFalse: [ '.
compiler codeReturn: elementVar, ' ', node block asString, '.'.
compiler add: '] ifTrue: ['.
compiler codeReturn: 'failure'.
compiler add: ']'.
!
visitTokenActionNode: node
"
Actually, do nothing, we are in Token mode and the
child does not return any result and token takes only
the input value.
"
compiler add: '^ '.
compiler callOnLine: (node child compileWith: compiler).
!
visitTokenNode: node
| startVar endVar |
startVar := compiler allocateTemporaryVariableNamed: 'start'.
endVar := compiler allocateTemporaryVariableNamed: 'end'.
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 codeReturn: node tokenClass asString, ' on: (context collection)
start: ', startVar, '
stop: ', endVar, '
value: nil.'.
compiler dedent.
compiler add: '].'.
!
visitTokenSequenceNode: node
| mementoVar |
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler add: (compiler smartRemember: node to: mementoVar).
"
self addGuard: compiler.
"
compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever.
compiler add: 'error ifTrue: [ ^ failure ].'.
2 to: (node children size) do: [ :idx | |child|
child := node children at: idx.
compiler codeStoreValueOf: [ self visit: child ] intoVariable: #whatever.
compiler add: 'error ifTrue: [ ', (compiler smartRestore: node from: mementoVar) ,' ^ failure ].'.
].
"Modified (comment): / 05-05-2015 / 14:31:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitTokenStarMessagePredicateNode: node
compiler add: '[ context peek ', node message,' ] whileTrue: ['.
compiler indent.
compiler add: 'context next'.
compiler indent.
compiler dedent.
compiler add: '].'.
!
visitTokenStarSeparatorNode: node
compiler add: 'context skipSeparators.'.
!
visitTrimNode: node
| mementoVar |
"TODO: This ignores the TrimmingParser trimmer object!!"
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler add: (compiler smartRemember: node child to: mementoVar).
compiler add: 'context skipSeparators.'.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler add: 'error ifTrue: [ '.
compiler indent.
compiler add: (compiler smartRestore: node child from: mementoVar).
compiler codeReturn.
compiler dedent.
compiler add: '] ifFalse: [' .
compiler indent.
compiler add: 'context skipSeparators.'.
compiler codeReturn.
compiler dedent.
compiler add: '].'.
!
visitTrimmingTokenNode: node
| id guard startVar endVar |
startVar := compiler allocateTemporaryVariableNamed: 'start'.
endVar := compiler allocateTemporaryVariableNamed: 'end'.
id := compiler idFor: node.
" (id beginsWith: 'kw') ifTrue: [ self halt. ]."
"self compileFirstWhitespace: compiler."
self compileTokenWhitespace: node.
(arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [
compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
guard id: id, '_guard'.
guard compileGuard: compiler.
compiler addOnLine: 'ifFalse: [ ^ self error ].'
].
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.
" self compileSecondWhitespace: compiler."
self compileTokenWhitespace: node.
compiler codeReturn: node tokenClass asString, ' on: (context collection)
start: ', startVar, '
stop: ', endVar, '
value: nil'.
compiler dedent.
compiler add: '].'
!
visitUnknownNode: node
| compiledChild compiledParser id |
id := compiler idFor: node.
compiledParser := node parser copy.
"Compile all the children and call compiled version of them instead of the original one"
compiledParser children do: [ :child |
compiledChild := self visit: child.
compiledParser replace: child with: compiledChild bridge.
].
compiler addConstant: compiledParser as: id.
compiler codeClearError.
compiler add: '(', self retvalVar, ' := ', id, ' parseOn: context) isPetitFailure'.
compiler indent.
compiler add: ' ifTrue: [self error: retval message at: ', self retvalVar, ' position ].'.
compiler dedent.
compiler add: 'error := ', self retvalVar, ' isPetitFailure.'.
compiler codeReturn.
! !