add a no-throw? flag to limited-streams, add unit tests

basis/io/streams/limited/limited-tests.factor

@@ -1,7 +1,7 @@
-IN: io.streams.limited.tests
 USING: io io.streams.limited io.encodings io.encodings.string
 io.encodings.ascii io.encodings.binary io.streams.byte-array
-namespaces tools.test strings kernel ;
+namespaces tools.test strings kernel io.streams.string accessors ;
+IN: io.streams.limited.tests
 
 [ ] [
     "hello world\nhow are you today\nthis is a very long line indeed"
@@ -41,3 +41,15 @@ namespaces tools.test strings kernel ;
 
 [ CHAR: a ]
 [ "a" <string-reader> 1 <limited-stream> stream-read1 ] unit-test
+
+[ "abc" ]
+[
+    "abc" <string-reader> 3 <limited-stream> t >>no-throw?
+    4 swap stream-read
+] unit-test
+
+[ f ]
+[
+    "abc" <string-reader> 3 <limited-stream> t >>no-throw?
+    4 over stream-read drop 10 swap stream-read
+] unit-test

basis/io/streams/limited/limited.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math io io.encodings destructors accessors
-sequences namespaces byte-vectors ;
+sequences namespaces byte-vectors fry ;
 IN: io.streams.limited
 
-TUPLE: limited-stream stream count limit ;
+TUPLE: limited-stream stream count limit no-throw? ;
 
 : <limited-stream> ( stream limit -- stream' )
     limited-stream new
@@ -22,19 +22,30 @@ M: object limit <limited-stream> ;
 
 ERROR: limit-exceeded ;
 
-: check-limit ( n stream -- )
-    [ + ] change-count
+: adjust-limit ( n stream -- n' stream )
+    2dup [ + ] change-count
     [ count>> ] [ limit>> ] bi >
-    [ limit-exceeded ] when ; inline
+    [
+        dup no-throw?>> [
+            dup [ count>> ] [ limit>> ] bi -
+            '[ _ - ] dip
+        ] [
+            limit-exceeded
+        ] if
+    ] when ; inline
+
+: maybe-read ( n limited-stream quot: ( n stream -- seq/f ) -- seq/f )
+    pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline
 
 M: limited-stream stream-read1
-    1 over check-limit stream>> stream-read1 ;
+    1 swap adjust-limit
+    [ nip stream-read1 ] maybe-read ;
 
 M: limited-stream stream-read
-    2dup check-limit stream>> stream-read ;
+    adjust-limit [ stream-read ] maybe-read ;
 
 M: limited-stream stream-read-partial
-    2dup check-limit stream>> stream-read-partial ;
+    adjust-limit [ stream-read-partial ] maybe-read ;
 
 : (read-until) ( stream seps buf -- stream seps buf sep/f )
     3dup [ [ stream-read1 dup ] dip memq? ] dip