"
COPYRIGHT (c) 1996 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
Object subclass:#Structure
instanceVariableNames:'superclass flags methodDictionary otherSupers 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 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'
poolDictionaries:''
category:'Programming-Support'
!
!Structure class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1996 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
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)
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
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
and access these values either as:
retVal at:1 -> returns the cls
retVal at:2 -> returns the selector
or (much more convenient and readable) as:
retVal containingClass
retVal selector
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.
Another prove that smalltalk is a powerful & flexible programming language.
However, some smalltalk systems crash if your try this ;-)
CAVEAT:
a maximum of 50 instance variables is allowed.
[author:]
Claus Gittinger
[see also:]
Array
Behavior
"
!
examples
"
access is possibly by name:
[exBegin]
Transcript showCR:
(Structure with:#foo->'foo value') foo
[exEnd]
AND also by index (for backward compatibility):
[exBegin]
Transcript showCR:
((Structure with:#foo->'foo value') at:1)
[exEnd]
it can be inspected:
[exBegin]
(Structure with:#foo->'foo value') inspect
[exEnd]
and presents its contents nicely:
[exBegin]
(Structure with:#foo->'foo value' with:#bar->'bar value') inspect
[exEnd]
[exBegin]
(Structure with:#foo->'hello' with:#bar->true with:#baz->'world') inspect
[exEnd]
"
! !
!Structure class methodsFor:'initialization'!
initialize
OneInstance isNil ifTrue:[
OneInstance := self basicNew.
DummyClass := Behavior shallowCopy.
DummyClass flags:(Behavior flagBehavior bitOr:Behavior flagPointers).
ReadAccessMethods := (1 to:50)
collect:[:i |
(self compiledMethodAt:('i', i printString) asSymbol)
].
WriteAccessMethods := (1 to:50)
collect:[:i |
(self compiledMethodAt:('i', i printString,':') asSymbol)
].
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:).
].
"
OneInstance := nil.
self initialize.
"
"Modified: 21.9.1996 / 16:01:48 / cg"
! !
!Structure class methodsFor:'instance creation'!
newWith:names
"return a new structure containing fields as passed in the names collection.
The argument must be a sequenceable collection of symbols.
The new structures values are all initialized to nil."
^ self newWith:names values:nil
"
Structure newWith:#(foo bar)
"
"Created: 13.5.1996 / 20:03:42 / cg"
!
newWith:names values:values
"return a new structure containing fields as passed in the names collection.
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|
sels := names collect:[:nm | nm asSymbol].
sels := sels , (names collect:[:nm | (nm , ':') asSymbol]).
sels := sels , #(#doesNotUnderstand: #class #at: #at:put: #basicAt: #basicAt:put:).
mthds := ReadAccessMethods copyTo:names size.
mthds := mthds , (WriteAccessMethods copyTo:names size).
mthds := mthds , OtherMethods.
"/ create a prototype object as an array ...
arr := Array new:(names size + 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
arr at:4 put:nil. "/ other supers
arr at:5 put:5. "/ instSize
"/ now, the big trick ...
arr changeClassTo:DummyClass.
arr changeClassTo:arr.
values notNil ifTrue:[
values keysAndValuesDo:[:i :val |
arr at:i put:val
]
].
^ arr.
"
Structure newWith:#(foo bar) values:#('foo' 'bar')
"
"Created: 13.5.1996 / 20:03:42 / cg"
"Modified: 3.7.1996 / 10:24:43 / cg"
!
with:assoc
"return a new structure with a single field, named to the assocs key,
and initialized with assocs value."
^ self newWith:(Array with:assoc key) values:(Array with:assoc value)
"
Structure with:#foo->'foo'
"
!
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'
"
! !
!Structure methodsFor:'accessing'!
flags
"return the flags - required class protocol"
^ flags
"Created: 13.5.1996 / 21:19:23 / cg"
!
flags:something
"set the flags - required class protocol"
flags := something.
"Created: 13.5.1996 / 21:19:23 / cg"
!
i1
"return the first instance variable"
^ i1
"Created: 13.5.1996 / 21:19:25 / cg"
!
i10
"return i10"
^ i10
"Created: 13.5.1996 / 21:19:27 / cg"
!
i10:something
"set i10"
i10 := something.
"Created: 13.5.1996 / 21:19:27 / cg"
!
i11
"return i11"
^ i11
"Created: 13.5.1996 / 21:19:27 / cg"
!
i11:something
"set i11"
i11 := something.
"Created: 13.5.1996 / 21:19:27 / cg"
!
i12
"return i12"
^ i12
"Created: 13.5.1996 / 21:19:27 / cg"
!
i12:something
"set i12"
i12 := something.
"Created: 13.5.1996 / 21:19:27 / cg"
!
i13
"return i13"
^ i13
"Created: 13.5.1996 / 21:19:28 / cg"
!
i13:something
"set i13"
i13 := something.
"Created: 13.5.1996 / 21:19:28 / cg"
!
i14
"return i14"
^ i14
"Created: 13.5.1996 / 21:19:28 / cg"
!
i14:something
"set i14"
i14 := something.
"Created: 13.5.1996 / 21:19:28 / cg"
!
i15
"return i15"
^ i15
"Created: 13.5.1996 / 21:19:28 / cg"
!
i15:something
"set i15"
i15 := something.
"Created: 13.5.1996 / 21:19:28 / cg"
!
i16
"return i16"
^ i16
"Created: 13.5.1996 / 21:19:28 / cg"
!
i16:something
"set i16"
i16 := something.
"Created: 13.5.1996 / 21:19:28 / cg"
!
i17
"return i17"
^ i17
"Created: 13.5.1996 / 21:19:28 / cg"
!
i17:something
"set i17"
i17 := something.
"Created: 13.5.1996 / 21:19:29 / cg"
!
i18
"return i18"
^ i18
"Created: 13.5.1996 / 21:19:29 / cg"
!
i18:something
"set i18"
i18 := something.
"Created: 13.5.1996 / 21:19:29 / cg"
!
i19
"return i19"
^ i19
"Created: 13.5.1996 / 21:19:29 / cg"
!
i19:something
"set i19"
i19 := something.
"Created: 13.5.1996 / 21:19:29 / cg"
!
i1:something
"set i1"
i1 := something.
"Created: 13.5.1996 / 21:19:25 / cg"
!
i2
"return i2"
^ i2
"Created: 13.5.1996 / 21:19:25 / cg"
!
i20
"return i20"
^ i20
"Created: 13.5.1996 / 21:19:29 / cg"
!
i20:something
"set i20"
i20 := something.
"Created: 13.5.1996 / 21:19:29 / cg"
!
i21
"return i21"
^ i21
"Created: 21.9.1996 / 16:06:21 / cg"
!
i21:something
"set i21"
i21 := something.
"Created: 21.9.1996 / 16:06:21 / cg"
!
i22
"return i22"
^ i22
"Created: 21.9.1996 / 16:06:21 / cg"
!
i22:something
"set i22"
i22 := something.
"Created: 21.9.1996 / 16:06:21 / cg"
!
i23
"return i23"
^ i23
"Created: 21.9.1996 / 16:06:21 / cg"
!
i23:something
"set i23"
i23 := something.
"Created: 21.9.1996 / 16:06:21 / cg"
!
i24
"return i24"
^ i24
"Created: 21.9.1996 / 16:06:21 / cg"
!
i24:something
"set i24"
i24 := something.
"Created: 21.9.1996 / 16:06:21 / cg"
!
i25
"return i25"
^ i25
"Created: 21.9.1996 / 16:06:21 / cg"
!
i25:something
"set i25"
i25 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i26
"return i26"
^ i26
"Created: 21.9.1996 / 16:06:22 / cg"
!
i26:something
"set i26"
i26 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i27
"return i27"
^ i27
"Created: 21.9.1996 / 16:06:22 / cg"
!
i27:something
"set i27"
i27 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i28
"return i28"
^ i28
"Created: 21.9.1996 / 16:06:22 / cg"
!
i28:something
"set i28"
i28 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i29
"return i29"
^ i29
"Created: 21.9.1996 / 16:06:22 / cg"
!
i29:something
"set i29"
i29 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i2:something
"set i2"
i2 := something.
"Created: 13.5.1996 / 21:19:25 / cg"
!
i3
"return i3"
^ i3
"Created: 13.5.1996 / 21:19:25 / cg"
!
i30:something
"set i30"
i30 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i31
"return i31"
^ i31
"Created: 21.9.1996 / 16:06:22 / cg"
!
i31:something
"set i31"
i31 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i32
"return i32"
^ i32
"Created: 21.9.1996 / 16:06:22 / cg"
!
i32:something
"set i32"
i32 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i33
"return i33"
^ i33
"Created: 21.9.1996 / 16:06:22 / cg"
!
i33:something
"set i33"
i33 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i34
"return i34"
^ i34
"Created: 21.9.1996 / 16:06:22 / cg"
!
i34:something
"set i34"
i34 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i35
"return i35"
^ i35
"Created: 21.9.1996 / 16:06:22 / cg"
!
i35:something
"set i35"
i35 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i36
"return i36"
^ i36
"Created: 21.9.1996 / 16:06:22 / cg"
!
i36:something
"set i36"
i36 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i37
"return i37"
^ i37
"Created: 21.9.1996 / 16:06:22 / cg"
!
i37:something
"set i37"
i37 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i38
"return i38"
^ i38
"Created: 21.9.1996 / 16:06:22 / cg"
!
i38:something
"set i38"
i38 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i39
"return i39"
^ i39
"Created: 21.9.1996 / 16:06:22 / cg"
!
i39:something
"set i39"
i39 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i3:something
"set i3"
i3 := something.
"Created: 13.5.1996 / 21:19:25 / cg"
!
i4
"return i4"
^ i4
"Created: 13.5.1996 / 21:19:25 / cg"
!
i40:something
"set i40"
i40 := something.
"Created: 21.9.1996 / 16:06:22 / cg"
!
i41
"return i41"
^ i41
"Created: 21.9.1996 / 16:06:23 / cg"
!
i41:something
"set i41"
i41 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i42
"return i42"
^ i42
"Created: 21.9.1996 / 16:06:23 / cg"
!
i42:something
"set i42"
i42 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i43
"return i43"
^ i43
"Created: 21.9.1996 / 16:06:23 / cg"
!
i43:something
"set i43"
i43 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i44
"return i44"
^ i44
"Created: 21.9.1996 / 16:06:23 / cg"
!
i44:something
"set i44"
i44 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i45
"return i45"
^ i45
"Created: 21.9.1996 / 16:06:23 / cg"
!
i45:something
"set i45"
i45 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i46
"return i46"
^ i46
"Created: 21.9.1996 / 16:06:23 / cg"
!
i46:something
"set i46"
i46 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i47
"return i47"
^ i47
"Created: 21.9.1996 / 16:06:23 / cg"
!
i47:something
"set i47"
i47 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i48
"return i48"
^ i48
"Created: 21.9.1996 / 16:06:23 / cg"
!
i48:something
"set i48"
i48 := something.
"Created: 21.9.1996 / 16:06:23 / cg"
!
i49
"return i49"
^ i49
"Created: 21.9.1996 / 16:06:23 / cg"
!
i49:something
"set i49"
i49 := something.
"Created: 21.9.1996 / 16:06:24 / cg"
!
i4:something
"set i4"
i4 := something.
"Created: 13.5.1996 / 21:19:25 / cg"
!
i5
"return i5"
^ i5
"Created: 13.5.1996 / 21:19:26 / cg"
!
i50
"return i50"
^ i50
"Created: 21.9.1996 / 16:06:24 / cg"
!
i50:something
"set i50"
i50 := something.
"Created: 21.9.1996 / 16:06:24 / cg"
!
i5:something
"set i5"
i5 := something.
"Created: 13.5.1996 / 21:19:26 / cg"
!
i6
"return i6"
^ i6
"Created: 13.5.1996 / 21:19:26 / cg"
!
i6:something
"set i6"
i6 := something.
"Created: 13.5.1996 / 21:19:26 / cg"
!
i7
"return i7"
^ i7
"Created: 13.5.1996 / 21:19:26 / cg"
!
i7:something
"set i7"
i7 := something.
"Created: 13.5.1996 / 21:19:26 / cg"
!
i8
"return i8"
^ i8
"Created: 13.5.1996 / 21:19:26 / cg"
!
i8:something
"set i8"
i8 := something.
"Created: 13.5.1996 / 21:19:26 / cg"
!
i9
"return i9"
^ i9
"Created: 13.5.1996 / 21:19:26 / cg"
!
i9:something
"set i9"
i9 := something.
"Created: 13.5.1996 / 21:19:27 / cg"
!
instSize
"return instSize - required class protocol"
^ instSize
"Created: 13.5.1996 / 21:19:24 / cg"
!
instSize:something
"set instSize - required class protocol"
instSize := something.
"Created: 13.5.1996 / 21:19:25 / cg"
!
methodDictionary
"return the methodDictionary - required class protocol"
^ methodDictionary
!
otherSupers
"return otherSupers"
^ otherSupers
"Created: 13.5.1996 / 21:19:24 / cg"
!
otherSupers:something
"set otherSupers"
otherSupers := something.
"Created: 13.5.1996 / 21:19:24 / cg"
!
superclass
"return superclass - required class protocol"
^ superclass
"Created: 13.5.1996 / 21:19:23 / cg"
!
superclass:something
"set superclass - required class protocol"
superclass := something.
"Created: 13.5.1996 / 21:19:23 / cg"
! !
!Structure methodsFor:'stubs'!
doesNotUnderstand:aMessage
"catch unimplemented messages - pass some to the superclass.
Notice that although this method calls super messages,
actual instances will have no valid superClass."
|sel args names sz s|
"/ instance protocol
sel := aMessage selector.
args := aMessage arguments.
sel == #displayString ifTrue:[
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
].
s nextPutAll:')'.
^ s contents
].
sel == #printString ifTrue:[
^ super printString
].
sel == #printOn: ifTrue:[
^ super printOn:(args at:1)
].
sel == #basicInspect ifTrue:[
^ InspectorView openOn:self
].
sel == #inspect ifTrue:[
^ InspectorView openOn:self
].
sel == #instVarAt: ifTrue:[
|nr|
nr := args at:1.
nr == 1 ifTrue:[^ i1].
nr == 2 ifTrue:[^ i2].
nr == 3 ifTrue:[^ i3].
nr == 4 ifTrue:[^ i4].
nr == 5 ifTrue:[^ i5].
nr == 6 ifTrue:[^ i6].
^ nil
].
(sel == #size
or:[sel == #basicSize]) ifTrue:[
^ super basicSize
].
(sel == #at:
or:[sel == #basicAt:]) ifTrue:[
^ super basicAt:(args at:1)
].
(sel == #at:put:
or:[sel == #basicAt:put:]) ifTrue:[
^ super basicAt:(args at:1) put:(args at:2)
].
sel == #== ifTrue:[
^ self == (args at:1)
].
"/ class protocol
(sel := aMessage selector) == #name ifTrue:[
^ 'Structure'
].
sel == #instSize ifTrue:[
^ instSize
].
sel == #isVariable ifTrue:[
^ false
].
sel == #isClass ifTrue:[
^ false
].
sel == #isMeta ifTrue:[
^ false
].
sel == #isBehavior ifTrue:[
^ false
].
sel == #respondsTo: ifTrue:[
(args at:1) printNL.
^ false
].
sel == #evaluatorClass ifTrue:[
^ Compiler
].
sel == #classNameWithArticle ifTrue:[
^ self displayString
].
sel == #allSubclasses ifTrue:[
^ #()
].
sel == #allClassVarNames ifTrue:[
^ #()
].
sel == #allInstVarNames ifTrue:[
sz := super basicSize.
names := Array new:sz.
methodDictionary copy keysAndValuesDo:[:sel :mthd|
|index|
(sel endsWith:$:) ifFalse:[
(sel ~~ #class) ifTrue:[
"/
"/ which method is it ?
"/
1 to:20 do:[:i |
|mysel|
mysel := ('i' , i printString) asSymbol.
mthd == (Structure compiledMethodAt:mysel) ifTrue:[
index := i
]
].
index isNil ifTrue:[
'oops' printNL.
^ nil
].
names at:index put:sel.
]
]
].
"/ must now sort by index ...
^ names
].
aMessage printNL.
'args ' print. args printNL.
^ nil.
"Created: 13.5.1996 / 20:22:22 / cg"
"Modified: 13.5.1996 / 21:12:54 / cg"
! !
!Structure class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/Structure.st,v 1.5 1996-11-08 14:37:23 cg Exp $'
! !
Structure initialize!