src/core/stream-transforms.slate

   1 streams define: #ConcatenatedReadStream
   2   &parents: {PositionableReadStream}
   3   &slots: {
   4 "A Stream acting as the result of concatenating all the source streams'
   5 sources into a single source to be read."
   6 #sources -> ExtensibleArray new.
   7 "The Streams which are concatenated."
   8 #currentSource.
   9 "The current Stream being read."
  10 #position -> 0.
  11 "The overall position of the stream, taken by tabulating."
  12 }.
  13
  14 s1@(Stream traits) ; s2@(Stream traits)
  15 [
  16   ConcatenatedReadStream newOn: {s1. s2}
  17 ].
  18
  19 cs@(ConcatenatedReadStream traits) ; s@(Stream traits)
  20 [
  21   cs sources addLast: s.
  22   cs
  23 ].
  24
  25 s@(ConcatenatedReadStream traits) on: sources
  26 [
  27   s sources := sources as: s sources.
  28   s currentSource := s sources first.
  29   s position := 0.
  30   s
  31 ].
  32
  33 s@(ConcatenatedReadStream traits) hasAnEnd [s sources allSatisfy: #hasAnEnd `er].
  34
  35 s@(ConcatenatedReadStream traits) isAtEnd
  36 [
  37   s currentSource = s sources last /\ [s currentSource isAtEnd]
  38 ].
  39
  40 s@(ConcatenatedReadStream traits) next
  41 [
  42   s currentSource isAtEnd ifTrue:
  43     [| nextSrcIdx |
  44      (nextSrcIdx := (s sources indexOf: s currentSource) + 1)
  45        = s sources size ifTrue: [^ s exhaustion].
  46      s currentSource := s sources at: nextSrcIdx].
  47   s currentSource next
  48 ].
  49
  50 streams define: #FlattenedReadStream &parents: {ReadStream} &slots: {#sources -> Stack new.}.
  51 "Allows the use of the flatten message to create a recursive traversal of
  52 all contained ReadStreams."
  53
  54 s@(Stream traits) flatten
  55 [FlattenedReadStream newOn: s].
  56
  57 s@(FlattenedReadStream traits) flatten
  58 [s].
  59
  60 s1@(FlattenedReadStream traits) on: s2
  61 [
  62   s1 sources := s1 sources newWith: s2.
  63   s1
  64 ].
  65
  66 s@(FlattenedReadStream traits) hasAnEnd [s sources allSatisfy: #hasAnEnd `er].
  67
  68 s@(FlattenedReadStream traits) isAtEnd
  69 [s sources size = 1 /\ [s sources top isAtEnd]].
  70
  71 s@(FlattenedReadStream traits) next
  72 [| obj |
  73   [s sources top isAtEnd]
  74     whileTrue:
  75      [s sources size <= 1
  76        ifTrue: [s exhausted]
  77        ifFalse: [s sources pop]].
  78   (obj := s sources top next) isSource
  79     ifTrue: [s sources push: obj reader.
  80              s next]
  81     ifFalse: [obj]
  82 ].
  83
  84 "A GeneratorStream will generate a stream of values by applying a step
  85 block to some seed value, and subsequently to what remains of the seed
  86 value, until the end block is satisfied."
  87 streams define: #GeneratorStream &parents: {ReadStream}
  88 &slots: {#currentValue -> Nil.
  89          #step -> Method Identity.
  90          #end -> [| :_ | False]}.
  91
  92 seed@(Root traits) generate: step until: end
  93 [GeneratorStream cloneSettingSlots: #{#currentValue. #step. #end}
  94                  to: {seed. step. end}].
  95
  96 seed@(Root traits) generate: step
  97 [seed generate: step until: GeneratorStream end].
  98
  99 s@(GeneratorStream traits) terminal [s step].
 100
 101 s@(GeneratorStream traits) hasAnEnd
 102 "TODO: Change to `maybe`, i.e. the Halting Problem."
 103 [True].
 104
 105 s@(GeneratorStream traits) isAtEnd
 106 [s end applyWith: s currentValue].
 107
 108 s@(GeneratorStream traits) next
 109 [
 110   s isAtEnd
 111     ifTrue: [s exhausted].
 112   s currentValue: (s step applyWith: s currentValue)
 113 ].
 114
 115 Stream traits define: #EchoStream &parents: {ReadWriteStream} &slots: {#original. #dribble}.
 116 "An EchoStream wraps some original stream and duplicates any interaction,
 117 reading or writing, done on it to another stream. This relies on EchoStream
 118 having defined all of the stream interaction methods that the client relies
 119 upon."
 120 "Inspired by Henry Lieberman's 1986 paper to the first OOPSLA, titled:
 121 _Using Prototypical Objects to Implement Shared Behavior in Object Oriented Systems_
 122 and archived at:
 123 http://lieber.www.media.mit.edu/people/lieber/Lieberary/OOP/Delegation/Delegation.html"
 124 "The target for the echo'ing operation, called dribble after the Lieberman /
 125 Lisp terminology."
 126
 127 s@(Stream traits) echoTo: log
 128 "Creates and returns a new EchoStream from the first to the log Stream."
 129 [(s EchoStream newOn: s) `>> [dribble := log. ]].
 130
 131 s@(Stream traits) echo
 132 "Creates and returns a new EchoStream to the console."
 133 [s echoTo: Console writer].
 134
 135 e@(Stream EchoStream traits) on: s
 136 [
 137   e original := s.
 138   e
 139 ].
 140
 141 e@(Stream EchoStream traits) echoTo: s
 142 "Chooses another Stream to dribble to, ensuring that echoTo: is not repeated."
 143 [
 144   e dribble := s.
 145   e
 146 ].
 147
 148 e@(Stream EchoStream traits) terminal [e dribble terminal].
 149
 150 e@(Stream EchoStream traits) next
 151 [
 152   e dribble nextPut: e original next
 153 ].
 154
 155 e@(Stream EchoStream traits) next: n
 156 [
 157   e dribble nextPutAll: (e original next: n)
 158 ].
 159
 160 e@(Stream EchoStream traits) nextPut: obj
 161 [
 162   e dribble nextPut: (e original nextPut: obj)
 163 ].
 164
 165 e@(Stream EchoStream traits) nextPutAll: seq
 166 [
 167   e dribble nextPutAll: (e original nextPutAll: seq)
 168 ].
 169
 170 e@(Stream EchoStream traits) position: n
 171 [
 172   e dribble position := e original position := n
 173 ].
 174
 175 ReadStream traits define: #LineStream &parents: {StreamProcessor} &slots: {#trailingNL -> False}.
 176 "A stream that reads lines of text from a wrapped stream, terminated by
 177 an appropriate line-ending (\r, \n or \r\n)."
 178
 179 l@(ReadStream LineStream traits) on: s
 180 [
 181   l source := s.
 182   l trailingNL := False.
 183   l
 184 ].
 185
 186 s@(Stream traits) lines [s LineStream newOn: s].
 187
 188 l@(ReadStream LineStream traits) collectionType [Array].
 189
 190 l@(ReadStream LineStream traits) nextLine
 191 [
 192   [| :line |
 193     l source `cacheAs: #underlying.
 194     [underlying isAtEnd
 195         ifTrue: [line collection isEmpty ifTrue: [^ Nil]. False]
 196         ifFalse: [| char |
 197           (char := underlying next) caseOf: {
 198             $\r -> [l trailingNL := True. False].
 199             $\n -> [| nl | nl := l trailingNL. l trailingNL := False. nl].
 200           } otherwise: [line nextPut: char. True]]
 201     ] whileTrue.
 202   ] writingAs: String
 203 ].
 204
 205 l@(ReadStream LineStream traits) next: n putInto: seq startingAt: start
 206 [
 207   0 below: n do:
 208     [| :index |
 209      l nextLine
 210        ifNil: [^ index] ifNotNilDo: [| :line | seq at: index + start put: line]].
 211   n
 212 ].
 213
 214 WriteStream traits define: #LineStream &parents: {Stream WrapperStream}.
 215 "A Stream that writes Strings of text to a wrapped Stream, interpolated with
 216 an appropriate line-ending."
 217
 218 l@(WriteStream LineStream traits) nextPut: str@(String traits)
 219 [l original ; str ; '\n'].
 220
 221 l@(WriteStream LineStream traits) nextPutAll: c
 222 [c do: #(l nextPut: _) `er].
 223
 224 l@(WriteStream LineStream traits) collectionType [Array].
 225
 226 ReadWriteStream traits define: #LineStream &parents:
 227   {ReadStream LineStream. WriteStream LineStream}.