src/core/stream-collections.slate

   1 Collection traits define: #Stream &parents: {PositionableStream} &slots: {#collection}.
   2 "Collection Streams allow accessing of and writing into Collections like any
   3 other Stream terminal."
   4
   5 s@(Collection Stream traits) terminal [s collection].
   6
   7 s@(Collection Stream traits) contents
   8 "Answer the Stream's contents, in the default case the collection itself."
   9 [
  10   s collection
  11 ].
  12
  13 s@(Collection Stream traits) close
  14 "Closes the link between the Stream and the Collection and resets it,
  15 returning the Collection."
  16 [
  17   result ::= s collection.
  18   s collection := Nil.
  19   s reset.
  20   result
  21 ].
  22
  23 s@(Collection Stream traits) hasAnEnd
  24 "All Collections are finite, so Streams over them have an end."
  25 [True].
  26
  27 s@(Collection Stream traits) collectionType
  28 [#{}].
  29
  30 streamBlock@(Method traits) writingInto: c@(Collection traits)
  31 "Create a new WriteStream for the given collection and apply the block to it,
  32 answering the contents once done."
  33 [
  34   stream ::= c writer.
  35   streamBlock applyWith: stream.
  36   stream contents
  37 ].
  38
  39 streamBlock@(Method traits) writingAs: c@(Collection traits) &capacity: capacity
  40 "Create a new WriteStream for a new collection like the given one and apply the
  41 block to it, answering the contents once done."
  42 [
  43   streamBlock writingInto: (c new &capacity: capacity)
  44 ].
  45
  46 streamBlock@(Method traits) writingAs: s@(ReadStream traits) &capacity: capacity
  47 [
  48   (streamBlock writingAs: s contents new &capacity: capacity) reader
  49 ].
  50
  51 Collection traits define: #ReadStream
  52                   &parents: {Collection Stream. ReadStream}.
  53 "The default kind of iterator, a slot on the shared traits of Collection."
  54
  55 ExtensibleCollection traits define: #WriteStream &parents: {WriteStream} &slots: {#collection}.
  56 "A totally non-Positionable WriteStream variant which just maps the protocol
  57 to Collection addition protocol."
  58
  59 ws@(ExtensibleCollection WriteStream traits) on: c
  60 "Targets the collection."
  61 [
  62   ws collection := c.
  63   ws
  64 ].
  65
  66 ws@(ExtensibleCollection WriteStream traits) contents
  67 [
  68   ws collection
  69 ].
  70
  71 ws@(ExtensibleCollection WriteStream traits) nextPut: obj
  72 [ws collection add: obj].
  73
  74 ws@(ExtensibleCollection WriteStream traits) nextPutAll: c
  75 [ws collection addAll: c].
  76
  77 ws@(ExtensibleCollection WriteStream traits) next: n putAll: seq startingAt: start
  78 [
  79   ws collection addAll: (seq sliceFrom: start)
  80 ].
  81
  82 ws@(ExtensibleCollection WriteStream traits) close
  83 "Closes the link between the Stream and the Collection and resets it."
  84 [
  85   result ::= ws collection.
  86   ws collection := Nil.
  87   result
  88 ].
  89
  90 ws@(ExtensibleCollection WriteStream traits) hasAnEnd [True].
  91
  92 ws@(ExtensibleCollection WriteStream traits) isAtEnd
  93 "This type of stream cannot write over the contents and is perpetually
  94 `at the end' of the contents, adding new elements."
  95 [True].
  96
  97 c@(Collection traits) iterator
  98 "Syntactic sugar for getting a new ReadStream or ReadWriteStream over the
  99 given Collection that respects the same type."
 100 [c reader].
 101
 102 c@(Collection traits) reader
 103 "Syntactic sugar for getting a new ReadStream onto the given Collection
 104 that respects the same type."
 105 [c ReadStream newOn: c].
 106
 107 c@(Collection traits) writer
 108 "Syntactic sugar for getting a new WriteStream onto the given Collection
 109 that respects the same type."
 110 [c WriteStream newOn: c].
 111
 112 cols@(Collection traits) iterators
 113 "Returns a Collection of ReadStreams on the those in the given one. The
 114 argument collection cannot contain non-collections."
 115 [
 116   cols collect: #iterator `er into: Array
 117 ].
 118
 119 cols@(Sequence traits) allDo: block
 120 "Apply a coordinated do: over all of the collections in the given one,
 121 using iterators."
 122 [
 123   iterators ::= cols iterators.
 124   args ::= Array newSizeOf: iterators.
 125   [iterators anySatisfy: #isAtEnd `er]
 126     whileFalse:
 127       [iterators collect: #next `er into: args.
 128        block applyTo: args].
 129 ].
 130
 131 x@(Collection traits) with: y@(Collection traits) do: block
 132 [{x. y} allDo: block].
 133
 134 cols@(Sequence traits) allCollect: block into: result
 135 "Uses allDo: to perform a collect: over the Sequence's Collections' elements,
 136 using a stream in between."
 137 [[| :result | cols allDo: [| *vals | result nextPut: (block applyTo: vals)]]
 138   writingAs: result
 139 ].
 140
 141 cols@(Sequence traits) allCollect: block
 142 "Perform allCollect:into: using the Sequence as the result template."
 143 [cols allCollect: block into: cols].
 144
 145 cols@(Sequence traits) streamAllCollect: block
 146 [
 147   [(cols iterators collect: #next`er)
 148      reader collect: [| *rest | block applyTo: rest]]
 149     breakOn: Exhaustion
 150 ].
 151
 152 x@(Collection traits) with: y@(Collection traits) collect: block
 153 [{x. y} allCollect: block].
 154
 155 cols@(Sequence traits) zip
 156 "Uses allCollect: to gather all the collection's collections' elements into
 157 one collection. In other words, zip means to turn a pair of lists into
 158 a list of pairs (for general values of 'pair')."
 159 [cols allCollect: [| *vals | vals]].
 160
 161 cols@(Sequence traits) unzip
 162 "Transposes a sequence of collection into a collection of sequences of those
 163 elements across them, using a collection of streams and running with:do:
 164 across the collection-result mapping. In other words, unzip means to turn a
 165 list of pairs into a pair of lists (for general values of 'pair')."
 166 [
 167   results ::= cols first collect: [| :_ | cols newSameSize writer].
 168   cols do:
 169     [| :col | col with: results do: [| :val :result | result nextPut: val]].
 170   results collect: #contents `er
 171 ].
 172
 173 cols@(Sequence traits) allInject: start into: block
 174 "Runs inject:into: across all the given collection's collections' elements."
 175 [| result |
 176   result := start.
 177   cols allDo: [| *vals | result := block applyTo: (vals copyWith: result at: 0)].
 178   result
 179 ].
 180
 181 source@(Root traits) streamInto: target
 182 "Totally generic method for streaming the contents of one thing into another."
 183 [
 184   source reader >> target writer
 185 ].
 186
 187 source@(Root traits) streamFrom: target
 188 [
 189   target streamInto: source
 190 ].
 191
 192 cols@(Sequence traits) combinationsDo: block
 193 "This performs a basic increment-with-carry across the iterators until
 194 they are exhausted. The block is applied to all intermediate results."
 195 [| position it |
 196   ((iterators ::= cols iterators) anySatisfy: #isAtEnd `er)
 197    ifTrue: [^ Nil].
 198   values ::= iterators collect: #next `er .
 199   block applyTo: values.
 200   [position := iterators indexLast.
 201    eachIterator := iterators at: position.
 202    [eachIterator isAtEnd /\ [position > 0]]
 203      whileTrue:
 204        [eachIterator reset.
 205         values at: position put: eachIterator next.
 206         position -= 1.
 207         eachIterator := iterators at: position].
 208    eachIterator isAtEnd /\ [position isZero]
 209      ifTrue:
 210        [^ Nil]
 211      ifFalse:
 212        [values at: position put: eachIterator next].
 213    block applyTo: values] loop
 214 ].
 215
 216 cols@(Sequence traits) combinationsCollect: block into: result
 217 "Uses combinationsDo: to perform a collect: over all combinations of elements from the
 218 Collections in the Sequence, using a stream in between."
 219 [[| :result | cols combinationsDo: [| *vals | result nextPut: (block applyTo: vals)]]
 220   writingAs: result
 221 ].
 222
 223 cols@(Sequence traits) combinationsCollect: block
 224 "Perform combinationsCollect:into: using the Sequence as the result template."
 225 [cols combinationsCollect: block into: cols].
 226
 227 cols@(Sequence traits) combinationsInject: start into: block
 228 "Runs inject:into: across all the combinations of the given Sequence's Collections' elements."
 229 [| result |
 230   result := start.
 231   cols combinationsDo: [| *vals | result := block applyTo: (vals copyWith: result at: 0)].
 232   result
 233 ].
 234
 235 Set traits define: #ReadStream &parents: {Collection ReadStream} &slots: {
 236   #collection -> Set new.
 237   #position -> 0. "The number of elements passed so far."
 238   #index -> 0. "The index into the Set's contents Array."
 239 }.
 240 "Set ReadStreams are just Positionable- over the element order in the Set's
 241 contents Array. They're not very efficient, having to check for Nil's."
 242
 243 i@(Set ReadStream traits) on: c
 244 "Retargets to the new Set, and resets position, etc."
 245 [i `>> [collection := c. position := 0. index := 0. ]].
 246
 247 i@(Set ReadStream traits) next
 248 "Increment the index through the array until a non-Nil element is reached.
 249 This is poor for sparse Sets."
 250 [
 251   (i collection contents indexOfFirstSatisfying: [| :x | x isNotNil] startingAt: i index)
 252     ifNil: [i exhausted]
 253     ifNotNilDo:
 254       [| :nextIndex |
 255        i index := nextIndex + 1.
 256        i position := i position + 1.
 257        i collection contents at: nextIndex]
 258 ].
 259
 260 i@(Set ReadStream traits) next: n putInto: seq startingAt: start
 261 [| numRead nextIndex |
 262   numRead := 0.
 263   contents ::= i collection contents.
 264   nextIndex := i index.
 265   seqIndex := start.
 266   [(nextIndex := contents indexOfFirstSatisfying: #isNotNil `er startingAt: i index) isNil] whileFalse:
 267     [i index := nextIndex + 1.
 268      i position += 1.
 269      seq at: seqIndex put: (contents at: nextIndex).
 270      numRead += 1.
 271      seqIndex += 1].
 272   numRead
 273 ].
 274
 275 i@(Set ReadStream traits) isAtEnd
 276 "Checks both the Set size and then the underlying Array index, since a sparse
 277 Set would reach the first before the second."
 278 [
 279   i position = i collection size \/ [i index = i collection contents indexLast]
 280 ].
 281
 282 Sequence traits define: #Stream &parents: {PositionableStream} &slots: {#collection -> ExtensibleArray new}.
 283 "A Stream over a Sequence, where the position corresponds to the index within
 284 the Sequence."
 285
 286 s@(Sequence Stream traits) on: c
 287 "Target the stream to the specific collection, and reset the indices."
 288 [s `>> [reset. collection := c. readLimit := c size. ]].
 289
 290 s@(Sequence Stream traits) contents
 291 "Answer the contents of the target by copying, up to the limit."
 292 [
 293   s collection copyFrom: 0 below: s readLimit
 294 ].
 295
 296 s@(Sequence Stream traits) collectionType
 297 [s collection].
 298
 299 s@(Sequence Stream traits) last
 300 [
 301   s collection at: s position
 302 ].
 303
 304 Sequence traits define: #ReadStream
 305   &parents: {Sequence Stream. ReadStream}.
 306 "A Stream used to read from a Sequence object."
 307
 308 s@(Stream traits) newFrom: obj
 309 "A convenient method to override for creating new ReadStreams of the
 310 appropriate type for a given type of object."
 311 "NOTE: determine what overrides justify this since #reader is easier for nearly
 312 all cases."
 313 [obj ReadStream newOn: obj].
 314
 315 rs@(Sequence ReadStream traits) next
 316 [
 317   (pos ::= rs position) < rs readLimit
 318     ifTrue:
 319       [rs position := pos + 1.
 320        rs collection at: pos]
 321     ifFalse: [rs exhausted]
 322 ].
 323
 324 rs@(Sequence ReadStream traits) next: n
 325 "Overridden for efficiency."
 326 [
 327   end ::= rs position + n min: rs readLimit.
 328   result ::= rs collection copyFrom: rs position below: end.
 329   rs position := end.
 330   result
 331 ].
 332
 333 rs@(Sequence ReadStream traits) next: n putInto: c startingAt: start
 334 [
 335   max ::= rs readLimit - rs position min: n.
 336   c replaceFrom: start to: start + max - 1 with: rs collection startingAt: rs position.
 337   rs position += max.
 338   max
 339 ].
 340
 341 rs@(Sequence ReadStream traits) peekAt: offset
 342 [
 343   rs collection at: rs position + offset
 344 ].
 345
 346 rs@(Sequence ReadStream traits) peek
 347 [rs peekAt: 0].
 348
 349 rs@(Sequence ReadStream traits) peekBack
 350 [
 351   rs position isZero ifFalse: [rs position := rs position - 1. rs next]
 352 ].
 353
 354 rs@(Sequence ReadStream traits) nextPut: obj
 355 "Sequence ReadStreams should not place elements into the stream."
 356 [Nil].
 357
 358 rs@(Sequence ReadStream traits) size
 359 "The limit is effectively the number of elements that can be collected."
 360 [
 361   rs readLimit
 362 ].
 363
 364 rs@(Sequence ReadStream traits) upTo: obj
 365 "Answer all the elements until the given object is reached."
 366 [
 367   start ::= rs position.
 368   end ::= rs collection indexOf: obj startingAt: start ifAbsent:
 369     [rs position := rs collection size. ^ (rs collection copyFrom: start)].
 370   rs position := end + 1.
 371   rs collection copyFrom: start below: end
 372 ].
 373
 374 rs@(Sequence ReadStream traits) upToEnd
 375 "Answer all the elements up to the limit by a copy."
 376 [
 377   start ::= rs position.
 378   rs position := rs collection size.
 379   rs collection copyFrom: start below: rs position
 380 ].
 381
 382 rs@(Sequence ReadStream traits) on: c from: start to: end
 383 "Target the stream on a particular slice of a collection."
 384 [rs `>> [collection := c. readLimit := end min: c size. position := start. ]].
 385
 386 Sequence traits define: #WriteStream
 387                 &parents: {Sequence Stream. WriteStream}
 388                 &slots: {#writeLimit}.
 389
 390 s@(Stream traits) newTo: obj@(Sequence traits) &position: position
 391 [obj WriteStream newOn: obj &position: position].
 392
 393 seq@(Sequence traits) writer &position: position
 394 [seq WriteStream newOn: seq &position: position].
 395
 396 seq@(Sequence traits) appender
 397 [seq WriteStream newOn: seq &position: seq size].
 398
 399 ws@(Sequence WriteStream traits) newOn: c &position: position
 400 [ws clone on: c &position: position].
 401
 402 ws@(Sequence WriteStream traits) on: c &position: position
 403 [
 404   resend.
 405   ws writeLimit := c size.
 406   position ifNotNil: [ws position := position].
 407   ws
 408 ].
 409
 410 ws@(Sequence WriteStream traits) contents
 411 [
 412   ws readLimit := ws readLimit max: ws position.
 413   ws collection copyFrom: 0 below: ws readLimit
 414 ].
 415
 416 ws@(Sequence WriteStream traits) next
 417 [Nil].
 418
 419 ws@(Sequence WriteStream traits) growCollectionAtEnd &byAtLeast: minGrowth
 420 [
 421   c ::= ws collection.
 422   newSize ::= c size + (c size min: 1000000 max: (minGrowth ifNil: [20])).
 423   ws collection := c newSize: newSize.
 424   ws collection replaceFrom: 0 to: c size - 1 with: c.
 425   ws writeLimit := newSize.
 426 ].
 427
 428 ws@(Sequence WriteStream traits) pastEndPut: obj
 429 [
 430   ws growCollectionAtEnd.
 431   ws collection at: ws position put: obj.
 432   ws position := ws position + 1.
 433   obj
 434 ].
 435
 436 ws@(Sequence WriteStream traits) nextPut: obj
 437 [
 438   (pos ::= ws position) >= ws writeLimit
 439     ifTrue: [ws pastEndPut: obj]
 440     ifFalse: [ws position := pos + 1.
 441               ws collection at: pos put: obj]
 442 ].
 443
 444 ws@(Sequence WriteStream traits) next: n putAll: c startingAt: start
 445 [
 446   (newEnd ::= ws position + n - 1) >= ws writeLimit ifTrue:
 447     [ws growCollectionAtEnd &byAtLeast: newEnd - ws writeLimit + 4].
 448   ws collection replaceFrom: ws position to: newEnd with: c startingAt: start.
 449   ws position := newEnd + 1.
 450   n
 451 ].
 452
 453 ws@(Sequence WriteStream traits) size
 454 [
 455   ws readLimit := ws readLimit max: ws position
 456 ].
 457
 458 ws@(Sequence WriteStream traits) position: n
 459 [
 460   ws readLimit := ws readLimit max: n.
 461   resend.
 462   ws
 463 ].
 464
 465 ws@(Sequence WriteStream traits) newLine
 466 "Output an appropriate newLine character."
 467 "TODO: make this portable."
 468 [
 469   ws nextPut: $\n
 470 ].
 471
 472 ws@(Sequence WriteStream traits) atBeginningOfLine
 473 "Returns whether the stream is writing at a point where a line ending has
 474 just occurred."
 475 "TODO: make this portable."
 476 [
 477   (ws collection at: ws position - 1) = $\n
 478 ].
 479
 480 ws@(Sequence WriteStream traits) freshLine
 481 "Output a newLine character character if not currently at the end of a line."
 482 [
 483   ws atBeginningOfLine ifFalse: [ws newLine]
 484 ].
 485
 486 ws@(Sequence WriteStream traits) reset
 487 [
 488   ws readLimit := ws readLimit max: ws position.
 489   ws position := 0.
 490   ws
 491 ].
 492
 493 ws@(Sequence WriteStream traits) resetToStart
 494 [
 495   ws readLimit := ws position := 0.
 496   ws
 497 ].
 498
 499 ws@(Sequence WriteStream traits) setToEnd
 500 [
 501   ws position := ws size.
 502   ws
 503 ].
 504
 505 ws@(Sequence WriteStream traits) on: c from: start to: end
 506 [
 507   ws collection := c.
 508   ws readLimit := ws writeLimit := end min: c size.
 509   ws position := start.
 510   ws
 511 ].
 512
 513 ws@(Sequence WriteStream traits) peekLast
 514 [
 515   ws position ifNotNil: [ws contents at: position]
 516 ].
 517
 518 ws@(Sequence WriteStream traits) with: c
 519 [
 520   ws collection := c.
 521   ws position := ws readLimit := ws writeLimit := c size.
 522   ws
 523 ].
 524
 525 Sequence traits define: #ReadWriteStream
 526                 &parents: {Sequence WriteStream. Sequence ReadStream}.
 527
 528 rws@(Sequence traits) iterator
 529 [
 530   rws ReadWriteStream newOn: rws
 531 ].
 532
 533 rws@(Sequence ReadWriteStream traits) contents
 534 [
 535   rws readLimit := rws readLimit max: rws position.
 536   rws collection copyFrom: 0 below: rws readLimit
 537 ].
 538
 539 rws@(Sequence ReadWriteStream traits) next
 540 [
 541   (pos ::= rws position) >= rws readLimit
 542     ifTrue: [rws exhausted]
 543     ifFalse: [rws position := pos + 1.
 544               rws collection at: pos]
 545 ].
 546
 547 rws@(Sequence ReadWriteStream traits) next: n
 548 [
 549   rws readLimit := rws readLimit max: rws position.
 550   end ::= rws position + n min: rws readLimit.
 551   result ::= rws collection copyFrom: rws position below: end.
 552   rws position := end.
 553   result
 554 ].
 555
 556 rws@(Sequence ReadWriteStream traits) = rws2@(Sequence ReadWriteStream traits)
 557 [
 558   rws position = rws2 position /\ [rws contents = rws2 contents]
 559 ].
 560
 561 rws@(Sequence ReadWriteStream traits) hash
 562 [
 563   (rws isSameAs: Sequence ReadWriteStream) ifFalse: [^ resend].
 564   (rws position + rws readLimit + 53) hash
 565 ].
 566
 567 ExtensibleSequence traits define: #WriteStream
 568   &parents: {Sequence WriteStream}.
 569 "A Stream used to write to a new or existing ExtensibleSequence."
 570
 571 ws@(ExtensibleSequence WriteStream traits) pastEndPut: obj
 572 [
 573   c ::= ws collection.
 574   c addLast: obj.
 575   ws writeLimit := c size.
 576   ws position += 1.
 577   obj
 578 ].
 579
 580 ws@(ExtensibleSequence WriteStream traits) next: n putAll: c startingAt: start
 581 [
 582   ws collection at: ws position insertAll: (c copyFrom: start below: start + n).
 583   ws position += n.
 584   n
 585 ].
 586
 587 ExtensibleSequence traits define: #ReadWriteStream
 588   &parents: {ExtensibleSequence WriteStream. ExtensibleSequence ReadStream}.