collections addPrototype: #ExtensibleSequence
	    derivedFrom: {Sequence. ExtensibleCollection}.
"A Sequence which is Extensible. This is abstract, with several possible
implementations. A particular feature of this type is that add: maps to
addLast:, adding at the end."

es@(ExtensibleSequence traits) copyFrom: start to: end
[| newES |
  end < start ifTrue: [^ es newEmpty].
  newES: (es newSize: end + 1 - start).
  start to: end do: [| :index | newES addLast: (es at: index)].
  newES
].

es@(ExtensibleSequence traits) copyWith: obj
"Non-destructively append."
[| newES |
  (newES: es copy) addLast: obj.
  newES
].

es@(ExtensibleSequence traits) reversed
[| newES |
  newES: es newSameSize.
  es reverseDo: [| :obj |
    newES addLast: obj].
  newES
].

es@(ExtensibleSequence traits) growSize
"The new capacity for a call to a grow- method."
[
  es capacity * 2 max: 8
].

es@(ExtensibleSequence traits) add: obj
"A particular feature of this type is that add: maps to addLast:, adding at
the end."
[
  es addLast: obj
].

es@(ExtensibleSequence traits) addAll: c
[
  es addAllLast: c
].

es@(ExtensibleSequence traits) addAllFirst: seq
[
  seq reverseDo: [| :each | es addFirst: each].
  seq
].

es@(ExtensibleSequence traits) addAllLast: seq
[
  seq do: [| :each | es addLast: each].
  seq
].

es@(ExtensibleSequence traits) grow
"This is the default for growing since add: addLast:s."
[es growLast].

es@(ExtensibleSequence traits) collect: block
"Override to use addLast: vice at:put:."
[| newC |
  newC: es newSameSize.
  es do: [| :each | newC addLast: (block applyWith: each)].
  newC
].

es@(ExtensibleSequence traits) collect: block from: start to: end
"Override to use addLast: vice at:put:."
[| newC |
  (start < 0 or: [end >= es size]) ifTrue: [^ Nil].
  newC: (es newSize: end - start + 1).
  start to: end do: [| :index |
    newC addLast: (block applyWith: (es at: index))].
  newC
].

es@(ExtensibleSequence traits) with: seq collect: binBlock
[| newC |
  newC: (es newSize: (es size min: seq size)).
  0 below: newC capacity do: [| :index |
    newC addLast: (binBlock applyWith: (es at: index) with: (seq at: index))].
  newC
].

es@(ExtensibleSequence traits) removeFirst: n
[| newC |
  n > es size [n: es size].
  newC: (es newSize: n).
  0 below: n
    do:
      [| :i | newC at: i put: es removeFirst]
].

es@(ExtensibleSequence traits) removeLast: n
[| newC |
  n > es size [n: es size].
  newC: (es newSize: n).
  [n > 0]
    whileTrue:
      [n: n - 1.
        newC at: n put: es removeLast]
].

collections addPrototype: #ExtensibleArray
	    derivedFrom: {ExtensibleSequence}.
"An ExtensibleArray implemented by an array with padding on both ends for
the contents."
ExtensibleArray addSlot: #contents valued: {}.
"The Array used for storage."
ExtensibleArray addSlot: #firstIndex valued: 0.
"The first index of the array which contains the Sequence' contents."
ExtensibleArray addSlot: #lastIndex valued: -1.
"The last index of the array which contains the Sequence' contents."

es@(ExtensibleArray traits) newEmpty
[
  es newSize: 4
].

es@(ExtensibleArray traits) newSize: capacity
[| newES |
  newES: es clone.
  newES firstIndex: 0.
  newES lastIndex: -1.
  newES contents: (es contents newSize: capacity).
  newES
].

es@(ExtensibleArray traits) arrayType
"The underlying implementation prototype."
[es contents arrayType].

s@(Sequence traits) as: es@(ExtensibleArray traits)
"Allows dynamically carrying forward the arrayType into the new Sequence."
[| newES |
  newES: es newEmpty.
  newES contents: (s arrayType newSize: s size).
  newES addAll: s.
  newES
].

es@(ExtensibleArray traits) size
[
  es lastIndex - es firstIndex + 1
].

es@(ExtensibleArray traits) capacity
[
  es contents size
].

es@(ExtensibleArray traits) at: index
[
  es contents at: es firstIndex + index
].

es@(ExtensibleArray traits) at: index put: value
[
  es contents
    at: es firstIndex + index
    put: value
].

es@(ExtensibleArray traits) clear
"Resets to the values for being empty. lastIndex is -1 to coordinate with the
size method and addLast:."
[
  es firstIndex: 0.
  es lastIndex: -1.
  es
].

es@(ExtensibleArray traits) copy
[| newES |
  newES: es clone.
  newES contents: es contents clone.
  newES
].

