alien.strings: faster string>alien for common cases.

diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor
index 346ad45673a14ec8cbc5916bb78e89a04264a0a8..58eb743266c46f5ddb8f940d0ca277577d7dc06d 100644 (file)
--- a/core/alien/strings/strings.factor
+++ b/core/alien/strings/strings.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien arrays byte-arrays init io io.encodings
-io.encodings.utf16n io.encodings.utf8 io.streams.byte-array
-io.streams.memory kernel kernel.private namespaces sequences
-strings system system.private ;
+USING: accessors alien arrays byte-arrays byte-vectors init io
+io.encodings io.encodings.ascii io.encodings.utf16n
+io.encodings.utf8 io.streams.byte-array io.streams.memory kernel
+kernel.private math namespaces sequences sequences.private
+strings strings.private system system.private ;
 IN: alien.strings
 
 GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
@@ -27,13 +28,35 @@ GENERIC# string>alien 1 ( string encoding -- byte-array )
 
 M: c-ptr string>alien drop ;
 
+<PRIVATE
+
+: fast-string? ( string encoding -- ? )
+    [ aux>> not ] [ { ascii utf8 } member-eq? ] bi* and ; inline
+
+: string>alien-fast ( string encoding -- byte-array )
+    { string object } declare ! aux>> must be f
+    drop [ length ] keep over [
+        1 + (byte-array) [
+            [
+                [ [ string-nth-fast ] 2keep drop ]
+                [ set-nth-unsafe ] bi*
+            ] 2curry each-integer
+        ] keep
+    ] keep 0 swap pick set-nth-unsafe ;
+
+: string>alien-slow ( string encoding -- byte-array )
+    { string object } declare
+    over length 1 + over guess-encoded-length <byte-vector> [
+        swap <encoder> [ stream-write ] [ 0 swap stream-write1 ] bi
+    ] keep B{ } like ;
+
+PRIVATE>
+
 M: string string>alien
     over check-string
-    <byte-writer>
-    [ stream-write ]
-    [ 0 swap stream-write1 ]
-    [ stream>> >byte-array ]
-    tri ;
+    2dup fast-string?
+    [ string>alien-fast ]
+    [ string>alien-slow ] if ;
 
 M: tuple string>alien drop underlying>> ;