"

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

"

Context subclass:#BlockContext

       instanceVariableNames:''  "do not add instvars here"

       classVariableNames:''

       poolDictionaries:''

       category:'Kernel-Methods'

!

BlockContext comment:'

              All Rights Reserved

!BlockContext methodsFor:'accessing'!

isBlockContext

    "return true, iff the receiver is a BlockContext, false otherwise"

    ^ true

!

methodHome

    "return the method-home for block contexts"

    |con h|

    home isNil ifTrue:[^ nil]. "XXX will change soon"

    home isContext ifFalse:[^ nil]. "copying blocks have no method home"

    con := self.

    h := home.

    [h notNil] whileTrue:[

        con := h.

        h := con home

    ].

    ^ con

!

home

    "return the immediate home of the receiver.

     normally this is the methodcontext, where the block was created,

     for nested block contexts, this is the surrounding blocks context."

    home isContext ifFalse:[^ nil]. "copying blocks have no home"

    ^ home

!

selector

    "return the selector of the context - which is one of the value

     selectors"

    |nargs|

    nargs := self nargs.

    (nargs == 0) ifTrue:[^ #value].

    (nargs == 1) ifTrue:[^ #value:].

    (nargs == 2) ifTrue:[^ #value:value:].

    (nargs == 3) ifTrue:[^ #value:value:value:].

    (nargs == 4) ifTrue:[^ #value:value:value:value:].

    (nargs == 5) ifTrue:[^ #value:value:value:value:value:].

    ^ nil

! !

!BlockContext methodsFor:'printing'!

receiverPrintString

    home isNil ifTrue:[

        ^ '[] optimized'

    ].

    home isContext ifFalse:[

        "a copying block"

        "receiverClassName := home selfValue class name."

        ^ '[] optimized'

    ].

    ^ '[] in ' , receiver class name , '-' , self methodHome selector printString

!

printReceiver

    self receiverPrintString print

!

printString

    ^ self receiverPrintString , ' ' , self selector printString

! !