--- a/Structure.st Sat Oct 04 19:23:04 1997 +0200
+++ b/Structure.st Thu Oct 09 13:51:58 1997 +0200
@@ -16,12 +16,12 @@
i22 i23 i24 i25 i26 i27 i28 i29 i30 i31 i32 i33 i34 i35 i36 i37
i38 i39 i40 i41 i42 i43 i44 i45 i46 i47 i48 i49 i50'
classVariableNames:'OneInstance DummyClass ReadAccessMethods WriteAccessMethods
- OtherMethods'
+ OtherMethods OtherSelectors'
poolDictionaries:''
category:'Programming-Support'
!
-!Structure class methodsFor:'documentation'!
+!Structure class methodsFor:'documentation'!
copyright
"
@@ -39,41 +39,44 @@
documentation
"
- are you tired of using arrays or identityDictionaries, when
- multiple values have to be returned from some method, AND
- you dont want to add many stupid dummy data-holder classes to
- avoid the above ?
- (for example, the value as returned by Method>>who)
+ This is an experimental class, stressing the metaObject capabilities.
- Here is a goody to return an object which is class-less,
- only holding some values, and provides a protocol to access
- those fields. In addition, it supports the array-protocol,
- so it can be used as a backward compatible replacement in
+ Structures are objects which are class-less,
+ only holding some values, and provide a protocol to access
+ those fields. In addition, they support the array-protocol,
+ so they can be used as backward compatible replacements in
places where arrays were returned.
-
- For example, in Method>>who, instead of returning:
- ^ Array with:cls with:selector
- you can also return:
- ^ Structure with:#containingClass->cls with:#selector->selector
+ (However, we recommend using private classes, since they are easier
+ to understand and aintain).
+
+ For example, some structure object can be create with:
+ ^ Structure with:#foo->'someFooValue' with:#bar->'someBarValue'
and access these values either as:
- retVal at:1 -> returns the cls
- retVal at:2 -> returns the selector
+ retVal at:1 -> returns the foo instvar value
+ retVal at:2 -> returns the bar instvar value
or (much more convenient and readable) as:
- retVal containingClass
- retVal selector
+ retVal foo
+ retVal bar
- implementation note:
+ Implementation note:
this is a very tricky (but fully legal) implementation,
- creating an objects which is its own class.
- Therefore, no additional overhead by extra objects is involved.
-
+ creating an object which is its own class.
+ Therefore, no additional overhead by extra (class) objects is involved.
+ These are very lightweight objects.
+
Another prove that smalltalk is a powerful & flexible programming language.
However, some smalltalk systems crash if your try this ;-)
CAVEAT:
+ tricky implementation - not the full object protocol is supported;
a maximum of 50 instance variables is allowed.
+ [WARNING:]
+ this is an experimental goody - for our amusement and not meant
+ to be used in real applications.
+ It may be removed without notice and/or no longer maintained in the furure.
+
[author:]
Claus Gittinger
@@ -114,7 +117,7 @@
"
! !
-!Structure class methodsFor:'initialization'!
+!Structure class methodsFor:'initialization'!
initialize
OneInstance isNil ifTrue:[
@@ -124,21 +127,43 @@
DummyClass flags:(Behavior flagBehavior bitOr:Behavior flagPointers).
ReadAccessMethods := (1 to:50)
- collect:[:i |
- (self compiledMethodAt:('i', i printString) asSymbol)
+ collect:[:i | |m|
+ m := self compiledMethodAt:('i', i printString) asSymbol.
+ (m notNil and:[m isLazyMethod]) ifTrue:[m makeRealMethod].
+ m
].
WriteAccessMethods := (1 to:50)
- collect:[:i |
- (self compiledMethodAt:('i', i printString,':') asSymbol)
+ collect:[:i | |m|
+ m := self compiledMethodAt:('i', i printString , ':') asSymbol.
+ (m notNil and:[m isLazyMethod]) ifTrue:[m makeRealMethod].
+ m
].
- OtherMethods := Array new:6.
- OtherMethods at:1 put:(self compiledMethodAt:#doesNotUnderstand:).
- OtherMethods at:2 put:(Object compiledMethodAt:#class).
- OtherMethods at:3 put:(Object compiledMethodAt:#at:).
- OtherMethods at:4 put:(Object compiledMethodAt:#at:put:).
- OtherMethods at:5 put:(Object compiledMethodAt:#basicAt:).
- OtherMethods at:6 put:(Object compiledMethodAt:#basicAt:put:).
+ OtherMethods := OrderedCollection new.
+ OtherMethods
+ add:(self compiledMethodAt:#doesNotUnderstand:);
+ add:(Object compiledMethodAt:#class);
+ add:(Object compiledMethodAt:#identityHash);
+ add:(Object compiledMethodAt:#at:);
+ add:(Object compiledMethodAt:#at:put:);
+ add:(Object compiledMethodAt:#basicAt:);
+ add:(Object compiledMethodAt:#basicAt:put:);
+ add:(Object compiledMethodAt:#printString);
+ add:(Object compiledMethodAt:#printOn:);
+ add:(Object compiledMethodAt:#addDependent:);
+ add:(Object compiledMethodAt:#removeDependent:);
+ add:(Object compiledMethodAt:#dependents);
+ add:(Object compiledMethodAt:#dependents:);
+ add:(Object compiledMethodAt:#perform:);
+ add:(Object compiledMethodAt:#perform:with:).
+ OtherMethods := OtherMethods asArray.
+
+ OtherSelectors := #(#doesNotUnderstand:
+ #class #identityHash
+ #at: #at:put: #basicAt: #basicAt:put:
+ #printString #printOn:
+ #addDependent: #removeDependent: #dependents #dependents:
+ #perform: #perform:with:).
].
"
@@ -149,7 +174,7 @@
"Modified: 21.9.1996 / 16:01:48 / cg"
! !
-!Structure class methodsFor:'instance creation'!
+!Structure class methodsFor:'instance creation'!
newWith:names
"return a new structure containing fields as passed in the names collection.
@@ -170,19 +195,24 @@
The argument must be a sequenceable collection of symbols.
The new structures values are set to corresponding values from the second argument, values."
- |cls arr sels mthds dummyClass|
+ |cls arr sels mthds dummyClass nInsts|
+
+ nInsts := names size.
sels := names collect:[:nm | nm asSymbol].
sels := sels , (names collect:[:nm | (nm , ':') asSymbol]).
- sels := sels , #(#doesNotUnderstand: #class #at: #at:put: #basicAt: #basicAt:put:).
+ sels := sels , OtherSelectors.
- mthds := ReadAccessMethods copyTo:names size.
- mthds := mthds , (WriteAccessMethods copyTo:names size).
+ mthds := ReadAccessMethods copyTo:nInsts.
+ mthds := mthds , (WriteAccessMethods copyTo:nInsts).
mthds := mthds , OtherMethods.
"/ create a prototype object as an array ...
+ "/ the object will be its own class, and have the indexable flag bit set;
+ "/ therefore, the first 5 instVars must correspond to Behavior instvars,
+ "/ the remaining ones will be the indexed instvars.
- arr := Array new:(names size + 5).
+ arr := Array new:(nInsts + 5).
arr at:1 put:nil. "/ superclass
arr at:2 put:(Behavior flagBehavior bitOr:Behavior flagPointers). "/ flags
arr at:3 put:(MethodDictionary withKeys:sels andValues:mthds). "/ selectors & methods
@@ -275,6 +305,19 @@
"
! !
+!Structure class methodsFor:'special'!
+
+primAddSelector:newSelector withMethod:newMethod
+ "must reinit myself when methods are accepted."
+
+ |val|
+
+ val := super primAddSelector:newSelector withMethod:newMethod.
+ OneInstance := nil.
+ self initialize.
+ ^ val
+! !
+
!Structure methodsFor:'accessing'!
flags
@@ -294,7 +337,7 @@
!
i1
- "return the first instance variable"
+ "prototype method to return the first instance variable"
^ i1
@@ -302,7 +345,7 @@
!
i10
- "return i10"
+ "prototype method to return the 10th instance variable"
^ i10
@@ -310,7 +353,7 @@
!
i10:something
- "set i10"
+ "prototype method to set the 10th instance variable"
i10 := something.
@@ -326,7 +369,7 @@
!
i11:something
- "set i11"
+ "prototype method to set the 11th instance variable"
i11 := something.
@@ -462,7 +505,7 @@
!
i1:something
- "set i1"
+ "prototype method to set the 1st instance variable"
i1 := something.
@@ -470,7 +513,7 @@
!
i2
- "return i2"
+ "prototype method to return the 2nd instance variable"
^ i2
@@ -638,7 +681,7 @@
!
i2:something
- "set i2"
+ "prototype method to set the 2nd instance variable"
i2 := something.
@@ -646,7 +689,7 @@
!
i3
- "return i3"
+ "prototype method to return the 3rd instance variable"
^ i3
@@ -806,7 +849,7 @@
!
i3:something
- "set i3"
+ "prototype method to set the 3rd instance variable"
i3 := something.
@@ -814,15 +857,20 @@
!
i4
- "return i4"
+ "prototype method to return the 4th instance variable"
^ i4
"Created: 13.5.1996 / 21:19:25 / cg"
!
+i40
+ "return the value of the instance variable 'i40' (automatically generated)"
+
+ ^ i40!
+
i40:something
- "set i40"
+ "prototype method"
i40 := something.
@@ -830,7 +878,7 @@
!
i41
- "return i41"
+ "prototype method"
^ i41
@@ -838,7 +886,7 @@
!
i41:something
- "set i41"
+ "prototype method"
i41 := something.
@@ -846,7 +894,7 @@
!
i42
- "return i42"
+ "prototype method"
^ i42
@@ -854,7 +902,7 @@
!
i42:something
- "set i42"
+ "prototype method"
i42 := something.
@@ -862,7 +910,7 @@
!
i43
- "return i43"
+ "prototype method"
^ i43
@@ -870,7 +918,7 @@
!
i43:something
- "set i43"
+ "prototype method"
i43 := something.
@@ -878,7 +926,7 @@
!
i44
- "return i44"
+ "prototype method"
^ i44
@@ -886,7 +934,7 @@
!
i44:something
- "set i44"
+ "prototype method"
i44 := something.
@@ -894,7 +942,7 @@
!
i45
- "return i45"
+ "prototype method"
^ i45
@@ -902,7 +950,7 @@
!
i45:something
- "set i45"
+ "prototype method"
i45 := something.
@@ -910,7 +958,7 @@
!
i46
- "return i46"
+ "prototype method"
^ i46
@@ -918,7 +966,7 @@
!
i46:something
- "set i46"
+ "prototype method"
i46 := something.
@@ -926,7 +974,7 @@
!
i47
- "return i47"
+ "prototype method"
^ i47
@@ -934,7 +982,7 @@
!
i47:something
- "set i47"
+ "prototype method"
i47 := something.
@@ -942,7 +990,7 @@
!
i48
- "return i48"
+ "prototype method"
^ i48
@@ -950,7 +998,7 @@
!
i48:something
- "set i48"
+ "prototype method"
i48 := something.
@@ -958,7 +1006,7 @@
!
i49
- "return i49"
+ "prototype method"
^ i49
@@ -966,7 +1014,7 @@
!
i49:something
- "set i49"
+ "prototype method"
i49 := something.
@@ -974,7 +1022,7 @@
!
i4:something
- "set i4"
+ "prototype method to set the 4th instance variable"
i4 := something.
@@ -982,7 +1030,7 @@
!
i5
- "return i5"
+ "prototype method to return the 5th instance variable"
^ i5
@@ -990,7 +1038,7 @@
!
i50
- "return i50"
+ "prototype method"
^ i50
@@ -998,7 +1046,7 @@
!
i50:something
- "set i50"
+ "prototype method"
i50 := something.
@@ -1006,7 +1054,7 @@
!
i5:something
- "set i5"
+ "prototype method to set the 5th instance variable"
i5 := something.
@@ -1014,7 +1062,7 @@
!
i6
- "return i6"
+ "prototype method to return the 6th instance variable"
^ i6
@@ -1022,7 +1070,7 @@
!
i6:something
- "set i6"
+ "prototype method to set the 6th instance variable"
i6 := something.
@@ -1030,7 +1078,7 @@
!
i7
- "return i7"
+ "prototype method to return the 7th instance variable"
^ i7
@@ -1038,7 +1086,7 @@
!
i7:something
- "set i7"
+ "prototype method to set the 7th instance variable"
i7 := something.
@@ -1046,7 +1094,7 @@
!
i8
- "return i8"
+ "prototype method to return the 8th instance variable"
^ i8
@@ -1054,7 +1102,7 @@
!
i8:something
- "set i8"
+ "prototype method to set the 8th instance variable"
i8 := something.
@@ -1062,7 +1110,7 @@
!
i9
- "return i9"
+ "prototype method to return the 9th instance variable"
^ i9
@@ -1070,7 +1118,7 @@
!
i9:something
- "set i9"
+ "prototype method to set the 9th instance variable"
i9 := something.
@@ -1138,7 +1186,7 @@
Notice that although this method calls super messages,
actual instances will have no valid superClass."
- |sel args names sz s|
+ |sel args names sz s idx|
"/ instance protocol
@@ -1149,23 +1197,17 @@
s := WriteStream on:''.
s nextPutAll:'Structure('.
names := self allInstVarNames.
- names keysAndValuesDo:[:idx :nm |
- s nextPutAll:nm; nextPutAll:'->'.
- s nextPutAll:(self at:idx) displayString.
- s space
+ names notNil ifTrue:[
+ names keysAndValuesDo:[:idx :nm |
+ s nextPutAll:nm; nextPutAll:'->'.
+ s nextPutAll:(self at:idx) displayString.
+ s space
+ ].
].
s nextPutAll:')'.
^ s contents
].
- sel == #printString ifTrue:[
- ^ super printString
- ].
-
- sel == #printOn: ifTrue:[
- ^ super printOn:(args at:1)
- ].
-
sel == #basicInspect ifTrue:[
^ InspectorView openOn:self
].
@@ -1212,10 +1254,6 @@
^ 'Structure'
].
- sel == #instSize ifTrue:[
- ^ instSize
- ].
-
sel == #isVariable ifTrue:[
^ false
].
@@ -1233,10 +1271,13 @@
].
sel == #respondsTo: ifTrue:[
- (args at:1) printNL.
^ false
].
+ sel == #whichClassIncludesSelector: ifTrue:[
+ ^ nil
+ ].
+
sel == #evaluatorClass ifTrue:[
^ Compiler
].
@@ -1254,41 +1295,41 @@
].
sel == #allInstVarNames ifTrue:[
+ methodDictionary isNil ifTrue:[
+ 'oops - nil ethodDict' printCR.
+ ^ #()
+ ].
+
sz := super basicSize.
names := Array new:sz.
- methodDictionary copy keysAndValuesDo:[:sel :mthd|
- |index|
+ methodDictionary keysAndValuesDo:[:sel :mthd|
+ |index mysel|
+
(sel endsWith:$:) ifFalse:[
(sel ~~ #class) ifTrue:[
"/
"/ which method is it ?
"/
- 1 to:20 do:[:i |
- |mysel|
-
- mysel := ('i' , i printString) asSymbol.
+ idx := 1.
+ [idx <= sz] whileTrue:[
+ mysel := ('i' , idx printString) asSymbol.
mthd == (Structure compiledMethodAt:mysel) ifTrue:[
- index := i
- ]
+ names at:idx put:sel.
+ idx := sz. "/ break
+ ].
+ idx := idx + 1.
].
-
- index isNil ifTrue:[
- 'oops' printNL.
- ^ nil
- ].
-
- names at:index put:sel.
]
]
].
- "/ must now sort by index ...
^ names
].
- aMessage printNL.
- 'args ' print. args printNL.
+ 'Structure [warning]: return nil for: ' print.
+ aMessage print.
+ ' args ' print. args printCR.
^ nil.
@@ -1296,9 +1337,9 @@
"Modified: 13.5.1996 / 21:12:54 / cg"
! !
-!Structure class methodsFor:'documentation'!
+!Structure class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Structure.st,v 1.5 1996-11-08 14:37:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Structure.st,v 1.6 1997-10-09 11:51:58 ca Exp $'
! !
Structure initialize!