"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 2009 by eXept Software AG

              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:libbasic' }"

"{ NameSpace: Smalltalk }"

Object subclass:#InlineObject

	instanceVariableNames:''

	classVariableNames:'MapOfImmutableClasses MapOfMutableClasses'

	poolDictionaries:''

	category:'Kernel-Classes'

!

ClassDescription subclass:#InlineObjectClassDescription

	instanceVariableNames:'name'

	classVariableNames:''

	poolDictionaries:''

	privateIn:InlineObject

!

InlineObject subclass:#InlineObjectPrototype

	instanceVariableNames:'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

		i51 i52 i53 i54 i55 i56 i57 i58 i59 i60 i61 i62 i63 i64 i65 i66

		i67 i68 i69 i70 i71 i72 i73 i74 i75 i76 i77 i78 i79 i80 i81 i82

		i83 i84 i85 i86 i87 i88 i89 i90 i91 i92 i93 i94 i95 i96 i97 i98

		i99 i100'

	classVariableNames:''

	poolDictionaries:''

	privateIn:InlineObject

!

!InlineObject class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2009 by eXept Software AG

              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

"

    WARNING: InlineObjects are an experimental feature.

    InlineObjects are written as literals of the form:

    For example:

    All inlineObjects will be instances of an anonymous subclass of me,

    and provide getter protocol for their fields (e.g. firstName, lastName and age in the above example.

"

! !

!InlineObject class methodsFor:'instance creation'!

slotNames:names values:slotValues

    "return a new inline object given slot names and slot values"

    ^ self slotNames:names values:slotValues mutable:true

    "

     InlineObject slotNames:#('foo' 'bar' 'baz') values:#(1 2 3)

     InlineObject slotNames:#('foo' 'bar' 'baz') values:#(1 2 3) mutable:false

    "

    "Created: / 21-01-2019 / 13:10:14 / Claus Gittinger"

    "Modified (comment): / 25-06-2019 / 16:43:03 / Claus Gittinger"

!

slotNames:names values:slotValues mutable:mutable

    "return a new inline object given slot names and slot values"

    |subclass inst|

    subclass := self classForSlotNames:names mutable:mutable.

    "/ need a new array here, because we changeClassTo:

    slotValues class == Array ifTrue:[

        inst := slotValues shallowCopy changeClassTo:subclass.                

    ] ifFalse:[

        inst := (Array withAll:slotValues) changeClassTo:subclass.                

    ].

    ^ inst

    "

     InlineObject slotNames:#('foo' 'bar' 'baz') values:#(1 2 3)

     InlineObject slotNames:#('foo' 'bar') values:#(1 2)

    "

    "Created: / 25-06-2019 / 16:40:36 / Claus Gittinger"

    "Modified: / 28-06-2019 / 14:38:32 / Claus Gittinger"

!

slotNamesAndValues:namesAndValues

    "return a new inline object given slot names and slot values as alternating elements

     in the argument, namesAndValues"

    ^ self 

        slotNames:(namesAndValues keysAndValuesSelect:[:idx :val | idx odd])

        values:(namesAndValues keysAndValuesSelect:[:idx :val | idx even])

        mutable:true

    "

     InlineObject slotNamesAndValues:#('foo' 10 'bar' 20 'baz' 30)

    "

    "Created: / 21-01-2019 / 13:15:46 / Claus Gittinger"

    "Modified: / 25-06-2019 / 16:55:02 / Claus Gittinger"

!

slotNamesAndValues:namesAndValues mutable:beMutable

    "return a new inline object given slot names and slot values as alternating elements

     in the argument, namesAndValues"

    ^ self 

        slotNames:(namesAndValues keysAndValuesSelect:[:idx :val | idx odd])

        values:(namesAndValues keysAndValuesSelect:[:idx :val | idx even])

        mutable:beMutable

    "

     InlineObject slotNamesAndValues:#('foo' 10 'bar' 20 'baz' 30)

    "

    "Created: / 25-06-2019 / 16:54:47 / Claus Gittinger"

!

slotNamesAndValuesFromDictionary:namesAndValuesDict

    "return a new inline object given slot names and slot values as elements

     in the argument, namesAndValuesDict"

    ^ self slotNamesAndValuesFromDictionary:namesAndValuesDict mutable:true

    "

     InlineObject slotNamesAndValuesFromDictionary:(Dictionary withKeyValuePairs:#(('foo' 10) ('bar' 20) ('baz' 30)))

    "

    "Created: / 25-06-2019 / 16:31:38 / Claus Gittinger"

!

slotNamesAndValuesFromDictionary:namesAndValuesDict mutable:beMutable

    "return a new inline object, given slot names and slot values as elements

     in the argument, namesAndValuesDict.

     If the dictionary is unordered, slots are created in the sorted key order"

    |sz keys values idx|

    sz := namesAndValuesDict size.

    keys := Array new:sz.

    values := Array new:sz.

    idx := 1.

    namesAndValuesDict isOrdered ifTrue:[

        namesAndValuesDict keysAndValuesDo:[:k :v |

            keys at:idx put:k.

            values at:idx put:v.

            idx := idx + 1.

        ].

    ] ifFalse:[

        namesAndValuesDict keysSorted do:[:k |

            keys at:idx put:k.

            values at:idx put:(namesAndValuesDict at:k).

            idx := idx + 1.

        ]

    ].

    ^ self slotNames:keys values:values mutable:beMutable

    "

     InlineObject 

        slotNamesAndValuesFromDictionary:(

            Dictionary withKeyValuePairs:#(('foo' 10) ('bar' 20) ('baz' 30))

        )

     InlineObject 

        slotNamesAndValuesFromDictionary:(

            OrderedDictionary withKeyValuePairs:#( ('bar' 20) ('baz' 30) ('foo' 10) )

        )

    "

    "Created: / 25-06-2019 / 16:53:50 / Claus Gittinger"

! !

!InlineObject class methodsFor:'flushing'!

flushMapOfClasses

    MapOfMutableClasses := MapOfImmutableClasses := nil

    "Created: / 22-01-2019 / 17:02:59 / Claus Gittinger"

    "Modified: / 25-06-2019 / 16:43:23 / Claus Gittinger"

! !

!InlineObject class methodsFor:'prototype access'!

prototype

    ^ InlineObjectPrototype

! !

!InlineObject class methodsFor:'queries'!

classForSlotNames:slotNames mutable:mutable

    "return either an existing or a new class to represent

     an inline object given its slot names"

    |map class|

    mutable ifTrue:[

        (map := MapOfMutableClasses) isNil ifTrue:[

            map := MapOfMutableClasses := Dictionary new.

        ]

    ] ifFalse:[

        (map := MapOfImmutableClasses) isNil ifTrue:[

            map := MapOfImmutableClasses := Dictionary new.

        ]

    ].    

    (class := map at:slotNames ifAbsent:nil) isNil ifTrue:[

        Class withoutUpdatingChangesDo:[

            |protoClass numProtoAccessMethods|

            false ifTrue:[

                "/ OLD:

                class := self 

                                subclass:#AnonymousInlineObject

                                instanceVariableNames:slotNames

                                classVariableNames:nil

                                poolDictionaries:nil

                                category:nil

                                inEnvironment:nil.

                slotNames do:[:each |

                    class compile:('%1 ^ %1' bindWith:each)

                           categorized:'accessing'.

                    mutable ifTrue:[

                        class compile:('%1:arg %1 := arg.' bindWith:each)

                              categorized:'accessing'.

                    ].

                ].

            ] ifFalse:[

                "/ NEW:

                class := InlineObjectClassDescription new.

                class setSuperclass: InlineObject.

                class setInstVarNames:slotNames.

                class instSize: slotNames size.

                protoClass := InlineObjectPrototype.

                numProtoAccessMethods := protoClass instSize.

                slotNames keysAndValuesDo:[:idx :instVarName |

                    |protoMethod|

                    idx <= numProtoAccessMethods ifTrue:[

                        protoMethod := protoClass compiledMethodAt:('i%1' bindWith:idx) asSymbol.

                        class basicAddSelector:instVarName asSymbol withMethod:protoMethod.

                        "/ fixup: undo side effect of adding selector (mclass changed)

                        protoMethod mclass:protoClass.

                        mutable ifTrue:[

                            protoMethod := protoClass compiledMethodAt:('i%1:' bindWith:idx) asSymbol.

                            class basicAddSelector:(instVarName asMutator) withMethod:protoMethod.

                            "/ fixup: undo side effect of adding selector (mclass changed)

                            protoMethod mclass:protoClass.

                        ].

                    ] ifFalse:[

                        Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class.

                        mutable ifTrue:[

                            Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class.

                        ].

                    ].

                ].

            ].

            map at:slotNames put:class.

        ].

    ].

    ^ class

    "

     |cls1 cls2|

     cls1 := self classForSlotNames:#('foo' 'bar' 'baz') mutable:false.

     cls2 := self classForSlotNames:#('foo' 'bar' 'baz') mutable:true.

     self assert:(self classForSlotNames:#('foo' 'bar' 'baz') mutable:false) == cls1.

     self assert:(self classForSlotNames:#('foo' 'bar' 'baz') mutable:true) == cls2.

    "

    "Created: / 25-06-2019 / 16:40:36 / Claus Gittinger"

    "Modified: / 28-06-2019 / 14:38:32 / Claus Gittinger"

!

isAbstract

    "Return if this class is an abstract class.

     True is returned here for myself only; false for subclasses.

     Abstract subclasses must redefine this again."

    ^ self == InlineObject.

! !

!InlineObject methodsFor:'comparing'!

= someObject

    "I conside someObject to be equal, if it has the same slotnames"

    |myInstSize|

    myInstSize := self class instSize.

    someObject class == self class ifFalse:[

        someObject class instSize == myInstSize ifFalse:[^ false].

        someObject isInlineObject ifTrue:[

            self class allInstVarNames keysAndValuesDo:[:i :nm |

                |mySlotValue otherSlotValue|

                mySlotValue := self instVarAt:i.

                otherSlotValue := someObject perform:nm asSymbol ifNotUnderstood:[^ false].

                mySlotValue = otherSlotValue ifFalse:[^ false].

            ].

            ^ true

        ].

        ^ false

    ].

    1 to:myInstSize do:[:i |

        ((self instVarAt:i) = (someObject instVarAt:i)) ifFalse:[^ false].  

    ].

    ^ true.

   "

    |o1 o2 o3|

    o1 := #{ foo: 1 . bar: 2 }.

    o2 := #{ foo: 1 . bar: 2 }.

    self assert:(o1 = o2).       

    self assert:(o1 == o2) not.    

    o3 := #{ bar: 2 . foo: 1 }.

    self assert:(o1 = o3).       

    self assert:(o2 = o3).       

   "

!

hash

    "I redefine =; so I also have to redefine hash"

    |h myInstSize|

    myInstSize := self class instSize.

    h := 0.

    1 to:myInstSize do:[:i |

        h := h bitXor:((self instVarAt:i) hash) 

    ].

    ^ h.

   "

    |o1 o2 o3|

    o1 := #{ foo: 1 . bar: 2 }.

    o2 := #{ foo: 1 . bar: 2 }.

    self assert:(o1 = o2).       

    self assert:(o1 hash = o2 hash).       

    self assert:(o1 == o2) not.    

    o3 := #{ bar: 2 . foo: 1 }.

    self assert:(o1 = o3).       

    self assert:(o1 hash = o3 hash).       

   "

!

isInlineObject

    ^ true

! !

!InlineObject methodsFor:'printing & storing'!

displayOn:aStream

    aStream nextPutAll:self classNameWithArticle.

    aStream nextPutAll:' '.

    self storeOn:aStream.

   "

    #{ foo: 1 . bar: 2 } displayString

   "

!

storeOn:aStream

    aStream nextPutAll:'#{'.

    self class allInstVarNames keysAndValuesDo:[:i :nm |

        i ~~ 1 ifTrue:[

            aStream nextPutAll:' . '.

        ].

        aStream nextPutAll:nm; nextPutAll:':'.

        (self instVarAt:i) storeOn:aStream.

    ].

    aStream nextPutAll:'}'.

   "

    #{ foo: 1 . bar: 2 } storeString                    

    Object readFrom:( #{ foo: 1 . bar: 2 } storeString)   

   "

! !

!InlineObject::InlineObjectClassDescription class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2009 by eXept Software AG

              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

"

    inline objects are an experimental feature in ST/X

    (and currently not used by the system).

    Inline literal objects are created by the parsers/compilers with the following

    syntax:

        #{

            <slotName1>: value .

            <slotName2>: value .

            ...

        }

    where each value is a literal, separated by period from the next   

    i.e. similar to the brace-array construct { expr1 . expr2... }

    For every inline object, an anonymous class is created,

    providing getters and setters for the slots.

    (if literal objects are immutable (which is the default), 

     no setters are generated)

    You cannot add any semantic (i.e. methods) to inline objects -

    they are only useful as containers with a nicer protocol

    as compared to dictionaries or arrays.

    All such created classes will be subclasses of me.

    [example:]

        |foo|

        foo := #{ 

                 foo: 'foo value' .

                 bar: 'bar value' .

                 baz: 'and obviously: a baz value' .

                }.

        foo bar.

        foo baz.

        foo inspect.