/core/alien/strings/strings.factor

 1! Copyright (C) 2008, 2011 Slava Pestov.
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: accessors alien arrays byte-arrays init io io.encodings
 4io.encodings.utf16n io.encodings.utf8 io.streams.byte-array
 5io.streams.memory kernel kernel.private namespaces sequences
 6strings system system.private ;
 7IN: alien.strings
 8
 9GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
10
11M: c-ptr alien>string
12    [ <memory-stream> ] [ <decoder> ] bi*
13    "\0" swap stream-read-until drop ;
14
15M: object alien>string
16    [ underlying>> ] dip alien>string ;
17
18M: f alien>string
19    drop ;
20
21ERROR: invalid-c-string string ;
22
23: check-string ( string -- )
24    0 over member-eq? [ invalid-c-string ] [ drop ] if ;
25
26GENERIC# string>alien 1 ( string encoding -- byte-array )
27
28M: c-ptr string>alien drop ;
29
30M: string string>alien
31    over check-string
32    <byte-writer>
33    [ stream-write ]
34    [ 0 swap stream-write1 ]
35    [ stream>> >byte-array ]
36    tri ;
37
38M: tuple string>alien drop underlying>> ;
39
40HOOK: native-string-encoding os ( -- encoding ) foldable
41
42M: unix native-string-encoding utf8 ;
43M: windows native-string-encoding utf16n ;
44
45: alien>native-string ( alien -- string )
46    native-string-encoding alien>string ; inline
47
48: native-string>alien ( string -- alien )
49    native-string-encoding string>alien ; inline
50
51: dll-path ( dll -- string )
52    path>> alien>native-string ;
53
54GENERIC: string>symbol ( str/seq -- alien )
55
56M: string string>symbol utf8 string>alien ;
57
58M: sequence string>symbol [ utf8 string>alien ] map ;
59
60: (symbol>string) ( alien -- str )
61    utf8 alien>string ;
62
63GENERIC: symbol>string ( symbol(s) -- string(s) )
64M: byte-array symbol>string (symbol>string) ;
65M: array symbol>string [ (symbol>string) ] map ;
66
67[
68    OBJ-CPU special-object utf8 alien>string string>cpu \ cpu set-global
69    OBJ-OS special-object utf8 alien>string string>os \ os set-global
70    OBJ-VM-COMPILER special-object utf8 alien>string \ vm-compiler set-global
71] "alien.strings" add-startup-hook