1 ! Copyright (C) 2010 Anton Gorenko.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types assocs combinators.short-circuit
4 gobject-introspection.common gobject-introspection.repository kernel
5 locals namespaces parser sequences sets ;
6 IN: gobject-introspection.types
9 type-infos [ H{ } ] initialize
11 SYMBOL: standard-types
12 standard-types [ V{ } ] initialize
14 TUPLE: type-info c-type ;
16 TUPLE: atomic-info < type-info ;
17 TUPLE: enum-info < type-info ;
18 TUPLE: bitfield-info < type-info ;
19 TUPLE: record-info < type-info ;
20 TUPLE: union-info < type-info ;
21 TUPLE: boxed-info < type-info ;
22 TUPLE: callback-info < type-info ;
23 TUPLE: class-info < type-info ;
24 TUPLE: interface-info < type-info ;
28 PREDICATE: none-type < simple-type
31 PREDICATE: atomic-type < simple-type
32 find-type-info atomic-info? ;
34 PREDICATE: utf8-type < atomic-type
37 PREDICATE: enum-type < simple-type
38 find-type-info enum-info? ;
40 PREDICATE: bitfield-type < simple-type
41 find-type-info bitfield-info? ;
43 PREDICATE: record-type < simple-type
44 find-type-info record-info? ;
46 PREDICATE: union-type < simple-type
47 find-type-info union-info? ;
49 PREDICATE: boxed-type < simple-type
50 find-type-info boxed-info? ;
52 PREDICATE: callback-type < simple-type
53 find-type-info callback-info? ;
55 PREDICATE: class-type < simple-type
56 find-type-info class-info? ;
58 PREDICATE: interface-type < simple-type
59 find-type-info interface-info? ;
61 PREDICATE: boxed-array-type < array-type name>> >boolean ;
62 PREDICATE: c-array-type < array-type name>> not ;
63 PREDICATE: fixed-size-array-type < c-array-type fixed-size>> >boolean ;
65 : standard-type? ( data-type -- ? )
66 name>> standard-types get-global in? ;
68 : qualified-name ( name -- qualified-name )
69 current-namespace-name get-global swap "." glue ;
71 : qualified-type-name ( data-type -- name )
73 [ name>> CHAR: . swap member? ]
76 } 1|| [ qualified-name ] unless ;
78 ERROR: unknown-type-error type ;
80 : get-type-info ( data-type -- info )
81 qualified-type-name dup type-infos get-global at
82 [ ] [ unknown-type-error ] ?if ;
84 : find-type-info ( data-type -- info/f )
85 qualified-type-name type-infos get-global at ;
87 :: register-type ( c-type type-info name -- )
88 type-info c-type >>c-type name
89 type-infos get-global set-at ;
91 : register-standard-type ( c-type name -- )
92 dup standard-types get-global adjoin
93 atomic-info new swap register-type ;
95 : register-atomic-type ( c-type name -- )
96 atomic-info new swap register-type ;
98 : register-enum-type ( c-type name -- )
99 enum-info new swap register-type ;
101 : register-record-type ( c-type name -- )
102 record-info new swap register-type ;
104 ERROR: deferred-type-error ;
107 void* lookup-c-type clone
108 [ drop deferred-type-error ] >>unboxer-quot
109 [ drop deferred-type-error ] >>boxer-quot
111 "deferred-type" create-in typedef