"{ 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:'code generation'!
generateChoiceChildOf: choiceNode atIndex: choiceChildNodeIndex useGuards: useGuards storeResultInto: resultVar
| children |
children := choiceNode children.
useGuards ifTrue:[
self addGuard: (children at: choiceChildNodeIndex) ifTrue: [
compiler add: 'self clearError.'.
compiler
codeAssignParsedValueOf:[ self visit:(children at: choiceChildNodeIndex) ]
to: resultVar.
compiler add: 'error ifFalse: [ '.
compiler codeReturn: resultVar.
compiler add: ' ].'.
] ifFalse:[
compiler add: 'error := true.'.
].
compiler add: 'error ifTrue:[ '.
choiceChildNodeIndex < children size ifTrue:[
self generateChoiceChildOf: choiceNode atIndex: choiceChildNodeIndex + 1 useGuards: useGuards storeResultInto: resultVar.
] ifFalse:[
compiler codeError: 'no choice suitable'.
].
compiler addOnLine: '].'.
] ifFalse:[
choiceChildNodeIndex <= children size ifTrue:[
compiler add: 'self clearError.'.
compiler
codeAssignParsedValueOf:[ self visit:(children at: choiceChildNodeIndex) ]
to: resultVar.
compiler add: 'error ifFalse: [ '.
compiler codeReturn: resultVar.
compiler add: ' ].'.
self generateChoiceChildOf: choiceNode atIndex: choiceChildNodeIndex + 1 useGuards: useGuards storeResultInto: resultVar.
] ifFalse:[
compiler codeError: 'no choice suitable'.
].
].
!
generateSequenceChildOf: sequenceNode atIndex: sequenceNodeChildIndex useMememntoVar: mementoVar storeResultInto: elementVars
| child childValueVar |
child := sequenceNode children at: sequenceNodeChildIndex.
childValueVar := elementVars at: sequenceNodeChildIndex.
compiler codeAssignParsedValueOf: [ self visit:child ]
to: childValueVar.
child acceptsEpsilon ifFalse: [
compiler codeIfErrorThen: [
"Handle error in the first element in a special way,
because one does not need to do backtracking if the first element fails."
(sequenceNodeChildIndex == 1) ifTrue: [
compiler codeReturn: 'failure'
] ifFalse: [
compiler smartRestore: sequenceNode from: mementoVar.
compiler codeReturn: 'failure.'.
]
] else:[
sequenceNode returnParsedObjectsAsCollection ifTrue:[
compiler add: self retvalVar , ' at: ', sequenceNodeChildIndex asString, ' put: ', childValueVar, '.'.
].
(sequenceNodeChildIndex < sequenceNode children size) ifTrue:[
self generateSequenceChildOf: sequenceNode atIndex: sequenceNodeChildIndex + 1 useMememntoVar: mementoVar storeResultInto: elementVars.
].
]
] ifTrue:[
sequenceNode returnParsedObjectsAsCollection ifTrue:[
compiler add: self retvalVar , ' at: ', sequenceNodeChildIndex asString, ' put: ', childValueVar, '.'.
].
(sequenceNodeChildIndex < sequenceNode children size) ifTrue:[
self generateSequenceChildOf: sequenceNode atIndex: sequenceNodeChildIndex + 1 useMememntoVar: mementoVar storeResultInto: elementVars.
].
]
! !
!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 defaultName: #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:'private'!
checkBlockIsInlinable: block
"Check whether the given block could be inlined. If not,
throw an error. If yes, this method is noop.
A block is inlineable if and only if it's a purely functional
(see PPCASTUtilities>>checkBlockIsPurelyFunctional:inClass: for
details)
As a side-effect, copy all self-sent methods from the block
to the target class.
"
| blockNode |
blockNode := block sourceNode.
"In Smalltalk implementation which use cheap-block optimization (Smalltalk/X) it may
happen that home context of the block is nil (in case of cheap blocks)"
block home notNil ifTrue:[
| blockClass |
blockClass := block home receiver class.
PPCASTUtilities new checkNodeIsFunctional: blockNode inClass: blockClass.
"The above code should raise an error when block is not functional (i.e., when not
inlineable, so if the control flow reach this point, block is OK and we can safely
copy self-sent methods."
self copySelfSentMethodsOf: blockNode inClass: blockClass
].
"Created: / 27-07-2015 / 14:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-07-2015 / 15:52:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
copySelfSentMethodsOf: anRBProgramNode inClass: aClass
PPCASTUtilities new withAllMessageNodesOf: anRBProgramNode sentToSelfDo: [ :node|
| method source |
method := aClass lookupSelector: node selector.
method isNil ifTrue:[
PPCCompilationError new signalWith: 'oops, no method found (internal error)!!'.
].
source := method source.
source isNil ifTrue:[
PPCCompilationError new signalWith: 'unavailable source for method ', method printString ,'!!'.
].
"Following actually copies the method to the target class,
though the APU is not nice. This has to be cleaned up"
(compiler cachedValue: node selector) isNil ifTrue:[
compiler cache: node selector as: (PPCMethod new id: node selector; source: source; yourself).
"Now compile self-sends of the just copied method"
self copySelfSentMethodsOf: method parseTree inClass: aClass
].
]
"Created: / 27-07-2015 / 14:50:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!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 defaultName: #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 codeComment: 'BEGIN inlined code of ' , node printString.
compiler indent.
] ifFalse:[
compiler startMethod: (compiler idFor: node).
compiler codeComment: '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 |
self checkBlockIsInlinable: node block.
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.
PPCASTUtilities new withAllVariableNodesOf: blockBody do:[: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..."
PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockNodesVar name ifTrue:[
variableNode name: self retvalVar.
].
].
] ifFalse:[
"Good, can avoid intermediate collection.
Replace references to collection with corresponding temporary variable"
blockMatches keysAndValuesDo:[:matchingNode :childValueVar |
matchingNode parent replaceNode: matchingNode 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: / 27-07-2015 / 15:49:15 / 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 defaultName: #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 defaultName: #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 useGuards resultVar |
resultVar := compiler allocateTemporaryVariableNamed: 'element'.
whitespaceConsumed := self addGuardTrimming: node.
useGuards := whitespaceConsumed.
self generateChoiceChildOf: node atIndex: 1 useGuards: useGuards storeResultInto: resultVar
"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 codeIf: 'context atEnd'
then: [ compiler codeReturn ]
else: [ compiler codeError: 'End of input expected' ].
"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 |
self checkBlockIsInlinable: node block.
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.
PPCASTUtilities new withAllVariableNodesOf: blockBody do:[:variableNode|
variableNode name = blockArg name ifTrue:[
variableNode name: 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: / 27-07-2015 / 15:49:58 / 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 defaultName: #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 defaultName: #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 defaultName: #pluggableBlock.
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 defaultName: #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 |
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.
].
self generateSequenceChildOf: node atIndex: 1 useMememntoVar: mementoVar storeResultInto: elementVars.
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 defaultName: #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 codeAssignParsedValueOf:[ self visit:node child ] to:elementVar.
compiler codeIf: 'error'
then: [
compiler codeClearError.
compiler codeReturn: '#()'.
] else: [
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
].
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>"
! !