"

 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.

"

"{ Package: 'stx:libcomp' }"

Object subclass:#Structure

!

!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

"

    This is an experimental class, stressing the metaObject capabilities.

    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.

    (However, we recommend using private classes, since they are easier

     to understand and maintain).

    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 foo instvar value

        retVal at:2     -> returns the bar instvar value

    or (much more convenient and readable) as:

        retVal foo

        retVal bar

    Implementation note:

        this is a very tricky (but fully legal) implementation,

        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

    [see also:]

        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).

        DummyClass setName:#DummyClass.

                                collect:[:i | |m|

                                            m := self compiledMethodAt:('i', i printString) asSymbol.

                                            (m notNil and:[m isLazyMethod]) ifTrue:[m makeRealMethod].

                                            m

                                ].

                                collect:[:i | |m|

                                            m := self compiledMethodAt:('i', i printString , ':') asSymbol.

                                            (m notNil and:[m isLazyMethod]) ifTrue:[m makeRealMethod].

                                            m

                                ].

        OtherMethods := OrderedCollection new.

            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:#basicPrintOn:);

            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:);

            add:(Object compiledMethodAt:#isBoolean).

        OtherMethods := OtherMethods asArray.

                            #class #identityHash

                            #printString #printOn: #basicPrintOn:

                            #addDependent: #removeDependent: #dependents #dependents:

                            #perform: #perform:with:

                            #isBoolean).

    ].

    "

     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."

    |arr sels mthds nInsts behviorsInstSize|

    nInsts := names size.

    sels := names collect:[:nm | nm asSymbol].

    sels := sels , (names collect:[:nm | (nm , ':') asSymbol]).

    sels := sels , OtherSelectors.

    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 behviorsInstSize instVars must correspond to Behavior instvars,

    "/ the remaining ones will be the indexed instvars.

    behviorsInstSize := Behavior instSize.

    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

    "/ now, the big trick ...

    arr changeClassTo:DummyClass.

    arr changeClassTo:arr.

    values notNil ifTrue:[

        values keysAndValuesDo:[:i :val |

            arr at:i put:val

        ]

    ].

    "

     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."

             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."

             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."

                           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."

                           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."

                           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."

                           with:assoc5 key with:assoc6 key

                           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'

    "

! !

!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

    "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

    "prototype method to return the first instance variable"

    ^ i1

    "Created: 13.5.1996 / 21:19:25 / cg"

!

i10

    "prototype method to return the 10th instance variable"

    ^ i10

    "Created: 13.5.1996 / 21:19:27 / cg"

!

i10:something

    "prototype method to set the 10th instance variable"

    i10 := something.

    "Created: 13.5.1996 / 21:19:27 / cg"

!

i11

    "return i11"

    ^ i11

    "Created: 13.5.1996 / 21:19:27 / cg"

!

i11:something

    "prototype method to set the 11th instance variable"

    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