"{ 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:'guards'!
addGuard: node ifTrue: trueBlock ifFalse: falseBlock
| guard id |
(self guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ false].
id := compiler idFor: node.
" falseBlock isNil ifFalse: [
compiler add: 'context atEnd'.
compiler addOnLine: ' ifTrue: ['.
compiler indent.
falseBlock value.
compiler dedent.
compiler addOnLine: '].'.
]."
guard id: (compiler idFor: guard prefixed: #guard).
guard compileGuard: compiler.
trueBlock isNil ifFalse: [
compiler addOnLine: ' ifTrue: ['.
compiler indent.
trueBlock value.
compiler dedent.
falseBlock isNil ifTrue: [ compiler addOnLine: '].' ]
ifFalse: [ compiler add: ']'. ]
].
falseBlock isNil ifFalse: [
compiler addOnLine: ' ifFalse: ['.
compiler indent.
falseBlock value.
compiler dedent.
compiler addOnLine: '].'.
].
^ true
!
addGuardTrimming: node
| guard firsts id |
(self guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ false].
id := compiler idFor: node.
firsts := node firstSetWithTokens.
(firsts allSatisfy: [ :e | e isTrimmingTokenNode ]) ifTrue: [
"If we start with trimming, we should invoke the whitespace parser"
self compileTokenWhitespace: firsts anyOne.
^ true
].
^ false
! !
!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'!
compileTokenWhitespace: node
compiler add: 'context atWs ifFalse: ['.
compiler indent.
compiler
codeAssignParsedValueOf:[ self visit:node whitespace ]
to:#whatever.
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
"Modified: / 15-06-2015 / 18:20:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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 (format): / 15-06-2015 / 18:03:07 / 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
| blockNode blockBody blockNodesVar blockNeedsCollection blockMatches childValueVars |
blockNode := node block sourceNode copy.
self assert: blockNode arguments size == 1.
blockNodesVar := blockNode arguments first .
blockBody := blockNode body.
"Now, analyze block body, search for all references to
block arg <barg> and check if in all cases it's used
in one of the following patterns:
* <barg> first , <barg> second, ... , <barg> sixth
* <barg> at: <integer constant>
If so, then the block code can be inlined and the intermediate
result collection need not to be created. Keep this information
in temporary `blockNeedsCollection`.
During the analysis, remember all nodes that matches the pattern
in a dictionary `blockMatches` mapping the node to actual temporary
variable where the node is used. This will be later used for block's node
rewriting"
blockNeedsCollection := true.
node child isSequenceNode ifTrue:[
blockNeedsCollection := false.
blockMatches := IdentityDictionary new."Must use IDENTITY dict as nodes have overwritten their #=!!!!!!"
childValueVars := node child preferredChildrenVariableNames.
blockBody variableNodesDo:[:variableNode|
variableNode name = blockNodesVar name ifTrue:[
"Check if variable node matches..."
variableNode parent isMessage ifTrue:[
| parent |
parent := variableNode parent.
"Check for <barg> at: <number>"
((parent selector == #at:) and:[ parent arguments first isLiteralNumber ]) ifTrue:[
blockMatches at: parent put: (childValueVars at: parent arguments first value).
] ifFalse:[
"Check for <barg> first / second / ..."
| i |
i := #(first second third fourth fifth sixth) indexOf: parent selector.
i ~~ 0 ifTrue:[
blockMatches at: parent put: (childValueVars at: i).
] ifFalse:[
blockNeedsCollection := true.
].
].
] ifFalse:[
blockNeedsCollection := true.
].
].
].
].
blockNeedsCollection ifTrue:[
"Bad, we have to use the collection.
Replace all references to blockNodeVar to retvalVar..."
blockBody variableNodesDo:[:variableNode|
variableNode name = blockNodesVar name ifTrue:[
variableNode token value: self retvalVar.
].
].
] ifFalse:[
"Good, can avoid intermediate collection.
Replace references to collection with corresponding temporary variable"
blockMatches keysAndValuesDo:[:node :childValueVar |
node parent replaceNode: node withNode: (RBVariableNode named: childValueVar).
].
node child returnParsedObjectsAsCollection: false.
].
"Block return value is return value of last statement.
So if the method is not inline, make last statement a return.
if the method is inline, make it assignment to retvalVar."
blockBody statements notEmpty ifTrue:["Care for empty blocks - [:t | ] !!"
compiler currentMethod isInline ifTrue:[
| assignment |
assignment := RBAssignmentNode variable: (RBVariableNode named: self retvalVar) value: blockBody statements last.
blockBody replaceNode: blockBody statements last withNode: assignment.
] ifFalse:[
| return |
return := RBReturnNode value: blockBody statements last.
blockBody replaceNode: blockBody statements last withNode: return.
].
].
compiler codeAssignParsedValueOf:[ self visit:node child ] to:self retvalVar.
compiler codeIfErrorThen: [
compiler codeReturn: 'failure'.
] else: [
compiler code: blockBody.
]
"Modified: / 16-06-2015 / 07:41:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitAndNode: node
| mementoVar |
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler smartRemember: node child to: mementoVar.
compiler
codeAssignParsedValueOf:[ self visit:node child ]
to: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: ['.
compiler codeError: '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: ['.
compiler indent.
compiler codeError: node character asInteger asString, ' expected'.
compiler dedent.
compiler add: '] ifTrue: [ '.
compiler indent.
compiler codeReturn: 'context next'.
compiler dedent.
compiler add: '].'.
compiler dedent.
!
visitChild: child of: node
| |
(self isOpen: child) ifTrue: [
"already processing..."
^ nil
].
^ self visit: child.
!
visitChoiceNode: node
| whitespaceConsumed allowGuard elementVar coding |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
whitespaceConsumed := self addGuardTrimming: node.
allowGuard := whitespaceConsumed.
allowGuard ifTrue:[
coding :=
[ :children :index |
self addGuard: (children at: index) ifTrue: [
compiler add: 'self clearError.'.
compiler
codeAssignParsedValueOf:[ self visit:(children at:index) ]
to:elementVar.
compiler add: 'error ifFalse: [ '.
compiler codeReturn: elementVar.
compiler add: ' ].'.
] ifFalse:[
compiler add: 'error := true.'.
].
compiler add: 'error ifTrue:[ '.
index < children size ifTrue:[
coding value: children value: index + 1.
] ifFalse:[
compiler codeError: 'no choice suitable'.
].
compiler add: '] '.
]
] ifFalse:[
coding :=
[ :children :index |
index <= children size ifTrue:[
compiler add: 'self clearError.'.
compiler
codeAssignParsedValueOf:[ self visit:(children at:index) ]
to:elementVar.
compiler add: 'error ifFalse: [ '.
compiler codeReturn: elementVar.
compiler add: ' ].'.
coding value: children value: index + 1.
] ifFalse:[
compiler codeError: 'no choice suitable'.
].
]
].
coding value: node children value: 1.
"Modified: / 29-05-2015 / 07:17:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitEndOfFileNode: node
compiler codeReturn: 'context atEnd ifTrue: [ #EOF ] ifFalse: [ self error: ''EOF expected!!'' ].'.
!
visitEndOfInputNode: node
compiler
codeAssignParsedValueOf:[ self visit:node child ]
to:self retvalVar.
compiler add: 'context atEnd ifTrue: ['.
compiler codeReturn.
compiler add: '] ifFalse: ['.
compiler codeError: 'End of input expected'.
compiler add: '].'.
"Modified: / 26-05-2015 / 19:03:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitForwardNode: node
compiler
codeAssignParsedValueOf:[ self visit:node child ]
to: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 indent.
compiler add: 'context position: ', positionVar, '.'.
compiler codeError: encodedLiteral, ' expected' at: positionVar.
compiler dedent.
compiler add: '].'.
!
visitMappedActionNode: node
| child blockNode blockBody |
child := node child.
blockNode := node block sourceNode copy.
blockBody := blockNode body.
"Block return value is return value of last statement.
So if the method is not inline, make last statement a return.
if the method is inline, make it assignment to retvalVar."
compiler currentMethod isInline ifTrue:[
| assignment |
assignment := RBAssignmentNode variable: (RBVariableNode named: self retvalVar) value: blockBody statements last.
blockBody replaceNode: blockBody statements last withNode: assignment.
] ifFalse:[
| return |
return := RBReturnNode value: blockBody statements last.
blockBody replaceNode: blockBody statements last withNode: return.
].
child isSequenceNode ifTrue:[
child isMarkedForInline ifTrue:[
child preferredChildrenVariableNames: blockNode argumentNames.
child returnParsedObjectsAsCollection: false.
].
] ifFalse:[
"Child is not a sequence so it 'returns' only one object.
Therefore the block takes only one argument and it's value
is value of child's retval.
In the block, replace all references to block argument to
my retvalVar. "
| blockArg |
blockArg := blockNode arguments first.
blockBody variableNodesDo:[:variableNode|
variableNode name = blockArg name ifTrue:[
variableNode token value: self retvalVar.
].
].
].
compiler codeAssignParsedValueOf: [ self visit: child ] to: self retvalVar.
compiler codeIf: 'error' then: [
compiler codeReturn: 'failure'.
] else: [
"If the child is sequence and not inlined, extract
nodes from returned collection into used-to-be block variables"
(child isSequenceNode and:[ child returnParsedObjectsAsCollection ]) ifTrue:[
blockNode arguments withIndexDo:[ :arg :idx |
node child isMarkedForInline ifFalse:[
compiler allocateTemporaryVariableNamed: arg name.
compiler codeAssign: (self retvalVar , ' at: ', idx printString) to: arg name.
].
compiler addOnLine: '.'; nl.
].
].
compiler code: blockBody.
]
"Created: / 02-06-2015 / 17:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-06-2015 / 06:34:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitMessagePredicateNode: node
compiler add: '(context peek ', node message, ') ifFalse: ['.
compiler codeError: '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: ['.
compiler codeError: 'predicate not expected'.
compiler add: '] ifFalse: ['.
compiler codeReturn: 'nil'.
compiler add: '].'.
compiler dedent.
!
visitNotCharacterNode: 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: 'ifTrue: ['.
compiler indent.
compiler codeError: node character asInteger asString, ' not expected'.
compiler dedent.
compiler add: '] ifFalse: [ '.
compiler indent.
compiler codeReturn: 'nil.'.
compiler dedent.
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: ['.
compiler codeError: 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 codeAssignParsedValueOf:[ self visit:node child ] to:#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
codeAssignParsedValueOf:[ self visit:node child ]
to:self retvalVar.
compiler add: 'error ifTrue: [ '.
compiler indent.
compiler add: 'self clearError. '.
compiler codeAssign: 'nil.' to: self retvalVar.
compiler dedent.
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'.
" self tokenGuards ifTrue: [
compiler codeTokenGuard: node ifFalse: [ compiler codeError: 'at least one occurence expected' ].
].
"
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
compiler add: 'error ifTrue: ['.
compiler codeError: 'at least one occurence expected'.
compiler add: '] ifFalse: ['.
compiler indent.
(self retvalVar ~~ #whatever) ifTrue:[
compiler add: self retvalVar , ' add: ',elementVar , '.'.
].
compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
compiler add: '[ error ] whileFalse: ['.
compiler indent.
(self retvalVar ~~ #whatever) ifTrue:[
compiler add: self retvalVar , ' add: ',elementVar , '.'.
].
compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
compiler dedent.
compiler add: '].'.
compiler add: 'self clearError.'.
(self retvalVar ~~ #whatever) ifTrue:[
compiler codeReturn: self retvalVar , ' asArray.'.
].
compiler dedent.
compiler add: '].'.
"Modified: / 26-05-2015 / 19:04:27 / 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: ['.
compiler codeError: '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 canBacktrack |
canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.
canBacktrack ifTrue: [
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler smartRemember: node to: mementoVar.
].
compiler
codeAssignParsedValueOf:[ self visit:(node children at:1) ]
to:#whatever.
compiler add: 'error ifTrue: [ ^ failure ].'.
2 to: (node children size) do: [ :idx | |child|
child := node children at: idx.
compiler codeAssignParsedValueOf:[ self visit:child ] to:#whatever.
child acceptsEpsilon ifFalse: [
compiler add: 'error ifTrue: [ '.
compiler indent.
compiler smartRestore: node from: mementoVar.
compiler add: ' ^ failure .'.
compiler dedent.
compiler add: '].'.
].
].
!
visitSequenceNode: node
| elementVars mementoVar canBacktrack coding |
elementVars := node preferredChildrenVariableNames.
elementVars do:[:e |
compiler allocateTemporaryVariableNamed: e.
].
canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.
" self addGuardTrimming: node.
self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ self error' ].
"
canBacktrack ifTrue: [
mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
compiler smartRemember: node to: mementoVar.
].
node returnParsedObjectsAsCollection ifTrue:[
compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
].
coding := [ :index |
| child childValueVar |
child := node children at: index.
childValueVar := elementVars at: index.
compiler codeAssignParsedValueOf: [ self visit:child ]
to: childValueVar.
child acceptsEpsilon ifFalse: [
compiler codeIfErrorThen: [
"Handle error in the first element specially"
"TODO: JK, please explain here why!!!!!!"
index == 1 ifTrue:[
compiler add: 'error ifTrue: [ ^ failure ].'.
] ifFalse:[
compiler smartRestore: node from: mementoVar.
compiler codeReturn: 'failure.'.
]
] else:[
node returnParsedObjectsAsCollection ifTrue:[
compiler add: self retvalVar , ' at: ', index asString, ' put: ', childValueVar, '.'.
].
(index < node children size) ifTrue:[
coding value: index + 1.
].
]
] ifTrue:[
node returnParsedObjectsAsCollection ifTrue:[
compiler add: self retvalVar , ' at: ', index asString, ' put: ', childValueVar, '.'.
].
(index < node children size) ifTrue:[
coding value: index + 1.
].
]
].
coding value:1.
compiler codeReturn
"Modified (comment): / 16-06-2015 / 06:38:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitStarAnyNode: node
| retvalVar sizeVar |
retvalVar := self retvalVar.
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: / 15-06-2015 / 18:53:58 / 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 codeEvaluate: 'add:' argument: 'context next.' on: self retvalVar.
compiler dedent.
compiler add: '].'.
compiler codeAssign: self retvalVar, ' asArray.' to: self retvalVar.
compiler codeReturn.
!
visitStarMessagePredicateNode: node
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler add: '[ context peek ', node message, ' ] whileTrue: ['.
compiler indent.
compiler codeEvaluate: 'add:' argument: 'context next.' on: self retvalVar.
compiler dedent.
compiler add: '].'.
compiler codeAssign: self retvalVar, ' asArray.' to: self retvalVar.
compiler codeReturn.
!
visitStarNode: node
| elementVar |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
self addGuard: node child ifTrue: nil ifFalse: [ compiler codeReturn: '#()' ].
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
compiler add: '[ error ] whileFalse: ['.
compiler indent.
compiler add: self retvalVar, ' add: ', elementVar, '.'.
compiler codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
compiler dedent.
compiler add: '].'.
compiler codeClearError.
compiler codeReturn: self retvalVar, ' asArray.'.
!
visitSymbolActionNode: node
| elementVar |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
compiler codeAssignParsedValueOf:[ self visit:node child ] to: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 profileTokenRead: (compiler idFor: node).
compiler codeAssign: 'context position + 1.' to: startVar.
compiler codeAssignParsedValueOf:[ self visit:node child ] to:#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 codeAssignParsedValueOf:[ self visit:node child ] to:#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
codeAssignParsedValueOf:[ self visit:node child ]
to: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: '].'.
!
visitTrimmingTokenCharacterNode: node
^ self visitTrimmingTokenNode: node
!
visitTrimmingTokenNode: node
| id guard startVar endVar |
startVar := compiler allocateTemporaryVariableNamed: 'start'.
endVar := compiler allocateTemporaryVariableNamed: 'end'.
id := compiler idFor: node.
compiler profileTokenRead: id.
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 codeAssignParsedValueOf:[ self visit:node child ] to:#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: ', self retvalVar, ' message at: ', self retvalVar, ' position ].'.
compiler dedent.
compiler add: 'error := ', self retvalVar, ' isPetitFailure.'.
compiler codeReturn.
"Modified: / 15-06-2015 / 17:59:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCCodeGenerator class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !