basis/alien/arrays/arrays.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.strings alien.c-types alien.data alien.accessors
   4 arrays words sequences math kernel namespaces fry cpu.architecture
   5 io.encodings.binary io.encodings.utf8 accessors ;
   6 IN: alien.arrays
   7
   8 INSTANCE: array value-type
   9
  10 M: array c-type ;
  11
  12 M: array c-type-class drop object ;
  13
  14 M: array c-type-boxed-class drop object ;
  15
  16 : array-length ( seq -- n )
  17     [ dup word? [ def>> call( -- object ) ] when ] [ * ] map-reduce ;
  18
  19 M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ;
  20
  21 M: array c-type-align first c-type-align ;
  22
  23 M: array c-type-align-first first c-type-align-first ;
  24
  25 M: array c-type-stack-align? drop f ;
  26
  27 M: array unbox-parameter drop void* unbox-parameter ;
  28
  29 M: array unbox-return drop void* unbox-return ;
  30
  31 M: array box-parameter drop void* box-parameter ;
  32
  33 M: array box-return drop void* box-return ;
  34
  35 M: array stack-size drop void* stack-size ;
  36
  37 M: array c-type-boxer-quot
  38     unclip [ array-length ] dip [ <c-direct-array> ] 2curry ;
  39
  40 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
  41
  42 PREDICATE: string-type < pair
  43     first2 [ char* = ] [ word? ] bi* and ;
  44
  45 M: string-type c-type ;
  46
  47 M: string-type c-type-class drop object ;
  48
  49 M: string-type c-type-boxed-class drop object ;
  50
  51 M: string-type heap-size
  52     drop void* heap-size ;
  53
  54 M: string-type c-type-align
  55     drop void* c-type-align ;
  56
  57 M: string-type c-type-align-first
  58     drop void* c-type-align-first ;
  59
  60 M: string-type c-type-stack-align?
  61     drop void* c-type-stack-align? ;
  62
  63 M: string-type unbox-parameter
  64     drop void* unbox-parameter ;
  65
  66 M: string-type unbox-return
  67     drop void* unbox-return ;
  68
  69 M: string-type box-parameter
  70     drop void* box-parameter ;
  71
  72 M: string-type box-return
  73     drop void* box-return ;
  74
  75 M: string-type stack-size
  76     drop void* stack-size ;
  77
  78 M: string-type c-type-rep
  79     drop int-rep ;
  80
  81 M: string-type c-type-boxer
  82     drop void* c-type-boxer ;
  83
  84 M: string-type c-type-unboxer
  85     drop void* c-type-unboxer ;
  86
  87 M: string-type c-type-boxer-quot
  88     second dup binary =
  89     [ drop void* c-type-boxer-quot ]
  90     [ '[ _ alien>string ] ] if ;
  91
  92 M: string-type c-type-unboxer-quot
  93     second dup binary =
  94     [ drop void* c-type-unboxer-quot ]
  95     [ '[ _ string>alien ] ] if ;
  96
  97 M: string-type c-type-getter
  98     drop [ alien-cell ] ;
  99
 100 M: string-type c-type-setter
 101     drop [ set-alien-cell ] ;
 102
 103 { char* utf8 } char <pointer> typedef
 104 { char* utf8 } char* typedef
 105 { char* utf8 } uchar <pointer> typedef
 106 { char* binary } byte <pointer> typedef
 107 { char* binary } ubyte <pointer> typedef
 108