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 ;
8 INSTANCE: array value-type
10 M: array lookup-c-type ;
12 M: array c-type-class drop object ;
14 M: array c-type-boxed-class drop object ;
16 : array-length ( seq -- n )
17 [ dup word? [ def>> call( -- object ) ] when ] [ * ] map-reduce ;
19 M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ;
21 M: array c-type-align first c-type-align ;
23 M: array c-type-align-first first c-type-align-first ;
25 M: array base-type drop void* base-type ;
27 PREDICATE: string-type < pair
28 first2 [ c-string = ] [ word? ] bi* and ;
30 M: string-type lookup-c-type ;
32 M: string-type c-type-class drop object ;
34 M: string-type c-type-boxed-class drop object ;
36 M: string-type heap-size drop void* heap-size ;
38 M: string-type c-type-align drop void* c-type-align ;
40 M: string-type c-type-align-first drop void* c-type-align-first ;
42 M: string-type base-type drop void* base-type ;
44 M: string-type c-type-rep drop int-rep ;
46 M: string-type c-type-boxer-quot
48 [ drop void* c-type-boxer-quot ]
49 [ '[ _ alien>string ] ] if ;
51 M: string-type c-type-unboxer-quot
53 [ drop void* c-type-unboxer-quot ]
54 [ '[ _ string>alien ] ] if ;
56 M: string-type c-type-getter
59 M: string-type c-type-copier
62 M: string-type c-type-setter
63 drop [ set-alien-cell ] ;
65 [ { c-string utf8 } c-string typedef ] with-compilation-unit