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-reset-hard ( buffer -- )
  25     0 >>fill 0 >>pos drop ;
  26
  27 : buffer-capacity ( buffer -- n )
  28     [ size>> ] [ fill>> ] bi - ; inline
  29
  30 : buffer-empty? ( buffer -- ? )
  31     fill>> zero? ; inline
  32
  33 : buffer-consume ( n buffer -- )
  34     [ + ] change-pos
  35     dup [ pos>> ] [ fill>> ] bi <
  36     [ 0 >>pos 0 >>fill ] unless drop ; inline
  37
  38 : buffer-peek ( buffer -- byte )
  39     [ ptr>> ] [ pos>> ] bi alien-unsigned-1 ; inline
  40
  41 : buffer-pop ( buffer -- byte )
  42     [ buffer-peek ] [ 1 swap buffer-consume ] bi ; inline
  43
  44 : buffer-length ( buffer -- n )
  45     [ fill>> ] [ pos>> ] bi - ; inline
  46
  47 : buffer@ ( buffer -- alien )
  48     [ pos>> ] [ ptr>> ] bi <displaced-alien> ;
  49
  50 : buffer-read ( n buffer -- byte-array )
  51     [ buffer-length min ] keep
  52     [ buffer@ ] [ buffer-consume ] 2bi
  53     swap memory>byte-array ;
  54
  55 HINTS: buffer-read fixnum buffer ;
  56
  57 : buffer-end ( buffer -- alien )
  58     [ fill>> ] [ ptr>> ] bi <displaced-alien> ; inline
  59
  60 : n>buffer ( n buffer -- )
  61     [ + ] change-fill drop ; inline
  62
  63 HINTS: n>buffer fixnum buffer ;
  64
  65 : >buffer ( byte-array buffer -- )
  66     [ buffer-end byte-array>memory ]
  67     [ [ length ] dip n>buffer ]
  68     2bi ;
  69
  70 HINTS: >buffer byte-array buffer ;
  71
  72 : byte>buffer ( byte buffer -- )
  73     [ >fixnum ] dip
  74     [ [ ptr>> ] [ fill>> ] bi set-alien-unsigned-1 ]
  75     [ 1 swap n>buffer ]
  76     bi ; inline
  77
  78 : search-buffer-until ( pos fill ptr separators -- n )
  79     [ [ swap alien-unsigned-1 ] dip memq? ] 2curry find-from drop ; inline
  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* ; inline
  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 } ;