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 cpu.architecture
   5 io.encodings.binary io.encodings.utf8 accessors compiler.units ;
   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 base-type drop void* base-type ;
  26
  27 PREDICATE: string-type < pair
  28     first2 [ c-string = ] [ word? ] bi* and ;
  29
  30 M: string-type c-type ;
  31
  32 M: string-type c-type-class drop object ;
  33
  34 M: string-type c-type-boxed-class drop object ;
  35
  36 M: string-type heap-size drop void* heap-size ;
  37
  38 M: string-type c-type-align drop void* c-type-align ;
  39
  40 M: string-type c-type-align-first drop void* c-type-align-first ;
  41
  42 M: string-type base-type drop void* base-type ;
  43
  44 M: string-type c-type-rep drop int-rep ;
  45
  46 M: string-type c-type-boxer-quot
  47     second dup binary =
  48     [ drop void* c-type-boxer-quot ]
  49     [ '[ _ alien>string ] ] if ;
  50
  51 M: string-type c-type-unboxer-quot
  52     second dup binary =
  53     [ drop void* c-type-unboxer-quot ]
  54     [ '[ _ string>alien ] ] if ;
  55
  56 M: string-type c-type-getter
  57     drop [ alien-cell ] ;
  58
  59 M: string-type c-type-setter
  60     drop [ set-alien-cell ] ;
  61
  62 [ { c-string utf8 } c-string typedef ] with-compilation-unit
  63