requires: {#Magnitude}.
provides: {#LookupKey. #Association. #Mapping. #MapComposition. #SingleValueMap}.

collections addSlot: #LookupKey valued: Magnitude derive.
LookupKey addSlot: #key.

x@(LookupKey traits) < y@(LookupKey traits)
[
  x key < y key
].

x@(LookupKey traits) = y@(LookupKey traits)
[
  x key = y key
].

x@(LookupKey traits) hash
[
  x key hash
].

collections addSlot: #Association valued: LookupKey derive.
Association addSlot: #value.

x@(Root traits) -> y
[
  Association clone key: x value: y
].

x@(Association traits) key: key value: obj
[
  x key: key.
  x value: obj.
  x
].

prototypes addDelegate: #mappings valued: Namespace clone.

mappings addSlot: #Mapping valued: Cloneable derive.
"Mappings provide the abstract protocols for all collections that provide
keyed storage, e.g. #at: and #at:put:."

_@(Mapping traits) acceptsKey: _@Nil
"This method is defined whenever indices are explicit in the mapping's
interface, and meaningless otherwise."
[
  False
].

_@(Mapping traits) acceptsKey: _@(Root traits)
[
  True
].

m@(Mapping traits) accepts: assoc
"This tests what add: will accept or not accept, as opposed to values or keys
arbitrarily."
[
  d acceptsKey: assoc key
].

m@(Mapping traits) at: key ifAbsent: block
[
  overrideThis
].

m@(Mapping traits) at: key
[
  m at: key ifAbsent: [error: 'Key not found']
].

m@(Mapping traits) at: key ifAbsentPut: block
[
  m at: key ifAbsent: [m at: key put: block value]
].

m@(Mapping traits) at: key ifPresent: block
[
  block value: (m at: key ifAbsent: [^ Nil]).
].

m@(Mapping traits) at: key put: obj
[
  overrideThis
].

m@(Mapping traits) removeKey: key
[
  m removeKey: key ifAbsent: []
].

m@(Mapping traits) keyAtValue: obj ifAbsent: block
[
  overrideThis
].

m@(Mapping traits) keyAtValue: obj
[
  m keyAtValue: obj ifAbsent: [Nil]
].

m@(Mapping traits) keysAndValuesDo: block
"Apply a two-argument block to each pair of key and value that the Mapping
consists of."
[
  overrideThis
].

m@(Mapping traits) keysDo: block
"Apply a single-argument block to each key in the mapping."
"This is the default safe method which should be overridden in each
implementation for efficiency."
[
  m keysAndValuesDo: [| :key :value | block value: key]
].

m@(Mapping traits) valuesDo: block
"Apply a single-argument block to each keyed value in the mapping."
"This is the default safe method which should be overridden in each
implementation for efficiency."
[
  m keysAndValuesDo: [| :key :value | block value: value]
].

mappings addSlot: #EmptyMapping valued: Mapping clone.
"The Mapping that doesn't point to anything."

_@EmptyMapping size [0].
_@EmptyMapping capacity [0].

_@EmptyMapping do: _ [].
_@EmptyMapping keysAndValuesDo: _ [].

_@EmptyMapping at: _ [].
_@EmptyMapping at: _ put: _ [].
_@EmptyMapping at: _ ifAbsent: block [block value].
_@EmptyMapping at: _ ifPresent: _ [].

_@(Mapping traits) newEmpty [EmptyMapping].

mappings addSlot: #MapComposition valued: Mapping derive.
"Represents a composition of Mappings."
MapComposition addSlot: #base valued: Mapping newEmpty.
"The Mapping treated as a basis."
MapComposition addSlot: #diff. "valued: Dictionary newEmpty."
"The change being composed over the basis. This Mapping's values have priority
over the basis."

m1@(Mapping traits) composeWith: m2@(Mapping traits)
"Creates a new MapComposition."
"Since Sequences are Mappings, we cannot re-use ; for mapping-composition
without some confusion."
[| result |
  result: MapComposition clone.
  result base: m1.
  result diff: m2.
  result
].

m@(MapComposition traits) at: index ifAbsent: block
[
  m diff at: index ifAbsent: [m base at: index ifAbsent: block]
].

m@(MapComposition traits) at: index put: obj
"TODO: This should instead conditionalize on whether the components are
mutable."
[
  (m diff acceptsKey: index)
    ifTrue: [m diff at: index put: obj]
    ifFalse: [m basis at: index put: obj]
].

m@(MapComposition traits) keyAtValue: obj ifAbsent: block
[
  m diff
    keyAtValue: obj
    ifAbsent: [m basis keyAtValue: obj ifAbsent: block]
].

m@(MapComposition traits) acceptsKey: key
[
  (m diff acceptsKey: key) or: [m basis acceptsKey: key]
].

m@(MapComposition traits) keysAndValuesDo: block
[
  m diff keysAndValuesDo: block.
  m basis keysAndValuesDo: block.
  m
].

m@(MapComposition traits) keysDo: block
[
  m diff keysDo: block.
  m basis keysDo: block.
  m
].

m@(MapComposition traits) valuesDo: block
[
  m diff valuesDo: block.
  m basis valuesDo: block.
  m
].

m@(MapComposition traits) size
[
  m diff size + m basis size
].

m@(MapComposition traits) capacity
[
  m diff capacity + m basis capacity
].

mappings addSlot: #SingleValueMap valued: Mapping derive.
"Maps a set of keys to a single value. This in combination with MapComposition
helps to represent sparse Mappings."
SingleValueMap addSlot: #keys valued: Set newEmpty.
"The set of keys mapped. This could be a Set or a Range (for sparse
Sequences) Generally, it simply has to be a NoDuplicatesCollection."
SingleValueMap addSlot: #value.
"The single value used."

m@(SingleValueMap traits) newFromAll: c to: obj
"Creates a new SingleValueMap using the collection as keys to access the given
object."
[| result |
  result: m clone.
  result keys: c.
  result value: obj.
  result
].

m@(SingleValueMap traits) at: key ifAbsent: block
[
  (m keys includes: key)
    ifTrue: [m value]
    ifFalse: [block value]
].

m@(SingleValueMap traits) at: key put: obj
[
  obj = m value
    ifTrue: [keys include: key]
    ifFalse: [error: 'This Mapping cannot store that object.']
].

m@(SingleValueMap traits) keysAndValuesDo: block
[
  m keys do: [| :key | block value: key value: m value]
].

m@(SingleValueMap traits) keyAtValue: obj ifAbsent: block
[
  obj = m value
    ifTrue: [keys atRandom]
    ifFalse: [block value]
].

m@(SingleValueMap traits) keyAtIdentityValue: obj ifAbsent: block
[
  obj == m value
    ifTrue: [keys atRandom]
    ifFalse: [block value]
].