--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/PrototypeLookupAlgorithm.st	Wed Apr 07 18:22:08 2010 +0200
@@ -0,0 +1,67 @@
+"{ Package: 'stx:libbasic' }"
+
+Object subclass:#PrototypeLookupAlgorithm
+	instanceVariableNames:''
+	classVariableNames:'TheOneAndOnlyInstance'
+	poolDictionaries:''
+	category:'Kernel-Classes'
+!
+
+!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.
+
+    [author:]
+        cg (cg@CG-PC)
+
+    [see also:]
+        jan Vrany's paper on Smalltalk's Meta-Object-Protocol proposal.
+"
+! !
+
+!PrototypeLookupAlgorithm class methodsFor:'instance creation'!
+
+new
+    TheOneAndOnlyInstance isNil ifTrue: [
+        TheOneAndOnlyInstance := super new.
+    ].
+    ^ TheOneAndOnlyInstance
+! !
+
+!PrototypeLookupAlgorithm methodsFor:'lookup'!
+
+lookupMethodForSelector:aSelector directedTo:searchClass for:aReceiver withArguments:args 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.1 2010-04-07 16:22:08 cg Exp $'
+! !