--- a/Behavior.st Mon May 18 02:39:03 2015 +0200
+++ b/Behavior.st Mon May 18 17:16:14 2015 +0200
@@ -1579,36 +1579,54 @@
lookupObject
"return the lookupObject (Jan's MetaObjectProtocol support) or nil.
- If non-nil, no lookup is performed by the VM, instead the lookupObject
- has to provide a method object for message sends."
-
- | behavior lookup |
-
- Lookup isNil ifTrue:[^ nil].
-
- behavior := self.
- [ behavior notNil ] whileTrue:[
- lookup := behavior getLookupObject.
- lookup notNil ifTrue: [^ lookup].
- behavior := behavior superclass
- ].
-
- ^ Lookup builtin.
+ If non-nil, no lookup is performed by the VM, instead the VM asks the lookupObject
+ to provide a method for message sends."
+
+ ^ lookupObject
+
+ "/ CG: why this?
+ "/ the VM ONLY looks at the lookupObject slot and does not walk the hierarchy;
+ "/ (which it should never !!!!!!)
+ "/ It is the responsibility of the IDE (or whoever uses lookupObjects),
+ "/ to make sure that subclasses get a lookupObject, if they need it.
+ "/ Also: it does not really make sense to redefine the behavior here
+ "/ (for inheritance of lookup),
+ "/ differently to what the VM does;
+ "/ remember: this is also called for canUnderstand, respondsTo etc.
+ "/ and no one expects these to return different results than what the VM does.
+
+ "/ | behavior lookupInherited |
+ "/
+ "/ lookupObject notNil ifTrue:[^ lookupObject].
+ "/ Lookup isNil ifTrue:[^ nil].
+
+ "/ behavior := self.
+ "/ [ behavior notNil ] whileTrue:[
+ "/ lookupInherited := behavior getLookupObject.
+ "/ lookupInherited notNil ifTrue: [^ lookupInherited].
+ "/ behavior := behavior superclass
+ "/ ].
+ "/ ^ BuiltinLookup instance "Lookup builtin"
"Modified: / 26-04-2010 / 21:05:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lookupObject: anObject
lookupObject == anObject ifTrue:[^ self ].
- anObject isNil ifTrue:[^self setLookupObject: anObject].
-
- (anObject respondsTo: #lookupMethodForSelector:directedTo:for:withArguments:from:ilc:)
- ifFalse:[
- self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:ilc'
- ].
- (anObject respondsTo:#superLookupObject:)
- ifTrue:[
- anObject superLookupObject: self lookupObject
+
+ anObject notNil ifTrue:[
+ "/ check if it is valid; the reason is that the VM gets into bad trouble,
+ "/ if some invalid thingy is set as lookup object
+ (anObject respondsTo: #lookupMethodForSelector:directedTo:for:withArguments:from:ilc:)
+ ifFalse:[
+ self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:ilc:'
+ ].
+
+ "/ CG: huh - what is this - it is nowhere implemented.
+ (anObject respondsTo:#superLookupObject:)
+ ifTrue:[
+ anObject superLookupObject: self lookupObject
+ ].
].
self setLookupObject: anObject.
@@ -3408,15 +3426,14 @@
"Created: / 26-04-2010 / 13:36:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-setLookupObject:aMethodLookupObject
+setLookupObject:aLookupObjectOrNil
"set the lookupObject (Jan's MetaObjectProtocol support) or nil.
If non-nil, no lookup is performed by the VM, instead the lookupObject
has to provide a method object for message sends."
- lookupObject ~~ aMethodLookupObject ifTrue:[
- lookupObject := aMethodLookupObject.
- ObjectMemory flushCachesFor: self.
- self allSubclassesDo:[:cls|ObjectMemory flushCachesFor: cls]
+ lookupObject ~~ aLookupObjectOrNil ifTrue:[
+ lookupObject := aLookupObjectOrNil.
+ self withAllSubclassesDo:[:cls | ObjectMemory flushCachesFor: cls]
]
"Modified: / 22-07-2010 / 18:10:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -5297,10 +5314,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.376 2015-05-18 00:16:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.377 2015-05-18 15:16:14 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.376 2015-05-18 00:16:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.377 2015-05-18 15:16:14 cg Exp $'
! !