"

 COPYRIGHT (c) 1989 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.

"

"{ Package: 'stx:libcomp' }"

ParseNode subclass:#MessageNode

	instanceVariableNames:'receiver selector argArray lineNr selectorPosition'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Compiler-Support'

!

!MessageNode class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 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.

"

!

documentation

"

    node for parse-trees, representing message sends

    This is a helper class for the compiler.

    [author:]

        Claus Gittinger

"

! !

!MessageNode class methodsFor:'instance creation'!

receiver:recNode selector:selectorString 

    ^ (self basicNew) receiver:recNode selector:selectorString args:nil lineno:0

!

receiver:recNode selector:selectorString arg1:arg1Node arg2:arg2Node

    ^ self receiver:recNode selector:selectorString arg1:arg1Node arg2:arg2Node fold:nil

!

receiver:recNode selector:selectorString arg1:argNode1 arg2:argNode2 fold:folding

    |result recVal argVal selector|

    "

     This is just a demonstration - of how complex constants can be folded.

     This was inspired by some discussion in c.l.s about enhancing the language - I prefer

     enhancing the compiler ....

     The following optimization will convert '#(...) with:#(...) collect:[...]' into an array constant,

     allowing constant arrays of complex objects.

     Notice: this method is normally disabled - its just a demo after all.

    "

    folding notNil ifTrue:[

        "/

        "/ do constant folding ...

        "/

        (recNode isConstant and:[argNode1 isConstant]) ifTrue:[

            "check if we can do it ..."

            selector := selectorString asSymbolIfInterned.

            selector notNil ifTrue:[

                recVal := recNode evaluate.

                (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 - you will crash so bad ...)

                    "

                    argVal := argNode1 evaluate.

                    ((recVal isMemberOf:Array) and:[argVal isMemberOf:Array]) ifTrue:[

                        folding == #full ifTrue:[

                            (selector == #with:collect:) ifTrue:[

                                (argNode2 isBlock) ifTrue:[

                                    SignalSet anySignal handle:[:ex |

                                        ^ ParseErrorNode errorString:'error in constant expression (' , ex description , ')'

                                    ] do:[

                                        result := recVal perform:selector with:argVal with:(argNode2 evaluate).

                                    ].

                                    ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result

                                ]

                            ]

                        ]

                    ]

                ]

            ]

        ]

    ].

    ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode1 with:argNode2) lineno:0

    "Modified: 28.6.1997 / 15:16:01 / cg"

!

receiver:recNode selector:selectorString arg:argNode

    ^ self receiver:recNode selector:selectorString arg:argNode fold:nil

!

