UnaryNode.st
changeset 0 7ad01559b262
child 3 b63b8a6b71fb
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/UnaryNode.st	Fri Jul 16 11:38:57 1993 +0200
@@ -0,0 +1,172 @@
+"
+ COPYRIGHT (c) 1989-93 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+MessageNode subclass:#UnaryNode
+       instanceVariableNames:''
+       classVariableNames:''
+       poolDictionaries:''
+       category:'System-Compiler-Support'
+!
+
+UnaryNode comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+              All Rights Reserved
+
+%W% %E%
+'!
+
+!UnaryNode class methodsFor:'instance creation'!
+
+receiver:r selector:s
+    ^ self receiver:r selector:s fold:true
+!
+
+receiver:r selector:s fold:folding
+    |result recVal sym|
+
+"
+    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 isConstant ifTrue:[
+            "check if we can do it ..."
+            recVal := r evaluate.
+            s knownAsSymbol ifTrue:[
+                (recVal respondsTo:sym) 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 ...)
+                    "
+                    Number domainErrorSignal handle:[:ex |
+                        ex return
+                    ] do:[
+                        sym := s asSymbol.
+                        recVal respondsToArithmetic ifTrue:[
+                            (#( negated abs asPoint degreesToRadians radiansToDegrees
+                                exp ln log sqrt reciprocal 
+                                arcCos arcSin arcTan sin cos tan) includes:sym)
+                            ifTrue:[
+                                result := recVal perform:sym.
+                                ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+                                              value:result
+                            ]
+                        ].
+                        (recVal isMemberOf:Character) ifTrue:[
+                            (#( asciiValue asInteger digitValue) includes:sym) 
+                            ifTrue:[
+                                result := recVal perform:sym.
+                                ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+                                              value:result
+                            ]
+                        ].
+                        (recVal isMemberOf:String) ifTrue:[
+                            (sym == #withCRs) ifTrue:[
+                                result := recVal perform:sym.
+                                ^ ConstantNode type:(ConstantNode typeOfConstant:result)
+                                              value:result
+                            ]
+                        ].
+                        ^ (self basicNew) receiver:r selector:s args:nil lineno:0
+                    ].
+                    "when we reach here, something went wrong (something like 0.0 log)"
+                    ^ 'error occured when evaluating constant expression'
+                ]
+            ]
+        ]
+    ].
+    ^ (self basicNew) receiver:r selector:s args:nil lineno:0
+! !
+
+!UnaryNode methodsFor:'queries'!
+
+isUnaryMessage
+    ^ true
+! !
+
+!UnaryNode methodsFor:'checks'!
+
+plausibilityCheck
+    |rec arg operand|
+
+    "check for funny selector - careful to do string compare instead
+     of symbol identity compare: I dont want to introduce these as symbols
+     into the system (would make the '... is nowhere implemented' warning
+     go away."
+
+    ((selector = 'self') or:[
+     (selector = 'super') or:[
+     (Smalltalk includesKey:selector)]]) ifTrue:[
+        ^ 'funny selector; possible missing ''.'' or keyword'
+    ].
+    ^ nil
+! !
+
+!UnaryNode methodsFor:'evaluating'!
+
+evaluate
+    ^ (receiver evaluate) perform:selector
+! !
+
+!UnaryNode methodsFor:'code generation'!
+
+codeOn:aStream inBlock:b
+    "optimize 
+        (a == b) not -> (a ~~ b)
+        (a ~~ b) not -> (a == b)
+    "
+    (selector == #not) ifTrue:[
+        (receiver class == BinaryNode) ifTrue:[
+            (receiver selector == #==) ifTrue:[
+                (BinaryNode receiver:(receiver receiver)
+                            selector:#~~
+                                 arg:(receiver arg)) codeOn:aStream inBlock:b.
+                ^ self
+            ].
+            (receiver selector == #~~) ifTrue:[
+                (BinaryNode receiver:(receiver receiver)
+                            selector:#==
+                                 arg:(receiver arg)) codeOn:aStream inBlock:b.
+                ^ self
+            ]
+        ]
+    ].
+
+    ^ super codeOn:aStream inBlock:b
+! !
+
+!UnaryNode methodsFor:'printing'!
+
+printOn:aStream indent:i
+    |needParen|
+
+    needParen := false.
+    receiver isMessage ifTrue:[
+        receiver isUnaryMessage ifFalse:[
+            needParen := true
+        ].
+    ].
+    needParen ifTrue:[
+        aStream nextPutAll:'('
+    ].
+    receiver printOn:aStream.
+    needParen ifTrue:[
+        aStream nextPutAll:') '
+    ].
+    aStream space.
+    selector printString printOn:aStream.
+"    aStream space.     "
+! !