1 ! Copyright (C) 2004, 2005 Mackenzie Straight.
2 ! Copyright (C) 2006, 2008 Slava Pestov.
3 ! See http://factorcode.org/license.txt for BSD license.
4 USING: accessors alien alien.accessors alien.c-types
5 alien.syntax kernel libc math sequences byte-arrays strings
6 hints accessors math.order destructors combinators ;
16 : <buffer> ( n -- buffer )
17 dup malloc 0 0 f buffer boa ;
19 M: buffer dispose* ptr>> free ;
21 : buffer-reset ( n buffer -- )
22 swap >>fill 0 >>pos drop ;
24 : buffer-capacity ( buffer -- n )
25 [ size>> ] [ fill>> ] bi - ; inline
27 : buffer-empty? ( buffer -- ? )
30 : buffer-consume ( n buffer -- )
32 dup [ pos>> ] [ fill>> ] bi <
33 [ 0 >>pos 0 >>fill ] unless drop ; inline
35 : buffer-peek ( buffer -- byte )
36 [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
38 : buffer-pop ( buffer -- byte )
39 [ buffer-peek ] [ 1 swap buffer-consume ] bi ;
41 HINTS: buffer-pop buffer ;
43 : buffer-length ( buffer -- n )
44 [ fill>> ] [ pos>> ] bi - ; inline
46 : buffer@ ( buffer -- alien )
47 [ pos>> ] [ ptr>> ] bi <displaced-alien> ;
49 : buffer-read ( n buffer -- byte-array )
50 [ buffer-length min ] keep
51 [ buffer@ ] [ buffer-consume ] 2bi
52 swap memory>byte-array ;
54 HINTS: buffer-read fixnum buffer ;
56 : buffer-end ( buffer -- alien )
57 [ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
59 : n>buffer ( n buffer -- )
60 [ + ] change-fill drop ; inline
62 HINTS: n>buffer fixnum buffer ;
64 : >buffer ( byte-array buffer -- )
65 [ buffer-end byte-array>memory ]
66 [ [ length ] dip n>buffer ]
69 HINTS: >buffer byte-array buffer ;
71 : byte>buffer ( byte buffer -- )
72 [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
76 HINTS: byte>buffer fixnum buffer ;
78 : search-buffer-until ( pos fill ptr separators -- n )
79 [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ;
81 : finish-buffer-until ( buffer n -- byte-array separator )
87 [ buffer-length ] keep
91 : buffer-until ( separators buffer -- byte-array separator )
92 swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip
96 HINTS: buffer-until { string buffer } ;