core/io/streams/sequence/sequence.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors byte-arrays combinators destructors growable
   4 io io.private io.streams.plain kernel math math.order sequences
   5 sequences.private strings ;
   6 IN: io.streams.sequence
   7
   8 ! Readers
   9 SLOT: underlying
  10 SLOT: i
  11
  12 : >sequence-stream< ( stream -- i underlying )
  13     [ i>> ] [ underlying>> ] bi ; inline
  14
  15 : sequence-read1 ( stream -- elt/f )
  16     dup >sequence-stream< dupd ?nth [ 1 + swap i<< ] dip ; inline
  17
  18 <PRIVATE
  19
  20 : (sequence-read-length) ( n buf stream -- buf count )
  21     [ underlying>> length ] [ i>> ] bi - rot min ; inline
  22
  23 : <sequence-copy> ( dst n src-i src dst-i -- n copy )
  24     [ ] curry 3curry dip <copy> ; inline
  25
  26 : sequence-copy-unsafe ( n buf stream offset -- count )
  27     [
  28         [ (sequence-read-length) ]
  29         [ [ dup pick + ] change-i underlying>> ] bi
  30     ] dip [ <sequence-copy> (copy) drop ] 3curry keep ; inline
  31
  32 ERROR: not-a-byte-array obj ;
  33 : check-byte-array ( buf stream offset -- buf stream offset )
  34     pick byte-array? [ pick not-a-byte-array ] unless ; inline
  35
  36 ERROR: not-a-string obj ;
  37 : check-string ( buf stream offset -- buf stream offset )
  38     pick string? [ pick not-a-string ] unless ; inline
  39
  40 : (sequence-read-unsafe) ( n buf stream -- count )
  41     [ integer>fixnum ]
  42     [ dup slice? [ [ seq>> ] [ from>> ] bi ] [ 0 ] if ]
  43     [
  44         swap over stream-element-type +byte+ eq?
  45         [ check-byte-array sequence-copy-unsafe ]
  46         [ check-string sequence-copy-unsafe ] if
  47     ] tri* ; inline
  48
  49 PRIVATE>
  50
  51 : sequence-read-unsafe ( n buf stream -- count )
  52     dup >sequence-stream< bounds-check?
  53     [ (sequence-read-unsafe) ] [ 3drop 0 ] if ; inline
  54
  55 <PRIVATE
  56
  57 : find-separator ( seps stream -- sep/f n )
  58     >sequence-stream< rot [ member? ] curry
  59     [ find-from swap ] curry 2keep pick
  60     [ drop - ] [ length swap - nip ] if ; inline
  61
  62 : (sequence-read-until) ( seps stream -- seq sep/f )
  63     [ find-separator ] keep
  64     [ [ (sequence-read-unsafe) ] (read-into-new) ]
  65     [ [ 1 + ] change-i drop ]
  66     [ stream-exemplar or ] tri swap ; inline
  67
  68 PRIVATE>
  69
  70 : sequence-read-until ( seps stream -- seq sep/f )
  71     dup >sequence-stream< bounds-check?
  72     [ (sequence-read-until) ] [ 2drop f f ] if ; inline
  73
  74 ! Writers
  75 M: growable dispose drop ;
  76
  77 M: growable stream-write1 push ;
  78 M: growable stream-write push-all ;
  79 M: growable stream-flush drop ;
  80
  81 INSTANCE: growable output-stream
  82 INSTANCE: growable plain-writer
  83
  84 ! Seeking
  85 : sequence-seek ( n seek-type stream -- )
  86     swap {
  87         { seek-absolute [ i<< ] }
  88         { seek-relative [ [ + ] change-i drop ] }
  89         { seek-end [ [ underlying>> length + ] [ i<< ] bi ] }
  90         [ bad-seek-type ]
  91     } case ;