"{ Package: 'stx:libbasic' }"

Object subclass:#PrototypeLookupAlgorithm

	instanceVariableNames:''

	classVariableNames:'TheOneAndOnlyInstance'

	poolDictionaries:''

	category:'Kernel-Extensions'

!

!PrototypeLookupAlgorithm class methodsFor:'documentation'!

documentation

"

    this is a dummy lookupAlgorithm class to demonstrate the meta-object-protoocol support.

    Create a sumclass of me, redefine the lookupmethod to return a method proper.

    If it returns nil, a doesNotUnderstand will be sent, as usual.

    This class does nothing real - it duplicates the algorithm as found in the VM.

    obsoleted by Lookup

    [author:]

        cg (cg@CG-PC)

    [see also:]

        jan Vrany's paper on Smalltalk's Meta-Object-Protocol proposal.

"

!

examples

"

    this is only a test for the lookup; when installed as a class's lookupObject,

    the lookup will be called from the VM for instances of that class.

    |mthd|

    mthd := self new

                lookupMethodForSelector:#squared 

                directedTo:nil 

                for:100 

                withArguments:nil 

                from:nil.

    mthd valueWithReceiver:100 arguments:#().     

"

! !

!PrototypeLookupAlgorithm class methodsFor:'instance creation'!

new

    TheOneAndOnlyInstance isNil ifTrue: [

        TheOneAndOnlyInstance := super new.

    ].

    ^ TheOneAndOnlyInstance

! !

!PrototypeLookupAlgorithm methodsFor:'lookup'!

lookupMethodForSelector:aSelector directedTo:searchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext

    "invoked by the VM to ask me for a method to call.

     The arguments are: the selector, receiver and arguments,

     the class to start the search in (for here-, super and directed sends)

     the sending context.

     The returned method object will be put into the inline- and polyCache

     at the call site; it might therefore be called more than once for the

     same receiver-class/selector combination (once for each call site).

     If I return nil, a doesNotUnderstand will be invoked."

     |cls md method|

     cls := searchClass.

     cls isNil ifTrue:[ cls := aReceiver class ].

     [ cls notNil ] whileTrue:[

        md := cls methodDictionary.

        method := md at:aSelector ifAbsent:nil.

        method notNil ifTrue:[^ method ].

        cls := cls superclass.

     ].

     ^ nil

! !

!PrototypeLookupAlgorithm class methodsFor:'documentation'!

version_CVS

    ^ '$Header: /cvs/stx/stx/libbasic/PrototypeLookupAlgorithm.st,v 1.5 2011-06-28 11:58:00 cg Exp $'

! !