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 ; inline
  40
  41 : buffer-length ( buffer -- n )
  42     [ fill>> ] [ pos>> ] bi - ; inline
  43
  44 : buffer@ ( buffer -- alien )
  45     [ pos>> ] [ ptr>> ] bi <displaced-alien> ;
  46
  47 : buffer-read ( n buffer -- byte-array )
  48     [ buffer-length min ] keep
  49     [ buffer@ ] [ buffer-consume ] 2bi
  50     swap memory>byte-array ;
  51
  52 HINTS: buffer-read fixnum buffer ;
  53
  54 : buffer-end ( buffer -- alien )
  55     [ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
  56
  57 : n>buffer ( n buffer -- )
  58     [ + ] change-fill drop ; inline
  59
  60 HINTS: n>buffer fixnum buffer ;
  61
  62 : >buffer ( byte-array buffer -- )
  63     [ buffer-end byte-array>memory ]
  64     [ [ length ] dip n>buffer ]
  65     2bi ;
  66
  67 HINTS: >buffer byte-array buffer ;
  68
  69 : byte>buffer ( byte buffer -- )
  70     [ >fixnum ] dip
  71     [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
  72     [ 1 swap n>buffer ]
  73     bi ; inline
  74
  75 : search-buffer-until ( pos fill ptr separators -- n )
  76     [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ; inline
  77
  78 : finish-buffer-until ( buffer n -- byte-array separator )
  79     [
  80         over pos>> -
  81         over buffer-read
  82         swap buffer-pop
  83     ] [
  84         [ buffer-length ] keep
  85         buffer-read f
  86     ] if* ; inline
  87
  88 : buffer-until ( separators buffer -- byte-array separator )
  89     swap [ { [ ] [ pos>> ] [ fill>> ] [ ptr>> ] } cleave ] dip
  90     search-buffer-until
  91     finish-buffer-until ;
  92
  93 HINTS: buffer-until { string buffer } ;