compiler/PPCCodeGenerator.st
changeset 488 19a9c25960ef
parent 487 602215b19135
child 489 0ca7a70db0f5
--- 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