UnaryNd.st
author claus
Wed, 13 Oct 1993 01:26:26 +0100
changeset 3 b63b8a6b71fb
parent 0 7ad01559b262
child 4 f6fd83437415
permissions -rw-r--r--
*** empty log message ***

"
 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

$Header: /cvs/stx/stx/libcomp/Attic/UnaryNd.st,v 1.2 1993-10-13 00:26:20 claus Exp $
'!

!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
    "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'
    ].
    "more to come ..."
    ^ 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.     "
! !