UnaryNode.st
changeset 212 ff39051e219f
parent 148 ef0e604209ec
child 261 0372e948ca2d
--- a/UnaryNode.st	Fri Feb 09 19:01:33 1996 +0100
+++ b/UnaryNode.st	Sat Feb 10 19:33:23 1996 +0100
@@ -45,93 +45,100 @@
     "return a new UnaryNode for sending selector s to receiver r.
      Fold constants."
 
-    ^ self receiver:r selector:s fold:true
+    ^ self receiver:r selector:s fold:nil
 !
 
 receiver:r selector:selectorString fold:folding
     "return a new UnaryNode for sending selector selectorString to receiver r.
      If folding is true, fold constant expressions."
 
-    |result recVal selector|
+    |result recVal selector canFold globalName|
 
 "
     The constant folding code can usually not optimize things - this may change
     when some kind of constant declaration is added to smalltalk.
 "
-    folding ifTrue:[
-	"do constant folding ..."
-	r isGlobal ifTrue:[
-	    (r name = 'Character') ifTrue:[
+
+    canFold := false.
+
+    folding notNil ifTrue:[
+	selector := selectorString asSymbolIfInterned.
+	selector notNil ifTrue:[
+	    "/
+	    "/ do constant folding ...
+	    "/
+	    r isGlobal ifTrue:[
+	        globalName := r name.
 		recVal := r evaluate.
-		selector := selectorString asSymbolIfInterned.
-		selector notNil ifTrue:[
-		    (#( tab cr space) includes:selector)
+
+	        (globalName = 'Character') ifTrue:[
+		    ( #( tab cr space backspace esc ) includes:selector)
+		    ifTrue:[
+			canFold := true
+		    ]
+	        ].
+	        (globalName = 'Float') ifTrue:[
+		    ( #( pi unity zero ) includes:selector)
 		    ifTrue:[
 			(recVal respondsTo:selector) ifTrue:[
-			    result := recVal perform:selector.
-			    ^ ConstantNode type:(ConstantNode typeOfConstant:result)
-					  value:result
+			    canFold := true
 			]
 		    ]
+	        ]
+	    ].
+
+	    r isConstant ifTrue:[
+	        "check if we can do it ..."
+	        recVal := r evaluate.
+
+		"
+		 we could do much more here - but then, we need a dependency from
+		 the folded selectors method to the method we generate code for ...
+		 limit optimizations to those that will never change 
+		 (or, if you change them, it will crash badly anyway ...)
+		"
+		recVal respondsToArithmetic ifTrue:[
+		    (#( negated abs asPoint degreesToRadians radiansToDegrees
+			exp ln log sqrt reciprocal 
+			arcCos arcSin arcTan sin cos tan) includes:selector)
+		    ifTrue:[
+			canFold := true
+		    ]
+		].
+		recVal isCharacter ifTrue:[
+		    (#( asciiValue asInteger digitValue) includes:selector) 
+		    ifTrue:[
+			canFold := true
+		    ]
+		].
+		recVal isString ifTrue:[
+		    (selector == #withCRs) ifTrue:[
+			canFold := (folding >= #level2) or:[folding == #full]
+		    ]
+		].
+		(recVal isMemberOf:Array) ifTrue:[
+		    (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
+			canFold := (folding >= #level2) or:[folding == #full]
+		    ]
 		]
 	    ]
 	].
-	r isConstant ifTrue:[
-	    "check if we can do it ..."
-	    recVal := r evaluate.
-	    selector := selectorString asSymbolIfInterned.
-	    selector notNil ifTrue:[
-		(recVal respondsTo:selector) ifTrue:[
-		    "
-		     we could do much more here - but then, we need a dependency from
-		     the folded selectors method to the method we generate code for ...
-		     limit optimizations to those that will never change 
-		     (or, if you change them, it will crash badly anyway ...)
-		    "
-		    SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
-			"in case of an error, abort fold and return original"
-			ex return
-		    ] do:[
-			recVal respondsToArithmetic ifTrue:[
-			    (#( negated abs asPoint degreesToRadians radiansToDegrees
-				exp ln log sqrt reciprocal 
-				arcCos arcSin arcTan sin cos tan) includes:selector)
-			    ifTrue:[
-				result := recVal perform:selector.
-				^ ConstantNode type:(ConstantNode typeOfConstant:result)
-					      value:result
-			    ]
-			].
-			recVal isCharacter ifTrue:[
-			    (#( asciiValue asInteger digitValue) includes:selector) 
-			    ifTrue:[
-				result := recVal perform:selector.
-				^ ConstantNode type:(ConstantNode typeOfConstant:result)
-					      value:result
-			    ]
-			].
-			recVal isString ifTrue:[
-			    (selector == #withCRs) ifTrue:[
-				result := recVal perform:selector.
-				^ ConstantNode type:(ConstantNode typeOfConstant:result)
-					      value:result
-			    ]
-			].
-			(recVal isMemberOf:Array) ifTrue:[
-			    (#(asFloatArray asDoubleArray) includes:selector) ifTrue:[
-				result := recVal perform:selector.
-				^ ConstantNode type:(ConstantNode typeOfConstant:result)
-					      value:result
-			    ]
-			].
-			^ (self basicNew) receiver:r selector:selector args:nil lineno:0
-		    ].
-		    "when we reach here, something went wrong (something like 0.0 log)"
-		    ^ 'error occured when evaluating constant expression'
-		]
-	    ]
-	]
+
+        canFold ifTrue:[
+	    (recVal respondsTo:selector) ifTrue:[
+                SignalSet anySignal "Number domainErrorSignal" handle:[:ex |
+	            "in case of an error, abort fold and return original"
+	            ex return
+                ] do:[
+	            result := recVal perform:selector.
+	            ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result
+	        ].
+                "when we reach here, something went wrong (something like 0.0 log)"
+                ^ 'error occured when evaluating constant expression'
+	    ].
+        ].
     ].
+
     ^ (self basicNew) receiver:r selector:selectorString args:nil lineno:0
 ! !
 
@@ -247,5 +254,5 @@
 !UnaryNode class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.19 1995-12-03 12:16:31 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/UnaryNode.st,v 1.20 1996-02-10 18:33:23 cg Exp $'
 ! !