basis/io/buffers/buffers.factor

   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 ;
   7 IN: io.buffers
   8
   9 TUPLE: buffer
  10 { size fixnum }
  11 { ptr simple-alien }
  12 { fill fixnum }
  13 { pos fixnum }
  14 disposed ;
  15
  16 : <buffer> ( n -- buffer )
  17     dup malloc 0 0 f buffer boa ;
  18
  19 M: buffer dispose* ptr>> free ;
  20
  21 : buffer-reset ( n buffer -- )
  22     swap >>fill 0 >>pos drop ;
  23
  24 : buffer-capacity ( buffer -- n )
  25     [ size>> ] [ fill>> ] bi - ; inline
  26
  27 : buffer-empty? ( buffer -- ? )
  28     fill>> zero? ; inline
  29
  30 : buffer-consume ( n buffer -- )
  31     [ + ] change-pos
  32     dup [ pos>> ] [ fill>> ] bi <
  33     [ 0 >>pos 0 >>fill ] unless drop ; inline
  34
  35 : buffer-peek ( buffer -- byte )
  36     [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
  37
  38 : buffer-pop ( buffer -- byte )
  39     [ buffer-peek ] [ 1 swap buffer-consume ] bi ;
  40
  41 HINTS: buffer-pop buffer ;
  42
  43 : buffer-length ( buffer -- n )
  44     [ fill>> ] [ pos>> ] bi - ; inline
  45
  46 : buffer@ ( buffer -- alien )
  47     [ pos>> ] [ ptr>> ] bi <displaced-alien> ;
  48
  49 : buffer-read ( n buffer -- byte-array )
  50     [ buffer-length min ] keep
  51     [ buffer@ ] [ buffer-consume ] 2bi
  52     swap memory>byte-array ;
  53
  54 HINTS: buffer-read fixnum buffer ;
  55
  56 : buffer-end ( buffer -- alien )
  57     [ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
  58
  59 : n>buffer ( n buffer -- )
  60     [ + ] change-fill drop ; inline
  61
  62 HINTS: n>buffer fixnum buffer ;
  63
  64 : >buffer ( byte-array buffer -- )
  65     [ buffer-end byte-array>memory ]
  66     [ [ length ] dip n>buffer ]
  67     2bi ;
  68
  69 HINTS: >buffer byte-array buffer ;
  70
  71 : byte>buffer ( byte buffer -- )
  72     [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
  73     [ 1 swap n>buffer ]
  74     bi ;
  75
  76 HINTS: byte>buffer fixnum buffer ;
  77
  78 : search-buffer-until ( pos fill ptr separators -- n )
  79     [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ;
  80
  81 : finish-buffer-until ( buffer n -- byte-array separator )
  82     [
  83         over pos>> -
  84         over buffer-read
  85         swap buffer-pop
  86     ] [
  87         [ buffer-length ] keep
  88         buffer-read f
  89     ] if* ;
  90
  91 : buffer-until ( separators buffer -- byte-array separator )
  92     swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip
  93     search-buffer-until
  94     finish-buffer-until ;
  95
  96 HINTS: buffer-until { string buffer } ;