diff -r 34672ab134f7 -r b5c07da2df11 Structure.st --- 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!