--- 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