extra/io/streams/peek/peek.factor

   1 ! Copyright (C) 2011 Doug Coleman.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien combinators combinators.short-circuit
   4 destructors io io.ports io.private kernel locals math namespaces
   5 sequences vectors ;
   6 IN: io.streams.peek
   7
   8 TUPLE: peek-stream stream peeked ;
   9 INSTANCE: peek-stream input-stream
  10 INSTANCE: peek-stream output-stream
  11
  12 M: peek-stream dispose stream>> dispose ;
  13
  14 : stream-new-resizable ( n stream -- exemplar )
  15     stream-exemplar new-resizable ; inline
  16
  17 : stream-like ( sequence stream -- sequence' )
  18     stream-exemplar like ; inline
  19
  20 : stream-clone-resizable ( sequence stream -- sequence' )
  21     stream-exemplar-growable clone-like ; inline
  22
  23 : <peek-stream> ( stream -- stream )
  24     peek-stream new
  25         swap >>stream
  26         64 over stream-new-resizable >>peeked ; inline
  27
  28 M: peek-stream stream-element-type
  29     stream>> stream-element-type ;
  30
  31 M: peek-stream stream-read1
  32     dup peeked>> [
  33         stream>> stream-read1
  34     ] [
  35         pop nip
  36     ] if-empty ;
  37
  38 M:: peek-stream stream-read-unsafe ( n buf stream -- count )
  39     stream peeked>> :> peeked
  40     peeked length :> #peeked
  41     #peeked 0 = [
  42         n buf stream stream>> stream-read-unsafe
  43     ] [
  44         #peeked n >= [
  45             peeked <reversed> n head-slice 0 buf copy
  46             peeked [ length n - ] keep shorten
  47             n
  48         ] [
  49             peeked <reversed> 0 buf copy
  50             0 peeked shorten
  51             n #peeked - :> n'
  52             stream stream>> input-port? [
  53                 #peeked buf <displaced-alien>
  54             ] [
  55                 buf #peeked tail-slice
  56             ] if :> buf'
  57             n' buf' stream stream-read-unsafe #peeked +
  58         ] if
  59     ] if ;
  60
  61 : peek-stream-read-until ( stream seps buf -- stream seps buf sep/f )
  62     3dup [ [ stream-read1 dup ] dip member-eq? ] dip swap
  63     [ drop ] [ over [ push peek-stream-read-until ] [ drop ] if ] if ;
  64
  65 M: peek-stream stream-read-until
  66     swap 64 pick stream-new-resizable
  67     peek-stream-read-until [ nip swap stream-like ] dip ;
  68
  69 M: peek-stream stream-write stream>> stream-write ;
  70 M: peek-stream stream-write1 stream>> stream-write1 ;
  71 M: peek-stream stream-flush stream>> stream-flush ;
  72 M: peek-stream stream-tell stream>> stream-tell ;
  73 M: peek-stream stream-seek stream>> stream-seek ;
  74
  75 : stream-peek1 ( stream -- elt )
  76     dup peeked>> [
  77         dup stream>> stream-read1 [
  78             [ 1vector over stream-clone-resizable >>peeked drop ] keep
  79         ] [
  80             drop f
  81         ] if*
  82     ] [
  83         last nip
  84     ] if-empty ;
  85
  86 : stream-peek ( n stream -- seq )
  87     2dup peeked>> { [ length <= ] [ length 0 > ] } 1&& [
  88         [ peeked>> <reversed> swap head ] [ stream-exemplar like ] bi
  89     ] [
  90         [ nip ]
  91         [ stream-read ] 2bi
  92         [ reverse swap peeked>> push-all ] keep
  93     ] if ;
  94
  95 : peek1 ( -- elt ) input-stream get stream-peek1 ; inline
  96 : peek ( n -- seq ) input-stream get stream-peek ; inline