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 [| result |
  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 [| stream |
  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 [| result |
  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 [| iterators |
 123   iterators: cols iterators.
 124   [iterators anySatisfy: #isAtEnd `er]
 125      whileFalse: [block applyTo: (iterators collect: #next `er)].
 126 ].
 127
 128 x@(Collection traits) with: y@(Collection traits) do: block
 129 [{x. y} allDo: block].
 130
 131 cols@(Sequence traits) allCollect: block into: result
 132 "Uses allDo: to perform a collect: over the Sequence's Collections' elements,
 133 using a stream in between."
 134 [[| :result | cols allDo: [| *vals | result nextPut: (block applyTo: vals)]]
 135   writingAs: result
 136 ].
 137
 138 cols@(Sequence traits) allCollect: block
 139 "Perform allCollect:into: using the Sequence as the result template."
 140 [cols allCollect: block into: cols].
 141
 142 cols@(Sequence traits) streamAllCollect: block
 143 [
 144   [(cols iterators collect: #next`er)
 145    reader collect: [| *rest | block applyTo: rest]]
 146      breakOn: Exhaustion
 147 ].
 148
 149 x@(Collection traits) with: y@(Collection traits) collect: block
 150 [{x. y} allCollect: block].
 151
 152 cols@(Sequence traits) zip
 153 "Uses allCollect: to gather all the collection's collections' elements into
 154 one collection. In other words, zip means to turn a pair of lists into
 155 a list of pairs (for general values of 'pair')."
 156 [cols allCollect: [| *vals | vals]].
 157
 158 cols@(Sequence traits) unzip
 159 "Transposes a sequence of collection into a collection of sequences of those
 160 elements across them, using a collection of streams and running with:do:
 161 across the collection-result mapping. In other words, unzip means to turn a
 162 list of pairs into a pair of lists (for general values of 'pair')."
 163 [| results |
 164   results: (cols first collect: [| :_ | cols newSameSize writer]).
 165   cols do:
 166     [| :col | col with: results do: [| :val :result | result nextPut: val]].
 167   results collect: #contents `er
 168 ].
 169
 170 cols@(Sequence traits) allInject: start into: block
 171 "Runs inject:into: across all the given collection's collections' elements."
 172 [| result |
 173   result: start.
 174   cols allDo: [| *vals | result: (block applyTo: (vals copyWith: result at: 0))].
 175   result
 176 ].
 177
 178 source@(Root traits) streamInto: target
 179 "Totally generic method for streaming the contents of one thing into another."
 180 [
 181   source reader >> target writer
 182 ].
 183
 184 source@(Root traits) streamFrom: target
 185 [
 186   target streamInto: source
 187 ].
 188
 189 cols@(Sequence traits) combinationsDo: block
 190 "This performs a basic increment-with-carry across the iterators until
 191 they are exhausted. The block is applied to all intermediate results."
 192 [| iterators values |
 193   iterators: cols iterators.
 194   (iterators anySatisfy: #isAtEnd `er)
 195     ifTrue: [^ Nil].
 196   values: (iterators collect: #next `er).
 197   block applyTo: values.
 198   [| position it |
 199     position: iterators indexLast.
 200     it: (iterators at: position).
 201     [it isAtEnd /\ [position > 0]]
 202       whileTrue:
 203         [it reset.
 204           values at: position put: it next.
 205           position: position - 1.
 206           it: (iterators at: position)].
 207     it isAtEnd /\ [position isZero]
 208       ifTrue:
 209         [^ Nil]
 210       ifFalse:
 211         [values at: position put: it next].
 212     block applyTo: values] loop
 213 ].
 214
 215 cols@(Sequence traits) combinationsCollect: block into: result
 216 "Uses combinationsDo: to perform a collect: over all combinations of elements from the
 217 Collections in the Sequence, using a stream in between."
 218 [[| :result | cols combinationsDo: [| *vals | result nextPut: (block applyTo: vals)]]
 219   writingAs: result
 220 ].
 221
 222 cols@(Sequence traits) combinationsCollect: block
 223 "Perform combinationsCollect:into: using the Sequence as the result template."
 224 [cols combinationsCollect: block into: cols].
 225
 226 cols@(Sequence traits) combinationsInject: start into: block
 227 "Runs inject:into: across all the combinations of the given Sequence's Collections' elements."
 228 [| result |
 229   result: start.
 230   cols combinationsDo: [| *vals | result: (block applyTo: (vals copyWith: result at: 0))].
 231   result
 232 ].
 233
 234 Set traits define: #ReadStream &parents: {Collection ReadStream} &slots: {
 235   #collection -> Set new.
 236   #position -> 0. "The number of elements passed so far."
 237   #index -> 0. "The index into the Set's contents Array."
 238 }.
 239 "Set ReadStreams are just Positionable- over the element order in the Set's
 240 contents Array. They're not very efficient, having to check for Nil's."
 241
 242 i@(Set ReadStream traits) on: c
 243 "Retargets to the new Set, and resets position, etc."
 244 [i `>> [collection: c. position: 0. index: 0. ]].
 245
 246 i@(Set ReadStream traits) next
 247 "Increment the index through the array until a non-Nil element is reached.
 248 This is poor for sparse Sets."
 249 [
 250   (i collection contents indexOfFirstSatisfying: [| :x | x isNotNil] startingAt: i index)
 251     ifNil: [i exhausted]
 252     ifNotNilDo:
 253       [| :nextIndex |
 254        i index: nextIndex + 1.
 255        i position: i position + 1.
 256        i collection contents at: nextIndex]
 257 ].
 258
 259 i@(Set ReadStream traits) next: n putInto: seq startingAt: start
 260 [| numRead contents nextIndex |
 261   numRead: 0.
 262   contents: i collection contents.
 263   nextIndex: i index.
 264   seqIndex: start.
 265   [(nextIndex: (contents indexOfFirstSatisfying: [| :x | x isNotNil] startingAt: i index)) isNil] whileFalse:
 266     [i index: nextIndex + 1.
 267      i position: i position + 1.
 268      seq at: seqIndex put: (contents at: nextIndex).
 269      seqIndex: seqIndex + 1].
 270   numRead
 271 ].
 272
 273 i@(Set ReadStream traits) isAtEnd
 274 "Checks both the Set size and then the underlying Array index, since a sparse
 275 Set would reach the first before the second."
 276 [
 277   i position = i collection size \/ [i index = i collection contents indexLast]
 278 ].
 279
 280 Sequence traits define: #Stream &parents: {PositionableStream} &slots: {#collection -> ExtensibleArray new}.
 281 "A Stream over a Sequence, where the position corresponds to the index within
 282 the Sequence."
 283
 284 s@(Sequence Stream traits) on: c
 285 "Target the stream to the specific collection, and reset the indices."
 286 [s `>> [reset. collection: c. readLimit: c size. ]].
 287
 288 s@(Sequence Stream traits) contents
 289 "Answer the contents of the target by copying, up to the limit."
 290 [
 291   s collection copyFrom: 0 below: s readLimit
 292 ].
 293
 294 s@(Sequence Stream traits) collectionType
 295 [s collection].
 296
 297 s@(Sequence Stream traits) last
 298 [
 299   s collection at: s position
 300 ].
 301
 302 Sequence traits define: #ReadStream
 303   &parents: {Sequence Stream. ReadStream}.
 304 "A Stream used to read from a Sequence object."
 305
 306 s@(Stream traits) newFrom: obj
 307 "A convenient method to override for creating new ReadStreams of the
 308 appropriate type for a given type of object."
 309 "NOTE: determine what overrides justify this since #reader is easier for nearly
 310 all cases."
 311 [obj ReadStream newOn: obj].
 312
 313 rs@(Sequence ReadStream traits) next
 314 [| pos |
 315   pos: rs position.
 316   pos < rs readLimit
 317     ifTrue:
 318       [rs position: pos + 1.
 319        rs collection at: pos]
 320     ifFalse: [rs exhausted]
 321 ].
 322
 323 rs@(Sequence ReadStream traits) next: n
 324 "Overridden for efficiency."
 325 [| newC end |
 326   end: (rs position + n min: rs readLimit).
 327   newC: (rs collection copyFrom: rs position below: end).
 328   rs position: end.
 329   newC
 330 ].
 331
 332 rs@(Sequence ReadStream traits) next: n putInto: c startingAt: start
 333 [| max |
 334   max: ((rs readLimit - rs position) min: n).
 335   c replaceFrom: start to: start + max - 1 with: rs collection startingAt: rs position.
 336   rs position: rs position + max.
 337   max
 338 ].
 339
 340 rs@(Sequence ReadStream traits) peekAt: offset
 341 [
 342   rs collection at: rs position + offset
 343 ].
 344
 345 rs@(Sequence ReadStream traits) peek
 346 [rs peekAt: 0].
 347
 348 rs@(Sequence ReadStream traits) peekBack
 349 [
 350   rs position isZero ifFalse: [rs position: rs position - 1. rs next]
 351 ].
 352
 353 rs@(Sequence ReadStream traits) nextPut: obj
 354 "Sequence ReadStreams should not place elements into the stream."
 355 [Nil].
 356
 357 rs@(Sequence ReadStream traits) size
 358 "The limit is effectively the number of elements that can be collected."
 359 [
 360   rs readLimit
 361 ].
 362
 363 rs@(Sequence ReadStream traits) upTo: obj
 364 "Answer all the elements until the given object is reached."
 365 [| start end |
 366   start: rs position.
 367   end: (rs collection indexOf: obj startingAt: start
 368          ifAbsent: [rs position: rs collection size. ^ (rs collection copyFrom: start)]).
 369   rs position: end + 1.
 370   rs collection copyFrom: start below: end
 371 ].
 372
 373 rs@(Sequence ReadStream traits) upToEnd
 374 "Answer all the elements up to the limit by a copy."
 375 [| start |
 376   start: rs position.
 377   rs position: rs collection size.
 378   rs collection copyFrom: start below: rs position
 379 ].
 380
 381 rs@(Sequence ReadStream traits) on: c from: start to: end
 382 "Target the stream on a particular slice of a collection."
 383 [rs `>> [collection: c. readLimit: (end min: c size). position: start. ]].
 384
 385 Sequence traits define: #WriteStream
 386                 &parents: {Sequence Stream. WriteStream}
 387                 &slots: {#writeLimit}.
 388
 389 s@(Stream traits) newTo: obj@(Sequence traits) &position: position
 390 [obj WriteStream newOn: obj &position: position].
 391
 392 seq@(Sequence traits) writer &position: position
 393 [seq WriteStream newOn: seq &position: position].
 394
 395 seq@(Sequence traits) appender
 396 [seq WriteStream newOn: seq &position: seq size].
 397
 398 ws@(Sequence WriteStream traits) newOn: c &position: position
 399 [ws clone on: c &position: position].
 400
 401 ws@(Sequence WriteStream traits) on: c &position: position
 402 [
 403   resend.
 404   ws writeLimit: c size.
 405   position ifNotNil: [ws position: position].
 406   ws
 407 ].
 408
 409 ws@(Sequence WriteStream traits) contents
 410 [
 411   ws readLimit: (ws readLimit max: ws position).
 412   ws collection copyFrom: 0 below: ws readLimit
 413 ].
 414
 415 ws@(Sequence WriteStream traits) next
 416 [Nil].
 417
 418 ws@(Sequence WriteStream traits) growCollectionAtEnd &byAtLeast: minGrowth
 419 [| c newSize |
 420   c: ws collection.
 421   newSize: c size + (c size min: 1000000 max: (minGrowth ifNil: [20])).
 422   ws collection: (c newSize: newSize).
 423   ws collection replaceFrom: 0 to: c size - 1 with: c.
 424   ws writeLimit: newSize.
 425 ].
 426
 427 ws@(Sequence WriteStream traits) pastEndPut: obj
 428 [
 429   ws growCollectionAtEnd.
 430   ws collection at: ws position put: obj.
 431   ws position: ws position + 1.
 432   obj
 433 ].
 434
 435 ws@(Sequence WriteStream traits) nextPut: obj
 436 [| pos |
 437   (pos: ws position) >= ws writeLimit
 438     ifTrue: [ws pastEndPut: obj]
 439     ifFalse: [ws position: pos + 1.
 440               ws collection at: pos put: obj]
 441 ].
 442
 443 ws@(Sequence WriteStream traits) next: n putAll: c startingAt: start
 444 [| newEnd |
 445   (newEnd: ws position + n - 1) >= ws writeLimit ifTrue:
 446     [ws growCollectionAtEnd &byAtLeast: newEnd - ws writeLimit + 4].
 447   ws collection replaceFrom: ws position to: newEnd with: c startingAt: start.
 448   ws position: newEnd + 1.
 449   n
 450 ].
 451
 452 ws@(Sequence WriteStream traits) size
 453 [
 454   ws readLimit: (ws readLimit max: ws position)
 455 ].
 456
 457 ws@(Sequence WriteStream traits) position: n
 458 [
 459   ws readLimit: (ws readLimit max: n).
 460   resend.
 461   ws
 462 ].
 463
 464 ws@(Sequence WriteStream traits) newLine
 465 "Output an appropriate newLine character."
 466 "TODO: make this portable."
 467 [
 468   ws nextPut: $\n
 469 ].
 470
 471 ws@(Sequence WriteStream traits) atBeginningOfLine
 472 "Returns whether the stream is writing at a point where a line ending has
 473 just occurred."
 474 "TODO: make this portable."
 475 [
 476   (ws collection at: ws position - 1) = $\n
 477 ].
 478
 479 ws@(Sequence WriteStream traits) freshLine
 480 "Output a newLine character character if not currently at the end of a line."
 481 [
 482   ws atBeginningOfLine ifFalse: [ws newLine]
 483 ].
 484
 485 ws@(Sequence WriteStream traits) reset
 486 [
 487   ws readLimit: (ws readLimit max: ws position).
 488   ws position: 0.
 489   ws
 490 ].
 491
 492 ws@(Sequence WriteStream traits) resetToStart
 493 [
 494   ws readLimit: (ws position: 0).
 495   ws
 496 ].
 497
 498 ws@(Sequence WriteStream traits) setToEnd
 499 [
 500   ws position: ws size.
 501   ws
 502 ].
 503
 504 ws@(Sequence WriteStream traits) on: c from: start to: end
 505 [
 506   ws collection: c.
 507   ws readLimit: (ws writeLimit: (end min: c size)).
 508   ws position: start.
 509   ws
 510 ].
 511
 512 ws@(Sequence WriteStream traits) peekLast
 513 [
 514   ws position ifNotNil: [ws contents at: position]
 515 ].
 516
 517 ws@(Sequence WriteStream traits) with: c
 518 [
 519   ws collection: c.
 520   ws position: (ws readLimit: (ws writeLimit: c size)).
 521   ws
 522 ].
 523
 524 Sequence traits define: #ReadWriteStream
 525                 &parents: {Sequence WriteStream. Sequence ReadStream}.
 526
 527 rws@(Sequence traits) iterator
 528 [
 529   rws ReadWriteStream newOn: rws
 530 ].
 531
 532 rws@(Sequence ReadWriteStream traits) contents
 533 [
 534   rws readLimit: (rws readLimit max: rws position).
 535   rws collection copyFrom: 0 below: rws readLimit
 536 ].
 537
 538 rws@(Sequence ReadWriteStream traits) next
 539 [| pos |
 540   pos: rws position.
 541   pos >= 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 [| newC end |
 549   rws readLimit: (rws readLimit max: rws position).
 550   end: (rws position + n min: rws readLimit).
 551   newC: (rws collection copyFrom: rws position below: end).
 552   rws position: end.
 553   newC
 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 [| c |
 573   c: ws collection.
 574   c addLast: obj.
 575   ws writeLimit: c size.
 576   ws position: 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: ws position + n.
 584   n
 585 ].
 586
 587 ExtensibleSequence traits define: #ReadWriteStream
 588   &parents: {ExtensibleSequence WriteStream. ExtensibleSequence ReadStream}.