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.byte-array io.streams.memory kernel
6 kernel.private math namespaces sequences sequences.private
7 strings strings.private system system.private ;
10 GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
13 [ <memory-stream> ] [ <decoder> ] bi*
14 "\0" swap stream-read-until drop ;
16 M: object alien>string
17 [ underlying>> ] dip alien>string ;
22 ERROR: invalid-c-string string ;
24 : check-string ( string -- )
25 0 over member-eq? [ invalid-c-string ] [ drop ] if ;
27 GENERIC# string>alien 1 ( string encoding -- byte-array )
29 M: c-ptr string>alien drop ;
33 : fast-string? ( string encoding -- ? )
34 [ aux>> not ] [ { ascii utf8 } member-eq? ] bi* and ; inline
36 : string>alien-fast ( string encoding -- byte-array )
37 { string object } declare ! aux>> must be f
38 drop [ length ] keep over [
41 [ [ string-nth-fast ] 2keep drop ]
42 [ set-nth-unsafe ] bi*
45 ] keep 0 swap pick set-nth-unsafe ;
47 : string>alien-slow ( string encoding -- byte-array )
48 { string object } declare
49 over length 1 + over guess-encoded-length <byte-vector> [
50 swap <encoder> [ stream-write ] [ 0 swap stream-write1 ] bi
55 M: string string>alien
59 [ string>alien-slow ] if ;
61 M: tuple string>alien drop underlying>> ;
63 HOOK: native-string-encoding os ( -- encoding ) foldable
65 M: unix native-string-encoding utf8 ;
66 M: windows native-string-encoding utf16n ;
68 : alien>native-string ( alien -- string )
69 native-string-encoding alien>string ; inline
71 : native-string>alien ( string -- alien )
72 native-string-encoding string>alien ; inline
74 : dll-path ( dll -- string )
75 path>> alien>native-string ;
77 GENERIC: string>symbol ( str/seq -- alien )
79 M: string string>symbol utf8 string>alien ;
81 M: sequence string>symbol [ utf8 string>alien ] map ;
83 : (symbol>string) ( alien -- str )
86 GENERIC: symbol>string ( symbol(s) -- string(s) )
87 M: byte-array symbol>string (symbol>string) ;
88 M: array symbol>string [ (symbol>string) ] map ;
91 OBJ-CPU special-object utf8 alien>string string>cpu \ cpu set-global
92 OBJ-OS special-object utf8 alien>string string>os \ os set-global
93 OBJ-VM-COMPILER special-object utf8 alien>string \ vm-compiler set-global
94 ] "alien.strings" add-startup-hook