1 ! Copyright (C) 2008, 2011 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien arrays byte-arrays byte-vectors init io
4 io.encodings io.encodings.ascii io.encodings.utf16n
5 io.encodings.utf8 io.streams.memory kernel kernel.private math
6 namespaces sequences sequences.private strings strings.private
7 system system.private ;
8 USE: io.streams.byte-array ! for windows, do not delete!
11 GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
14 [ <memory-stream> ] [ <decoder> ] bi*
15 "\0" swap stream-read-until drop ;
17 M: object alien>string
18 [ underlying>> ] dip alien>string ;
23 ERROR: invalid-c-string string ;
25 : check-string ( string -- )
26 0 over member-eq? [ invalid-c-string ] [ drop ] if ;
28 GENERIC# string>alien 1 ( string encoding -- byte-array )
30 M: c-ptr string>alien drop ;
34 : fast-string? ( string encoding -- ? )
35 [ aux>> not ] [ { ascii utf8 } member-eq? ] bi* and ; inline
37 : string>alien-fast ( string encoding -- byte-array )
38 { string object } declare ! aux>> must be f
39 drop [ length ] keep over [
42 [ [ string-nth-fast ] 2keep drop ]
43 [ set-nth-unsafe ] bi*
46 ] keep 0 swap pick set-nth-unsafe ;
48 : string>alien-slow ( string encoding -- byte-array )
49 { string object } declare
50 over length 1 + over guess-encoded-length <byte-vector> [
51 swap <encoder> [ stream-write ] [ 0 swap stream-write1 ] bi
56 M: string string>alien
60 [ string>alien-slow ] if ;
62 M: tuple string>alien drop underlying>> ;
64 HOOK: native-string-encoding os ( -- encoding ) foldable
66 M: unix native-string-encoding utf8 ;
67 M: windows native-string-encoding utf16n ;
69 : alien>native-string ( alien -- string )
70 native-string-encoding alien>string ; inline
72 : native-string>alien ( string -- alien )
73 native-string-encoding string>alien ; inline
75 : dll-path ( dll -- string )
76 path>> alien>native-string ;
78 GENERIC: string>symbol ( str/seq -- alien )
80 M: string string>symbol utf8 string>alien ;
82 M: sequence string>symbol [ utf8 string>alien ] map ;
84 : (symbol>string) ( alien -- str )
87 GENERIC: symbol>string ( symbol(s) -- string )
88 M: byte-array symbol>string (symbol>string) ;
89 M: array symbol>string [ (symbol>string) ] map ", " join ;
92 OBJ-CPU special-object utf8 alien>string string>cpu \ cpu set-global
93 OBJ-OS special-object utf8 alien>string string>os \ os set-global
94 OBJ-VM-COMPILER special-object utf8 alien>string \ vm-compiler set-global
95 ] "alien.strings" add-startup-hook