src/text/stream-processors.slate

   1 streams define: #LimitedProcessor &parents: {DelegatingProcessor} &slots: {
   2   #count -> 0
   3 }.
   4
   5 s@(LimitedProcessor traits) for: n
   6 [
   7   s clone `>> [count := n. ]
   8 ].
   9
  10 s@(LimitedProcessor traits) isAtEnd
  11 [
  12   s count <= s count zero \/ [resend]
  13 ].
  14
  15 s@(LimitedProcessor traits) next: n putInto: seq startingAt: start
  16 [
  17   s count >= n
  18     ifTrue: [s count -= n. resend]
  19     ifFalse: [n := s count. s count := 0. resend]
  20 ].
  21
  22 streams define: #InOutProcessor &parents: {StreamProcessor} &slots: {
  23   #inputBuffer.
  24   #outputBuffer
  25 }.
  26
  27 p@(InOutProcessor traits) on: s
  28 [
  29   resend `>> [inputBuffer := s source collectionType new. outputBuffer := s collectionType new. ]
  30 ].
  31
  32 s@(InOutProcessor traits) canProcessMore
  33 [
  34   s inputBuffer isNotEmpty \/ [s source isAtEnd not]
  35 ].
  36
  37 s@(InOutProcessor traits) next: n putInto: seq startingAt: start
  38 [| buf amt |
  39   [s outputBuffer size < n /\ [s canProcessMore]]
  40     whileTrue: [s bufferInputTo: s requiredInSize. s process].
  41   amt := n min: s outputBuffer size.
  42   seq replaceFrom: start to: start + amt - 1 with: s outputBuffer.
  43   s outputBuffer := s outputBuffer allButFirst: amt.
  44   amt
  45 ].
  46
  47 s@(InOutProcessor traits) isAtEnd
  48 [
  49   s outputBuffer isEmpty /\ [s inputBuffer isEmpty] /\ [resend]
  50 ].
  51
  52 s@(InOutProcessor traits) requiredInSize
  53 "This is the amount we try to get into the in buffer every time. Useful
  54 if you're looking for a search string of a specified size. Override in child classes."
  55 [
  56   4
  57 ].
  58
  59 "doesn't/can't guarantee that it's filled!"
  60 s@(InOutProcessor traits) bufferInputTo: neededSize
  61 [| nextBuffer amt needed |
  62   s inputBuffer size >= neededSize ifFalse:
  63     [needed := neededSize - s inputBuffer size.
  64      nextBuffer := s source collectionType new &capacity: needed.
  65      amt := s source next: needed putInto: nextBuffer.
  66      s inputBuffer := s inputBuffer ; (nextBuffer first: amt)].
  67 ].
  68
  69 s@(InOutProcessor traits) process
  70 [
  71   s passInThrough
  72 ].
  73
  74 s@(InOutProcessor traits) passInThrough
  75 [
  76   s write: s inputBuffer.
  77   s inputBuffer := s source collectionType new.
  78 ].
  79
  80 s@(InOutProcessor traits) write: seq
  81 [
  82   s outputBuffer := s outputBuffer ; seq
  83 ].
  84
  85 s@(InOutProcessor traits) skip: amt
  86 [
  87   s inputBuffer := s inputBuffer allButFirst: amt
  88 ].
  89
  90
  91 s@(InOutProcessor traits) guaranteedReadable
  92 [
  93   s outputBuffer size
  94 ].
  95
  96 streams define: #SimpleReplacementStream &parents: {InOutProcessor} &slots: {
  97   #search.
  98   #replace
  99 }.
 100
 101 s@(SimpleReplacementStream traits) find: x replaceWith: y
 102 [
 103   s new `>> [search: x. replace: y. ]
 104 ].
 105
 106 s@(SimpleReplacementStream traits) requiredInSize
 107 [
 108   s search size max: 1
 109 ].
 110
 111 "fixme don't cons as much"
 112 s@(SimpleReplacementStream traits) process
 113 [
 114   s search size < 1 ifTrue: [^ s passInThrough].
 115
 116   [s inputBuffer size >= s requiredInSize]
 117     whileTrue:
 118       [(s inputBuffer first: s search size) = s search
 119          ifTrue: [s write: s replace. s skip: s search size]
 120          ifFalse: [s write: (s inputBuffer first: 1). s skip: 1 ]].
 121
 122   s source isAtEnd ifTrue: [s passInThrough]
 123 ].
 124
 125 s@(Sequence traits) find: find@(Sequence traits) replaceWith: replace@(Sequence traits)
 126 [
 127   [| :out |
 128    s reader >> (SimpleReplacementStream find: find replaceWith: replace) >> out
 129   ] writingAs: s
 130 ].
 131
 132 streams define: #MultiProcessor &parents: {DelegatingProcessor} &slots: {#children}.
 133
 134 mp@(MultiProcessor traits) using: s
 135 [
 136   mp new `>> [children: s. ]
 137 ].
 138
 139 mp@(MultiProcessor traits) on: s
 140 [
 141   mp children isEmpty ifTrue: [^ (error: 'No children for processor')].
 142
 143   "fixme we should be able to write the following in a better way"
 144   mp children first on: s.
 145   (1 to: mp children size - 1 by: 1) do: [|:i| (mp children at: i) on: (mp children at: i - 1)].
 146   mp source: mp children last.
 147
 148   mp
 149 ].
 150
 151 d@(Dictionary traits) keysAndValuesCollect: block
 152 [
 153   d isEmpty ifTrue: [^ #{}].
 154   result ::= ExtensibleArray new.
 155   d keysAndValuesDo: [| :key :val | result add: (block applyWith: key with: val)].
 156   result
 157 ].
 158
 159 s@(Sequence traits) sequentialFindAndReplace: dict@(Dictionary traits)
 160 [
 161   [| :out |
 162    s reader
 163      >> (MultiProcessor using:
 164            (dict keysAndValuesCollect: [| :key :val | SimpleReplacementStream find: key replaceWith: val]))
 165      >> out] writingAs: s
 166 ].
 167
 168 streams define: #MultiReplacementStream &parents: {InOutProcessor} &slots: {
 169   #dict -> Dictionary new.
 170   #cachedSize
 171 }.
 172
 173 s@(MultiReplacementStream traits) from: d@(Dictionary traits)
 174 [
 175   s new `>> [dict := d. ]
 176 ].
 177
 178 s@(MultiReplacementStream traits) requiredInSize
 179 [
 180   s cachedSize `defaultsTo: (s dict keys collect: #size `er) max
 181 ].
 182
 183 s@(MultiReplacementStream traits) process
 184 [| hasMatched |
 185   s requiredInSize < 1 ifTrue: [^ s passInThrough].
 186   [s inputBuffer size >= 1]
 187     whileTrue:
 188       [hasMatched := False.
 189        s dict keysAndValuesDo:
 190          [| :key :val |
 191           (s inputBuffer beginsWith: key)
 192             ifTrue:
 193               [s write: val.
 194                s skip: key size.
 195                hasMatched := True]].
 196        hasMatched ifFalse:
 197          [s write: s inputBuffer first.
 198           s skip: 1]].
 199 ].
 200
 201 s@(Sequence traits) findAndReplace: dict@(Dictionary traits)
 202 [
 203   [| :out |
 204    s reader >> (MultiReplacementStream from: dict) >> out
 205   ] writingAs: s
 206 ].
 207
 208 "todo: look at using extensible arrays"
 209 streams define: #LineProcessor &parents: {InOutProcessor} &slots: {#currentLine}.
 210
 211 s@(LineProcessor traits) collectionType [Array].
 212
 213 s@(LineProcessor traits) process
 214 [| pos lastChar |
 215   s currentLine `defaultsTo: (s inputBuffer newSize: 0).
 216   (pos := s inputBuffer indexOfFirstSatisfying: [| :char | lastChar := char. char = $\n \/ [char = $\r]])
 217     ifNil:
 218       [s currentLine := s currentLine ; s inputBuffer.
 219        s inputBuffer := s inputBuffer new.
 220        ^ Nil].
 221   (s currentLine := s currentLine ; (inputBuffer first: pos))
 222     isEmpty ifFalse: [s currentLine last = $\r ifTrue: [s currentLine := s currentLine allButLast]].
 223   s write: s currentLine.
 224   s inputBuffer := inputBuffer allButFirst: pos.
 225   s bufferInputTo: 1.
 226   s inputBuffer isEmpty not /\ [s inputBuffer first = $\n] /\ [lastChar = $\r]
 227     ifTrue: [s inputBuffer := s inputBuffer allButFirst].
 228 ].
 229
 230 s@(LineProcessor traits) next: n putInto: seq startingAt: start
 231 [| buf amt |
 232   [s outputBuffer size < n /\ [s canProcessMore]] whileTrue:
 233     [s bufferInputTo: s requiredInSize. s process].
 234   amt := n min: s outputBuffer size.
 235   seq replaceFrom: start to: start + amt - 1 with: s outputBuffer.
 236   s outputBuffer := s outputBuffer allButFirst: amt.
 237   amt
 238 ].
 239