Do not create intermediate collection when parsing sequence if not necesary.
The collection is not needed when the result of a choice is being used in mapped parser.
In that case, store parsed objects in variables and inline action code to use these variables
to access parsed objects.
--- a/analyzer/tests/Make.proto Wed Jun 03 09:06:49 2015 +0100
+++ b/analyzer/tests/Make.proto Fri Jun 05 00:05:08 2015 +0100
@@ -103,7 +103,6 @@
prereq:
cd ../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
--- a/analyzer/tests/bc.mak Wed Jun 03 09:06:49 2015 +0100
+++ b/analyzer/tests/bc.mak Fri Jun 05 00:05:08 2015 +0100
@@ -53,7 +53,6 @@
prereq:
pushd ..\..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\.. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
--- a/compiler/PPCCodeGenerator.st Wed Jun 03 09:06:49 2015 +0100
+++ b/compiler/PPCCodeGenerator.st Fri Jun 05 00:05:08 2015 +0100
@@ -421,21 +421,28 @@
blockBody replaceNode: blockBody statements last withNode: return.
].
+ node child preferredChildrenVariableNames: blockNode argumentNames.
+ node child isMarkedForInline ifTrue:[
+ node child returnParsedObjectsAsCollection: false.
+ ].
+
compiler codeStoreValueOf: [ self visit: node child ] intoVariable: self retvalVar.
compiler codeIf: 'error' then: [
compiler codeReturn: 'failure'.
] else: [
"First, extract mapped elements to variable..."
blockNode arguments withIndexDo:[ :arg :idx |
- compiler allocateTemporaryVariableNamed: arg name.
- compiler codeAssign: (self retvalVar , ' at: ', idx printString) to: arg name.
+ node child isMarkedForInline ifFalse:[
+ compiler allocateTemporaryVariableNamed: arg name.
+ compiler codeAssign: (self retvalVar , ' at: ', idx printString) to: arg name.
+ ].
compiler add: '.'.
].
compiler code: blockBody.
]
"Created: / 02-06-2015 / 17:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 03-06-2015 / 06:10:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2015 / 23:46:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitMessagePredicateNode: node
@@ -636,42 +643,52 @@
visitSequenceNode: node
- | elementVar mementoVar canBacktrack |
+ | elementVars mementoVar canBacktrack |
- elementVar := compiler allocateTemporaryVariableNamed: 'element'.
+ elementVars := node preferredChildrenVariableNames.
+ elementVars do:[:e |
+ compiler allocateTemporaryVariableNamed: e.
+ ].
+
+
canBacktrack := (node children allButFirst allSatisfy: [:e | e acceptsEpsilon ]) not.
-" self addGuardTrimming: node.
+" 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.
+
+ node returnParsedObjectsAsCollection ifTrue:[
+ compiler codeAssign: 'Array new: ', node children size asString, '.' to: self retvalVar.
+ ].
- compiler codeStoreValueOf: [ self visit: (node children at: 1)] intoVariable: elementVar.
+ compiler codeStoreValueOf: [ self visit: (node children at: 1)] intoVariable: (elementVars at: 1).
compiler add: 'error ifTrue: [ ^ failure ].'.
- compiler add: self retvalVar , ' at: 1 put: ', elementVar, '.'.
-
+ node returnParsedObjectsAsCollection ifTrue:[
+ compiler add: self retvalVar , ' at: 1 put: ', (elementVars at: 1), '.'.
+ ].
2 to: (node children size) do: [ :idx | |child|
child := node children at: idx.
- compiler codeStoreValueOf: [ self visit: child ] intoVariable: elementVar.
+ compiler codeStoreValueOf: [ self visit: child ] intoVariable: (elementVars at: idx).
child acceptsEpsilon ifFalse: [
compiler add: 'error ifTrue: [ '.
compiler indent.
compiler smartRestore: node from: mementoVar.
- compiler add: '^ failure.'.
+ compiler codeReturn: 'failure.'.
compiler dedent.
compiler add: '].'.
].
- compiler add: self retvalVar , ' at: ', idx asString, ' put: ',elementVar,'.'.
+ node returnParsedObjectsAsCollection ifTrue:[
+ compiler add: self retvalVar , ' at: ', idx asString, ' put: ',(elementVars at: idx),'.'.
+ ].
].
compiler codeReturn
- "Modified: / 23-04-2015 / 22:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2015 / 23:47:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitStarAnyNode: node
--- a/compiler/PPCSequenceNode.st Wed Jun 03 09:06:49 2015 +0100
+++ b/compiler/PPCSequenceNode.st Fri Jun 05 00:05:08 2015 +0100
@@ -12,8 +12,58 @@
!PPCSequenceNode methodsFor:'accessing'!
+preferredChildrenVariableNames
+ "Return an array of preferred variable names of variables where to store
+ particular child's result value."
+
+ | names |
+
+ names := self propertyAt: #preferredChildrenVariableNames ifAbsent:[ nil ].
+ names notNil ifTrue:[ ^ names ].
+ names := OrderedCollection new.
+ self children do:[:child |
+ | id |
+
+ id := child name ? 'c'.
+ (names includes: id) ifTrue:[
+ | i |
+
+ i := 1.
+ [ names includes: (id , '_' , i printString) ] whileTrue:[
+ i := i + 1.
+ ].
+ id := (id , '_' , i printString).
+ ].
+ names add: id.
+ ].
+ self propertyAt: #preferredChildrenVariableNames put: names.
+ ^ names
+
+ "Created: / 04-06-2015 / 23:08:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+preferredChildrenVariableNames: aSequenceableCollection
+ "Sets an array of preferred variable names"
+
+ self propertyAt: #preferredChildrenVariableNames put: aSequenceableCollection
+
+ "Created: / 04-06-2015 / 23:09:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
prefix
^ #seq
+!
+
+returnParsedObjectsAsCollection
+ ^ self propertyAt: #returnParsedObjectsAsCollection ifAbsent:[ true ]
+
+ "Created: / 04-06-2015 / 23:43:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+returnParsedObjectsAsCollection: aBoolean
+ self propertyAt: #returnParsedObjectsAsCollection put: aBoolean
+
+ "Created: / 04-06-2015 / 23:43:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCSequenceNode methodsFor:'analysis'!
--- a/compiler/PPCTokenizingVisitor.st Wed Jun 03 09:06:49 2015 +0100
+++ b/compiler/PPCTokenizingVisitor.st Fri Jun 05 00:05:08 2015 +0100
@@ -9,6 +9,7 @@
category:'PetitCompiler-Visitors'
!
+
!PPCTokenizingVisitor methodsFor:'hooks'!
afterAccept: node retval: parserNode
@@ -115,3 +116,10 @@
yourself.
! !
+!PPCTokenizingVisitor class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/extensions.st Wed Jun 03 09:06:49 2015 +0100
+++ b/compiler/extensions.st Fri Jun 05 00:05:08 2015 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"{ Package: 'stx:goodies/petitparser/compiler' }"!
!Character methodsFor:'*petitcompiler'!
--- a/compiler/tests/PPCCodeGeneratorTest.st Wed Jun 03 09:06:49 2015 +0100
+++ b/compiler/tests/PPCCodeGeneratorTest.st Fri Jun 05 00:05:08 2015 +0100
@@ -435,10 +435,29 @@
parse:'cz'
to:'cz'.
self assert:parser fail:''.
- self assert:parser fail:'asd'.
+ self assert:parser fail:'a'.
"Created: / 02-06-2015 / 17:04:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 03-06-2015 / 06:10:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2015 / 22:44:04 / 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 fail:''.
+ self assert:parser fail:'a'.
+
+ "Created: / 04-06-2015 / 23:13:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testMessagePredicate
--- a/compiler/tests/extras/PPTokenizedSmalltalkVerificationTest.st Wed Jun 03 09:06:49 2015 +0100
+++ b/compiler/tests/extras/PPTokenizedSmalltalkVerificationTest.st Fri Jun 05 00:05:08 2015 +0100
@@ -9,6 +9,7 @@
category:'PetitCompiler-Extras-Tests-Smalltalk'
!
+
!PPTokenizedSmalltalkVerificationTest class methodsFor:'as yet unclassified'!
resources
@@ -37,3 +38,10 @@
super testSmalltalkObject
! !
+!PPTokenizedSmalltalkVerificationTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+