core/io/streams/string/string.factor

   1 ! Copyright (C) 2003, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors io kernel math namespaces sequences sbufs
   4 strings generic splitting continuations destructors
   5 io.streams.plain io.encodings math.order growable ;
   6 IN: io.streams.string
   7
   8 <PRIVATE
   9
  10 : harden-as ( seq growble-exemplar -- newseq )
  11     underlying>> like ;
  12
  13 : growable-read-until ( growable n -- str )
  14     >fixnum dupd tail-slice swap harden-as dup reverse-here ;
  15
  16 SINGLETON: null-encoding
  17
  18 M: null-encoding decode-char drop stream-read1 ;
  19
  20 : format-column ( seq ? -- seq )
  21     [
  22         [ 0 [ length max ] reduce ] keep
  23         swap [ CHAR: \s pad-right ] curry map
  24     ] unless ;
  25
  26 : map-last ( seq quot -- seq )
  27     [ dup length <reversed> ] dip [ 0 = ] prepose 2map ; inline
  28
  29 PRIVATE>
  30
  31 : format-table ( table -- seq )
  32     flip [ format-column ] map-last
  33     flip [ " " join ] map ;
  34
  35 M: growable dispose drop ;
  36
  37 M: growable stream-write1 push ;
  38 M: growable stream-write push-all ;
  39 M: growable stream-flush drop ;
  40
  41 : <string-writer> ( -- stream )
  42     512 <sbuf> ;
  43
  44 : with-string-writer ( quot -- str )
  45     <string-writer> swap [ output-stream get ] compose with-output-stream*
  46     >string ; inline
  47
  48 M: growable stream-read1 [ f ] [ pop ] if-empty ;
  49
  50 : find-last-sep ( seq seps -- n )
  51     swap [ memq? ] curry find-last drop ;
  52
  53 M: growable stream-read-until
  54     [ find-last-sep ] keep over [
  55         [ swap 1+ growable-read-until ] 2keep [ nth ] 2keep
  56         set-length
  57     ] [
  58         [ swap drop 0 growable-read-until f like f ] keep
  59         delete-all
  60     ] if ;
  61
  62 M: growable stream-read
  63     [
  64         drop f
  65     ] [
  66         [ length swap - 0 max ] keep
  67         [ swap growable-read-until ] 2keep
  68         set-length
  69     ] if-empty ;
  70
  71 M: growable stream-read-partial
  72     stream-read ;
  73
  74 : <string-reader> ( str -- stream )
  75     >sbuf dup reverse-here null-encoding <decoder> ;
  76
  77 : with-string-reader ( str quot -- )
  78     [ <string-reader> ] dip with-input-stream ; inline
  79
  80 INSTANCE: growable plain-writer
  81
  82 M: plain-writer stream-write-table
  83     [ drop format-table [ print ] each ] with-output-stream* ;
  84
  85 M: plain-writer make-cell-stream 2drop <string-writer> ;