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
12 : >sequence-stream< ( stream -- i underlying )
13 [ i>> ] [ underlying>> ] bi ; inline
15 : sequence-read1 ( stream -- elt/f )
16 dup >sequence-stream< dupd ?nth [ 1 + swap i<< ] dip ; inline
20 : (sequence-read-length) ( n buf stream -- buf count )
21 [ underlying>> length ] [ i>> ] bi - rot min ; inline
23 : <sequence-copy> ( dst n src-i src dst-i -- n copy )
24 [ ] curry 3curry dip <copy> ; inline
26 : sequence-copy-unsafe ( n buf stream offset -- count )
28 [ (sequence-read-length) ]
29 [ [ dup pick + ] change-i underlying>> ] bi
30 ] dip [ <sequence-copy> (copy) drop ] 3curry keep ; inline
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
36 ERROR: not-a-string obj ;
37 : check-string ( buf stream offset -- buf stream offset )
38 pick string? [ pick not-a-string ] unless ; inline
40 : (sequence-read-unsafe) ( n buf stream -- count )
42 [ dup slice? [ [ seq>> ] [ from>> ] bi ] [ 0 ] if ]
44 tuck stream-element-type +byte+ eq?
45 [ check-byte-array sequence-copy-unsafe ]
46 [ check-string sequence-copy-unsafe ] if
51 : sequence-read-unsafe ( n buf stream -- count )
52 dup >sequence-stream< bounds-check?
53 [ (sequence-read-unsafe) ] [ 3drop 0 ] if ; inline
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
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
70 : sequence-read-until ( seps stream -- seq sep/f )
71 dup >sequence-stream< bounds-check?
72 [ (sequence-read-until) ] [ 2drop f f ] if ; inline
75 M: growable dispose drop ;
77 M: growable stream-write1 push ;
78 M: growable stream-write push-all ;
79 M: growable stream-flush drop ;
81 INSTANCE: growable output-stream
82 INSTANCE: growable plain-writer
85 : sequence-seek ( n seek-type stream -- )
87 { seek-absolute [ i<< ] }
88 { seek-relative [ [ + ] change-i drop ] }
89 { seek-end [ [ underlying>> length + ] [ i<< ] bi ] }