Skip to content

Commit 13ba508

Browse files
committed
pushing code around a bit before diving in ...
1 parent 72d9fe9 commit 13ba508

File tree

3 files changed

+54
-10
lines changed

3 files changed

+54
-10
lines changed

tonel/Rowan-GemStone/RwGSLoadedSymbolDictPackage.class.st

+18-6
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,16 @@ Class {
44
#category : 'Rowan-GemStone'
55
}
66

7+
{ #category : 'queries' }
8+
RwGSLoadedSymbolDictPackage >> classOrExtensionForClass: behavior ifAbsent: absentBlock [
9+
10+
| className |
11+
className := behavior theNonMetaClass name asString.
12+
^ loadedClasses
13+
at: className
14+
ifAbsent: [ loadedClassExtensions at: className ifAbsent: absentBlock ]
15+
]
16+
717
{ #category : 'initialization' }
818
RwGSLoadedSymbolDictPackage >> initialize [
919

@@ -22,17 +32,19 @@ RwGSLoadedSymbolDictPackage >> initializeForName: aName [
2232
]
2333

2434
{ #category : 'queries' }
25-
RwGSLoadedSymbolDictPackage >> loadedClassForClass: aClass [
35+
RwGSLoadedSymbolDictPackage >> loadedClassExtensionForClass: aClass ifAbsent: absentBlock [
2636

27-
"If there is an existing loadedClass for the given (non-meta) class in this package, answer it, otherwise the AbsentToken."
37+
"If there is an existing extension for the given (non-meta) class in this package, answer it, otherwise the AbsentToken."
2838

29-
^ loadedClasses at: aClass name asString ifAbsent: [ AbsentToken ]
39+
^ loadedClassExtensions
40+
at: aClass theNonMetaClass name asString
41+
ifAbsent: absentBlock
3042
]
3143

3244
{ #category : 'queries' }
33-
RwGSLoadedSymbolDictPackage >> loadedExtensionForClass: aClass [
45+
RwGSLoadedSymbolDictPackage >> loadedClassForClass: aClass ifAbsent: absentBlock [
3446

35-
"If there is an existing extension for the given (non-meta) class in this package, answer it, otherwise the AbsentToken."
47+
"If there is an existing loadedClass for the given (non-meta) class in this package, answer it, otherwise the AbsentToken."
3648

37-
^ loadedClassExtensions at: aClass classHistory ifAbsent: [ AbsentToken ]
49+
^ loadedClasses at: aClass theNonMetaClass name asString ifAbsent: absentBlock
3850
]

tonel/Rowan-GemStone/RwGsPackageSymbolDictionary.class.st

+35-3
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,39 @@ RwGsPackageSymbolDictionary >> addClassAssociation: assoc toPackageNamed: packag
106106
{ #category : 'method - patch api' }
107107
RwGsPackageSymbolDictionary >> addExtensionCompiledMethod: compiledMethod for: behavior protocol: protocolString toPackageNamed: packageName [
108108

109-
109+
| methodDictionary selector protocolSymbol existing loadedMethod loadedPackage loadedClassOrExtension properties |
110+
methodDictionary := behavior persistentMethodDictForEnv: 0.
111+
selector := compiledMethod selector.
112+
methodDictionary at: selector put: compiledMethod.
113+
114+
protocolSymbol := protocolString asSymbol.
115+
(behavior includesCategory: protocolSymbol)
116+
ifFalse: [ behavior addCategory: protocolSymbol ].
117+
behavior moveMethod: selector toCategory: protocolSymbol.
118+
119+
existing := methodRegistry at: compiledMethod ifAbsent: [ nil ].
120+
existing
121+
ifNotNil: [
122+
self
123+
error:
124+
'Internal error -- existing LoadedMethod found for extension compiled method.' ].
125+
loadedMethod := RwGsLoadedSymbolDictMethod forMethod: compiledMethod.
126+
127+
methodRegistry at: compiledMethod put: loadedMethod.
128+
129+
loadedPackage := self packageRegistry
130+
at: packageName
131+
ifAbsent: [
132+
self
133+
error: 'Internal error -- attempt to add a method to a nonexistent package.' ].
134+
135+
loadedClassOrExtension := loadedPackage
136+
loadedClassExtensionForClass: behavior
137+
ifAbsent: [
138+
self
139+
error:
140+
'Internal error -- attempt to add a method to a package in which its class is neither defined nor extended.' ].
141+
loadedClassOrExtension addLoadedMethod: loadedMethod
110142
]
111143

112144
{ #category : 'class - patch api' }
@@ -155,7 +187,7 @@ RwGsPackageSymbolDictionary >> addNewCompiledMethod: compiledMethod for: behavio
155187
error: 'Internal error -- attempt to add a method to a nonexistent package.' ].
156188

157189
loadedClassOrExtension := loadedPackage
158-
classOrExtensionForClassNamed: behavior theNonMetaClass name asString
190+
loadedClassForClass: behavior
159191
ifAbsent: [
160192
self
161193
error:
@@ -287,7 +319,7 @@ RwGsPackageSymbolDictionary >> deleteCompiledMethod: compiledMethod from: behavi
287319

288320
loadedPackage := loadedMethod loadedPackage.
289321
loadedClassOrExtension := loadedPackage
290-
classOrExtensionForClassNamed: behavior theNonMetaClass name asString
322+
classOrExtensionForClass: behavior
291323
ifAbsent: [
292324
self
293325
error:

tonel/Rowan-Tests/RwSymbolDictionaryTest.class.st

+1-1
Original file line numberDiff line numberDiff line change
@@ -516,7 +516,7 @@ RwSymbolDictionaryTest >> testMethodExtensionPatchInSymbolDictionaryExtension [
516516

517517
dict
518518
addExtensionCompiledMethod: compiledMethod
519-
into: class
519+
for: class
520520
protocol: methodProtocol
521521
toPackageNamed: packageName2.
522522

0 commit comments

Comments
 (0)