core/alien/strings/strings.factor

   1 ! Copyright (C) 2008, 2009 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: f alien>string
  16     drop ;
  17
  18 ERROR: invalid-c-string string ;
  19
  20 : check-string ( string -- )
  21     0 over memq? [ invalid-c-string ] [ drop ] if ;
  22
  23 GENERIC# string>alien 1 ( string encoding -- byte-array )
  24
  25 M: c-ptr string>alien drop ;
  26
  27 M: string string>alien
  28     over check-string
  29     <byte-writer>
  30     [ stream-write ]
  31     [ 0 swap stream-write1 ]
  32     [ stream>> >byte-array ]
  33     tri ;
  34
  35 HOOK: alien>native-string os ( alien -- string )
  36
  37 HOOK: native-string>alien os ( string -- alien )
  38
  39 M: windows alien>native-string utf16n alien>string ;
  40
  41 M: wince native-string>alien utf16n string>alien ;
  42
  43 M: winnt native-string>alien utf8 string>alien ;
  44
  45 M: unix alien>native-string utf8 alien>string ;
  46
  47 M: unix native-string>alien utf8 string>alien ;
  48
  49 : dll-path ( dll -- string )
  50     path>> alien>native-string ;
  51
  52 : string>symbol ( str -- alien )
  53     dup string?
  54     [ native-string>alien ]
  55     [ [ native-string>alien ] map ] if ;
  56
  57 [
  58     8 getenv utf8 alien>string string>cpu \ cpu set-global
  59     9 getenv utf8 alien>string string>os \ os set-global
  60 ] "alien.strings" add-init-hook
  61