--- a/compiler/PPCCodeGenerator.st Wed May 20 16:47:52 2015 +0100
+++ b/compiler/PPCCodeGenerator.st Thu May 21 14:35:34 2015 +0100
@@ -33,6 +33,59 @@
^ 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
@@ -56,36 +109,10 @@
!PPCCodeGenerator methodsFor:'support'!
-addGuard: node
- | guard firsts id |
- (self guards not or: [(guard := PPCGuard on: node) makesSense not]) ifTrue: [ ^ self].
-
- id := compiler idFor: node.
- firsts := node firstSetWithTokens.
-
-
- (firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [
- "If we start with trimming, we should invoke the whitespace parser"
- self compileTokenWhitespace: firsts anyOne.
-
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
-
- (firsts allSatisfy: [ :e | e isTerminal ]) ifTrue: [
- compiler add: 'context atEnd ifTrue: [ ^ self error ].'.
- guard id: id, '_guard'.
- guard compileGuard: compiler.
- compiler addOnLine: 'ifFalse: [ ^ self error ].'
- ].
-!
-
compileTokenWhitespace: node
compiler add: 'context atWs ifFalse: ['.
compiler indent.
- compiler call: (self visit: node whitespace).
+ compiler codeStoreValueOf: [ self visit: node whitespace ] intoVariable: #whatever.
compiler add: 'context setWs.'.
compiler dedent.
compiler add: '].'.
@@ -222,8 +249,9 @@
compiler add: '(', classificationId, ' at: context peek asInteger)'.
compiler indent.
- compiler add: 'ifFalse: [ self error: ''predicate not found'' ]'.
- compiler add: 'ifTrue: [ '.
+ compiler add: 'ifFalse: ['.
+ compiler codeError: 'predicate not found'.
+ compiler add: '] ifTrue: [ '.
compiler codeReturn: 'context next'.
compiler add: '].'.
compiler dedent.
@@ -240,9 +268,14 @@
compiler add: '(context peek == ', chid, ')'.
compiler indent.
- compiler add: 'ifFalse: [ self error: ''', node character asInteger asString, ' expected'' at: context position ] '.
- compiler add: 'ifTrue: [ '.
+ 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.
!
@@ -259,45 +292,31 @@
!
visitChoiceNode: node
- | firsts guard whitespaceConsumed elementVar |
+ | whitespaceConsumed elementVar |
"The code is not ready for inlining"
self assert: node isMarkedForInline not.
- whitespaceConsumed := false.
- firsts := node firstSetWithTokens.
-
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- "
- If we want to compile in guard and the choice starts with trimming token,
- we should invoke the whitespace parser
- "
- (self guards and: [ firsts allSatisfy: [ :e | e isTrimmingTokenNode ] ]) ifTrue: [
- self compileTokenWhitespace: firsts anyOne.
- whitespaceConsumed := true.
- ].
-
+ whitespaceConsumed := self addGuardTrimming: node.
+
1 to: node children size do: [ :idx | |child allowGuard |
child := node children at: idx.
allowGuard := whitespaceConsumed.
-
- (allowGuard and: [self guards and: [ (guard := PPCGuard on: child) makesSense ]]) ifTrue: [
- guard id: (compiler idFor: guard prefixed: #guard).
- guard compileGuard: compiler.
- compiler add: ' ifTrue: [ '.
- compiler indent.
+
+ allowGuard ifTrue: [
+ self addGuard: child ifTrue: [
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: 'error ifFalse: [ ^ ', elementVar, ' ].'.
+ ] ifFalse: nil.
+ ] ifFalse: [
+ compiler add: 'self clearError.'.
+ compiler codeStoreValueOf: [self visit: child] intoVariable: elementVar.
+ compiler add: 'error ifFalse: [ ^ ', elementVar, ' ].'.
]
].
- compiler add: '^ self error: ''no choice suitable'''.
+ compiler codeError: 'no choice suitable'.
"Modified: / 05-05-2015 / 14:10:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -331,14 +350,16 @@
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 indent.
+ compiler add: 'context position: ', positionVar, '.'.
+ compiler codeError: encodedLiteral, ' expected' at: positionVar.
+ compiler dedent.
compiler add: '].'.
!
visitMessagePredicateNode: node
compiler add: '(context peek ', node message, ') ifFalse: ['.
- compiler add: ' self error: ''predicate not found'''.
+ compiler codeError: 'predicate not found'.
compiler add: '] ifTrue: [ '.
compiler codeReturn: ' context next'.
compiler add: '].'.
@@ -359,13 +380,37 @@
compiler addOnLine: '(', classificationId, ' at: context peek asInteger)'.
compiler indent.
- compiler add: ' ifTrue: [ self error: '' predicate not expected'' ]'.
- compiler add: ' ifFalse: ['.
+ 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.
@@ -373,8 +418,9 @@
compiler add: '((context peek: ', size, ') =#''', encodedLiteral, ''')'.
compiler indent.
- compiler add: 'ifTrue: [ self error: ''', encodedLiteral, ' not expected'' ]'.
- compiler add: 'ifFalse: [ '.
+ compiler add: 'ifTrue: ['.
+ compiler codeError: encodedLiteral, ' not expected'.
+ compiler add: '] ifFalse: [ '.
compiler codeReturn: 'nil' .
compiler add: '].'.
compiler dedent.
@@ -408,8 +454,10 @@
visitOptionalNode: node
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler add: 'error ifTrue: [ '.
- compiler add: ' self clearError. '.
+ compiler indent.
+ compiler add: 'self clearError. '.
compiler codeAssign: 'nil.' to: self retvalVar.
+ compiler dedent.
compiler add: '].'.
compiler codeReturn.
!
@@ -423,14 +471,20 @@
!
visitPlusNode: node
- | elementVar |
+ | 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 codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
- compiler add: 'error ifTrue: [ self error: ''at least one occurence expected'' ] ifFalse: ['.
+ compiler add: 'error ifTrue: ['.
+ compiler codeError: 'at least one occurence expected'.
+ compiler add: '] ifFalse: ['.
compiler indent.
compiler add: self retvalVar , ' add: ',elementVar , '.'.
@@ -457,8 +511,9 @@
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 add: 'ifFalse: ['.
+ compiler codeError: 'predicate not found'.
+ compiler add: '] ifTrue: [ ', self retvalVar ,' := context next ].'.
compiler dedent.
compiler codeReturn.
@@ -466,49 +521,66 @@
!
visitRecognizingSequenceNode: node
- | mementoVar |
+ | mementoVar canBacktrack |
+
+ canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.
- mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
- compiler smartRemember: node to: mementoVar.
+ canBacktrack ifTrue: [
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ compiler smartRemember: node to: mementoVar.
+ ].
-" self addGuard: compiler."
-
- compiler codeStoreValueOf: [ self visit: (node children at: 1) ] intoVariable: #whatever.
+ 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: '].'.
+
+ child acceptsEpsilon ifFalse: [
+ compiler add: 'error ifTrue: [ '.
+ compiler indent.
+ compiler smartRestore: node from: mementoVar.
+ compiler add: ' ^ failure .'.
+ compiler dedent.
+ compiler add: '].'.
+ ].
].
!
visitSequenceNode: node
- | elementVar mementoVar |
+ | elementVar mementoVar canBacktrack |
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
- mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.
- compiler smartRemember: node to: mementoVar.
+" self addGuardTrimming: node.
+ self addGuard: node ifTrue: nil ifFalse: [ compiler addOnLine: ' ^ self error' ].
+"
+ canBacktrack ifTrue: [
+ mementoVar := compiler allocateTemporaryVariableNamed: 'memento'.
+ compiler smartRemember: node to: mementoVar.
+ ].
+
compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
- self addGuard: node.
- 1 to: (node children size) do: [ :idx | |child|
+ compiler codeStoreValueOf: [ self visit: (node children at: 1)] intoVariable: elementVar.
+ compiler add: 'error ifTrue: [ ^ failure ].'.
+ compiler add: self retvalVar , ' at: 1 put: ', elementVar, '.'.
+
+ 2 to: (node children size) do: [ :idx | |child|
child := node children at: idx.
compiler codeStoreValueOf: [ self visit: child ] intoVariable: elementVar.
-
- compiler add: 'error ifTrue: [ '.
- compiler indent.
- compiler smartRestore: node from: mementoVar.
- compiler add: '^ failure.'.
- compiler dedent.
- compiler add: '].'.
+
+ child acceptsEpsilon ifFalse: [
+ 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
@@ -540,10 +612,11 @@
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 codeEvaluate: 'add:' argument: 'context next.' on: self retvalVar.
compiler dedent.
compiler add: '].'.
- compiler codeReturn: 'retval asArray'.
+ compiler codeAssign: self retvalVar, ' asArray.' to: self retvalVar.
+ compiler codeReturn.
!
visitStarMessagePredicateNode: node
@@ -551,10 +624,11 @@
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler add: '[ context peek ', node message, ' ] whileTrue: ['.
compiler indent.
- compiler add: self retvalVar, ' add: context next.'.
+ compiler codeEvaluate: 'add:' argument: 'context next.' on: self retvalVar.
compiler dedent.
compiler add: '].'.
- compiler codeReturn: 'retval asArray'.
+ compiler codeAssign: self retvalVar, ' asArray.' to: self retvalVar.
+ compiler codeReturn.
!
visitStarNode: node
@@ -562,6 +636,8 @@
elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ self addGuard: node child ifTrue: nil ifFalse: [ compiler codeReturn: '#()' ].
+
compiler codeAssign: 'OrderedCollection new.' to: self retvalVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: elementVar.
compiler add: '[ error ] whileFalse: ['.
@@ -602,6 +678,8 @@
startVar := compiler allocateTemporaryVariableNamed: 'start'.
endVar := compiler allocateTemporaryVariableNamed: 'end'.
+ compiler profileTokenRead: (compiler idFor: node).
+
compiler codeAssign: 'context position + 1.' to: startVar.
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: #whatever.
compiler add: 'error ifFalse: [ '.
@@ -660,6 +738,10 @@
compiler add: '].'.
!
+visitTrimmingTokenCharacterNode: node
+ ^ self visitTrimmingTokenNode: node
+!
+
visitTrimmingTokenNode: node
| id guard startVar endVar |
@@ -667,8 +749,8 @@
endVar := compiler allocateTemporaryVariableNamed: 'end'.
id := compiler idFor: node.
-" (id beginsWith: 'kw') ifTrue: [ self halt. ]."
- "self compileFirstWhitespace: compiler."
+ compiler profileTokenRead: id.
+
self compileTokenWhitespace: node.
(arguments guards and: [(guard := PPCGuard on: node) makesSense]) ifTrue: [