"{ 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:
#{
fieldName1: value1.
fieldName2: value2.
...
fieldNameN: valueN.
}
For example:
#{
firstName: 'Peter'.
lastName: 'Miller'.
age: 25.
}
The above was an inline literal: all field values must be again literals.
WARNING: the following is currently ONLY experimental,
and may or may not be supported by stc.
Do not use non-literal inline objects at the moment.
However, similar to brace-Arrays, inline objects can also be dynamically created (constructed):
{
date: Date today.
time: Time now.
}
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.
Literal InlineObjects are immutable (no setters), whereas constructed are not.
|foo|
foo := { date: Date today. time: Time now }.
foo date:(Date yesterday).
foo
"
! !
!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.
"
!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !
!InlineObject::InlineObjectClassDescription methodsFor:'accessing'!
setName:newName
"because classes are shared, multiple uses may try to use different names.
I am anonymous anyway, so the name is only kept for the user's convenience
(i.e. to provide a nicer printString)
Only remember the very first one.
(maybe we should concatenate names instead)."
name isNil ifTrue:[
name := newName
] ifFalse:[
name = newName ifFalse:[
name := name,'/',newName
].
].
"
|o1 o2|
o1 := InlineObject slotNames:#('foo' 'bar' 'baz' 'bla') values:#(1 2 3 4).
o1 class setName:'myFoo'.
o2 := InlineObject slotNames:#('foo' 'bar' 'baz' 'bla') values:#(1 2 3 4).
o2 class setName:'myFoo2'.
o1 inspect.
o2 inspect.
"
"Created: / 25-06-2019 / 16:40:36 / Claus Gittinger"
"Modified: / 28-06-2019 / 14:38:32 / Claus Gittinger"
! !
!InlineObject::InlineObjectClassDescription methodsFor:'instance creation'!
values:slotValues
"return a new inline object instance of myself,
given slot values (must be in my inst-slot order).
I must be the class of an existing concrete inline object,
not the (abstract) InlineObject class itself."
^ (slotValues copyAs:Array) changeClassTo:self
"
|proto protoClass|
proto := InlineObject slotNames:#('foo' 'bar' 'baz') values:#(1 2 3).
protoClass := proto class.
protoClass setName:'Foo'.
(protoClass values:#( 10 20 30 )) inspect.
"
! !
!InlineObject::InlineObjectClassDescription methodsFor:'queries'!
name
"although inline objects usually have no name, we return something
useful here - there are many places (inspectors) where
a classes name is asked for."
^ name ? #'InlineObject'
!
nameSpace
^ nil
"Created: / 13-08-2010 / 18:23:33 / cg"
!
package
"return libbasic, so the methods of my subclass-instances (i.e. the inline objects)
are not seen as extensions in the browser)"
^ InlineObject package
! !
!InlineObject::InlineObjectPrototype 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
"
All getter/setter methods of all inline objects are actually shared code,
which is acquired from this prototypeInlineObject class.
"
!
version
^ '$Header$'
! !
!InlineObject::InlineObjectPrototype methodsFor:'accessing'!
i1
^ i1
"Created: / 20-01-2019 / 14:49:52 / Claus Gittinger"
!
i10
^ i10
!
i100
^ i100
!
i100:something
i100 := something.
!
i10:something
i10 := something.
!
i11
^ i11
!
i11:something
i11 := something.
!
i12
^ i12
!
i12:something
i12 := something.
!
i13
^ i13
!
i13:something
i13 := something.
!
i14
^ i14
!
i14:something
i14 := something.
!
i15
^ i15
!
i15:something
i15 := something.
!
i16
^ i16
!
i16:something
i16 := something.
!
i17
^ i17
!
i17:something
i17 := something.
!
i18
^ i18
!
i18:something
i18 := something.
!
i19
^ i19
!
i19:something
i19 := something.
!
i1:something
i1 := something.
"Created: / 20-01-2019 / 14:49:52 / Claus Gittinger"
!
i2
^ i2
"Created: / 20-01-2019 / 14:49:52 / Claus Gittinger"
!
i20
^ i20
!
i20:something
i20 := something.
!
i21
^ i21
!
i21:something
i21 := something.
!
i22
^ i22
!
i22:something
i22 := something.
!
i23
^ i23
!
i23:something
i23 := something.
!
i24
^ i24
!
i24:something
i24 := something.
!
i25
^ i25
!
i25:something
i25 := something.
!
i26
^ i26
!
i26:something
i26 := something.
!
i27
^ i27
!
i27:something
i27 := something.
!
i28
^ i28
!
i28:something
i28 := something.
!
i29
^ i29
!
i29:something
i29 := something.
!
i2:something
i2 := something.
"Created: / 20-01-2019 / 14:49:52 / Claus Gittinger"
!
i3
^ i3
"Created: / 20-01-2019 / 14:49:52 / Claus Gittinger"
!
i30
^ i30
!
i30:something
i30 := something.
!
i31
^ i31
!
i31:something
i31 := something.
!
i32
^ i32
!
i32:something
i32 := something.
!
i33
^ i33
!
i33:something
i33 := something.
!
i34
^ i34
!
i34:something
i34 := something.
!
i35
^ i35
!
i35:something
i35 := something.
!
i36
^ i36
!
i36:something
i36 := something.
!
i37
^ i37
!
i37:something
i37 := something.
!
i38
^ i38
!
i38:something
i38 := something.
!
i39
^ i39
!
i39:something
i39 := something.
!
i3:something
i3 := something.
"Created: / 20-01-2019 / 14:49:52 / Claus Gittinger"
!
i4
^ i4
!
i40
^ i40
!
i40:something
i40 := something.
!
i41
^ i41
!
i41:something
i41 := something.
!
i42
^ i42
!
i42:something
i42 := something.
!
i43
^ i43
!
i43:something
i43 := something.
!
i44
^ i44
!
i44:something
i44 := something.
!
i45
^ i45
!
i45:something
i45 := something.
!
i46
^ i46
!
i46:something
i46 := something.
!
i47
^ i47
!
i47:something
i47 := something.
!
i48
^ i48
!
i48:something
i48 := something.
!
i49
^ i49
!
i49:something
i49 := something.
!
i4:something
i4 := something.
!
i5
^ i5
!
i50
^ i50
!
i50:something
i50 := something.
!
i51
^ i51
!
i51:something
i51 := something.
!
i52
^ i52
!
i52:something
i52 := something.
!
i53
^ i53
!
i53:something
i53 := something.
!
i54
^ i54
!
i54:something
i54 := something.
!
i55
^ i55
!
i55:something
i55 := something.
!
i56
^ i56
!
i56:something
i56 := something.
!
i57
^ i57
!
i57:something
i57 := something.
!
i58
^ i58
!
i58:something
i58 := something.
!
i59
^ i59
!
i59:something
i59 := something.
!
i5:something
i5 := something.
!
i6
^ i6
!
i60
^ i60
!
i60:something
i60 := something.
!
i61
^ i61
!
i61:something
i61 := something.
!
i62
^ i62
!
i62:something
i62 := something.
!
i63
^ i63
!
i63:something
i63 := something.
!
i64
^ i64
!
i64:something
i64 := something.
!
i65
^ i65
!
i65:something
i65 := something.
!
i66
^ i66
!
i66:something
i66 := something.
!
i67
^ i67
!
i67:something
i67 := something.
!
i68
^ i68
!
i68:something
i68 := something.
!
i69
^ i69
!
i69:something
i69 := something.
!
i6:something
i6 := something.
!
i7
^ i7
!
i70
^ i70
!
i70:something
i70 := something.
!
i71
^ i71
!
i71:something
i71 := something.
!
i72
^ i72
!
i72:something
i72 := something.
!
i73
^ i73
!
i73:something
i73 := something.
!
i74
^ i74
!
i74:something
i74 := something.
!
i75
^ i75
!
i75:something
i75 := something.
!
i76
^ i76
!
i76:something
i76 := something.
!
i77
^ i77
!
i77:something
i77 := something.
!
i78
^ i78
!
i78:something
i78 := something.
!
i79
^ i79
!
i79:something
i79 := something.
!
i7:something
i7 := something.
!
i8
^ i8
!
i80
^ i80
!
i80:something
i80 := something.
!
i81
^ i81
!
i81:something
i81 := something.
!
i82
^ i82
!
i82:something
i82 := something.
!
i83
^ i83
!
i83:something
i83 := something.
!
i84
^ i84
!
i84:something
i84 := something.
!
i85
^ i85
!
i85:something
i85 := something.
!
i86
^ i86
!
i86:something
i86 := something.
!
i87
^ i87
!
i87:something
i87 := something.
!
i88
^ i88
!
i88:something
i88 := something.
!
i89
^ i89
!
i89:something
i89 := something.
!
i8:something
i8 := something.
!
i9
^ i9
!
i90
^ i90
!
i90:something
i90 := something.
!
i91
^ i91
!
i91:something
i91 := something.
!
i92
^ i92
!
i92:something
i92 := something.
!
i93
^ i93
!
i93:something
i93 := something.
!
i94
^ i94
!
i94:something
i94 := something.
!
i95
^ i95
!
i95:something
i95 := something.
!
i96
^ i96
!
i96:something
i96 := something.
!
i97
^ i97
!
i97:something
i97 := something.
!
i98
^ i98
!
i98:something
i98 := something.
!
i99
^ i99
!
i99:something
i99 := something.
!
i9:something
i9 := something.
! !
!InlineObject class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !