# HG changeset patch # User Jan Vrany # Date 1434392029 -3600 # Node ID 19a9c25960ef499d61f1b006cf4d9becd1195d2e # Parent 602215b19135defcbe8032c9e5ae69512050d57e Avoid creation of intermediate collection for mapped action nodes. diff -r 602215b19135 -r 19a9c25960ef compiler/PPCCodeGenerator.st --- 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 " ! 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 " "Modified: / 23-04-2015 / 19:13:25 / Jan Vrany " - "Modified (comment): / 23-04-2015 / 21:31:24 / Jan Vrany " + "Modified (format): / 15-06-2015 / 18:03:07 / Jan Vrany " ! 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 " - "Modified: / 04-06-2015 / 23:46:41 / Jan Vrany " + "Modified: / 15-06-2015 / 19:03:57 / Jan Vrany " ! 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 " + + "Modified: / 15-06-2015 / 18:53:58 / Jan Vrany " ! visitStarCharSetPredicateNode: node diff -r 602215b19135 -r 19a9c25960ef compiler/PPCCompiler.st --- 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 " + "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany " +! - ^ 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 " - "Modified (comment): / 23-04-2015 / 21:12:57 / Jan Vrany " + "Created: / 15-06-2015 / 18:04:48 / Jan Vrany " ! allocateTemporaryVariableNamed: preferredName diff -r 602215b19135 -r 19a9c25960ef compiler/PPCInlinedMethod.st --- 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 " + "Created: / 15-06-2015 / 17:52:35 / Jan Vrany " ! allocateTemporaryVariableNamed:aString diff -r 602215b19135 -r 19a9c25960ef compiler/PPCMethod.st --- 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 " - "Modified (format): / 01-06-2015 / 21:01:29 / Jan Vrany " + variableForReturn notNil ifTrue:[ + self error: 'Return variable already allocated!!'. + ^ self. + ]. + variableForReturn := self allocateTemporaryVariableNamed: name. + ^ variableForReturn + + "Created: / 15-06-2015 / 17:52:14 / Jan Vrany " ! allocateTemporaryVariableNamed:preferredName @@ -177,17 +179,21 @@ "Modified: / 01-06-2015 / 21:04:02 / Jan Vrany " ! -returnVariable - ^ variableForReturn +returnVariable + ^ variableForReturn "Created: / 23-04-2015 / 20:50:50 / Jan Vrany " + "Modified (format): / 15-06-2015 / 18:12:28 / Jan Vrany " ! 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 " - "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany " + "Modified: / 15-06-2015 / 18:14:02 / Jan Vrany " ! ! !PPCMethod methodsFor:'initialization'! diff -r 602215b19135 -r 19a9c25960ef compiler/PPCNode.st --- 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 " ! +isSequenceNode + ^ false + + "Created: / 15-06-2015 / 18:29:32 / Jan Vrany " +! + isTokenNode ^ false ! diff -r 602215b19135 -r 19a9c25960ef compiler/PPCSequenceNode.st --- 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 " +! ! + !PPCSequenceNode methodsFor:'visiting'! accept: visitor diff -r 602215b19135 -r 19a9c25960ef compiler/tests/PPCCodeGeneratorTest.st --- 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 " +! + 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 " "Modified: / 04-06-2015 / 22:44:04 / Jan Vrany " + "Modified (format): / 15-06-2015 / 14:08:11 / Jan Vrany " ! 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 " + "Modified (format): / 15-06-2015 / 14:08:36 / Jan Vrany " +! + +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 " ! testMessagePredicate