core/io/streams/sequence/sequence.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: sequences io io.streams.plain kernel accessors math math.order
   4 growable destructors combinators sequences.private io.private ;
   5 IN: io.streams.sequence
   6
   7 ! Readers
   8 SLOT: underlying
   9 SLOT: i
  10
  11 : >sequence-stream< ( stream -- i underlying )
  12     [ i>> ] [ underlying>> ] bi ; inline
  13
  14 : sequence-read1 ( stream -- elt/f )
  15     dup >sequence-stream< dupd ?nth [ 1 + swap i<< ] dip ; inline
  16
  17 : (sequence-read-length) ( n buf stream -- buf count )
  18     [ underlying>> length ] [ i>> ] bi - rot min ; inline
  19
  20 : <sequence-copy> ( dst n i src -- n copy )
  21     [ 0 ] 3curry dip <copy> ; inline
  22
  23 : (sequence-read-unsafe) ( n buf stream -- count )
  24     [ (sequence-read-length) ]
  25     [ [ dup pick + ] change-i underlying>> ] bi
  26     [ <sequence-copy> (copy) drop ] 2curry keep ; inline
  27
  28 : sequence-read-unsafe ( n buf stream -- count )
  29     dup >sequence-stream< bounds-check?
  30     [ (sequence-read-unsafe) ] [ 3drop 0 ] if ; inline
  31
  32 : find-separator ( seps stream -- sep/f n )
  33     swap [ >sequence-stream< ] dip
  34     [ member-eq? ] curry [ find-from swap ] curry 2keep
  35     pick [ drop - ] [ length swap - nip ] if ; inline
  36
  37 : sequence-read-until ( seps stream -- seq sep/f )
  38     [ find-separator ] keep
  39     [ [ (sequence-read-unsafe) ] (read-into-new) ]
  40     [ [ 1 + ] change-i drop ] bi swap ; inline
  41
  42 ! Writers
  43 M: growable dispose drop ;
  44
  45 M: growable stream-write1 push ;
  46 M: growable stream-write push-all ;
  47 M: growable stream-flush drop ;
  48
  49 INSTANCE: growable output-stream
  50 INSTANCE: growable plain-writer
  51
  52 ! Seeking
  53 : (stream-seek) ( n seek-type stream -- )
  54     swap {
  55         { seek-absolute [ i<< ] }
  56         { seek-relative [ [ + ] change-i drop ] }
  57         { seek-end [ [ underlying>> length + ] [ i<< ] bi ] }
  58         [ bad-seek-type ]
  59     } case ;