core/alien/strings/strings.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays sequences kernel kernel.private accessors math
   4 alien.accessors byte-arrays io io.encodings io.encodings.utf8
   5 io.encodings.utf16n io.streams.byte-array io.streams.memory system
   6 system.private alien strings combinators namespaces init ;
   7 IN: alien.strings
   8
   9 GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
  10
  11 M: c-ptr alien>string
  12     [ <memory-stream> ] [ <decoder> ] bi*
  13     "\0" swap stream-read-until drop ;
  14
  15 M: object alien>string
  16     [ underlying>> ] dip alien>string ;
  17
  18 M: f alien>string
  19     drop ;
  20
  21 ERROR: invalid-c-string string ;
  22
  23 : check-string ( string -- )
  24     0 over member-eq? [ invalid-c-string ] [ drop ] if ;
  25
  26 GENERIC# string>alien 1 ( string encoding -- byte-array )
  27
  28 M: c-ptr string>alien drop ;
  29
  30 M: 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
  38 M: tuple string>alien drop underlying>> ;
  39
  40 HOOK: native-string-encoding os ( -- encoding ) foldable
  41
  42 M: unix native-string-encoding utf8 ;
  43 M: 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
  54 HOOK: string>symbol* os ( str/seq -- alien )
  55
  56 M: winnt string>symbol* utf8 string>alien ;
  57
  58 M: wince string>symbol* utf16n string>alien ;
  59
  60 M: unix string>symbol* utf8 string>alien ;
  61
  62 GENERIC: string>symbol ( str -- alien )
  63
  64 M: string string>symbol string>symbol* ;
  65
  66 M: sequence string>symbol [ string>symbol* ] map ;
  67
  68 [
  69      8 special-object utf8 alien>string string>cpu \ cpu set-global
  70      9 special-object utf8 alien>string string>os \ os set-global
  71     67 special-object utf8 alien>string \ vm-compiler set-global
  72 ] "alien.strings" add-startup-hook