steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
John Benediktsson 2014-05-20 11:53:36 -07:00
parent 8293425783
commit ff46966cfb
1 changed files with 32 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
core/alien/strings/strings.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008, 2011 Slava Pestov. ! Copyright (C) 2008, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien arrays byte-arrays init io io.encodings USING: accessors alien arrays byte-arrays byte-vectors init io
io.encodings.utf16n io.encodings.utf8 io.streams.byte-array io.encodings io.encodings.ascii io.encodings.utf16n
io.streams.memory kernel kernel.private namespaces sequences io.encodings.utf8 io.streams.byte-array io.streams.memory kernel
strings system system.private ; kernel.private math namespaces sequences sequences.private
strings strings.private system system.private ;
IN: alien.strings IN: alien.strings
GENERIC# alien>string 1 ( c-ptr encoding -- string/f ) 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 ; 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 M: string string>alien
over check-string over check-string
<byte-writer> 2dup fast-string?
[ stream-write ] [ string>alien-fast ]
[ 0 swap stream-write1 ] [ string>alien-slow ] if ;
[ stream>> >byte-array ]
tri ;
M: tuple string>alien drop underlying>> ; M: tuple string>alien drop underlying>> ;