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 ;
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 swap aux>> not [ { ascii utf8 } member-eq? ] [ drop f ] if ; 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 ] keepd ]
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 ;
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 GENERIC: symbol>string ( symbol(s) -- string )
86 M: byte-array symbol>string utf8 alien>string ;
88 M: array symbol>string [ utf8 alien>string ] map ", " join ;
90 : special-object>string ( n -- str )
91 special-object utf8 alien>string ;
94 OBJ-CPU special-object>string string>cpu \ cpu set-global
95 OBJ-OS special-object>string string>os \ os set-global
96 OBJ-VM-VERSION special-object>string \ vm-version set-global
97 OBJ-VM-GIT-LABEL special-object>string \ vm-git-label set-global
98 OBJ-VM-COMPILER special-object>string \ vm-compiler set-global
99 OBJ-VM-COMPILE-TIME special-object>string \ vm-compile-time set-global
100 ] "alien.strings" add-startup-hook