requires: {#Collection. #Mapping}.
provides: {#Sequence. #SubSequence. #Repetition}.

collections addSlot: #Sequence valued: (Collection deriveWith: {Mapping}).
"Sequences are Mappings from a range of Integers starting from 0 to a final
Integer, in a sequence, to arbitrary objects. The last address will be one
less than the size."

"Mapping compatibility methods."

c@(Sequence traits) acceptsKey: n@(Integer traits)
[n isPositive and: [n < c size]].

c@(Sequence traits) acceptsKey: _
[False].

c@(Sequence traits) keys
"Answers the keys of a Sequence as a Range; will not work until Range is
installed."
[
  0 below: s size
].

c@(Sequence traits) keysDo: block
"Iterate over just the indices in the Sequence."
[
  0 below: c size do: [| :index | block value: index]
].

c@(Sequence traits) keysAndValuesDo: block
[
  c doWithIndex: [| :each :index | block value: index value: each]
].

"Some commonly useful idioms."

c@(Sequence traits) first [c at: 0].
c@(Sequence traits) first: value [c at: 0 put: value].
c@(Sequence traits) second [c at: 1].
c@(Sequence traits) second: value [c at: 1 put: value].
c@(Sequence traits) third [c at: 2].
c@(Sequence traits) third: value [c at: 2 put: value].
c@(Sequence traits) fourth [c at: 3].
c@(Sequence traits) fourth: value [c at: 3 put: value].
c@(Sequence traits) fifth [c at: 4].
c@(Sequence traits) fifth: value [c at: 4 put: value].
c@(Sequence traits) sixth [c at: 5].
c@(Sequence traits) sixth: value [c at: 5 put: value].
c@(Sequence traits) seventh [c at: 6].
c@(Sequence traits) seventh: value [c at: 6 put: value].
c@(Sequence traits) eighth [c at: 7].
c@(Sequence traits) eighth: value [c at: 7 put: value].
c@(Sequence traits) ninth [c at: 8].
c@(Sequence traits) ninth: value [c at: 8 put: value].
c@(Sequence traits) tenth [c at: 9].
c@(Sequence traits) tenth: value [c at: 9 put: value].
c@(Sequence traits) last [c at: c size - 1].
c@(Sequence traits) last: value [c at: c size - 1 put: value].

c@(Sequence traits) newSize: n
"This is a general catch-all which is the core creation method to override.
TODO: Make it generic."
[
  Array newSize: n
].

c@(Sequence traits) newEmpty
[
  c newSize: 0
].

s@(Sequence traits) newWithAll: c@(Collection traits)
[| newS cs |
  cs: c size.
  newS: (s newSize: cs).
  newS replaceFrom: 0 to: cs - 1 with: c startingAt: 0.
  newS
].

s1@(Sequence traits) as: s2@(Sequence traits)
[| newS |
  newS: (s2 newSizeOf: s1).
  s1 doWithIndex: [| :each :index | newS at: index put: each].
  newS
].

c@(Sequence traits) after: obj ifAbsent: block
[| index |
  (index: (c indexOf: obj))
    ifNil: [block value]
    ifNotNil: [index = (c size - 1)
      ifTrue: [Nil]
      ifFalse: [c at: index + 1]]
].

c@(Sequence traits) after: obj
[
  c after: obj ifAbsent: [Nil]
].

c@(Sequence traits) allButFirst: n
[
  c copyFrom: n to: c size - 1
].

c@(Sequence traits) allButFirst
[
  c allButFirst: 1
].

c@(Sequence traits) allButLast: n
[
  c copyFrom: 0 to: c size - n - 1
].

c@(Sequence traits) allButLast
[
  c allButLast: 1
].

c@(Sequence traits) anyOne
[
  c first
].

c@(Sequence traits) acceptsKey: n@(Integer traits)
"Note that this method is a temporal query: it answers about the 'now'."
[
  n >= 0 and: [n < c size]
].

c@(Sequence traits) acceptsKey: _@(Root traits)
"Sequenceables are keyed by integers as indices only."
[
  False
].

c@(Sequence traits) at: index ifAbsent: block
[
  (index between: 0 and: c size - 1)
    ifTrue: [c at: index]
    ifFalse: [block value]
].

c@(Sequence traits) atAll: d@(Collection traits)
[| newC |
  newC: (c newSizeOf: d).
  d doWithIndex: [| :each :index | newC at: index put: each].
  newC
].

c@(Sequence traits) atAll: d@(Sequence traits)
[| newC |
  newC: (c newSizeOf: d).
  newC keysDo: [| :index |
    newC at: index put: (c at: (d at: index))].
  newC
].

c@(Sequence traits) atAll: d put: obj
[
  d do: [| :index | c at: index put: obj].
  obj
].

c@(Sequence traits) atAll: indices put: values
[
  indices with: values do: [| :index :value | c at: index put: value].
  values
].

c@(Sequence traits) atAllPut: obj
[| size |
  0 below: size do: [| :index | c at: index put: obj].
  c
].

c@(Sequence traits) = d@(Sequence traits)
[
  c == d or: [| size |
    (size: c size) = d size and:
    [0 below: size do: [| :index |
      (c at: index) = (d at: index) ifFalse: [^ False]].
    True]]
].

c@(Sequence traits) hash
[| hash |
  hash: resend.
  0 below: c size do: [| :index | hash: (hash + (c at: index) hash) hashMultiply].
  hash
].

c@(Sequence traits) isSequenceable
[True].

c@(Sequence traits) atPin: index
"Return the indexed element, coercing index to the collection's range."
[| cs |
  index <= 0 ifTrue: [^ c first].
  index >= c size ifTrue: [^ c last].
  c at: index
].

c@(Sequence traits) atWrap: index
"Return the indexed element, wrapping the index around until it's in range."
[
  c at: index \\ c size
].

c@(Sequence traits) atWrap: index put: obj
"Set the indexed element, wrapping the index around until it's in range."
[
  c at: index \\ c size put: obj
].

c@(Sequence traits) before: obj ifAbsent: block
[| index |
  (index: (c indexOf: obj))
    ifNil: [block value]
    ifNotNil: [index = 0
      ifTrue: [Nil]
      ifFalse: [c at: index - 1]]
].

c@(Sequence traits) before: obj
[
  c before: obj ifAbsent: [Nil]
].

c@(Sequence traits) first
[
  c isEmpty
    ifTrue: [Nil]
    ifFalse: [c at: 0]
].

c@(Sequence traits) first: n
[
  c copyFrom: 0 to: n - 1
].


c@(Sequence traits) identityIndexOf: obj ifAbsent: block
[
  0 below: c size do: [| :index |
    (c at: index) == obj ifTrue: [^ index]].
  block value
].

c@(Sequence traits) identityIndexOf: obj
[
  c identityIndexOf: obj ifAbsent: [Nil]
].

c@(Sequence traits) indexOf: obj startingAt: start ifAbsent: block
[
  start below: c size do: [| :index |
    (c at: index) = obj ifTrue: [^ index]].
  block value
].

c@(Sequence traits) indexOf: obj ifAbsent: block
[
  c indexOf: obj startingAt: 0 ifAbsent: block
].

c@(Sequence traits) indexOf: obj
[
  c indexOf: obj ifAbsent: [Nil]
].

c@(Sequence traits) includes: obj
[
  (c indexOf: obj) isNotNil
].

c@(Sequence traits) indexOfSubSeq: subSeq startingAt: start ifAbsent: block
[| first index |
  subSeq isEmpty ifTrue: [^ block value].
  subSeq size = 1 ifTrue: [^ (c indexOf: subSeq first startingAt: start ifAbsent: block)].
  first: subSeq first.
  start upTo: c size - subSeq size do: [| :startIndex |
    (c at: startIndex) = first ifTrue:
      [index: 1.
      [(c at: startIndex + index) = (subSeq at: index)]
        whileTrue: [index = subSeq size
          ifTrue: [^ startIndex].
          index: index + 1]]].
  block value
].

c@(Sequence traits) indexOfSubSeq: subSeq startingAt: start
[
  c indexOfSubSeq: subSeq startingAt: start ifAbsent: [Nil]
].

c@(Sequence traits) indexOfSubSeq: subSeq
[
  c indexOfSubSeq: subSeq startingAt: 0
].

c@(Sequence traits) last
[| size |
  (size: c size) = 0 ifTrue: [^ Nil].
  c at: size - 1
].

c@(Sequence traits) last: n
[| size |
  c copyFrom: (size: c size) - n to: size - 1
].

c@(Sequence traits) lastIndexOf: obj startingAt: start ifAbsent: block
[
  start downTo: 0 do: [| :index |
    (c at: index) = obj ifTrue: [^ index]].
  block value
].

c@(Sequence traits) lastIndexOf: obj ifAbsent: block
[
  c lastIndexOf: obj startingAt: c size - 1 ifAbsent: block
].

c@(Sequence traits) lastIndexOf: obj
[
  c lastIndexOf: obj startingAt: c size - 1 ifAbsent: [Nil]
].

c@(Sequence traits) middle
[
  c at: c size // 2
].

c@(Sequence traits) replaceAll: obj with: newOne
[| index |
  index: (c indexOf: obj startingAt: 0).
  [index isNil]
    whileFalse: [c at: index put: newOne.
      index: (c indexOf: obj startingAt: index)].
  c
].

c@(Sequence traits) replaceFrom: start to: end with: replacement startingAt: repStart
"This destructively modifies the collection."
[| repOff |
  repOff: repStart - start.
  (c = replacement and: [start > repStart])
    ifTrue:
      [end
        downTo: start
        do:
          [| :index |
            c at: index put: (replacement at: repOff + index)]]
    ifFalse:
      [start
        upTo: end
        do:
          [| :index |
            c at: index put: (replacement at: repOff + index)]].
  c
].

c@(Sequence traits) swap: index1 with: index2
[| obj |
  obj: (c at: index1).
  c at: index1 put: (c at: index2).
  c at: index2 put: obj.
  c
].

c@(Sequence traits) ; d@(Sequence traits)
"Concatenates the two Sequences, answering the result."
[| cs |
  c copyReplaceFrom: (cs: c size)
    to: cs - 1
    with: d
].

c@(Sequence traits) copyAfter: obj
[
  c allButFirst: (c indexOf: obj ifAbsent: [^ c traits newEmpty])
].

c@(Sequence traits) copyAfterLast: obj
[
  c allButFirst: (c lastIndexOf: obj ifAbsent: [^ c traits newEmpty])
].

c@(Sequence traits) copyFrom: start to: end
[| newSize |
  (c newSize: (newSize: end - start + 1))
    replaceFrom: 0
    to: newSize - 1
    with: c
    startingAt: start
].

c@(Sequence traits) copyReplaceFrom: start to: end with: d
"Cope with replacement, except if end < start, then this is instead an insertion.
 start = 0 and end = -1 inserts at the beginning; start = size appends at the end."
[| newC ns endReplace ds |
  ns: c size - (end - start + 1) + (ds: d size).
  endReplace: start - 1 + ds.
  newC: (c newSize: ns).
  start > 0 ifTrue: [
    newC replaceFrom: 0 to: start - 1 with: c startingAt: 0].
  start <= endReplace ifTrue: [
    newC replaceFrom: start to: endReplace with: d startingAt: 0].
  endReplace < ns ifTrue: [
    newC replaceFrom: endReplace + 1 to: ns - 1 with: c startingAt: end + 1].
  newC
].

c@(Sequence traits) copyUpTo: obj
[
  c first: (c indexOf: obj ifAbsent: [^ c copy]) - 1
].

c@(Sequence traits) copyUpToLast: obj
[
  c first: (c lastIndexOf: obj ifAbsent: [^ c copy]) - 1
].

c@(Sequence traits) copyWith: obj
"Non-destructively append an object."
[| newC cs |
  (newC: (c newSize: (cs: c size) + 1))
    replaceFrom: 0 to: cs - 1 with: c startingAt: 0.
  newC at: cs put: obj.
  newC
].

c@(Sequence traits) copyWithoutFirst
[
  c allButFirst
].

c@(Sequence traits) copyWithoutAt: index
[| newC ns |
  newC: (c newSize: (ns: c size - 1)).
  newC replaceFrom: 0 to: index - 1 with: c startingAt: 0.
  newC replaceFrom: index to: ns - 1 with: c startingAt: index + 1.
  newC
].

c@(Sequence traits) shallowCopy
[
  c copyFrom: 0 to: c size - 1.
].

c@(Sequence traits) sortBy: block
[
  ((c as: SortedSequence) block: block) as: ExtensibleSequence
].

c@(Sequence traits) choose: k of: n into: workingArray do: block
"Execute the block on all the combinations of size k out of the sequence.
This uses a single array as an iterator object which should not be modified
by the client code."
[
  n < k ifTrue: [^ c].
  k = 0 ifTrue: [^ (block value: workingArray)].
  workingArray at: k put: (c at: n).
  c choose: k - 1 of: n - 1 into: workingArray do: block.
  c choose: k of: n - 1 into: workingArray do: block.
].

c@(Sequence traits) choose: n do: block
"Execute the block on all the combinations of size N out of the sequence.
This uses a single array as an iterator object which should not be modified
by the client code."
[| workingArray |
  workingArray: (Array newSize: n).
  c choose: n of: c size into: workingArray do: block
].

c@(Sequence traits) collect: block
[| newC |
  newC: c newSameSize.
  c doWithIndex: [| :each :index |
    newC at: index put: (block value: each)].
  newC
].

c@(Sequence traits) collect: block from: start to: end
[| newC size j |
  size: end - start + 1.
  result: (c newSize: size).
  j: start.
  0 below: size do: [| :i | newC at: i put: (block value: (c at: j)). j: j + 1].
  newC
].

c@(Sequence traits) collectWithIndex: binBlock
"binBlock should take :element and :index."
[| newC |
  newC: c newSameSize.
  c doWithIndex: [| :index |
    newC at: index put: (binBlock value: each value: index)].
  newC
].

c@(Sequence traits) do: block
[
  0 below: c size do:
    [| :index | block value: (c at: index)].
  c
].

c@(Sequence traits) do: block separatedBy: sepBlock
"Run the separator block between applying the block to each element."
[
  c size > 0 ifTrue: [block value: c first].
  1 below: c size do: [| :index | sepBlock value. block value: (c at: index)].
  c
].

c@(Sequence traits) do: block ifNotEqualTo: obj
[
  c do: [| :each | each = obj ifFalse: [block value: each]]. 
  c
].

c@(Sequence traits) allButFirst: n do: block
"Apply the block to all elements but the first N in the Sequence."
[
  c from: n to: c size - 1 do: block
].

c@(Sequence traits) allButLast: n do: block
"Apply the block to all but the last N members of the Sequence."
[
  c from: 0 to: c size - n - 1 do: block
].

c@(Sequence traits) doWithIndex: binBlock
"binBlock takes :each object and its :index."
[
  0 below: c size do: [| :index |
    binBlock value: (c at: index) value: index].
  c
].

c@(Sequence traits) do: block every: step
"Invoke the block on every n'th argument."
[
  c do: block every: step startingAt: 0
].

c@(Sequence traits) do: block every: step startingAt: start
"Invoke the block on every n'th argument, starting at a particular index."
[| index steps |
  index: start.
  steps: (c size - start) // step.
  steps timesRepeat: [| :iter |
    block value: (c at: index).
    index: index + step].
  c
].

c@(Sequence traits) do: block inGroupsOf: arity
"Send the elements of the target to the block in the number of its arity. If
fewer than that are remaining, abort and return."
[
  c do: block inGroupsOf: arity startingAt: 0
].

c@(Sequence traits) do: block inGroupsOf: arity startingAt: start
"Send the elements of the target to the block in the number of its arity,
beginning with a given index. If fewer than that are remaining, abort and
return."
[| index steps |
  index: start.
  steps: (c size - start) // arity.
  steps timesRepeat: [
    block values: (c from: index to: index + arity - 1).
    index: index + arity].
  c
].

c@(Sequence traits) findFirst: block
"Find the index of the first occurrence of an object satisfying the block."
[
  c doWithIndex: [| :obj :index | (block value: obj) ifTrue: [^ index]].
  Nil
].

c@(Sequence traits) findLast: block
"Find the index of the last occurrence of an object satisfying the block."
[
  c size - 1
    downTo: 0
    do:
      [| :index |
        (block value: (c at: index))
          ifTrue: [^ index]].
  Nil
].

c@(Sequence traits) from: start to: end do: block
[
  start to: end do: [| :index | block value: (c at: index)].
  c
].

c@(Sequence traits) reverseDo: block
[
  c size - 1 downTo: 0 do: [| :index | block value: (c at: index)].
  c
].

c@(Sequence traits) reverseWith: d do: block
[| cs |
  (cs: c size) ~= d size ifTrue: [^ Nil].
  cs downTo: 0 do: [| :index | block value: (c at: index) value: (d at: index)].
  c
].

c@(Sequence traits) select: block
[| result |
  result: c newSameSize.
  c doWithIndex: [| :each :index | (block value: each)
    ifTrue: [result at: index put: each]].
  result
].

c@(Sequence traits) with: d@(Sequence traits) collect: binBlock
"Collect the result from applying the block to as many pairs of elements from
each Sequence as possible."
[| newC |
  newC: (c newSize: (c size min: d size)).
  newC keysDo: [| :index |
    newC at: index put: (binBlock value: (c at: index) value: (d at: index))].
  newC
].

c@(Sequence traits) with: d@(Sequence traits) do: binBlock
"Apply the block to as many pairs of elements from each Sequence as possible."
[| cs |
  0 below: (c size min: d size) do: [| :index |
    binBlock value: (c at: index) value: (d at: index)].
  c
].

prefix@(Sequence traits) isPrefixOf: seq@(Sequence traits)
"Answer whether the first elements of the Sequence match the potential prefix
Sequence's elements in order."
[
  prefix size <= seq size ifFalse: [^ False].
  prefix doWithIndex: [| :each :index |
    each = (seq at: index) ifFalse: [^ False]].
  True
].

c@(Sequence traits) reversed
[| cs newC srcIdx |
  cs: c size.
  newC: (c newSize: cs).
  srcIdx: cs.
  0 below: cs do: [| :destIdx |
    newC at: destIdx put: (c at: (srcIdx: (srcIdx - 1)))].
  newC
].

a@(Sequence traits) isSortedBy: block
[| lastObj obj |
  a isEmpty ifTrue: [^ True].
  lastObj: a first.
  1 below: a size do: [| :index |
    obj: (a at: index).
    (block value: lastObj value: obj) ifFalse: [^ False].
    lastObj: obj].
  True
].

a@(Sequence traits) mergeSortFrom: start to: end by: block
"A merge-sort, worst-case complexity O(n log n): recursively splits
the range into halves, sort each half, then merge the two. An extra
copy of data is a temporary buffer for the merge phases. The final
merge goes into the array."
[| iterBlock mergeBlock |
  (a isEmpty or: [start = end]) ifTrue: [^ a].
  (start < 0 or: [end >= a size]) ifTrue: [^ Nil].

  mergeBlock: [| :start :end :middle :dst i1 i2 d1 d2 out |
    i1: first.
    i2: middle + 1.
    d1: (a at: i1).
    d2: (a at: i2).
    out: first - 1.
    "Select the lower half based on the block."
    [(i1 <= middle) and: [i2 <= last]] whileTrue:
      [(block value: d1 value: d2)
        ifTrue: [dst at: (out: out + 1) put: d1.
          d1: (a at: (i1: i1 + 1))]
        ifFalse: [dst at: (out: out + 1) put: d2.
          (i2: i2 + 1) <= last ifTrue: [d2: (a at: i2)]]].
    "Copy the remaining elements."
    i1 <= middle
      ifTrue: [dst replaceFrom: out + 1 to: last with: a startingAt: i1]
      ifFalse: [dst replaceFrom: out + 1 to: last with: a startingAt: i2]].

  iterBlock: [| :start :end :src :dst middle |
    start = end ifTrue: [a]
      ifFalse: [middle: (start + end) // 2.
        iterBlock value: first value: middle value: dst value: src.
        iterBlock value: middle + 1 value: end value: dst value: src.
        mergeBlock value: start value: end value: middle value: dst]].
  iterBlock value: start value: end value: a clone value: a.
  a
].

a@(Sequence traits) sort: block
[
  a mergeSortFrom: 0 to: a size - 1 by: block
].

a@(Sequence traits) sort
[
  a sort: [| :x :y | x <= y]
].

x caseOf: cases@(Sequence traits) otherwise: block
"A Sequence of Associations between Objects and Blocks is used as a control
structure. Matching against the first argument causes the respective block
to be evaluated and its result returned. If none match, an alternative block
is provided."
[
  cases do: [| :assoc | assoc key = x ifTrue: [^ assoc value value]].
  block value
].

x caseOf: cases@(Sequence traits)
[
  x caseOf: cases otherwise: []
].

c@(Collection traits) collect: block into: seq@(Sequence traits)
"Specialized to handle sequences which are not Extensible. This returns a
result of applying the block to each element, which may not be the given
Sequence if it was not of the right size."
[| result |
  result: (seq capacity = c size ifTrue: [seq] ifFalse: [seq newSizeOf: c]).
  c doWithIndex: [| :each :index | result at: index put: (block value: each)].
  result
].

collections addSlot: #SubSequence valued: Sequence derive.
"Represents a section/slice of a Sequence without allocating a new Sequence."
SubSequence addSlot: #start valued: 0.
"The index within the source of the first element of the SubSequence."
SubSequence addSlot: #end valued: 0.
"The index within the source of the last element of the SubSequence."
SubSequence addSlot: #sequence.
"The source of the elements."

c@(Sequence traits) sliceFrom: start to: end
[| newSS |
  newSS: SubSequence clone.
  start < end ifFalse: [^ Nil].
  newSS sequence: c.
  newSS start: start.
  newSS end: end.
  newSS
].

ss@(SubSequence traits) size
[
  ss end - ss start + 1
].

ss@(SubSequence traits) at: index
[
  ss sequence at: index + start
].

ss@(SubSequence traits) at: index put: obj
[
  ss sequence at: index + start put: obj
].

ss@(SubSequence traits) do: block
[
  ss start upTo: ss end do: [| :index |
    block value: (ss sequence at: index)].
  ss
].

ss@(SubSequence traits) reverseDo: block
[
  ss end downTo: ss start do: [| :index |
    block value: (ss sequence at: index)].
  ss
].

ss@(SubSequence traits) doWithIndex: binBlock
[
  ss start upTo: ss end do: [| :index |
    binBlock value: (ss sequence at: index) value: index].
  ss
].

ss@(SubSequence traits) ; seq
"An override to provide correct concatenation behavior."
[| newS midpt |
  midpt: ss size.
  newS: (seq newSize: midpt + seq size).
  newS replaceFrom: 0 to: midpt - 1 with: ss startingAt: 0.
  newS replaceFrom: midpt to: newS size - 1 with: seq startingAt: 0.
  newS
].

seq@(Sequence traits) ; ss@(SubSequence traits)
[ss ; seq].

collections addSlot: #Repetition valued: Sequence derive.
"A Repetition is a Sequence of the same element repeated over its length."
Repetition addSlot: #number. "The number of times the element occurs."
Repetition addSlot: #element. "The repeated element."

r@(Repetition traits) newSize: n
[| newR |
  newR: r clone.
  newR element: Nil.
  newR number: n.
  newR
].

r@(Repetition traits) newFor: obj sized: n
[| newR |
  newR: r clone.
  newR element: obj.
  newR number: n.
  newR
].

r@(Repetition traits) size
[
  r number
].

r@(Repetition traits) at: index
[
  (index between: 0 and: r number) ifTrue: [r element]
].

r@(Repetition traits) at: index put: obj
[
  r element
    ifNil: [r element: obj]
    ifNotNil: [error: 'An attempt was made to modify a Repetition.']
].

r@(Repetition traits) do: block
[
  r number timesRepeat: [block value: r element]
].