PrototypeLookupAlgorithm.st
author Claus Gittinger <cg@exept.de>
Tue, 28 Jun 2011 13:47:25 +0200
changeset 13408 64c92572b3d7
parent 12852 dcf28b683769
child 13409 5353fa4f93f0
permissions -rw-r--r--
class definition
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
12843
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:libbasic' }"
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
Object subclass:#PrototypeLookupAlgorithm
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:''
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:'TheOneAndOnlyInstance'
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
13408
64c92572b3d7 class definition
Claus Gittinger <cg@exept.de>
parents: 12852
diff changeset
     7
	category:'Kernel-Extensions'
12843
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!PrototypeLookupAlgorithm class methodsFor:'documentation'!
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
documentation
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
    this is a dummy lookupAlgorithm class to demonstrate the meta-object-protoocol support.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
    Create a sumclass of me, redefine the lookupmethod to return a method proper.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
    If it returns nil, a doesNotUnderstand will be sent, as usual.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
    This class does nothing real - it duplicates the algorithm as found in the VM.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
    [author:]
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
        cg (cg@CG-PC)
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
    [see also:]
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
        jan Vrany's paper on Smalltalk's Meta-Object-Protocol proposal.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
"
12852
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    26
!
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    27
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    28
examples
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    29
"
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    30
    this is only a test for the lookup; when installed as a class's lookupObject,
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    31
    the lookup will be called from the VM for instances of that class.
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    32
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    33
    |mthd|
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    34
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    35
    mthd := self new
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    36
                lookupMethodForSelector:#squared 
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    37
                directedTo:nil 
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    38
                for:100 
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    39
                withArguments:nil 
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    40
                from:nil.
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    41
    mthd valueWithReceiver:100 arguments:#().     
dcf28b683769 added: #examples
Claus Gittinger <cg@exept.de>
parents: 12851
diff changeset
    42
"
12843
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
! !
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
!PrototypeLookupAlgorithm class methodsFor:'instance creation'!
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
new
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
    TheOneAndOnlyInstance isNil ifTrue: [
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
        TheOneAndOnlyInstance := super new.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    ].
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    ^ TheOneAndOnlyInstance
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
! !
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
!PrototypeLookupAlgorithm methodsFor:'lookup'!
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
12851
f533e90633a1 changed: #lookupMethodForSelector:directedTo:for:withArguments:from:
Claus Gittinger <cg@exept.de>
parents: 12843
diff changeset
    56
lookupMethodForSelector:aSelector directedTo:searchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext
12843
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
    "invoked by the VM to ask me for a method to call.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
     The arguments are: the selector, receiver and arguments,
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
     the class to start the search in (for here-, super and directed sends)
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
     the sending context.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
     The returned method object will be put into the inline- and polyCache
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
     at the call site; it might therefore be called more than once for the
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
     same receiver-class/selector combination (once for each call site).
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
     If I return nil, a doesNotUnderstand will be invoked."
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
     |cls md method|
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
     cls := searchClass.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
     cls isNil ifTrue:[ cls := aReceiver class ].
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
     [ cls notNil ] whileTrue:[
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
        md := cls methodDictionary.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
        method := md at:aSelector ifAbsent:nil.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
        method notNil ifTrue:[^ method ].
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
        cls := cls superclass.
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
     ].
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
     ^ nil
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
! !
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
!PrototypeLookupAlgorithm class methodsFor:'documentation'!
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
version_CVS
13408
64c92572b3d7 class definition
Claus Gittinger <cg@exept.de>
parents: 12852
diff changeset
    83
    ^ '$Header: /cvs/stx/stx/libbasic/PrototypeLookupAlgorithm.st,v 1.4 2011-06-28 11:47:25 cg Exp $'
12843
eb7256764bbf initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
! !