es@(ExtensibleArray traits) copyReplaceFrom: start to: end with: c
"Performs an insert or append as necessary if the replacing collection doesn't
fit in the bounds. eg start < 0 prepends, start > size appends."
[| newES delta startIndex endIndex ess cs |
  delta: 0.
  ess: es size.
  cs: c size.
  start < 0 ifTrue: [startIndex: (endIndex: 0)]
    ifFalse: [
      endIndex: end.
      (startIndex: start) > ess
        ifTrue: [startIndex: (endIndex: size + 1)]
        ifFalse: [(endIndex < (startIndex - 1) or: [endIndex > (ess - 1)])
          ifTrue: [^ Nil].
        delta: endIndex - startIndex + 1]].
  newES: (c newSize: ess + cs - delta).
  0 below: startIndex do: [| :index | newES add: (es at: index)].
  0 below: cs do: [| :index |
    newES add: (c at: index)].
  endIndex + 1 below: ess do: [| :index |
    newES add: (es at: index)].
  newES
].

es@(ExtensibleArray traits) growFirst
"Provide a larger array and map the contents in to yield more growth area at
the beginning. The growth factor is 2."
[| newContents offset |
  es lastIndex >= (es capacity - 1)
    ifTrue:
      [newContents: (es contents newSize: es growSize)]
    ifFalse:
      [newContents: es contents].
  offset: newContents size - es lastIndex - 1.
  es lastIndex
    downTo: es firstIndex
    do:
      [| :index |
        newContents 
          at: index + offset
          put: (es contents at: index)
      ].
  es firstIndex: es firstIndex + offset.
  es lastIndex: es lastIndex + offset.
  es contents: newContents
].

es@(ExtensibleArray traits) growLast
"Provide a larger array and map the contents in to yield more growth area at
the end. The growth factor is 2."
[| newContents |
  es firstIndex = 0
    ifTrue:
      [newContents: (es contents newSize: es growSize)]
    ifFalse:
      [newContents: es contents].
  es firstIndex
    upTo: es lastIndex
    do:
      [| :index |
        newContents
          at: index - es firstIndex
          put: (es contents at: index)
      ].
  es lastIndex: es lastIndex - es firstIndex.
  es firstIndex: 0.
  es contents: newContents
].

es@(ExtensibleArray traits) addFirst: obj
[| firstIndex |
  (firstIndex: es firstIndex) = 0 ifTrue: [es growFirst].
  es firstIndex: es firstIndex - 1.
  es contents at: es firstIndex put: obj.
  obj
].

es@(ExtensibleArray traits) addLast: obj
[
  es lastIndex + 1 < es capacity ifFalse: [es growLast].
  es lastIndex: es lastIndex + 1.
  es contents at: es lastIndex put: obj.
  obj
].

es@(ExtensibleArray traits) add: obj after: member
[| index |
  (index: (es find: member)) ifNil: [^ Nil].
  es insert: obj before: index + 1.
  obj
].

es@(ExtensibleArray traits) at: index insert: obj
[
  es insert: obj before: es firstIndex + index.
  obj
].

es@(ExtensibleArray traits) add: obj before: member
[| index |
  (index: (es find: member)) ifNil: [^ Nil].
  es insert: obj before: index.
  obj
].

es@(ExtensibleArray traits) remove: obj ifAbsent: block
[| index |
  index: es firstIndex.
  [index <= es lastIndex] whileTrue:
    [obj = (es contents at: index)
      ifTrue: [es contents replaceFrom: index to: es lastIndex - 1
          with: es contents startingAt: index + 1.
          es contents at: es lastIndex put: Nil.
          es lastIndex: es lastIndex - 1.
          ^ obj]
      ifFalse: [index: index + 1]].
  block do
].

es@(ExtensibleArray traits) removeAllSuchThat: block
[| n |
  (n: es firstIndex) to: es lastIndex do: [| :index |
    (block applyWith: (es contents at: index)) ifFalse:
      [es contents at: n put: (es at: index).
       n: n + 1]].
  n to: es lastIndex do: [| :index |
    es contents at: index put: Nil].
  es lastIndex: n - 1.
  es
].

es@(ExtensibleArray traits) at: index remove: n
"Remove the next N objects currently starting from the given index, sliding
items from the right over to fill in the places."
[| removed localStart |
  removed: (es at: index).
  localStart: index + es firstIndex.
  es contents replaceFrom: localStart - n to: es lastIndex - n
      with: es contents startingAt: localStart.
  es contents at: es lastIndex put: Nil.
  es lastIndex: es lastIndex - n.
  es
].

es@(ExtensibleArray traits) removeAt: index
"Remove the object currently at the given index, sliding items from the right
over to fill in the place."
[| removed localIndex |
  removed: (es at: index).
  localIndex: index + es firstIndex.
  es contents replaceFrom: localIndex - 1 to: es lastIndex - 1
      with: es contents startingAt: localIndex.
  es contents at: es lastIndex put: Nil.
  es lastIndex: es lastIndex - 1.
  es
].

es@(ExtensibleArray traits) removeFirst
[| firstObj |
  es emptyCheck.
  firstObj: (es contents at: es firstIndex).
  es contents at: es firstIndex put: Nil.
  es firstIndex: es firstIndex + 1.
  firstObj
].

