--- /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. "
+! !