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