-
-
Notifications
You must be signed in to change notification settings - Fork 353
/
TraitedMetaclass.class.st
369 lines (279 loc) · 11 KB
/
TraitedMetaclass.class.st
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
"
All the traited class metaclasses are instances of myself.
I include all the custom behavior to implement traits.
I override a number of methods in Metaclass to implement traits.
Also I have the localMethodDict and the traitComposition of the base class.
So it is not needed to recompile the methods from TraitedClass. Check #initializeBasicMethods for more details
"
Class {
#name : #TraitedMetaclass,
#superclass : #Metaclass,
#instVars : [
'localMethods',
'composition',
'baseLocalMethods',
'baseComposition'
],
#category : #'TraitsV2-Base'
}
{ #category : #accessing }
TraitedMetaclass class >> traitedClassTrait [
^ (TaCompositionElement for: TraitedClass)
]
{ #category : #'accessing method dictionary' }
TraitedMetaclass >> addAndClassifySelector: selector withMethod: compiledMethod inProtocol: aCategory [
self localMethodDict at: selector put: compiledMethod.
super
addAndClassifySelector: selector
withMethod: compiledMethod
inProtocol: aCategory.
TraitChange addSelector: selector on: self.
]
{ #category : #'accessing method dictionary' }
TraitedMetaclass >> addSelector: selector withMethod: compiledMethod [
self localMethodDict at: selector put: compiledMethod.
super addSelector: selector withMethod: compiledMethod.
TraitChange addSelector: selector on: self
]
{ #category : #'accessing method dictionary' }
TraitedMetaclass >> addSelector: selector withRecompiledMethod: compiledMethod [
self localMethodDict at: selector put: compiledMethod.
super addSelector: selector withRecompiledMethod: compiledMethod.
TraitChange addSelector: selector on: self
]
{ #category : #querying }
TraitedMetaclass >> allTraits [
^ self traitComposition allTraits
]
{ #category : #accessing }
TraitedMetaclass >> baseComposition [
^ baseComposition
]
{ #category : #accessing }
TraitedMetaclass >> baseComposition: anObject [
baseComposition := anObject
]
{ #category : #accessing }
TraitedMetaclass >> baseLocalMethods [
^ baseLocalMethods
]
{ #category : #accessing }
TraitedMetaclass >> baseLocalMethods: anObject [
baseLocalMethods := anObject
]
{ #category : #'file in/out' }
TraitedMetaclass >> definition [
"Refer to the comment in ClassDescription|definition."
^ String streamContents:
[:strm |
strm print: self.
self hasTraitComposition ifTrue: [
strm
crtab;
nextPutAll: 'uses: ';
print: self traitComposition ].
(self slotsNeedFullDefinition or: [ Slot showSlotClassDefinition ])
ifFalse: [
strm
crtab;
nextPutAll: 'instanceVariableNames: ';
store: self instanceVariablesString]
ifTrue: [
strm
crtab;
nextPutAll: 'slots: ';
nextPutAll: self slotDefinitionString]]
]
{ #category : #initialization }
TraitedMetaclass >> emptyMethodDictionary [
^ MethodDictionary new: 64.
]
{ #category : #testing }
TraitedMetaclass >> findOriginClassOf: aMethod [
"I return the myself or the trait that has the original implementation of a method.
If the method is an alias, the returned class includes the original aliased method"
(aMethod hasProperty: #traitSource)
ifTrue: [ ^ aMethod traitSource innerClass ].
(self isLocalSelector: aMethod selector)
ifTrue: [ ^ self ].
^ (self traitComposition
traitDefining: aMethod selector
ifNone: [ self class traitedClassTrait traitDefining: aMethod selector ifNone: [ ^ self ] ]) innerClass
]
{ #category : #testing }
TraitedMetaclass >> findOriginMethodOf: aMethod [
"I return the original method for a aMethod.
If this is a local method, the original method is itself.
If it cames from a trait composition I look for the method in the trait composition.
First I try with the trait stored in the traitSource.
If it is an aliased or conflicting method, the method is look up in the whole trait composition"
(self isLocalSelector: aMethod selector)
ifTrue: [ ^ aMethod].
(aMethod hasProperty: #traitSource)
ifTrue: [ |newSelector|
newSelector := self traitComposition originSelectorOf: aMethod selector.
^ aMethod traitSource compiledMethodAt: newSelector ifAbsent: [aMethod] ].
^ (self traitComposition
traitDefining: aMethod selector
ifNone: [ self class traitedClassTrait traitDefining: aMethod selector ifNone: [ self ] ])
compiledMethodAt: aMethod selector ifAbsent: [ ^ aMethod ]
]
{ #category : #testing }
TraitedMetaclass >> hasTraitComposition [
^ self traitComposition isEmpty not
]
{ #category : #'testing method dictionary' }
TraitedMetaclass >> includesLocalSelector: aSymbol [
^ self isLocalSelector: aSymbol
]
{ #category : #initialization }
TraitedMetaclass >> initialize [
super initialize.
localMethods := self emptyMethodDictionary.
composition := TaEmptyComposition new.
baseComposition := TaEmptyComposition new.
baseLocalMethods := self emptyMethodDictionary.
]
{ #category : #initialization }
TraitedMetaclass >> initializeBasicMethods [
| selectors |
"When a traited class is created, the methods from TraitedClass are inserted in the classSide of the new class.
So this new class can have traits. The methods are filtered using #isRejectedMethod:"
selectors := self class traitedClassTrait selectors reject: [ :e | self isRejectedMethod: e ].
selectors do: [ :e | self class traitedClassTrait copyMethod: e into: self replacing: true ]
]
{ #category : #testing }
TraitedMetaclass >> isAliasSelector: aSymbol [
"Return true if the selector aSymbol is an alias defined
in my or in another composition somewhere deeper in
the tree of traits compositions."
^ self traitComposition isAliasSelector: aSymbol
]
{ #category : #testing }
TraitedMetaclass >> isLocalAliasSelector: aSymbol [
"Return true if the selector aSymbol is an alias defined
in my trait composition."
^ self traitComposition isLocalAliasSelector: aSymbol
]
{ #category : #testing }
TraitedMetaclass >> isLocalMethodsProtocol: aProtocol [
"Checks if the given protocol includes any local defined selector"
aProtocol methodSelectors ifEmpty: [ ^ true ].
^ aProtocol methodSelectors anySatisfy: [ :each |
self isLocalSelector: each ]
]
{ #category : #testing }
TraitedMetaclass >> isLocalSelector: aSelector [
^ localMethods includesKey: aSelector
]
{ #category : #testing }
TraitedMetaclass >> isRejectedMethod: aSelector [
"Determine if the method is not to be installed in method dictionary"
| isFromClass isFromTraitedClass isTheTraitIUseDefinesTheSelector isMySuperclassTraitedClass |
"the selector is one of the local methods"
(self isLocalSelector: aSelector)
ifTrue: [ ^ true ].
"If a trait I used define the selector, we do not reject"
isTheTraitIUseDefinesTheSelector := self traitComposition traits anySatisfy: [:inTrait |
inTrait localMethods anySatisfy: [ :meth | meth selector = aSelector ]].
isTheTraitIUseDefinesTheSelector ifTrue:[ ^false ].
isFromClass := Class canUnderstand: aSelector.
isFromTraitedClass := TraitedClass methodDict includesKey: aSelector.
isMySuperclassTraitedClass := (superclass isKindOf: TraitedMetaclass) and: [
superclass isObsolete not].
"It is from Class (we already have them) and they are not overriden in TraitedClass"
(isFromClass and: [ isFromTraitedClass not ]) ifTrue: [ ^ true ].
"If it is in TraitedClass and it is in my superclass."
(isFromTraitedClass and: isMySuperclassTraitedClass)
ifTrue: [ ^ true ].
^ false
]
{ #category : #testing }
TraitedMetaclass >> isSelectorToKeep: aSelector [
"I have to keep the local methods and the methods from TraitedClass
The methods from TraitedClass makes me a class suporting traits, without them I am a normal class"
^ (self isLocalSelector: aSelector)
or: [ TraitedClass methodDict includesKey: aSelector ]
]
{ #category : #accessing }
TraitedMetaclass >> localMethodDict [
^ localMethods
]
{ #category : #accessing }
TraitedMetaclass >> localMethods [
"returns the methods of classes excluding the ones of the traits that the class uses"
^ localMethods values
]
{ #category : #accessing }
TraitedMetaclass >> localSelectors [
^ localMethods keys
]
{ #category : #initialization }
TraitedMetaclass >> rebuildMethodDictionary [
| selectors removedSelectors modified |
"During the creation of the class or after a change in the traitComposition, the whole method dictionary is calculated.
If I return true, my users should be updated.
Check the version in TraitedClass for more details."
modified := false.
self methodDict valuesDo: [ :m | m traitSource ifNil: [ localMethods at: m selector put: m ]].
selectors := self traitComposition selectors reject: [ :e | self isRejectedMethod: e ].
selectors do: [ :e | modified := modified | (self traitComposition installSelector: e into: self replacing: false) ].
removedSelectors := self methodDict keys reject: [ :aSelector | (selectors includes: aSelector) or: [ self isSelectorToKeep: aSelector ] ].
modified := modified | (removedSelectors isNotEmpty).
removedSelectors do: [ :aSelector | self methodDict removeKey: aSelector ].
removedSelectors do: [ :aSelector | self organization removeElement: aSelector ].
^ modified
]
{ #category : #categories }
TraitedMetaclass >> recategorizeSelector: selector from: oldCategory to: newCategory [
| original |
"When a method is recategorized I have to classify the method, but also recategorize the aliases pointing to it"
original := self organization categoryOfElement: selector ifAbsent: [ ^ self ].
"If it is nil is because it is a removal. It will removed when the method is removed."
newCategory ifNil: [ ^ self ].
original = oldCategory
ifTrue: [ self organization classify: selector under: newCategory suppressIfDefault: true ].
(self traitComposition reverseAlias: selector) do: [ :e |
self recategorizeSelector: e from: oldCategory to: newCategory.
self notifyOfRecategorizedSelector: e from: oldCategory to: newCategory ].
self organization removeEmptyCategories
]
{ #category : #traits }
TraitedMetaclass >> removeFromComposition: aTrait [
self setTraitComposition: (self traitComposition copyWithoutTrait: aTrait asTraitComposition)
]
{ #category : #'accessing method dictionary' }
TraitedMetaclass >> removeSelector: aSelector [
"When a selector is removed it should be notified to my users.
Check the class TraitChange for more details"
super removeSelector: aSelector.
self localMethodDict removeKey: aSelector ifAbsent: [ ].
TraitChange removeSelector: aSelector on: self.
]
{ #category : #slots }
TraitedMetaclass >> slots [
^ super slots reject: [ :e | composition slots includes: e ]
]
{ #category : #accessing }
TraitedMetaclass >> traitComposition [
^ composition
]
{ #category : #accessing }
TraitedMetaclass >> traitComposition: aComposition [
aComposition asTraitComposition allTraits do: [ :aMaybeTrait |
aMaybeTrait isTrait ifFalse: [
self error: 'All the members of the trait composition should be traits' ]].
composition := aComposition
]
{ #category : #accessing }
TraitedMetaclass >> traitCompositionString [
^ self traitComposition asString
]
{ #category : #accessing }
TraitedMetaclass >> traitUsers [
^ #()
]
{ #category : #initialization }
TraitedMetaclass >> traits [
^ composition traits
]