io.encodings: speed up ascii and utf8 stream-read-until.

diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index 6aeedb2da0b40f8b617c50b441a9e73c1df3f91f..6451e4808ed247f940a5b86741c4ac2d084753c9 100644 (file)
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -117,9 +117,9 @@ set-specializer
 
 \ split, { string string } set-specializer
 
-{ member? member-eq? } [
-    { array } set-specializer
-] each
+\ member? { { array } { string } } set-specializer
+
+\ member-eq? { array } set-specializer
 
 \ assoc-stack { vector } set-specializer
 

diff --git a/basis/io/encodings/ascii/ascii.factor b/basis/io/encodings/ascii/ascii.factor
index 2b5640489f3d38539903874b1ee01a0a75c41084..0f7f1f0760bc96d704923ce1d5d5ffc65d24707c 100644 (file)
--- a/basis/io/encodings/ascii/ascii.factor
+++ b/basis/io/encodings/ascii/ascii.factor
@@ -25,3 +25,5 @@ M: ascii decode-char
     stream-read1 dup [
         dup 127 <= [ >fixnum ] [ drop replacement-char ] if
     ] when ; inline
+
+M: ascii decode-until (decode-until) ;

diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index cc6ce42ff17700df9212a23a4d79d9e7c981f734..d46672df721299191de69cb0972209435fc2902e 100644 (file)
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -230,7 +230,7 @@ M: object underlying-handle underlying-port handle>> ;
 
 ! Fast-path optimization
 
-HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ;
+HINTS: (decode-until) { string input-port object } ;
 
 HINTS: M\ input-port stream-read-partial-unsafe
     { fixnum byte-array input-port }

diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index fdb320ff30bfb1a22bb9659ef6de07041ddc1bcb..bd36a65fba11caa5151269200c2cd189ac128eb4 100644 (file)
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -15,6 +15,27 @@ M: object guess-encoded-length drop ; inline
 
 GENERIC: decode-char ( stream encoding -- char/f )
 
+GENERIC: decode-until ( seps stream encoding -- string/f sep/f )
+
+<PRIVATE
+
+! If the stop? branch is taken convert the sbuf to a string
+! If sep is present, returns ``string sep'' (string can be "")
+! If sep is f, returns ``string f'' or ``f f''
+: read-until-loop ( buf quot: ( -- char stop? ) -- string/f sep/f )
+    dup call
+    [ nip [ "" like ] dip [ f like f ] unless* ]
+    [ pick push read-until-loop ] if ; inline recursive
+
+PRIVATE>
+
+: (decode-until) ( seps stream encoding -- string/f sep/f )
+    [ decode-char dup ] 2curry swap [ dupd member? ] curry
+    [ [ drop f t ] if ] curry compose
+    [ 100 <sbuf> ] dip read-until-loop ; inline
+
+M: object decode-until (decode-until) ;
+
 GENERIC: encode-char ( char stream encoding -- )
 
 GENERIC: encode-string ( string stream encoding -- )
@@ -111,23 +132,10 @@ M: decoder stream-contents*
         { CHAR: \n [ line-ends\n ] }
     } case ; inline
 
-! If the stop? branch is taken convert the sbuf to a string
-! If sep is present, returns ``string sep'' (string can be "")
-! If sep is f, returns ``string f'' or ``f f''
-: read-until-loop ( buf quot: ( -- char stop? ) -- string/f sep/f )
-    dup call
-    [ nip [ "" like ] dip [ f like f ] unless* ]
-    [ pick push read-until-loop ] if ; inline recursive
-
-: decoder-read-until ( seps stream encoding -- string/f sep/f )
-    [ decode-char dup ] 2curry swap [ dupd member? ] curry
-    [ [ drop f t ] if ] curry compose
-    [ 100 <sbuf> ] dip read-until-loop ; inline
-
-M: decoder stream-read-until >decoder< decoder-read-until ;
+M: decoder stream-read-until >decoder< decode-until ;
 
 M: decoder stream-readln
-    "\r\n" over >decoder< decoder-read-until handle-readln ;
+    "\r\n" over >decoder< decode-until handle-readln ;
 
 M: decoder dispose stream>> dispose ;
 

diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor
index c01ee89e9eb65b5369b85fb6b95223a003aa7ec8..61f71e3d3b7b62bdb72ffed48dd0ce5aad0c5a68 100644 (file)
--- a/core/io/encodings/utf8/utf8.factor
+++ b/core/io/encodings/utf8/utf8.factor
@@ -54,6 +54,8 @@ SINGLETON: utf8
 M: utf8 decode-char
     drop decode-utf8 ; inline
 
+M: utf8 decode-until (decode-until) ;
+
 ! Encoding UTF-8
 
 : encoded ( stream char -- )