extra/io/streams/counting/counting.factor

   1 ! Copyright (C) 2021 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors delegate delegate.protocols destructors io
   4 kernel math sequences ;
   5 IN: io.streams.counting
   6
   7 TUPLE: counting-stream stream { in-count integer initial: 0 } { out-count integer initial: 0 } ;
   8 INSTANCE: counting-stream input-stream
   9 INSTANCE: counting-stream output-stream
  10
  11 : <counting-stream> ( stream -- counting-stream )
  12     counting-stream new
  13         swap >>stream ; inline
  14
  15 CONSULT: input-stream-protocol counting-stream stream>> ;
  16 CONSULT: output-stream-protocol counting-stream stream>> ;
  17
  18 M: counting-stream dispose stream>> dispose ;
  19
  20 M:: counting-stream stream-read1 ( stream -- obj )
  21     stream stream>> stream-read1
  22     dup [ stream [ 1 + ] change-in-count drop ] when ;
  23
  24 M:: counting-stream stream-read-unsafe ( n buf stream -- count )
  25     n buf stream stream>> stream-read-unsafe :> count
  26     stream [ count + ] change-in-count drop
  27     count ;
  28
  29 M:: counting-stream stream-read-partial-unsafe ( n buf stream -- count )
  30     n buf stream stream>> stream-read-partial-unsafe :> count
  31     stream [ count + ] change-in-count drop
  32     count ;
  33
  34 M:: counting-stream stream-read-until ( seps stream -- seq sep/f )
  35     seps stream stream>> stream-read-until :> ( seq sep )
  36     sep [ stream [ seq length + ] change-in-count drop ] when
  37     seq sep ;
  38
  39 M:: counting-stream stream-write1 ( elt stream -- )
  40     elt stream stream>> stream-write1
  41     stream [ 1 + ] change-out-count drop ;
  42
  43 M:: counting-stream stream-write ( data stream -- )
  44     data stream stream>> stream-write
  45     stream [ data length + ] change-out-count drop ;
  46
  47 M:: counting-stream stream-contents* ( stream -- seq )
  48     stream stream>> stream-contents :> seq
  49     stream [ seq length + ] change-in-count drop
  50     seq ;
  51
  52 : with-counting-stream ( stream quot -- in-count out-count )
  53     [ <counting-stream> ] dip [ with-input-stream ] keepd [ in-count>> ] [ out-count>> ] bi ; inline