requires: {}.
provides: {#Stream. #ReadStream. #WriteStream. #PositionableStream. #BlockStream. #DummyStream. #LineNumberedStream. #EchoStream}.

prototypes addSlot: #Stream valued: Cloneable derive.
"The shared protocol of all Stream objects, also providing a common
instantiation protocol."

s@(Stream traits) newOn: _
"Create a new stream of the same kind targetted on the given object."
[overrideThis].

s@(Stream traits) on: _
"(Re-)target the stream to some object. This modifies it in-place.
Overriding this will also customize newOn: for most uses."
[overrideThis].

s@(Stream traits) flush
"Do nothing by default."
[s].

s@(Stream traits) atEnd
"Answer whether the end of the Stream has been reached."
[overrideThis].

prototypes addSlot: #ReadStream valued: Stream derive.

s@(ReadStream traits) next
"Obtain and answer the next element from the Stream."
[overrideThis].

s@(ReadStream traits) next: n putInto: seq startingAt: start
"Returns a partial copy if not all elements can be read into the other collection."
[| obj |
  0 below: n do: [| :index |
    (obj: s next) ifNil: [^ (seq copyFrom: 0 to: start + index)].
    seq at: start + index put: obj].
  seq
].

s@(ReadStream traits) nextPutInto: seq startingAt: start
[
  s next: seq size putInto: seq startingAt: start
].

s@(ReadStream traits) nextPutInto: seq
[
  s next: seq size putInto: seq startingAt: 0
].

s@(ReadStream traits) next: n putAll: seq startingAt: start
[
  0 below: n do: [| :index |
    s nextPut: (seq at: start + index)].
  seq
].

s@(ReadStream traits) next: n putAll: seq
[
  s next: n putAll: seq startingAt: 0
].

s@(ReadStream traits) next: n putInto: seq@(Sequence traits)
"Places the next N elements into a Sequence at the starting indices."
[
  0 below: n do: [| :index | seq at: index put: s next].
  seq
].

s@(ReadStream traits) next: n putInto: seq@(ExtensibleSequence traits)
"Places the next N elements at the end of a given ExtensibleSequence."
[
  n timesRepeat: [seq addLast: s next].
  seq
].

s@(ReadStream traits) next: n
"Answer the next N elements."
[
  s next: n putInto: (Array newSize: n)
].

s@(ReadStream traits) next: n put: obj
"Make the next N values the argument object."
[
  n timesRepeat: [s nextPut: obj].
  obj
].

s@(ReadStream traits) nextMatchAll: c
"Whether the next N objects in the Stream are in the other collection
(which generally should be a Sequence, ie have linear order)."
[| pos |
  pos: s position.
  c do: [| :each |
    s next = each ifFalse: [s position: pos. ^ False]].
  True
].

prototypes addSlot: #WriteStream valued: Stream derive.

s@(WriteStream traits) nextPut: _
"Place the given element on the Stream."
[overrideThis].

s@(WriteStream traits) nextPutAll: c
"Place the Collection's contents into the stream."
[
  c do: [| :obj | s nextPut: obj].
  s
].

s@(WriteStream traits) nextPutAll: seq from: start to: end
"Place a range of the Sequence's contents into the Stream."
[
  seq from: start to: end do: [| :each | s nextPut: each]
].

s@(WriteStream traits) ; c
"Syntactic sugaring to make collection-insertion similar to concatenation."
[
  s nextPutAll: c
].

s@(WriteStream traits) upToEnd
"Supply all the elements up to the end of the stream."
[| newES |
  newES: ExtensibleSequence newEmpty.
  [s atEnd] whileFalse: [newES add: s next].
  newES
].

s@(WriteStream traits) do: block
"Call the block on all the elements in turn until the Stream is empty."
[
  [s atEnd] whileFalse: [block value: s next].
  s
].

r@(Stream traits) >> w
"Write the contents from source to target one element at a time."
[
  [r atEnd and: [w atEnd]]
    whileFalse: [w nextPut: r next]
].

w@(Stream traits) << r
[r >> w].

prototypes addSlot: #ReadWriteStream
  valued: (ReadStream deriveWith: {WriteStream}).

prototypes addSlot: #PositionableStream valued: Stream derive.
"PositionableStreams have an index and iterate over some sequenced collection,
but with a specific limit on the stream."
PositionableStream addSlot: #position valued: 0.
PositionableStream addSlot: #readLimit valued: 0.

s@(PositionableStream traits) newOn: c
"Override on: in derived objects in order to customize this."
[
  s clone on: c
].

s@(PositionableStream traits) newWith: c
[
  s clone with: c
].

s@(PositionableStream traits) newOn: c from: start to: end
[
  s clone on: c from: start to: end
].

s@(PositionableStream traits) on: _
"Reset the position."
[s reset].

s@(PositionableStream traits) contents
"Answer the contents of the target up to the readLimit."
[overrideThis].

s@(PositionableStream traits) collectionType
"Answer the default collection prototype to dump contents into."
[String].

s@(PositionableStream traits) last
[overrideThis].

s@(PositionableStream traits) next: n
[
  s next: n putInto: (s collectionType newSize: n)
].

s@(PositionableStream traits) upTo: obj
"Answer all objects up to one equal to the argument."
[| newS elem |
  newS: (s collectionType newSize: 100) writer.
  [s atEnd or: [(elem: s next) = obj]]
    whileFalse: [newS nextPut: elem].
  newS contents
].

s@(PositionableStream traits) upToEnd
[| newS obj |
  newS: (s collectionType newSize: 100) writer.
  [(obj: s next) isNil]
    whileFalse: [newS nextPut: obj].
  newS contents
].

s@(PositionableStream traits) peek
"Returns the results of next without advancing the stream."
[| obj |
  s atEnd ifTrue: [^ Nil].
  obj: s next.
  s position: s position - 1.
  obj
].

s@(PositionableStream traits) peekFor: obj
"Returns whether the object is next in the stream. Advances if true."
[| next |
  s atEnd ifTrue: [^ False].
  next: s next.
  obj = next
    ifFalse: [s position: s position - 1. False]
].

s@(PositionableStream traits) upTo: obj
"Answer all objects up to one equal to the argument."
[overrideThis].

s@(PositionableStream traits) upToAnyOf: c
"Answer all objects up to the first occurrence of something in the collection."
[| start endMatch newC |
  start: s position.
  (s match: c)
    ifTrue: [endMatch: s position.
      s position: start.
      newC: (s next: endMatch - start - c size).
      s position: endMatch.
      newC]
    ifFalse: [s position: start.
      s upToEnd]
].

s@(PositionableStream traits) upToEnd
"Answer all the elements up to the limit by a copy."
[overrideThis].

s@(PositionableStream traits) atEnd
[
  s position >= s readLimit
].

s@(PositionableStream traits) reset
[
  s position: 0.
  s
].

s@(PositionableStream traits) resetContents
[
  s position: 0.
  s readLimit: 0.
  s
].

s@(PositionableStream traits) setToEnd
[
  s position: s readLimit.
  s
].


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

s@(PositionableStream traits) skipTo: obj
[
  [s atEnd]
    whileFalse: [s next = obj ifTrue: [^ True]].
  False
].

s@(PositionableStream traits) setFrom: start to: end
[
  s position: start - 1.
  s readLimit: end.
  s
].

prototypes addSlot: #PositionableReadStream
  valued: (PositionableStream deriveWith: {ReadStream}).
prototypes addSlot: #PositionableWriteStream
  valued: (PositionableStream deriveWith: {WriteStream}).
prototypes addSlot: #PositionableReadWriteStream
  valued: (PositionableStream deriveWith: {ReadStream. WriteStream}).

prototypes addSlot: #DummyStream valued: ReadWriteStream derive.
"DummyStreams always return Nil's and can't be repositioned or written to,
but pretend that they can, eating up input and providing no output."

s@(Stream traits) newFrom: _@Nil
[DummyStream].

_@Nil iterator
[DummyStream].

_@Nil writer
[DummyStream].

_@(DummyStream traits) nextPut: _ [].
_@(DummyStream traits) nextPutAll: _ [].
_@(DummyStream traits) position [0].
_@(DummyStream traits) position: _ [].
_@(DummyStream traits) position: _ [].

prototypes addSlot: #BlockStream valued: ReadStream derive.
"BlockStreams take their next element from the recalculation of a code
closure with no arguments. This is effectively a means to poll some condition
or to generate a sequence."
BlockStream addSlot: #block valued: [].
"The calculation for generating the Stream elements."

s@(Stream traits) newFrom: block@(Method traits)
[BlockStream newOn: block].

m@(Method traits) iterator
"Mimics the Collection interface for making iterators that target them."
[m reader].

m@(Method traits) reader
"Mimics the Collection interface for making ReadStreams that target them."
[BlockStream newOn: m].

s@(BlockStream traits) newOn: block
[| newS |
  newS: s clone.
  newS block: block.
  newS
].

s@(BlockStream traits) next
[
  s block value
].

s@(BlockStream traits) atEnd
[False].

Stream traits addSlot: #EchoStream valued: ReadWriteStream derive.
"An EchoStream wraps some original stream and duplicates any interaction,
reading or writing, done on it to another stream. This relies on EchoStream
having defined all of the stream interaction methods that the client relies
upon."
"Inspired by Henry Lieberman's 1986 paper to the first OOPSLA, titled:
_Using Prototypical Objects to Implement Shared Behavior in Object Oriented Systems_
and archived at:
http://lieber.www.media.mit.edu/people/lieber/Lieberary/OOP/Delegation/Delegation.html"
Stream EchoStream addDelegate: #original valued: Stream clone.
"The source of the echo."
Stream EchoStream addSlot: #dribble valued: ConsoleOutput.
"The target for the echo'ing operation, called dribble after the Lieberman / 
Lisp terminology."

s@(Stream traits) echoTo: log
"Creates and returns a new EchoStream from the first to the log Stream."
[| echo |
  echo: (s EchoStream newOn: s).
  echo echoTo: log
].

e@(Stream EchoStream traits) newOn: s
[
  e clone on: s
].

e@(Stream EchoStream traits) on: s
[
  e original: s.
  e
].

e@(Stream EchoStream traits) echoTo: s
"Chooses another Stream to dribble to, ensuring that echoTo: is not repeated."
[
  e dribble: s.
  e
].

e@(Stream EchoStream traits) next
[
  e dribble nextPut: resend
].

e@(Stream EchoStream traits) next: n
[
  e dribble nextPutAll: resend
].

e@(Stream EchoStream traits) nextPut: obj
[
  e dribble nextPut: resend
].

e@(Stream EchoStream traits) nextPutAll: seq
[
  resend.
  e dribble nextPutAll: seq
].

PositionableStream traits addSlot: #EchoStream valued: Stream EchoStream derive.

e@(PositionableStream EchoStream traits) position: n
[
  e dribble position: resend
].

x printOn: s@(Stream traits)
[
  s ; '<@' ; x name ; ': '.
  x slotNames do: [| :each | s ; (each as: String)]
	      separatedBy: [s ; ', '].
  s nextPut: $>.
  x
].

ConsoleOutput addDelegate: #Stream valued: PositionableWriteStream traits.
ConsoleInput addDelegate: #Stream valued: PositionableReadStream traits.

co@(ConsoleOutput) skip: n
[
  n isPositive ifTrue:
    [n timesRepeat: (co nextPut: $\s)].
  n isNegative ifTrue: [co nextPut: $\b].
  co
].

"Defined in the interpreter.
x@(Root traits) print
[
  x printOn: ConsoleOutput
].
"