Merged with PetitCompiler-JanKurs.20150510144201, PetitCompiler-Tests-JanKurs.20150510144201, PetitCompiler-Extras-Tests-JanKurs.20150510144201, PetitCompiler-Benchmarks-JanKurs.20150510144201
Name: PetitCompiler-JanKurs.20150510144201
Author: JanKurs
Time: 10-05-2015, 04:42:29.192 PM
UUID: 58a4786b-1182-4904-8b44-a13d3918f244
Name: PetitCompiler-Tests-JanKurs.20150510144201
Author: JanKurs
Time: 10-05-2015, 04:32:12.870 PM
UUID: 2a8fd41a-331b-4dcf-a7a3-752a50ce86e7
Name: PetitCompiler-Extras-Tests-JanKurs.20150510144201
Author: JanKurs
Time: 10-05-2015, 04:59:25.308 PM
UUID: ef43bd1a-be60-4e88-b749-8b635622c969
Name: PetitCompiler-Benchmarks-JanKurs.20150510144201
Author: JanKurs
Time: 10-05-2015, 05:04:54.561 PM
UUID: d8e764fd-016b-46e2-9fc1-17c38c18f0e5
"{ Package: 'stx:goodies/petitparser/compiler' }"
"{ NameSpace: Smalltalk }"
PPCNodeVisitor subclass:#PPCCodeGenerator
instanceVariableNames:'compiler'
classVariableNames:''
poolDictionaries:''
category:'PetitCompiler-Visitors'
!
!PPCCodeGenerator class methodsFor:'as yet unclassified'!
new
^ self basicNew
initialize;
yourself
!
on: aPPCCompiler
^ self new
compiler: aPPCCompiler;
yourself
! !
!PPCCodeGenerator methodsFor:'accessing'!
compiler: aPPCCompiler
compiler := aPPCCompiler
!
guards
^ arguments guards
! !
!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 |
(self guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ self].
id := compiler idFor: node.
firsts := node firstSetWithTokens.
(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
| blockId |
blockId := 'block_', (compiler idFor: node).
compiler addConstant: node block as: blockId.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler add: 'error ifFalse: ['.
compiler codeReturn: blockId, ' value: ', self retvalVar.
compiler add: '] ifTrue: ['.
compiler codeReturn: 'failure'.
compiler add: '].'.
"Modified: / 23-04-2015 / 15:59:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAndNode: node
| mementoVar |
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler smartRemember: node child to: mementoVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
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 add: '(', 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
].
^ self visit: child.
!
visitChoiceNode: node
| firsts guard whitespaceConsumed elementVar |
"The code is not ready for inlining"
self assert: node isMarkedForInline not.
whitespaceConsumed := false.
firsts := node firstSetWithTokens.
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
"
If we want to compile in guard and the choice starts with trimming token,
we should invoke the whitespace parser
"
(self guards and: [ firsts allSatisfy: [ :e | e isTrimmingTokenNode ] ]) ifTrue: [
self compileTokenWhitespace: firsts anyOne.
whitespaceConsumed := true.
].
1 to: node children size do: [ :idx | |child allowGuard |
child := node children at: idx.
allowGuard := whitespaceConsumed.
(allowGuard and: [self 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: [ ^ element ].'.
compiler dedent.
compiler add: ' ].'.
] ifFalse: [
compiler add: 'self clearError.'.
compiler codeStoreValueOf: [self visit: child] intoVariable: elementVar.
compiler add: 'error ifFalse: [ ^ element ].'.
]
].
compiler add: '^ self error: ''no choice suitable'''.
"Modified: / 23-04-2015 / 21:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitEndOfFileNode: node
compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'.
!
visitEndOfInputNode: node
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler add: 'context atEnd ifTrue: ['.
compiler codeReturn.
compiler add: '] ifFalse: ['.
compiler codeError: 'End of input expected'.
compiler add: ']'.
!
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 smartRemember: node child to: mementoVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
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>"
!
visitRecognizingSequenceNode: node
| mementoVar |
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
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 indent.
compiler smartRestore: node from: mementoVar.
compiler add: ' ^ failure .'.
compiler dedent.
compiler add: '].'.
].
!
visitSequenceNode: node
| elementVar mementoVar |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
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 indent.
compiler smartRestore: node from: mementoVar.
compiler add: '^ failure.'.
compiler dedent.
compiler add: '].'.
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: ', elementVar, '.'.
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: '].'.
!
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.'.
!
visitTokenWhitespaceNode: node
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
compiler codeReturn.
!
visitTrimNode: node
| mementoVar |
"TODO: This ignores the TrimmingParser trimmer object!!"
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
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 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: [
guard id: id, '_guard'.
compiler add: 'context atEnd ifTrue: [ self error ].'.
guard compileGuard: compiler.
compiler addOnLine: 'ifFalse: [ self error ].'.
compiler add: 'error ifFalse: ['.
compiler indent.
].
compiler codeAssign: 'context position + 1.' to: startVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
(arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [
compiler dedent.
compiler add: '].'.
].
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.
! !