/
MetaLinkAnonymousClassBuilder.class.st
112 lines (95 loc) · 3.6 KB
/
MetaLinkAnonymousClassBuilder.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
"
I build anonymous subclasses for object with instance specific MetaLinks.
I can compile methods in those subclasses, and provide access to anonymous classes;
I also handle the migration of an object from its original class to an anonymous subclass and vice versa.
I consider that for one anonymous subclass i hold one object reference. I therefore cannot work as is with other clients using anonymous subclasses.
"
Class {
#name : #MetaLinkAnonymousClassBuilder,
#superclass : #Object,
#instVars : [
'classes',
'migratedObjects'
],
#category : #'Reflectivity-Installer'
}
{ #category : #accessing }
MetaLinkAnonymousClassBuilder >> allSubclassesOf: class withSelector: selector [
| subclasses |
class isAnonymous
ifTrue: [ ^ OrderedCollection with: class ].
subclasses := self anonSubclassesFor: class.
^ (subclasses select: [ :c | c selectors includes: selector ]) asOrderedCollection
]
{ #category : #accessing }
MetaLinkAnonymousClassBuilder >> anonSubclassesFor: aClass [
^ classes at: aClass ifAbsent: [ ^ Array new ]
]
{ #category : #creation }
MetaLinkAnonymousClassBuilder >> anonymousClassForObject: anObject [
"Building the anonymous subclass for an object.
If the object already is instance of an anonymous class, its class is returned as is.
Otherwise an anonymous class is derived from its class.
There is a single anonymous class by adapted object (1-1 relationship)."
| class |
class := anObject class.
^ class isAnonymous
ifTrue: [ class ]
ifFalse: [ self newAnonymousSubclassFor: class ]
]
{ #category : #compiling }
MetaLinkAnonymousClassBuilder >> compileMethodFrom: aNode in: anAnonymousClass [
| selector source |
selector := aNode methodNode selector.
(anAnonymousClass methodDict at: selector ifAbsent: [ nil ]) ifNotNil: [ :compiledMethod | ^ compiledMethod ].
source := aNode methodNode source.
anAnonymousClass compile: source.
^ anAnonymousClass >> selector
]
{ #category : #accessing }
MetaLinkAnonymousClassBuilder >> compiledMethodsOfSelector: selector inAnonSubClassesOf: class [
| anonSubClasses |
anonSubClasses := self anonSubclassesFor: class.
^ self compiledMethodsOfSelector: selector inClasses: anonSubClasses
]
{ #category : #accessing }
MetaLinkAnonymousClassBuilder >> compiledMethodsOfSelector: selector inClasses: someClasses [
^ (someClasses select: [ :ac | ac selectors includes: selector ])
collect: [ :ac | ac compiledMethodAt: selector ]
]
{ #category : #initialize }
MetaLinkAnonymousClassBuilder >> initialize [
classes := Dictionary new.
migratedObjects := WeakIdentityKeyDictionary new
]
{ #category : #migration }
MetaLinkAnonymousClassBuilder >> migrateObject: anObject toAnonymousClass: anonClass [
anObject class == anonClass
ifFalse: [ anonClass adoptInstance: anObject.
migratedObjects at: anonClass put: anObject ]
]
{ #category : #migration }
MetaLinkAnonymousClassBuilder >> migrateObjectToOriginalClass: anObject [
| class |
class := anObject class.
class isAnonymous
ifTrue: [ migratedObjects removeKey: class.
class superclass adoptInstance: anObject ]
]
{ #category : #creation }
MetaLinkAnonymousClassBuilder >> newAnonymousSubclassFor: aClass [
| anonSubclass |
anonSubclass := aClass newAnonymousSubclass.
(classes at: aClass ifAbsentPut: WeakSet new)
add: anonSubclass.
^ anonSubclass
]
{ #category : #creation }
MetaLinkAnonymousClassBuilder >> removeMethodNode: aNode fromObject: anObject [
anObject class isAnonymous ifFalse:[^self].
anObject class removeSelector: aNode methodNode selector.
]
{ #category : #accessing }
MetaLinkAnonymousClassBuilder >> soleInstanceOf: anAnonymousClass [
^ migratedObjects at: anAnonymousClass
]