requires: {#Collection. #Set. #Bag. #Sequence. #ExtensibleArray. #Stream. #PositionableStream}.
provides: {#Iterator}.

"Iterators allow more generic and varied accessing of Collections;
generally only ReadStreams are provided as attributes, except in the case of
Sequences."

Collection traits addPrototype: #Stream derivedFrom: {PositionableStream}.
Collection Stream addSlot: #collection.
"The target or source of the Stream."

s@(Collection Stream traits) contents
"Answer the Stream's contents, in the default case the collection itself."
[
  s collection
].

s@(Collection Stream traits) close
"Closes the link between the Stream and the Collection and resets it,
returning the Collection."
[| result |
  result: s collection.
  s collection: Nil.
  s reset.
  result
].

streamBlock@(Method traits) writingAs: c@(Collection traits)
"Create a new WriteStream for a new collection like the given one and apply the
block to it, answering the contents once done."
[| stream |
  stream: (c newSize: 100) writer.
  streamBlock applyWith: stream.
  stream contents
].

Collection traits addPrototype: #ReadStream
		  derivedFrom: {Collection Stream. ReadStream}.
"The default kind of iterator, a slot on the shared traits of Collection."

ExtensibleCollection traits addPrototype: #WriteStream derivedFrom: {WriteStream}.
"A totally non-Positionable WriteStream variant which just maps the protocol
to Collection addition protocol."
ExtensibleCollection WriteStream addSlot: #collection.
"The target of the WriteStream."

ws@(ExtensibleCollection WriteStream traits) on: c
"Targets the collection."
[
  ws collection: c.
  ws
].

ws@(ExtensibleCollection WriteStream traits) nextPut: obj
[ws collection add: obj].

ws@(ExtensibleCollection WriteStream traits) nextPutAll: c
[ws collection addAll: c].

ws@(ExtensibleCollection WriteStream traits) next: n putAll: seq startingAt: start
[
  ws collection addAll: (seq sliceFrom: start)
].

ws@(ExtensibleCollection WriteStream traits) close
"Closes the link between the Stream and the Collection and resets it."
[| result |
  result: ws collection.
  ws collection: Nil.
  result
].

ws@(ExtensibleCollection WriteStream traits) atEnd
"This type of stream cannot write over the contents and is perpetually
`at the end' of the contents, adding new elements."
[True].

c@(Collection traits) iterator
"Syntactic sugar for getting a new ReadStream or ReadWriteStream over the
given Collection that respects the same type."
[c reader].

c@(Collection traits) reader
"Syntactic sugar for getting a new ReadStream onto the given Collection
that respects the same type."
[c ReadStream newOn: c].

c@(Collection traits) writer
"Syntactic sugar for getting a new WriteStream onto the given Collection
that respects the same type."
[c WriteStream newOn: c].

cols@(Collection traits) iterators
"Returns a Collection of ReadStreams on the those in the given one. The
argument collection cannot contain non-collections."
[
  cols collect: [| :c | c iterator]
].

cols@(Collection traits) allDo: block
"Apply a coordinated do: over all of the collections, using iterators."
[| iterators |
  iterators: (cols iterators as: Array).
  [iterators anySatisfy: [| :it | it atEnd]]
     whileFalse: [block applyTo: (iterators collect: [| :it | it value]).
       iterators do: [| :it | it next]]
].

source@(Root traits) streamInto: target
"Totally generic method for streaming the contents of one thing into another."
[
  source reader >> target writer
].

source@(Root traits) streamFrom: target
[
  target streamInto: source
].

Set traits addPrototype: #ReadStream derivedFrom: {Collection ReadStream}.
"Set ReadStreams are just Positionable- over the element order in the Set's
contents Array. They're not very efficient, having to check for Nil's."
Set ReadStream collection: Set newEmpty.
Set ReadStream addSlot: #position valued: 0.
"The number of elements passed so far."
Set ReadStream addSlot: #index valued: 0.
"The index into the Set's contents Array."

i@(Set ReadStream traits) on: c
"Retargets to the new Set, and resets position, etc."
[
  i collection: c.
  i position: 0.
  i index: 0.
  i
].

i@(Set ReadStream traits) next
"Increment the index through the array until a non-Nil element is reached.
This is poor for sparse Sets."
[| each |
  i atEnd
    whileFalse:
      [each: (i collection array at: (i index: i index + 1)).
       each ifNotNil: [i position: i position + 1.
		       ^ each]].
].

i@(Set ReadStream traits) atEnd
"Checks both the Set size and then the underlying Array index, since a sparse
Set would reach the first before the second."
[
  i position = i collection size or: [i index = (i collection array size - 1)]
].

Bag traits addPrototype: #ReadStream derivedFrom: {Collection ReadStream}.
"Bag ReadStreams need some state to track their position in the Bag."
Bag ReadStream collection: Bag newEmpty.
Bag ReadStream addSlot: #elementIdx valued: 0.
"Which element index is the current one. This should traverse over the Mapping
from least to greatest, however the Mapping defines it."
Bag ReadStream addSlot: #occurrence valued: 0.
"Which occurrence is being looked at. It should vary from 0 to < the number of
occurrences for that element value."

i@(Bag ReadStream traits) on: b
"Targets the Bag and resets the position."
[
  resend.
  i collection: b.
  i elementIdx: 0.
  i occurrence: 0.
  i
].

i@(Bag ReadStream traits) atLastOccurrence
"Answer whether there are any further occurrences of the same element as the
iterator currently points to."
[
  i occurrence = (i collection contents at: i elementIdx)
].

i@(Bag ReadStream traits) atEnd
"The iterator has reached the end when it targets the last element and points
to the last occurrence of that object."
[
  i elementIdx = i collection contents tally and:
    [i atLastOccurrence]
].

i@(Bag ReadStream traits) next
"Significant logic has to occur to verify and update the position."
[
  i atEnd ifTrue: [^ Nil].
  i atLastOccurrence
    ifTrue: [i elementIdx: i elementIdx + 1. i occurrence: 1]
    ifFalse: [i occurrence: i occurrence + 1].
  i collection contents keyAt: i elementIdx
].

i@(Bag ReadStream traits) next: n
"This returns a Sequence up to the requested length of the next elements.
It returns early if it reaches the end, with the accumulated results."
[| result |
  result: (Array newSize: n).
  0 below: n do: [| :idx each |
    each: i next.
    each ifNil: [^ result] ifNotNil: [result at: idx put: each]]
  result
].

i@(Bag ReadStream traits) peek
"Note that this doesn't cache the peeked value."
[
  i atEnd ifTrue: [^ Nil].
  i atLastOccurrence
    ifTrue: [i collection contents keyAt: i elementIdx + 1]
    ifFalse: [i collection contents keyAt: i elementIdx]
].

Sequence traits addPrototype: #Stream derivedFrom: {PositionableStream}.
"A Stream over a Sequence, where the position corresponds to the index within
the Sequence."
Sequence Stream addSlot: #collection valued: ExtensibleArray newEmpty.

s@(Sequence Stream traits) on: c
"Target the stream to the specific collection, and reset the indices."
[
  s reset.
  s collection: c.
  s readLimit: c size.
  s
].

s@(Sequence Stream traits) contents
"Answer the contents of the target by copying, up to the limit."
[
  s collection copyFrom: 0 to: s readLimit - 1
].

s@(Sequence Stream traits) collectionType
[s collection].

s@(Sequence Stream traits) last
[
  s collection at: s position
].

Sequence traits addPrototype: #ReadStream
  derivedFrom: {Sequence Stream. ReadStream}.
"A Stream used to read from a Sequence object."

s@(Stream traits) newFrom: obj
"A convenient method to override for creating new ReadStreams of the
appropriate type for a given type of object."
[seq ReadStream newOn: obj].

seq@(Sequence traits) reader
[seq ReadStream newOn: seq].

rs@(Sequence ReadStream traits) next
[| pos |
  pos: rs position.
  pos < rs readLimit
    ifTrue:
      [rs position: pos + 1.
        rs collection at: pos]
].

rs@(Sequence ReadStream traits) next: n
"Overridden for efficiency."
[| newC end |
  end: (rs position + n min: rs readLimit).
  newC: (rs collection copyFrom: rs position to: end - 1).
  rs position: end.
  newC
].

rs@(Sequence ReadStream traits) next: n putInto: c startingAt: start
[| max |
  max: ((rs readLimit - rs position) min: n).
  c replaceFrom: start to: start + max - 1 with: rs collection startingAt: rs position.
  rs position: rs position + max.
  max = n
    ifTrue: [c]
    ifFalse: [c copyFrom: 0 to: start + max - 1]
].

rs@(Sequence ReadStream traits) peekAt: offset
[
  rs collection at: rs position + offset
].

rs@(Sequence ReadStream traits) peek
[rs peekAt: 0].

rs@(Sequence ReadStream traits) peekBack
[
  rs position = 0 ifFalse: [rs position: rs position - 1. rs next]
].

rs@(Sequence ReadStream traits) nextPut: obj
"Sequence ReadStreams should not place elements into the stream."
[Nil].

rs@(Sequence ReadStream traits) size
"The limit is effectively the number of elements that can be collected."
[
  rs readLimit
].

rs@(Sequence ReadStream traits) upTo: obj
"Answer all the elements until the given object is reached."
[| start end |
  start: rs position.
  end: (rs collection indexOf: obj startingAt: start 
         ifAbsent: [rs position: rs collection size. ^ (rs collection copyFrom: start)]).
  rs position: end + 1. 
  rs collection copyFrom: start to: end - 1
].

rs@(Sequence ReadStream traits) upToEnd
"Answer all the elements up to the limit by a copy."
[| start |
  start: rs position.
  rs position: rs collection size.
  rs collection copyFrom: start to: rs position - 1
].

rs@(Sequence ReadStream traits) on: c from: start to: end
"Target the stream on a particular slice of a collection."
[
  rs collection: c.
  rs readLimit: (end min: c size).
  rs position: start.
  rs
].

Sequence traits addPrototype: #WriteStream
		derivedFrom: {Sequence Stream. WriteStream}.
"A Stream used to write to a new or existing Sequence."
Sequence WriteStream addSlot: #writeLimit.

s@(Stream traits) newTo: obj@(Sequence traits)
[Sequence WriteStream newOn: obj].

seq@(Sequence traits) writer
[seq WriteStream newOn: seq].

ws@(Sequence WriteStream traits) on: c
[
  resend.
  ws readLimit: 0.
  ws writeLimit: c size.
  ws
].

ws@(Sequence WriteStream traits) contents
[
  ws readLimit: (ws readLimit max: ws position).
  ws collection copyFrom: 0 to: ws position - 1
].

ws@(Sequence WriteStream traits) next
[Nil].

ws@(Sequence WriteStream traits) nextPut: obj
[| pos |
  pos: ws position.
  pos >= ws writeLimit
    ifTrue: [ws pastEndPut: obj]
    ifFalse: [ws position: pos + 1.
      ws collection at: pos put: obj]
].

ws@(Sequence WriteStream traits) next: n putAll: c startingAt: start
[| newEnd |
  newEnd: ws position + n.
  newEnd > ws writeLimit ifTrue: [^ resend].
  0 below: n
    do: [| :index | 
      ws collection at: ws position + index put: (c at: start + index)].
  ws position: newEnd.
  ws
].

ws@(Sequence WriteStream traits) size
[
  ws readLimit: (ws readLimit max: ws position)
].

ws@(Sequence WriteStream traits) position: n
[
  ws readLimit: (ws readLimit max: n).
  resend.
  ws
].

ws@(Sequence WriteStream traits) newLine
"Output an appropriate newLine character."
"TODO: make this portable."
[
  ws nextPut: $\n
].

ws@(Sequence WriteStream traits) atBeginningOfLine
"Returns whether the stream is writing at a point where a line ending has
just occurred."
"TODO: make this portable."
[
  (ws collection at: ws position - 1) = $\n
].

ws@(Sequence WriteStream traits) freshLine
"Output a newLine character character if not currently at the end of a line."
[
  ws atBeginningOfLine ifFalse: [ws newLine]
].

ws@(Sequence WriteStream traits) reset
[
  ws readLimit: (ws readLimit max: ws position).
  ws position: 0.
  ws
].

ws@(Sequence WriteStream traits) resetToStart
[
  ws readLimit: (ws position: 0).
  ws
].

ws@(Sequence WriteStream traits) setToEnd
[
  ws position: ws size.
  ws
].

ws@(Sequence WriteStream traits) on: c from: start to: end
[
  ws collection: c.
  ws readLimit: (ws writeLimit: (end min: c size)).
  ws position: start.
  ws
].

ws@(Sequence WriteStream traits) pastEndPut: obj
[| c cs |
  c: ws collection.
  ws collection: c ; (c newSize: ((c size max: 20) min: 1000000)).
  ws writeLimit: ws collection size.
  ws collection at: ws position put: obj.
  ws position: ws position + 1.
  obj
].

ws@(Sequence WriteStream traits) peekLast
[
  ws position ifNotNil: [ws contents at: position]
].

ws@(Sequence WriteStream traits) with: c
[
  ws collection: c.
  ws position: (ws readLimit: (ws writeLimit: c size)).
  ws
].

Sequence traits addPrototype: #ReadWriteStream
		derivedFrom: {Sequence WriteStream. Sequence ReadStream}.

rws@(Sequence ReadWriteStream traits) contents
[
  rws readLimit: (rws readLimit max: rws position).
  rws collection copyFrom: 0 to: rws readLimit - 1
].

rws@(Sequence ReadWriteStream traits) next
[| pos |
  pos: rws position.
  pos >= rws readLimit
    ifTrue: [Nil]
    ifFalse: [rws position: pos + 1.
      rws collection at: pos]
].

rws@(Sequence ReadWriteStream traits) next: n
[| newC end |
  rws readLimit: (rws readLimit max: rws position).
  end: (rws position + n min: rws readLimit).
  newC: (rws collection copyFrom: rws position to: end - 1).
  rws position: end.
  newC
].

rws@(Sequence ReadWriteStream traits) = rws2@(Sequence ReadWriteStream traits)
[
  rws position = rws2 position and: [rws contents = rws2 contents]
].

rws@(Sequence ReadWriteStream traits) hash
[
  (rws isSameAs: Sequence ReadWriteStream) ifFalse: [^ resend].
  (rws position + rws readLimit + 53) hash
].

prototypes addPrototype: #LineNumberedStream derivedFrom: {Sequence ReadStream}.
"This is a wrapper mixin for streams that calculates line numbers."
LineNumberedStream addDelegate: #source valued: Stream clone.
"The stream being wrapped."
LineNumberedStream addSlot: #eolPositions valued: ExtensibleArray newEmpty.
"The positions of the end of each line."
LineNumberedStream addSlot: #lastPosition valued: 0.
"The position of the last character that EOL has been calculated for; we know
the line number for all characters before this position and nothing about
those after."
LineNumberedStream addSlot: #previousWasCR valued: False.
"Whether the previous character was a CR, for CR-LF streams. CR-LF in
combination should only increment the line number by 1."

s@(LineNumberedStream traits) on: r@(ReadStream traits)
[
  s source: r.
  s eolPositions: ({r position} as: ExtensibleArray).
  s lastPosition: r position.
  s previousWasCR: False.
  s
].

s@(LineNumberedStream traits) newOn: s2@(LineNumberedStream traits)
"LineNumberedStreams should not wrap other ones of the same type."
[
  s2
].

s@(LineNumberedStream traits) atEnd
[
  s source atEnd
].

s@(LineNumberedStream traits) is: _@(ReadStream traits)
[
  s source is: ReadStream
].

s@(LineNumberedStream traits) is: _@(WriteStream traits)
[
  s source is: WriteStream
].

s@(LineNumberedStream traits) lineNumber
[| index start stop pos |
  pos: s source position.
  pos >= s eolPositions last
    ifTrue: [^ s eolPositions size].
  start: 0.
  stop: s eolPositions size.
  [start + 1 < stop]
    whileTrue: [index: start + stop // 2.
		(s eolPositions at: index) <= pos
		  ifTrue: [start: index]
		  ifFalse: [stop: index]].
  start
].

s@(LineNumberedStream traits) columnNumber
"Returns the index difference from the position to the last eolPosition."
[
  s position - s eolPositions last
].

s@(LineNumberedStream traits) atBeginningOfLine
[
  s columnNumber = 0
].

s@(LineNumberedStream traits) atBOL
[s atBeginningOfLine].

s@(LineNumberedStream traits) atEndOfLine
[
  s position + 1 = s eolPositions last
].

s@(LineNumberedStream traits) atEOL
[s atEndOfLine].

s@(LineNumberedStream traits) next
[| char |
  char: s source next.
  s source position - 1 == s lastPosition
    ifTrue: [lastPosition: lastPosition + 1.
	     char == Character cr
	       ifTrue: [s eolPositions add: s source position.
			s previousWasCR: True]
	       ifFalse: [(s previousWasCR not
			    and: [char == Character lf])
			   ifTrue: [s eolPositions add: s source position].
			 s previousWasCR: False]].
  char
].

s@(LineNumberedStream traits) position
[
  s source position
].

s@(LineNumberedStream traits) position: n
[
  n > s lastPosition
    ifTrue: [s source position: lastPosition.
	     [s source position < n
		and: [s source atEnd not]]
	       whileTrue: [s next]]
    ifFalse: [s source position: n].
  s
].

s@(LineNumberedStream traits) skip: n
[
  s position: s position + n
].

s@(LineNumberedStream traits) upTo: char
[| stream char |
  stream: String writer.
  [s atEnd or: [(char: s next) == char]]
    whileFalse: [stream nextPut: char].
  stream contents
].