hg/stx-libcomp: comparison Structure.st

equal deleted inserted replaced

-:0099dfc0e1a2
+:d05835f10cb8
 hereby transferred.
 "
 "{ Package: 'stx:libcomp' }"
 Object subclass:#Structure
-	instanceVariableNames:'superclass flags methodDictionary instSize i1 i2 i3 i4 i5 i6 i7
+instanceVariableNames:'superclass flags methodDictionary lookupFunction instSize i1 i2 i3 i4 i5 i6 i7
-		i8 i9 i10 i11 i12 i13 i14 i15 i16 i17 i18 i19 i20 i21 i22 i23 i24
+i8 i9 i10 i11 i12 i13 i14 i15 i16 i17 i18 i19 i20 i21 i22 i23 i24
-		i25 i26 i27 i28 i29 i30 i31 i32 i33 i34 i35 i36 i37 i38 i39 i40
+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'
+i41 i42 i43 i44 i45 i46 i47 i48 i49 i50'
-	classVariableNames:'OneInstance DummyClass ReadAccessMethods WriteAccessMethods
+classVariableNames:'OneInstance DummyClass ReadAccessMethods WriteAccessMethods
-		OtherMethods OtherSelectors'
+OtherMethods OtherSelectors'
-	poolDictionaries:''
+poolDictionaries:''
-	category:'Programming-Support'
+category:'Programming-Support'
 !
 !Structure class methodsFor:'documentation'!
 copyright
 retVal foo
 retVal bar
 Implementation note:
 this is a very tricky (but fully legal) implementation,
 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 ;-)
 [author:]
 Claus Gittinger
 [see also:]
 Array
 Behavior
 "
 !
 examples
 !Structure class methodsFor:'initialization'!
 initialize
 OneInstance isNil ifTrue:[
-Behavior instSize ~~ 4 ifTrue:[
+"/ check if the first few instvars correspond to Behavior's definition:
-self halt:'must change definition of this class'.
+(Behavior instSize + 1) == (self instanceVariableNames indexOf:#i1) ifFalse:[
+self halt:'you must change the definition of this class (instvars before i1 must match behavior''s)'.
 ].
 OneInstance := self basicNew.
 DummyClass := Behavior shallowCopy.
 DummyClass flags:(Behavior flagBehavior bitOr:Behavior flagPointers).
 DummyClass setName:#DummyClass.
 ReadAccessMethods := (1 to:50)
 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 | |m|
 m := self compiledMethodAt:('i', i printString , ':') asSymbol.
 (m notNil and:[m isLazyMethod]) ifTrue:[m makeRealMethod].
 m
 ].
 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:#perform:);
 add:(Object compiledMethodAt:#perform:with:);
 add:(Object compiledMethodAt:#isBoolean).
 OtherMethods := OtherMethods asArray.
 OtherSelectors := #(#doesNotUnderstand:
 #class #identityHash
 #at: #at:put: #basicAt: #basicAt:put:
 #printString #printOn: #basicPrintOn:
 #addDependent: #removeDependent: #dependents #dependents:
 #perform: #perform:with:
 #isBoolean).
 ].
 sels := names collect:[:nm | nm asSymbol].
 sels := sels , (names collect:[:nm | (nm , ':') asSymbol]).
 sels := sels , OtherSelectors.
 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;
 arr := Array new:(behviorsInstSize + nInsts).
 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
 arr at:4 put:behviorsInstSize.                                      "/ instSize
 "/ now, the big trick ...
 arr changeClassTo:DummyClass.
 arr changeClassTo:arr.
 values keysAndValuesDo:[:i :val |
 arr at:i put:val
 ]
 ].
 ^ arr.
 "
 Structure newWith:#(foo bar) values:#('foo' 'bar')
 "
 with:assoc1 with:assoc2
 "return a new structure with two fields, named as defined by the arguments'
 keys, and and initialized with the assocs' values."
 ^ self newWith:(Array with:assoc1 key with:assoc2 key)
 values:(Array with:assoc1 value with:assoc2 value)
 "
 Structure with:#foo->'foo' with:#bar->'bar'
 "
 with:assoc1 with:assoc2 with:assoc3
 "return a new structure with three fields, named as defined by the arguments'
 keys, and and initialized with the assocs' values."
 ^ self newWith:(Array with:assoc1 key with:assoc2 key with:assoc3 key)
 values:(Array with:assoc1 value with:assoc2 value with:assoc3 value)
 "
 Structure with:#foo->'foo' with:#bar->'bar' with:#baz->'baz'
 "
 with:assoc1 with:assoc2 with:assoc3 with:assoc4
 "return a new structure with four fields, named as defined by the arguments'
 keys, and and initialized with the assocs' values."
 ^ self newWith:(Array with:assoc1 key with:assoc2 key
 with:assoc3 key with:assoc4 key)
 values:(Array with:assoc1 value with:assoc2 value
 with:assoc3 value with:assoc4 value)
 "
 Structure with:#foo->'foo' with:#bar->'bar' with:#baz->'baz' with:#hello->'hello'
 "
 with:assoc1 with:assoc2 with:assoc3 with:assoc4 with:assoc5
 "return a new structure with five fields, named as defined by the arguments'
 keys, and and initialized with the assocs' values."
 ^ self newWith:(Array with:assoc1 key with:assoc2 key
 with:assoc3 key with:assoc4 key
 with:assoc5 key)
 values:(Array with:assoc1 value with:assoc2 value
 with:assoc3 value with:assoc4 value
 with:assoc5 value)
 "
 Structure with:#foo->'foo' with:#bar->'bar' with:#baz->'baz' with:#hello->'hello' with:#world->'world'
 "
 with:assoc1 with:assoc2 with:assoc3 with:assoc4 with:assoc5 with:assoc6
 "return a new structure with five fields, named as defined by the arguments'
 keys, and and initialized with the assocs' values."
 ^ self newWith:(Array with:assoc1 key with:assoc2 key
 with:assoc3 key with:assoc4 key
 with:assoc5 key with:assoc6 key)
 values:(Array with:assoc1 value with:assoc2 value
 with:assoc3 value with:assoc4 value
 with:assoc5 value with:assoc6 value)
 "
 Structure with:#foo->'foo' with:#bar->'bar' with:#baz->'baz' with:#hello->'hello' with:#world->'world'
 "
 with:assoc1 with:assoc2 with:assoc3 with:assoc4 with:assoc5 with:assoc6 with:assoc7
 "return a new structure with five fields, named as defined by the arguments'
 keys, and and initialized with the assocs' values."
 ^ self newWith:(Array with:assoc1 key with:assoc2 key
 with:assoc3 key with:assoc4 key
 with:assoc5 key with:assoc6 key
 with:assoc7 key)
 values:(Array with:assoc1 value with:assoc2 value
 with:assoc3 value with:assoc4 value
 with:assoc5 value with:assoc6 value
 with:assoc7 value)
 "
 Structure with:#foo->'foo' with:#bar->'bar' with:#baz->'baz' with:#hello->'hello' with:#world->'world'
 idx := idx + 1.
 ].
 ]
 ]
 ].
 ^ names
 ].
 (sel == #instSize) ifTrue:[
 ^ instSize
 ! !
 !Structure class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libcomp/Structure.st,v 1.23 2009-10-08 14:01:57 mb Exp $'
+^ '$Header: /cvs/stx/stx/libcomp/Structure.st,v 1.24 2010-04-07 14:53:33 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libcomp/Structure.st,v 1.23 2009-10-08 14:01:57 mb Exp $'
+^ '$Header: /cvs/stx/stx/libcomp/Structure.st,v 1.24 2010-04-07 14:53:33 cg Exp $'
 ! !
 Structure initialize!

changeset 2341	d05835f10cb8
parent 2215	8ae61b93c7eb
child 2351	4371af1faf81