- #resolveSlot should raise SlotNotFound instead of error

- Very first ComposedSlot + some tests (more to be done) - inline #initializeProperties - remove #changingIn:, not send by the new class builder - add DerivedSlot superclass for PropertySlot, BooleabSlot... - Simplify WeakSlot - add WeakSlotComposable (will replace WeakSlot later) - refactor tests: one class per Slot Example fixes #3153
pharo-project · Apr 10, 2019 · 3821ba4 · 3821ba4
1 parent d1fa886
commit 3821ba4
Show file tree

Hide file tree

Showing 23 changed files with 443 additions and 332 deletions.
diff --git a/src/Slot-Core/AbstractLayout.class.st b/src/Slot-Core/AbstractLayout.class.st
@@ -129,8 +129,7 @@ AbstractLayout >> isWeak [
 
 { #category : #accessing }
 AbstractLayout >> resolveSlot: aName [
-	self flag: 'Signal rather than error'.
-	self error: 'No slots found'
+	^SlotNotFound signalForName: aName
 ]
 
 { #category : #api }

diff --git a/src/Slot-Core/ComposedSlot.class.st b/src/Slot-Core/ComposedSlot.class.st
@@ -0,0 +1,62 @@
+"
+Slots can be composed. A composition always has one ""real"" slot that knows how to store values and one ore more SlotDecorators. The decorators are chained and delegate reading/writing to the front of the compostion until the finally use the one storage slot to store or read the value.
+"
+Class {
+	#name : #ComposedSlot,
+	#superclass : #Slot,
+	#instVars : [
+		'implementor',
+		'next'
+	],
+	#category : #'Slot-Core-Variables'
+}
+
+{ #category : #'instance creation' }
+ComposedSlot class >> named: aSymbol [
+	| instance |
+	instance := super named: aSymbol.
+	instance implementor: (InstanceVariableSlot named: aSymbol).
+	^instance
+]
+
+{ #category : #accessing }
+ComposedSlot >> baseSlot [
+	"the head of the composition is the slot that manages storage"
+	^implementor baseSlot
+]
+
+{ #category : #accessing }
+ComposedSlot >> implementor: anObject [
+	implementor := anObject
+]
+
+{ #category : #accessing }
+ComposedSlot >> index [
+	^self baseSlot index
+]
+
+{ #category : #accessing }
+ComposedSlot >> index: anInteger [
+	^self baseSlot index: anInteger
+]
+
+{ #category : #testing }
+ComposedSlot >> isVirtual [
+	"indexed slots are the only not virtual slots for now"
+	^self baseSlot isVirtual
+]
+
+{ #category : #accessing }
+ComposedSlot >> next: anObject [
+	next := anObject
+]
+
+{ #category : #'meta-object-protocol' }
+ComposedSlot >> read: anObject [
+	^ implementor read: anObject
+]
+
+{ #category : #'meta-object-protocol' }
+ComposedSlot >> write: aValue to: anObject [
+	^implementor write: aValue to: anObject
+]
diff --git a/src/Slot-Core/IndexedSlot.class.st b/src/Slot-Core/IndexedSlot.class.st
@@ -38,7 +38,7 @@ IndexedSlot >> index: anIndex [
 
 { #category : #testing }
 IndexedSlot >> isVirtual [
-	"virtual slots do not take up space in the object and have size = 0"
+	"indexed slots are the only not virtual slots for now"
 	^false
 ]
 

diff --git a/src/Slot-Core/LiteralVariable.class.st b/src/Slot-Core/LiteralVariable.class.st
@@ -30,17 +30,9 @@ LiteralVariable class >> checkValidName: aString [
 
 { #category : #'class initialization' }
 LiteralVariable class >> initialize [
-	Properties
-		ifNil: [ self initializeProperties ]
-		ifNotNil: [ | newDict | 
-			newDict := WeakIdentityKeyDictionary newFrom: Properties.
-			newDict rehash.
-			Properties := newDict ]
-]
-
-{ #category : #'class initialization' }
-LiteralVariable class >> initializeProperties [
-	Properties := WeakIdentityKeyDictionary new.
+	Properties := Properties
+		ifNil: [ WeakIdentityKeyDictionary new. ]
+		ifNotNil: [ (WeakIdentityKeyDictionary newFrom: Properties) rehash]
 ]
 
 { #category : #'instance creation' }

diff --git a/src/Slot-Core/Slot.class.st b/src/Slot-Core/Slot.class.st
@@ -41,17 +41,9 @@ Slot class >> checkValidName: aSymbol [
 
 { #category : #'class initialization' }
 Slot class >> initialize [
-	Properties
-		ifNil: [ self initializeProperties ]
-		ifNotNil: [ | newDict | 
-			newDict := WeakIdentityKeyDictionary newFrom: Properties.
-			newDict rehash.
-			Properties := newDict ]
-]
-
-{ #category : #'class initialization' }
-Slot class >> initializeProperties [
-	Properties := WeakIdentityKeyDictionary new.
+	Properties := Properties
+		ifNil: [ WeakIdentityKeyDictionary new. ]
+		ifNotNil: [ (WeakIdentityKeyDictionary newFrom: Properties) rehash]
 ]
 
 { #category : #'instance creation' }
@@ -82,6 +74,14 @@ Slot class >> slotSetting: aBuilder [
 		target: self
 ]
 
+{ #category : #composition }
+Slot >> + anotherSlot [
+	^anotherSlot new 
+		implementor: self;
+		name: name
+
+]
+
 { #category : #comparing }
 Slot >> = other [
 	"Every subclass that adds state must redefine this method"
@@ -110,9 +110,9 @@ Slot >> asSlot [
 	^ self
 ]
 
-{ #category : #'class building' }
-Slot >> changingIn: aClass [
-	"the slot was changed. Default is to do nothing"
+{ #category : #accessing }
+Slot >> baseSlot [
+	^self
 ]
 
 { #category : #accessing }
@@ -392,7 +392,7 @@ Slot >> usingMethods [
 
 { #category : #'meta-object-protocol' }
 Slot >> wantsInitalization [
-	"if a slot wants to hable initalization, return true here"
+	"if a slot wants to enable instance initalization, return true here"
 	^false
 ]
 

diff --git a/src/Slot-Core/TemporaryVariable.class.st b/src/Slot-Core/TemporaryVariable.class.st
@@ -23,19 +23,10 @@ Class {
 
 { #category : #'class initialization' }
 TemporaryVariable class >> initialize [
-	Properties
-		ifNil: [ self initializeProperties ]
-		ifNotNil: [ | newDict | 
-			newDict := WeakIdentityKeyDictionary newFrom: Properties.
-			newDict rehash.
-			Properties := newDict ].
-	PersistentTemps ifNil: [ PersistentTemps := Set new]
-
-]
-
-{ #category : #'class initialization' }
-TemporaryVariable class >> initializeProperties [
-	Properties := WeakIdentityKeyDictionary new.
+	Properties := Properties
+		ifNil: [ WeakIdentityKeyDictionary new ]
+		ifNotNil: [ (WeakIdentityKeyDictionary newFrom: Properties) rehash ].
+	PersistentTemps ifNil: [ PersistentTemps := Set new ]
 ]
 
 { #category : #'instance creation' }

diff --git a/src/Slot-Examples/BaseSlot.class.st b/src/Slot-Examples/BaseSlot.class.st
@@ -52,6 +52,6 @@ BaseSlot >> isVisible [
 
 { #category : #'meta-object-protocol' }
 BaseSlot >> wantsInitalization [
-	"if a slot wants to hable initalization, return true here"
+	"we need to call the initialize to set the default value for the base slot"
 	^true
 ]
diff --git a/src/Slot-Examples/BooleanSlot.class.st b/src/Slot-Examples/BooleanSlot.class.st
@@ -7,9 +7,8 @@ I am a Slot that does not allocate one field for each slot. Instead, all Boolean
 "
 Class {
 	#name : #BooleanSlot,
-	#superclass : #Slot,
+	#superclass : #DerivedSlot,
 	#instVars : [
-		'baseSlot',
 		'offset'
 	],
 	#category : #'Slot-Examples-Base'
@@ -71,24 +70,6 @@ BooleanSlot >> installingIn: aClass [
 
 
 
-]
-
-{ #category : #testing }
-BooleanSlot >> isAccessedIn: aMethod [
-	(baseSlot isAccessedIn: aMethod) ifFalse: [ ^false ].
-	^super isAccessedIn: aMethod
-]
-
-{ #category : #testing }
-BooleanSlot >> isReadIn: aMethod [
-	(baseSlot isReadIn: aMethod) ifFalse: [ ^false ].
-	^super isReadIn: aMethod
-]
-
-{ #category : #testing }
-BooleanSlot >> isWrittenIn: aMethod [
-	(baseSlot isWrittenIn: aMethod) ifFalse: [ ^false ].
-	^super isWrittenIn: aMethod
 ]
 
 { #category : #accessing }
@@ -106,7 +87,7 @@ BooleanSlot >> todo [
 	'
     - adding a Booleanslot in between --> offsets need to be updated?
 	 - removing BooleanSlot in the middle	
-	 - adding booleanslot higher in the hierarchy: move baseselot (same as in TODO for DictionarySlot)
+	 - adding booleanslot higher in the hierarchy: move baseselot (same as in TODO for PropertySlot)
 	'
 ]
 

diff --git a/src/Slot-Examples/DerivedSlot.class.st b/src/Slot-Examples/DerivedSlot.class.st
@@ -0,0 +1,29 @@
+"
+A derived slot is a virtual slot that stores its value in a hidden base slot.
+"
+Class {
+	#name : #DerivedSlot,
+	#superclass : #Slot,
+	#instVars : [
+		'baseSlot'
+	],
+	#category : #'Slot-Examples-Base'
+}
+
+{ #category : #testing }
+DerivedSlot >> isAccessedIn: aMethod [
+	(baseSlot isAccessedIn: aMethod) ifFalse: [ ^false ].
+	^super isAccessedIn: aMethod
+]
+
+{ #category : #testing }
+DerivedSlot >> isReadIn: aMethod [
+	(baseSlot isReadIn: aMethod) ifFalse: [ ^false ].
+	^super isReadIn: aMethod
+]
+
+{ #category : #testing }
+DerivedSlot >> isWrittenIn: aMethod [
+	(baseSlot isWrittenIn: aMethod) ifFalse: [ ^false ].
+	^super isWrittenIn: aMethod
+]
diff --git a/src/Slot-Examples/ExampleClassVariable.class.st b/src/Slot-Examples/ExampleClassVariable.class.st
@@ -8,7 +8,7 @@ Class {
 	#instVars : [
 		'state'
 	],
-	#category : #'Slot-Examples-Base'
+	#category : #'Slot-Examples-ClassVariables'
 }
 
 { #category : #'meta-object-protocol' }

diff --git a/src/Slot-Examples/PropertySlot.class.st b/src/Slot-Examples/PropertySlot.class.st
@@ -7,10 +7,7 @@ Keep in mind:
 "
 Class {
 	#name : #PropertySlot,
-	#superclass : #Slot,
-	#instVars : [
-		'baseSlot'
-	],
+	#superclass : #DerivedSlot,
 	#category : #'Slot-Examples-Base'
 }
 
@@ -55,24 +52,6 @@ PropertySlot >> installingIn: aClass [
 
 ]
 
-{ #category : #testing }
-PropertySlot >> isAccessedIn: aMethod [
-	(baseSlot isAccessedIn: aMethod) ifFalse: [ ^false ].
-	^super isAccessedIn: aMethod
-]
-
-{ #category : #testing }
-PropertySlot >> isReadIn: aMethod [
-	(baseSlot isReadIn: aMethod) ifFalse: [ ^false ].
-	^super isReadIn: aMethod
-]
-
-{ #category : #testing }
-PropertySlot >> isWrittenIn: aMethod [
-	(baseSlot isWrittenIn: aMethod) ifFalse: [ ^false ].
-	^super isWrittenIn: aMethod
-]
-
 { #category : #'meta-object-protocol' }
 PropertySlot >> read: anObject [
 	^ (baseSlot read: anObject) at: self name ifAbsent: nil

diff --git a/src/Slot-Examples/UnlimitedInstanceVariableSlot.class.st b/src/Slot-Examples/UnlimitedInstanceVariableSlot.class.st
@@ -3,9 +3,8 @@ We store state in a hidden array. Contrary to normal instance variables the numb
 "
 Class {
 	#name : #UnlimitedInstanceVariableSlot,
-	#superclass : #Slot,
+	#superclass : #DerivedSlot,
 	#instVars : [
-		'baseSlot',
 		'offset'
 	],
 	#category : #'Slot-Examples-Base'

diff --git a/src/Slot-Examples/WeakSlot.class.st b/src/Slot-Examples/WeakSlot.class.st
@@ -42,6 +42,7 @@ WeakSlot >> emitValue: aMethodBuilder [
 
 { #category : #initialization }
 WeakSlot >> initialize: anObject [
+
 	super write: (WeakArray new: 1) to: anObject
 ]
 
@@ -60,6 +61,5 @@ WeakSlot >> wantsInitalization [
 { #category : #'meta-object-protocol' }
 WeakSlot >> write: aValue to: anObject [
 
-	(super read: anObject) at: 1 put: aValue.
-	^ aValue
+	^(super read: anObject) at: 1 put: aValue.
 ]
diff --git a/src/Slot-Examples/WeakSlotComposable.class.st b/src/Slot-Examples/WeakSlotComposable.class.st
@@ -0,0 +1,33 @@
+"
+Composable version of WeakSlot. When the implementation is complete enough, we will replace WeakSlot with this implementation
+"
+Class {
+	#name : #WeakSlotComposable,
+	#superclass : #ComposedSlot,
+	#category : #'Slot-Examples-Base'
+}
+
+{ #category : #initialization }
+WeakSlotComposable >> initialize: anObject [
+
+	implementor write: (WeakArray new: 1) to: anObject
+]
+
+{ #category : #'meta-object-protocol' }
+WeakSlotComposable >> read: anObject [
+
+	^ (implementor read: anObject) at: 1.
+]
+
+{ #category : #'meta-object-protocol' }
+WeakSlotComposable >> wantsInitalization [
+
+	^ true
+]
+
+{ #category : #'meta-object-protocol' }
+WeakSlotComposable >> write: aValue to: anObject [
+
+	^(implementor read: anObject) at: 1 put: aValue.
+
+]
diff --git a/src/Slot-Examples/WriteOnceSlot.class.st b/src/Slot-Examples/WriteOnceSlot.class.st
@@ -30,9 +30,8 @@ WriteOnceSlot >> wantsInitalization [
 
 { #category : #'meta-object-protocol' }
 WriteOnceSlot >> write: aValue to: anObject [
-	| asso |
-	asso := super read: anObject.
-	(self isWritten: anObject)
-		ifTrue: [ asso key: aValue value: false ]
+
+	^(self isWritten: anObject)
+		ifTrue: [ (super read: anObject) key: aValue value: false. aValue ]
 		ifFalse: [ self error: 'only one assigment allowed' ]
 ]