2019-10-18 09:05:06 -04:00
|
|
|
! Copyright (C) 2004, 2007 Slava Pestov.
|
2006-01-16 02:48:15 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2005-07-19 21:52:10 -04:00
|
|
|
IN: io
|
2019-10-18 09:05:08 -04:00
|
|
|
USING: arrays errors generic io kernel math namespaces sequences
|
2005-08-19 21:46:12 -04:00
|
|
|
vectors ;
|
2005-06-19 17:50:35 -04:00
|
|
|
|
|
|
|
|
TUPLE: line-reader cr ;
|
|
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
C: line-reader ( stream -- new-stream ) [ set-delegate ] keep ;
|
2005-06-19 17:50:35 -04:00
|
|
|
|
2019-10-18 09:05:06 -04:00
|
|
|
: cr+ t swap set-line-reader-cr ; inline
|
|
|
|
|
|
|
|
|
|
: cr- f swap set-line-reader-cr ; inline
|
|
|
|
|
|
|
|
|
|
: line-ends/eof ( stream str -- str ) f like swap cr- ; inline
|
|
|
|
|
|
|
|
|
|
: line-ends\r ( stream str -- str ) swap cr+ ; inline
|
|
|
|
|
|
|
|
|
|
: line-ends\n ( stream str -- str )
|
|
|
|
|
over line-reader-cr over empty? and
|
|
|
|
|
[ drop dup cr- stream-readln ] [ swap cr- ] if ; inline
|
|
|
|
|
|
|
|
|
|
: handle-readln ( stream str ch -- str )
|
|
|
|
|
{
|
|
|
|
|
{ f [ line-ends/eof ] }
|
|
|
|
|
{ CHAR: \r [ line-ends\r ] }
|
|
|
|
|
{ CHAR: \n [ line-ends\n ] }
|
|
|
|
|
} case ;
|
|
|
|
|
|
|
|
|
|
M: line-reader stream-readln ( stream -- str )
|
|
|
|
|
"\r\n" over delegate stream-read-until handle-readln ;
|
|
|
|
|
|
|
|
|
|
: fix\r ( stream string -- string )
|
|
|
|
|
"\n" ?head [ swap stream-read1 [ add ] when* ] [ nip ] if ;
|
2005-06-19 17:50:35 -04:00
|
|
|
|
2006-08-15 03:01:24 -04:00
|
|
|
M: line-reader stream-read
|
2019-10-18 09:05:06 -04:00
|
|
|
tuck delegate stream-read over line-reader-cr
|
|
|
|
|
[ over cr- fix\r ] [ nip ] if ;
|
|
|
|
|
|
|
|
|
|
: lines-loop ( -- ) readln [ , lines-loop ] when* ;
|
|
|
|
|
|
2019-10-18 09:05:08 -04:00
|
|
|
: lines ( stream -- seq )
|
|
|
|
|
[ [ lines-loop ] { } make ] with-stream ;
|
|
|
|
|
|
|
|
|
|
: string-lines ( str -- seq )
|
|
|
|
|
dup [ "\r\n" member? not ] all? [
|
|
|
|
|
1array
|
|
|
|
|
] [
|
|
|
|
|
[
|
|
|
|
|
"\n" split dup 1 head-slice* [
|
|
|
|
|
"\r" ?tail drop "\r" split %
|
|
|
|
|
] each peek "\r" split %
|
|
|
|
|
] { } make
|
|
|
|
|
] if ;
|