io.crlf: adding read-ignoring-crlf and read1-ignoring-crlf.

basis/io/crlf/crlf-tests.factor

@@ -13,3 +13,16 @@ USING: io.crlf tools.test io.streams.string io ;
 
 { "foo\nbar" } [ "foo\n\rbar" crlf>lf ] unit-test
 { "foo\r\nbar" } [ "foo\nbar" lf>crlf ] unit-test
+
+{ f } [ "" [ read1-ignoring-crlf ] with-string-reader ] unit-test
+{ CHAR: a } [ "a" [ read1-ignoring-crlf ] with-string-reader ] unit-test
+{ CHAR: b } [ "\nb" [ read1-ignoring-crlf ] with-string-reader ] unit-test
+{ CHAR: c } [ "\r\nc" [ read1-ignoring-crlf ] with-string-reader ] unit-test
+
+{ f } [ "" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test
+{ "a" } [ "a" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test
+{ "ab" } [ "a\nb" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test
+{ "abc" } [ "a\nb\r\nc" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test
+{ "abcd" } [ "a\nb\r\ncd" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test
+{ "abcde" } [ "a\nb\r\ncd\r\ne" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test
+{ "abcde" } [ "a\nb\r\ncd\r\ne\nfghi" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test

basis/io/crlf/crlf.factor

@@ -1,21 +1,62 @@
 ! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io kernel sequences splitting ;
+USING: byte-vectors io io.private kernel locals math namespaces
+sbufs sequences splitting ;
 IN: io.crlf
 
 : crlf ( -- )
     "\r\n" write ;
 
+:: stream-read-crlf ( stream -- seq )
+    "\r" stream stream-read-until [
+        CHAR: \r assert= stream stream-read1 CHAR: \n assert=
+    ] [ f like ] if* ;
+
 : read-crlf ( -- seq )
-    "\r" read-until
-    [ CHAR: \r assert= read1 CHAR: \n assert= ] [ f like ] if* ;
+    input-stream get stream-read-crlf ;
+
+:: stream-read-?crlf ( stream -- seq )
+    "\r\n" stream stream-read-until [
+        CHAR: \r = [ stream stream-read1 CHAR: \n assert= ] when
+    ] [ f like ] if* ;
 
 : read-?crlf ( -- seq )
-    "\r\n" read-until
-    [ CHAR: \r = [ read1 CHAR: \n assert= ] when ] [ f like ] if* ;
+    input-stream get stream-read-?crlf ;
 
 : crlf>lf ( str -- str' )
     CHAR: \r swap remove ;
 
 : lf>crlf ( str -- str' )
     "\n" split "\r\n" join ;
+
+:: stream-read1-ignoring-crlf ( stream -- ch )
+    stream stream-read1 dup "\r\n" member?
+    [ drop stream stream-read1-ignoring-crlf ] when ; inline recursive
+
+: read1-ignoring-crlf ( -- ch )
+    input-stream get stream-read1-ignoring-crlf ;
+
+: push-ignoring-crlf ( elt seq -- )
+    [ "\r\n" member? not ] swap push-if ;
+
+: push-all-ignoring-crlf ( src dst -- )
+    [ push-ignoring-crlf ] curry each ;
+
+:: stream-read-ignoring-crlf ( n stream -- seq/f )
+    n stream stream-read dup [
+        dup [ "\r\n" member? ] any? [
+            stream stream-element-type +byte+ =
+            [ n <byte-vector> ] [ n <sbuf> ] if :> accum
+            accum push-all-ignoring-crlf
+
+            [ accum length n < and ] [
+                n accum length - stream stream-read
+                [ accum push-all-ignoring-crlf ] keep
+            ] do while
+
+            accum stream stream-exemplar like
+        ] when
+    ] when ;
+
+: read-ignoring-crlf ( n -- seq/f )
+    input-stream get stream-read-ignoring-crlf ;