receiver:recNode selector:selectorString arg:argNode fold:folding

    |result recVal argVal selector globalName canFold|

   "

     The constant folding code can usually not optimize much

     - this may change when some kind of constant/macro declaration is added to smalltalk,

     so that constant classVars can be inlined.

    "

    folding notNil ifTrue:[

        selector := selectorString asSymbolIfInterned.

        selector notNil ifTrue:[

            "/

            "/ do constant folding ...

            "/

            canFold := false.

            (recNode isGlobal and:[argNode isConstant]) ifTrue:[

                globalName := recNode name.

                recVal := recNode evaluate.

                (globalName = 'SmallInteger') ifTrue:[

                    ( #( bitMaskFor: ) includes:selector)

                    ifTrue:[

                        canFold := true

                    ]

                ].

            ].

            (recNode isConstant and:[argNode isConstant]) ifTrue:[

                "check if we can do it ..."

                recVal := recNode 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 - you will crash so bad ...)

                "

                argVal := argNode evaluate.

                (recVal respondsToArithmetic and:[argVal respondsToArithmetic]) ifTrue:[

                    ( #( + - * / // \\ min: max: quo: raisedTo:) includes:selector) ifTrue:[

                        (#( / // \\ ) includes:selector) ifTrue:[

                            argVal = 0 ifTrue:[

                                ^ ParseErrorNode errorString:'division by zero in constant expression'

                            ].

                        ].

                        canFold := true

                    ].

                    ( #( @ ) includes:selector) ifTrue:[

                        canFold := (folding == #full)

                    ]

                ].

                (recVal isInteger and:[argVal isInteger]) ifTrue:[

                    ( #( bitShift: bitOr: bitAnd: ) includes:selector) ifTrue:[

                        canFold := true

                    ]

                ].

                (recVal isMemberOf:String) ifTrue:[

                    (argVal isInteger and:[selector == #at:]) ifTrue:[

                        canFold := folding isSymbol

                                   and:[(folding >= #level2) or:[folding == #full]].

                    ].

                    selector == #',' ifTrue:[

                        (argVal isMemberOf:String) ifTrue:[

                            canFold := folding isSymbol

                                       and:[(folding >= #level2) or:[folding == #full]].

                        ].

                        (argVal isMemberOf:Character) ifTrue:[

                            canFold := folding isSymbol

                                       and:[(folding >= #level2) or:[folding == #full]].

                        ].

                    ]

                ].

            ].

            canFold ifTrue:[

                (recVal respondsTo:selector) ifTrue:[

                    SignalSet anySignal handle:[:ex |

                        ^ ParseErrorNode errorString:'error in constant expression (' , ex description , ')'

                    ] do:[

                        result := recVal perform:selector with:argVal.

                    ].

                    ^ ConstantNode type:(ConstantNode typeOfConstant:result) value:result

                ]

            ]

        ].

        "/

        "/ #perform with a constant selector

        "/

        (selector == #perform: 

        and:[argNode isConstant]) ifTrue:[

            argVal := argNode evaluate.

            argVal isSymbol ifTrue:[

                ^ UnaryNode receiver:recNode selector:argVal fold:folding

            ]

        ].

    ].

    ^ (self basicNew) receiver:recNode selector:selectorString args:(Array with:argNode) lineno:0

    "Modified: / 16.11.1999 / 21:50:33 / cg"

!

receiver:recNode selector:selectorString args:anArray

    ^ self receiver:recNode selector:selectorString args:anArray fold:nil

!

receiver:recNode selector:selectorString args:argArray fold:folding

    |numArgs arg1 arg1Val|

    folding notNil ifTrue:[

        numArgs := argArray size.

        numArgs > 0 ifTrue:[

            arg1 := (argArray at:1).

            (numArgs == 1) ifTrue:[

                ^ self receiver:recNode selector:selectorString arg:arg1 fold:folding 

            ].

            "/

            "/ #perform:... with a constant selector

            "/

            numArgs <= 6 ifTrue:[

                (#(nil

                   #'perform:with:'

                   #'perform:with:with:'

                   #'perform:with:with:with:'

                   #'perform:with:with:with:with:'

                   #'perform:with:with:with:with:with:'

                   #'perform:with:with:with:with:with:with:'

                ) at:numArgs) = selectorString 

                ifTrue:[

                    arg1 isConstant ifTrue:[    

                        arg1Val := arg1 evaluate.

                        arg1Val isSymbol ifTrue:[

                            ^ MessageNode 

                                    receiver:recNode 

                                    selector:arg1Val

                                    args:(argArray copyFrom:2)

                                    fold:folding

                        ]

                    ]

                ]

            ].

        ].

        (numArgs == 2) ifTrue:[

            ^ self receiver:recNode selector:selectorString arg1:arg1 arg2:(argArray at:2) fold:folding 

        ].

        numArgs > Method maxNumberOfArguments ifTrue:[

            ^ ParseErrorNode errorString:'too many arguments for current VM implementation'.

        ].

    ].

    ^ (self basicNew) receiver:recNode selector:selectorString args:argArray lineno:0

    "Modified: / 3.9.1995 / 16:41:39 / claus"

    "Modified: / 15.5.1998 / 15:32:05 / cg"

! !

!MessageNode methodsFor:'accessing'!

arg1

    ^ argArray at:1

!

arg2

    ^ argArray at:2

!

args

    ^ argArray

!

arguments

    ^ argArray ? #()

    "Created: 19.6.1997 / 17:31:14 / cg"

    "Modified: 19.6.1997 / 17:32:25 / cg"

!

lineNumber

     ^ lineNr

!

lineNumber:num

     lineNr := num

!

receiver

    ^ receiver

!

receiver:r selector:s args:a lineno:l

    receiver := r.

"/ create the symbol only, if the symbol is already known in the system.

"/ otherwise a lot of partial symbols will be created by the SyntaxHighlighter

"/ during typing

"/    selector := s asSymbol.

    selector := s asSymbolIfInterned ? s.

    argArray := a.

    lineNr := l.

    self checkInlinability.

    "Modified: 2.7.1997 / 17:01:24 / cg"

!

selector

    ^ selector

!

selector:s

"/ create the symbol only, if the symbol is already known in the system.

"/ otherwise a lot of partial symbols will be created by the SyntaxHighlighter

"/ during typing

"/    selector := s asSymbol.

    selector := s asSymbolIfInterned ? s.

"/    selector := s asSymbol.

!

selectorPosition

    "return the value of the instance variable 'selectorPosition' (automatically generated)"

    ^ selectorPosition

    "Created: 5.8.1997 / 02:49:27 / cg"

!

selectorPosition:something

    "set the value of the instance variable 'selectorPosition' (automatically generated)"

    selectorPosition := something.

    "Created: 5.8.1997 / 02:49:27 / cg"

! !

!MessageNode methodsFor:'checks'!

checkCondition

    |args lastArg receiverSelector or1 or2|

    receiver isBlock ifTrue:[

        (Block canUnderstand:selector) ifFalse:[

            ^ 'blocks usually do not respond to ' , selector , ' messages'

        ].

    ].

    "/ (rr keyw:ra = a) ifTrue:[ ...]

    receiver isMessage ifTrue:[

        (receiver numArgs > 0) ifTrue:[

            receiverSelector := receiver selector asSymbol.

            (receiverSelector isKeyword) ifTrue:[

                (args := receiver arguments) notEmptyOrNil ifTrue:[

                    (lastArg := args last) isMessage ifTrue:[

                        lastArg parenthesized ifFalse:[

                            (#( #'=' #'~=' #'==' #'~~' '>' '<' '>=' '<=') 

                            includes:(lastArg selector asSymbol)) ifTrue:[

                                ^ 'possible precedence error in condition (missing parenthesis ?)'

                            ]

                        ]

                    ].

                ].

                (selector == #ifFalse: or:[ selector == #ifFalse:ifTrue: ]) ifTrue:[

                    receiverSelector == #or: ifTrue:[

                        or1 := receiver receiver.    

                        or2 := receiver arg1.

                        (or1 isMessage and:[or1 selector = '~~']) ifTrue:[

                            (or2 isBlock 

                            and:[ or2 isSingleExpressionBlock

                            and:[ or2 statements expression isMessage 

                            and:[ or2 statements expression selector = '~~']]]) ifTrue:[

                                ^ 'please use "((...==...) and:[...==...]) ifTrue:" here\\(are you obfuscating by purpose ?)'

                            ].

                        ].

                    ].

                ].

            ]

        ].

    ].

    ^ nil

!

checkGlobalFromNameSpaceConflictFor:aNode

    "check if aNode is a local-nameSpace's variable,

     which hides a global from Smalltalk with the same name.

     This is especially bad for Error handle: do:... "

    |fullName shortName|

    aNode isGlobalVariable ifTrue:[

        fullName := aNode name.

        shortName := Class nameWithoutPrefix:fullName.

        shortName ~= fullName ifTrue:[

            (Smalltalk includesKey:shortName) ifTrue:[

                ^ 'Possible name conflict (local ',shortName,' vs. Smalltalk::',shortName,')'

            ].

        ].

    ].

    ^ nil.

!

checkIdentityCompare

    |rec arg1 arg1Value operand|

    "

     check #== applied to Floats, Strings or Fractions

    "

    ((selector == #==) or:[selector == #~~]) ifTrue:[

        (argArray size > 0) ifTrue:[

            arg1 := argArray at:1

        ].

        "

         it once took me almost an hour, to find a '==' which

         should have been an '=' (you cannot compare floats with ==)

         (well, I looked at the '==' at least 50 times -

          - but didn't think about it ...).

         that's reason enough to add this check here.

         I will add more as heuristic knowledge increases ...

         (send me comments on common programming errors...)

        "

        receiver isConstant ifTrue:[

            rec := receiver evaluate.

            ((rec isMemberOf:String) or:[

             (rec isMemberOf:Float) or:[

             (rec isMemberOf:Fraction)]]) ifTrue:[

                operand := rec

            ].

        ].

        arg1 isConstant ifTrue:[

            arg1Value := arg1 evaluate.

            ((arg1Value isMemberOf:String) or:[

             (arg1Value isMemberOf:Float) or:[

             (arg1Value isMemberOf:Fraction)]]) ifTrue:[

                operand := arg1Value

            ].

        ].

        operand notNil ifTrue:[

            (selector == #==) ifTrue:[

                ^ 'identity compare is unsafe here'

            ].

            ^ 'identity compare will usually return true here'

        ]

    ].

    ^ nil

!

checkInlinability

    "early check for possible inlinability"

    |numArgs arg1 arg2 arg3|

    (numArgs := argArray size) >= 1 ifTrue:[

        arg1 := argArray at:1.

    ].

    numArgs == 0 ifTrue:[

        (selector == #whileTrue 

        or:[selector == #whileFalse]) ifTrue:[

            receiver isBlock ifTrue:[

                receiver possiblyInlined:true

            ].

        ].

        (selector == #value) ifTrue:[

            receiver isBlock ifTrue:[

                receiver possiblyInlined:true

            ].

        ].

        ((selector == #repeat) or:[selector == #loop]) ifTrue:[

            receiver isBlock ifTrue:[