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.accessors
   4 arrays words sequences math kernel namespaces fry libc cpu.architecture
   5 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-stack-align? drop f ;
  24
  25 M: array unbox-parameter drop void* unbox-parameter ;
  26
  27 M: array unbox-return drop void* unbox-return ;
  28
  29 M: array box-parameter drop void* box-parameter ;
  30
  31 M: array box-return drop void* box-return ;
  32
  33 M: array stack-size drop void* stack-size ;
  34
  35 M: array c-type-boxer-quot
  36     unclip
  37     [ array-length ]
  38     [ [ require-c-array ] keep ] bi*
  39     [ <c-direct-array> ] 2curry ;
  40
  41 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
  42
  43 PREDICATE: string-type < pair
  44     first2 [ char* = ] [ word? ] bi* and ;
  45
  46 M: string-type c-type ;
  47
  48 M: string-type c-type-class drop object ;
  49
  50 M: string-type c-type-boxed-class drop object ;
  51
  52 M: string-type heap-size
  53     drop void* heap-size ;
  54
  55 M: string-type c-type-align
  56     drop void* c-type-align ;
  57
  58 M: string-type c-type-stack-align?
  59     drop void* c-type-stack-align? ;
  60
  61 M: string-type unbox-parameter
  62     drop void* unbox-parameter ;
  63
  64 M: string-type unbox-return
  65     drop void* unbox-return ;
  66
  67 M: string-type box-parameter
  68     drop void* box-parameter ;
  69
  70 M: string-type box-return
  71     drop void* box-return ;
  72
  73 M: string-type stack-size
  74     drop void* stack-size ;
  75
  76 M: string-type c-type-rep
  77     drop int-rep ;
  78
  79 M: string-type c-type-boxer
  80     drop void* c-type-boxer ;
  81
  82 M: string-type c-type-unboxer
  83     drop void* c-type-unboxer ;
  84
  85 M: string-type c-type-boxer-quot
  86     second '[ _ alien>string ] ;
  87
  88 M: string-type c-type-unboxer-quot
  89     second '[ _ string>alien ] ;
  90
  91 M: string-type c-type-getter
  92     drop [ alien-cell ] ;
  93
  94 M: string-type c-type-setter
  95     drop [ set-alien-cell ] ;
  96
  97 { char* utf8 } char* typedef
  98 char* uchar* typedef
  99
 100 char  char*  "pointer-c-type" set-word-prop
 101 uchar uchar* "pointer-c-type" set-word-prop