Avoid creation of intermediate collection for mapped action nodes.
--- a/compiler/PPCCodeGenerator.st Mon Jun 15 18:00:44 2015 +0100
+++ b/compiler/PPCCodeGenerator.st Mon Jun 15 19:13:49 2015 +0100
@@ -158,23 +158,25 @@
!
retvalVar
- ^ compiler currentReturnVariable
+ ^ 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.
+ 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.
+ compiler startMethod: (compiler idFor: node).
+ compiler addComment: 'GENERATED by ' , node printString.
+ compiler allocateReturnVariable.
].
"Created: / 23-04-2015 / 15:51:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-04-2015 / 19:13:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 15-06-2015 / 18:03:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
stopMethodForNode:aPPCNode
@@ -418,8 +420,9 @@
!
visitMappedActionNode: node
- | blockNode blockBody |
+ | child blockNode blockBody |
+ child := node child.
blockNode := node block ast copy.
blockBody := blockNode body.
@@ -438,30 +441,47 @@
blockBody replaceNode: blockBody statements last withNode: return.
].
- node child preferredChildrenVariableNames: blockNode argumentNames.
- node child isMarkedForInline ifTrue:[
- node child returnParsedObjectsAsCollection: false.
+ 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:node child ]
- to:self retvalVar.
+ compiler codeAssignParsedValueOf: [ self visit: child ] to: self retvalVar.
compiler codeIf: 'error' then: [
compiler codeReturn: 'failure'.
] else: [
- "First, extract mapped elements to variable..."
- blockNode arguments withIndexDo:[ :arg :idx |
- node child isMarkedForInline ifFalse:[
- compiler allocateTemporaryVariableNamed: arg name.
- compiler codeAssign: (self retvalVar , ' at: ', idx printString) to: arg name.
+ "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 add: '.'.
].
compiler code: blockBody.
]
"Created: / 02-06-2015 / 17:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 04-06-2015 / 23:46:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-06-2015 / 19:03:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitMessagePredicateNode: node
@@ -721,14 +741,14 @@
visitStarAnyNode: node
| retvalVar sizeVar |
- retvalVar := compiler allocateReturnVariable.
+ 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: / 05-05-2015 / 14:13:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+
+ "Modified: / 15-06-2015 / 18:53:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitStarCharSetPredicateNode: node
--- a/compiler/PPCCompiler.st Mon Jun 15 18:00:44 2015 +0100
+++ b/compiler/PPCCompiler.st Mon Jun 15 19:13:49 2015 +0100
@@ -510,13 +510,19 @@
!PPCCompiler methodsFor:'code generation - variables'!
-allocateReturnVariable
- "Return a new variable to store parsed value"
+allocateReturnVariable
+ ^ self allocateReturnVariableNamed: 'retval'
+
+ "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
- ^ currentMethod allocateReturnVariable
+allocateReturnVariableNamed: name
+ "Allocate (or return previously allocated one) temporary variable used for
+ storing a parser's return value (the parsed object)"
+ ^ currentMethod allocateReturnVariableNamed: name
- "Created: / 23-04-2015 / 17:58:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (comment): / 23-04-2015 / 21:12:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 15-06-2015 / 18:04:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
allocateTemporaryVariableNamed: preferredName
--- a/compiler/PPCInlinedMethod.st Mon Jun 15 18:00:44 2015 +0100
+++ b/compiler/PPCInlinedMethod.st Mon Jun 15 19:13:49 2015 +0100
@@ -28,10 +28,10 @@
!PPCInlinedMethod methodsFor:'code generation - variables'!
-allocateReturnVariable
+allocateReturnVariableNamed: name
self error: 'return variable must be assigned by the non-inlined method....'
- "Created: / 23-04-2015 / 21:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 15-06-2015 / 17:52:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
allocateTemporaryVariableNamed:aString
--- a/compiler/PPCMethod.st Mon Jun 15 18:00:44 2015 +0100
+++ b/compiler/PPCMethod.st Mon Jun 15 19:13:49 2015 +0100
@@ -156,15 +156,17 @@
!PPCMethod methodsFor:'code generation - variables'!
-allocateReturnVariable
- ^ variableForReturn isNil ifTrue:[
- variableForReturn := self allocateTemporaryVariableNamed: 'retval'
- ] ifFalse:[
- variableForReturn
- ].
+allocateReturnVariableNamed: name
+ "Allocate temporary variable used for storing a parser's return value (the parsed object)"
- "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (format): / 01-06-2015 / 21:01:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ variableForReturn notNil ifTrue:[
+ self error: 'Return variable already allocated!!'.
+ ^ self.
+ ].
+ variableForReturn := self allocateTemporaryVariableNamed: name.
+ ^ variableForReturn
+
+ "Created: / 15-06-2015 / 17:52:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
allocateTemporaryVariableNamed:preferredName
@@ -177,17 +179,21 @@
"Modified: / 01-06-2015 / 21:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-returnVariable
- ^ variableForReturn
+returnVariable
+ ^ variableForReturn
"Created: / 23-04-2015 / 20:50:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 15-06-2015 / 18:12:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
returnVariable: aString
- ^ variableForReturn := aString
+ (variableForReturn notNil and:[variableForReturn ~= aString]) ifTrue:[
+ self error: 'Return variable already allocated with different name (''', variableForReturn , ''' vs ''', aString,''')'.
+ ].
+ variableForReturn := aString
"Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-06-2015 / 18:14:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCMethod methodsFor:'initialization'!
--- a/compiler/PPCNode.st Mon Jun 15 18:00:44 2015 +0100
+++ b/compiler/PPCNode.st Mon Jun 15 19:13:49 2015 +0100
@@ -532,6 +532,12 @@
"Created: / 23-04-2015 / 15:40:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+isSequenceNode
+ ^ false
+
+ "Created: / 15-06-2015 / 18:29:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
isTokenNode
^ false
!
--- a/compiler/PPCSequenceNode.st Mon Jun 15 18:00:44 2015 +0100
+++ b/compiler/PPCSequenceNode.st Mon Jun 15 19:13:49 2015 +0100
@@ -172,6 +172,14 @@
reject: [ :each | each isNullable ]) ] ]
! !
+!PPCSequenceNode methodsFor:'testing'!
+
+isSequenceNode
+ ^ true
+
+ "Created: / 15-06-2015 / 18:29:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!PPCSequenceNode methodsFor:'visiting'!
accept: visitor
--- a/compiler/tests/PPCCodeGeneratorTest.st Mon Jun 15 18:00:44 2015 +0100
+++ b/compiler/tests/PPCCodeGeneratorTest.st Mon Jun 15 19:13:49 2015 +0100
@@ -72,6 +72,24 @@
self assert: parser fail: ''.
!
+testActionNode2
+ node := PPCPlusNode new
+ child:
+ (PPCActionNode new
+ block: [ :res | res asUppercase ];
+ child: #letter asParser asCompilerTree;
+ yourself);
+ yourself.
+
+ self compileTree: node.
+
+ self assert: parser parse: 'foo' to: { $F . $O . $O}.
+ self assert: parser parse: 'bar' to: { $B . $A . $R}.
+ self assert: parser fail: ''.
+
+ "Created: / 15-06-2015 / 13:57:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
testAnyNode
node := PPCForwardNode new
child: PPCAnyNode new;
@@ -425,39 +443,49 @@
testMappedActionNode1
node := ((#letter asParser , #letter asParser)
map:[:a :b | String with:a with:b ]) asCompilerTree.
+
self compileTree:node.
- self
- assert:parser
- parse:'ab'
- to:'ab'.
- self
- assert:parser
- parse:'cz'
- to:'cz'.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
self assert:parser fail:''.
self assert:parser fail:'a'.
"Created: / 02-06-2015 / 17:04:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-06-2015 / 22:44:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 15-06-2015 / 14:08:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testMappedActionNode2
node := ((#letter asParser , #letter asParser)
map:[:a :b | String with:a with:b ]) asCompilerTree.
node child markForInline.
+
self compileTree:node.
- self
- assert:parser
- parse:'ab'
- to:'ab'.
- self
- assert:parser
- parse:'cz'
- to:'cz'.
+
+ self assert:parser parse:'ab' to:'ab'.
+ self assert:parser parse:'cz' to:'cz'.
self assert:parser fail:''.
self assert:parser fail:'a'.
"Created: / 04-06-2015 / 23:13:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (format): / 15-06-2015 / 14:08:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testMappedActionNode3
+ node := PPCPlusNode new
+ child:
+ (PPCMappedActionNode new
+ block: [ :l | l asUppercase ];
+ child: #letter asParser asCompilerTree;
+ yourself);
+ yourself.
+
+ self compileTree:node.
+
+ self assert:parser parse:'abc' to:#($A $B $C).
+
+ "Created: / 15-06-2015 / 18:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testMessagePredicate