es@(ExtensibleArray traits) removeLast
[| lastObj |
  es emptyCheck.
  lastObj: (es contents at: es lastIndex).
  es contents at: es lastIndex put: Nil.
  es lastIndex: es lastIndex - 1.
  lastObj
].

es@(ExtensibleArray traits) removeFirst: n
[| newC i |
  n > es size ifTrue: [n: es size].
  newC: (Array newSize: n).
  es firstIndex below: esFirstIndex + n
    do: [| :i | newC at: i put: (es contents at: i)].
  es firstIndex: es firstIndex + n.
  newC
].

es@(ExtensibleArray traits) removeLast: n
[| newC |
  n > es size ifTrue: [n: es size].
  newC: (Array newSize: n).
  es lastIndex above: (es lastIndex: es lastIndex - n)
    do:
      [| :i | newC at: (n: n - 1) put: (es contents at: i)].
  newC
].

es@(ExtensibleArray traits) collect: block
"Override to use the specific implementation."
[| newC |
  newC: es newSameSize.
  es firstIndex to: es lastIndex do: [| :index |
    newC addLast: (block applyWith: (es contents at: index))].
  newC
].

es@(ExtensibleArray traits) collect: block from: start to: end
"Override to use the specific implementation."
[| newC |
  (start < 0 or: [end >= es size]) ifTrue: [^ Nil].
  newC: (es newSize: end - start + 1).
  es firstIndex + start to: es firstIndex + end do: [| :index |
    newC addLast: (block applyWith: (es contents at: index))].
  newC
].

es@(ExtensibleArray traits) do: block
[| index limit |
  index: es firstIndex.
  limit: es lastIndex.
  [index <= limit]
    whileTrue: [block applyWith: (es at: index).
      index: index + 1].
  es
].

es@(ExtensibleArray traits) reverseDo: block
[| index |
  index: es lastIndex.
  [index >= es firstIndex]
    whileTrue: [block applyWith: (es at: index).
      index: index - 1].
  es
].

es@(ExtensibleArray traits) select: block
[| newC elem |
  newC: es traits newEmpty.
  es firstIndex to: es lastIndex do: [| :index |
    (block applyWith: (elem: (es contents at: index)))
      ifTrue: [newC addLast: elem]].
  newC
].

es@(ExtensibleArray traits) collectWithIndex: binBlock
"Override to use addLast: vice at:put:."
[| newC |
  newC: es newSameSize.
  es firstIndex to: es lastIndex do: [| :index |
    newC addLast: (binBlock applyWith: (es contents at: index) with: index - es firstIndex + 1)].
  newC
].

es@(ExtensibleArray traits) find: obj
[| index |
  index: es firstIndex.
  [index <= es lastIndex] whileTrue:
    [(es contents at: index) = obj ifTrue: [^ index].
      index: index + 1].
  Nil
].

es@(ExtensibleArray traits) insert: obj before: index
[
  (es firstIndex > 0 and: [index = es firstIndex])
    ifTrue: 
      [es firstIndex: es firstIndex - 1.
       ^ (es contents at: es firstIndex put: obj)].
  es lastIndex + 1 < es capacity 
    ifFalse: [es growLast].
  index > es lastIndex
    ifTrue: 
      [es lastIndex: es lastIndex + 1.
       ^ (es contents at: es lastIndex put: obj)].
  es contents
    replaceFrom: index + 1
    to: es lastIndex + 1
    with: es contents
    startingAt: index.
  es lastIndex: es lastIndex + 1.
  es contents at: index put: obj
].

es@(ExtensibleArray traits) move: obj to: index
"Re-position the object so that it has the given index, and slide up/down other
objects as needed."
[| src tgt |
  src: (es find: obj).
  tgt: index + es startIndex.
  src ifNil: [^ Nil].
  src = tgt
    ifTrue: [^ es].
  src > tgt
    ifTrue: [es contents
      replaceFrom: tgt + 1
      to: src
      with: es contents
      startingAt: tgt]
    ifFalse: [es contents
      replaceFrom: src
      to: es contents lastIndex
      with: es contents
      startingAt: src + 1].
  es contents at: tgt put: obj.
  es
].

collections addPrototype: #Stack derivedFrom: {ExtensibleArray}.
"An abstraction over ExtensibleArray implementations to follow the stack
protocol."

s@(Stack traits) push: obj
[
  s addLast: obj
].

s@(Stack traits) pop
[
  s removeLast
].

s@(Stack traits) pop: n
[
  s removeLast: n
].

s@(Stack traits) top
[
  s last
].

s@(Stack traits) top: n
[
  s last: n
].

s@(Stack traits) bottom
[
  s first
].

s@(Stack traits) bottom: n
[
  s first: n
].

s@(Stack traits) position
[
  s size
].

s@(Stack traits) position: n
[
  s lastIndex: s firstIndex + n
].

s@(Stack traits) fromTop: offset
[
  s at: s position - offset - 1
].

s@(Stack traits) fromTop: offset put: value
[
  s at: s position - offset - 1 put: value
].

s@(Stack traits) bottomToTopDo: block
[
  s do: block
].

s@(Stack traits) topToBottomDo: block
[
  s reverseDo: block
].