--- a/compiler/PPCCodeGenerator.st Tue May 05 16:25:23 2015 +0200
+++ b/compiler/PPCCodeGenerator.st Sun May 10 06:46:56 2015 +0100
@@ -12,113 +12,113 @@
!PPCCodeGenerator class methodsFor:'as yet unclassified'!
on: aPPCCompiler
- ^ self new
- compiler: aPPCCompiler;
- yourself
+ ^ self new
+ compiler: aPPCCompiler;
+ yourself
! !
!PPCCodeGenerator methodsFor:'accessing'!
compiler: aPPCCompiler
- compiler := aPPCCompiler
+ compiler := aPPCCompiler
! !
!PPCCodeGenerator methodsFor:'hooks'!
afterAccept: node retval: retval
- "return the method from compiler"
- ^ self stopMethodForNode: node.
+ "return the method from compiler"
+ ^ self stopMethodForNode: node.
!
beforeAccept: node
- self startMethodForNode: node
+ self startMethodForNode: node
!
closedDetected: node
- ^ node isMarkedForInline ifFalse: [
- self error: 'Should not happen!!'
- ]
+ ^ node isMarkedForInline ifFalse: [
+ self error: 'Should not happen!!'
+ ]
!
openDetected: node
- ^ compiler checkCache: (compiler idFor: 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].
+ | 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 ] ]).
+ 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 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 ].'
- ].
+ (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: '].'.
+ 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.
+ | 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.
+ 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.
+ | 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.
+ 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
+ ^ compiler currentReturnVariable
!
startMethodForNode:node
@@ -153,233 +153,248 @@
!PPCCodeGenerator methodsFor:'traversing - caching'!
cache: node value: retval
- "this is compiler thing, not mine"
+ "this is compiler thing, not mine"
!
cachedDetected: node
- ^ compiler checkCache: (compiler idFor: node)
+ ^ compiler checkCache: (compiler idFor: node)
!
isCached: node
- ^ (compiler checkCache: (compiler idFor: node)) isNil not
+ ^ (compiler checkCache: (compiler idFor: node)) isNil not
! !
!PPCCodeGenerator methodsFor:'visiting'!
visitActionNode: node
- | elementVar |
+ | blockId |
- 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'.
+ 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: / 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).
+ | mementoVar |
+
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ compiler smartRemember: node child to: mementoVar.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
- compiler add: (compiler smartRestore: node child from: mementoVar).
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler smartRestore: node child from: mementoVar.
- compiler codeReturn.
+ 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. ].'.
+ 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.
+ | 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.
+ | 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 isOpen: child) ifTrue: [
+ "already processing..."
+ ^ nil
+ ].
- "TODO JK: this is is wrong,.. to tired now to fix this :("
+ "TODO JK: this is is wrong,.. to tired now to fix this :("
" (self isCached: child) ifTrue: [
- node replace: child with: (self cachedValue: child).
- ^ nil
- ].
+ node replace: child with: (self cachedValue: child).
+ ^ nil
+ ].
"
- ^ self visit: child.
+ ^ self visit: child.
!
visitChoiceNode: node
- | firsts guard whitespaceConsumed elementVar |
-
-
- whitespaceConsumed := false.
- firsts := (node firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
+ | 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 start with trimming token, we should invoke the whitespace parser"
- (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
- self compileTokenWhitespace: firsts anyOne.
- whitespaceConsumed := true.
- ].
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ "
+ If we want to compile in guard and the choice starts with trimming token,
+ we should invoke the whitespace parser
+ "
+ (arguments 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 := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not.
-"
- allowGuard := whitespaceConsumed.
+ 1 to: node children size do: [ :idx | |child allowGuard |
+ child := node children at: idx.
+ 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'''.
+ (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: [ ^ 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: / 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!!'' ].'.
+ 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.
+ compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
+ compiler codeReturn.
!
visitLiteralNode: node
- | positionVar encodedLiteral |
- encodedLiteral := node encodeQuotes: node literal.
- positionVar := compiler allocateTemporaryVariableNamed: 'position'.
+ | 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: '].'.
+ 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: '].'.
+ 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.'.
+ 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.
+ | 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.
+ | 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.
+ 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 smartRemember: node child to: mementoVar.
- compiler call: (self visit: node child).
- compiler add: (compiler smartRestore: node child from: 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 ]'.
@@ -387,84 +402,112 @@
!
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.
+ 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.'.
+ | blockId |
+ blockId := compiler idFor: node block prefixed: #block.
+
+ compiler addConstant: node block as: blockId.
+ compiler codeReturn: blockId, ' value: context.'.
!
visitPlusNode: node
- | elementVar |
+ | elementVar |
- elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
- compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
+ 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 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: '].'.
+ 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).
+ | pid |
+ pid := (compiler idFor: node predicate prefixed: #predicate).
- compiler addConstant: node predicate as: pid.
+ 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.
+ 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 mementoVar |
- elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ 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.
+ 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.
+ 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
+ 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>"
!
@@ -478,211 +521,204 @@
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 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: '].'.
+ 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 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'.
+ | 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'.
+ 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: ']'.
+ | 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.
- "
+ "
+ 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).
+ 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>"
+ | 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: '].'.
+ 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.'.
+ 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 |
+ "TODO: This ignores the TrimmingParser trimmer object!!"
- mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
- compiler add: (compiler smartRemember: node child to: mementoVar).
- compiler add: 'context skipSeparators.'.
+ 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: '].'.
+ 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 |
+ | id guard startVar endVar |
- startVar := compiler allocateTemporaryVariableNamed: 'start'.
- endVar := compiler allocateTemporaryVariableNamed: 'end'.
-
- id := compiler idFor: node.
+ startVar := compiler allocateTemporaryVariableNamed: 'start'.
+ endVar := compiler allocateTemporaryVariableNamed: 'end'.
+
+ id := compiler idFor: node.
" (id beginsWith: 'kw') ifTrue: [ self halt. ]."
- "self compileFirstWhitespace: compiler."
- self compileTokenWhitespace: node.
+ "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.
+ ].
- (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.
+
+ (arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [
+ compiler dedent.
+ compiler add: '].'.
+ ].
- 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 add: 'error ifFalse: [ '.
+ compiler indent.
+ compiler codeAssign: 'context position.' to: endVar.
+
" self compileSecondWhitespace: compiler."
- self compileTokenWhitespace: node.
+ self compileTokenWhitespace: node.
- compiler codeReturn: node tokenClass asString, ' on: (context collection)
- start: ', startVar, '
- stop: ', endVar, '
- value: nil'.
- compiler dedent.
- compiler add: '].'
+ compiler codeReturn: node tokenClass asString, ' on: (context collection)
+ start: ', startVar, '
+ stop: ', endVar, '
+ value: nil'.
+ compiler dedent.
+ compiler add: '].'
!
visitUnknownNode: node
- | compiledChild compiledParser id |
+ | 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.
+ 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.
! !