CascadeNode.st
changeset 4181 21f00e5abe0a
parent 3155 5ab5d8ad71ed
child 4183 4e9dedb504ca
--- a/CascadeNode.st	Tue Aug 08 17:41:14 2017 +0200
+++ b/CascadeNode.st	Tue Aug 08 18:08:03 2017 +0200
@@ -11,6 +11,8 @@
 "
 "{ Package: 'stx:libcomp' }"
 
+"{ NameSpace: Smalltalk }"
+
 MessageNode subclass:#CascadeNode
 	instanceVariableNames:''
 	classVariableNames:''
@@ -88,9 +90,34 @@
 !CascadeNode methodsFor:'code generation'!
 
 codeForCascadeOn:aStream inBlock:b for:aCompiler
-    receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
+    "the old code could lead to a recursion error with
+     long cascades;
+     the new code does not."
+
+    "/ old
+    "/ receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
+    "/ aStream nextPut:#dup.
+    "/ self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
+
+    "/ new
+    |leftMostExpression sequence|
+
+    leftMostExpression := receiver.
+    sequence := OrderedCollection new.
+    [ leftMostExpression isCascade ] whileTrue:[
+        sequence addFirst:leftMostExpression.
+        leftMostExpression := leftMostExpression receiver.
+    ].
+    
+    leftMostExpression codeForCascadeOn:aStream inBlock:b for:aCompiler.
+    sequence do:[:eachCascade |
+        aStream nextPut:#dup.
+        eachCascade codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+    ].
     aStream nextPut:#dup.
-    self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
+    self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler.
+
+    "Modified: / 08-08-2017 / 18:04:48 / cg"
 !
 
 codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
@@ -251,10 +278,10 @@
 !CascadeNode class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.32 2013-04-25 13:10:46 stefan Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libcomp/CascadeNode.st,v 1.32 2013-04-25 13:10:46 stefan Exp $'
+    ^ '$Header$'
 ! !