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 ;
   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 : next ( stream -- )
  15     [ 1 + ] change-i drop ; inline
  16
  17 : sequence-read1 ( stream -- elt/f )
  18     [ >sequence-stream< ?nth ] [ next ] bi ; inline
  19
  20 : add-length ( n stream -- i+n )
  21     [ i>> + ] [ underlying>> length ] bi min ; inline
  22
  23 : (sequence-read) ( n stream -- seq/f )
  24     [ add-length ] keep
  25     [ [ swap dup ] change-i drop ]
  26     [ underlying>> ] bi
  27     subseq ; inline
  28
  29 : sequence-read ( n stream -- seq/f )
  30     dup >sequence-stream< bounds-check?
  31     [ (sequence-read) ] [ 2drop f ] if ; inline
  32
  33 : find-sep ( seps stream -- sep/f n )
  34     swap [ >sequence-stream< swap tail-slice ] dip
  35     [ member-eq? ] curry find swap ; inline
  36
  37 : sequence-read-until ( separators stream -- seq sep/f )
  38     [ find-sep ] keep
  39     [ sequence-read ] [ next ] bi swap ; inline
  40
  41 ! Writers
  42 M: growable dispose drop ;
  43
  44 M: growable stream-write1 push ;
  45 M: growable stream-write push-all ;
  46 M: growable stream-flush drop ;
  47
  48 INSTANCE: growable plain-writer
  49
  50 ! Seeking
  51 : (stream-seek) ( n seek-type stream -- )
  52     swap {
  53         { seek-absolute [ i<< ] }
  54         { seek-relative [ [ + ] change-i drop ] }
  55         { seek-end [ [ underlying>> length + ] [ i<< ] bi ] }
  56         [ bad-seek-type ]
  57     } case ;