# HG changeset patch
# User Jan Vrany <jan.vrany@fit.cvut.cz>
# Date 1434437361 -3600
# Node ID 82b272c7dc376366b09cc8fb82eec481a7d22d05
# Parent  a836cbc0d8df666b430f57237654f43b745b6bd4
Codegen: added support for smart action node compiling.

Avoid creation of intermediate result collection for action nodes if all references
to action block's argument (i.e., the nodes collection) is in form of:

* <nodes> at: <numeric constant>
* <nodes> first (second, third...

diff -r a836cbc0d8df -r 82b272c7dc37 compiler/PPCCodeGenerator.st
--- a/compiler/PPCCodeGenerator.st	Tue Jun 16 06:54:14 2015 +0100
+++ b/compiler/PPCCodeGenerator.st	Tue Jun 16 07:49:21 2015 +0100
@@ -209,18 +209,77 @@
 !PPCCodeGenerator methodsFor:'visiting'!
 
 visitActionNode: node
-    | blockNode blockBody blockNodesVar |
+    | blockNode blockBody blockNodesVar blockNeedsCollection blockMatches childValueVars |
 
     blockNode := node block ast copy.
     self assert: blockNode arguments size == 1.
     blockNodesVar := blockNode arguments first .
     blockBody := blockNode body.
-    "Replace all references to blockNodeVar to retvalVar..."
-    blockBody variableNodesDo:[:variableNode| 
-        variableNode name = blockNodesVar name ifTrue:[ 
-            variableNode token value: self retvalVar.
+
+    "Now, analyze block body, search for all references to
+     block arg <barg> and check if in all cases it's used 
+     in one of the following patterns:
+
+        * <barg> first , <barg> second, ... , <barg> sixth
+        * <barg> at: <integer constant>
+
+     If so, then the block code can be inlined and the intermediate
+     result collection need not to be created. Keep this information
+     in temporary `blockNeedsCollection`. 
+     During the analysis, remember all nodes that matches the pattern
+     in a dictionary `blockMatches` mapping the node to actual temporary
+     variable where the node is used. This will be later used for block's node
+     rewriting"
+    blockNeedsCollection := true.
+    node child isSequenceNode ifTrue:[
+        blockNeedsCollection := false.
+        blockMatches := IdentityDictionary new."Must use IDENTITY dict as nodes have overwritten their #=!!!!!!"
+        childValueVars := node child preferredChildrenVariableNames.
+        blockBody variableNodesDo:[:variableNode| 
+            variableNode name = blockNodesVar name ifTrue:[ 
+                "Check if variable node matches..."
+                variableNode parent isMessage ifTrue:[ 
+                    | parent |
+
+                    parent := variableNode parent.
+                    "Check for <barg> at: <number>"
+                    ((parent selector == #at:) and:[ parent arguments first isLiteralNumber ]) ifTrue:[ 
+                        blockMatches at: parent put: (childValueVars at: parent arguments first value).
+                    ] ifFalse:[ 
+                        "Check for <barg> first / second / ..."
+                        | i |
+
+                        i := #(first second third fourth fifth sixth) indexOf: parent selector.
+                        i ~~ 0 ifTrue:[ 
+                            blockMatches at: parent put: (childValueVars at: i).
+                        ] ifFalse:[ 
+                            blockNeedsCollection := true.
+                        ].
+                    ].
+                ] ifFalse:[ 
+                    blockNeedsCollection := true.
+                ].
+            ].
         ].
     ].
+
+    blockNeedsCollection ifTrue:[
+        "Bad, we have to use the collection.
+         Replace all references to blockNodeVar to retvalVar..."
+        blockBody variableNodesDo:[:variableNode| 
+            variableNode name = blockNodesVar name ifTrue:[ 
+                variableNode token value: self retvalVar.
+            ].
+        ].
+    ] ifFalse:[ 
+        "Good, can avoid intermediate collection.
+         Replace references to collection with corresponding temporary variable"
+        blockMatches keysAndValuesDo:[:node :childValueVar |
+            node parent replaceNode: node withNode: (RBVariableNode named: childValueVar).
+        ].
+        node child returnParsedObjectsAsCollection: false. 
+    ].
+
     "Block return value is return value of last statement.
      So if the method is not inline, make last statement a return.
         if the method is inline, make it assignment to retvalVar."
@@ -238,16 +297,14 @@
         ].
     ].
 
-    compiler 
-          codeAssignParsedValueOf:[ self visit:node child ]
-          to:self retvalVar.
-    compiler codeIf: 'error' then: [ 
+    compiler codeAssignParsedValueOf:[ self visit:node child ] to:self retvalVar.
+    compiler codeIfErrorThen: [ 
         compiler codeReturn: 'failure'. 
     ] else: [
         compiler code: blockBody.    
     ]
 
-    "Modified: / 15-06-2015 / 17:08:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 16-06-2015 / 07:41:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 visitAndNode: node
diff -r a836cbc0d8df -r 82b272c7dc37 compiler/tests/PPCCodeGeneratorTest.st
--- a/compiler/tests/PPCCodeGeneratorTest.st	Tue Jun 16 06:54:14 2015 +0100
+++ b/compiler/tests/PPCCodeGeneratorTest.st	Tue Jun 16 07:49:21 2015 +0100
@@ -129,6 +129,20 @@
     "Created: / 16-06-2015 / 06:53:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+testActionNode6
+    node := ((#letter asParser , #letter asParser) 
+            ==> [:nodes | String withAll:nodes ]) 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:''.
+
+    "Created: / 16-06-2015 / 07:22:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 testAnyNode
     node := PPCForwardNode new
         child: PPCAnyNode new;