1 ! Copyright (C) 2009 Anton Gorenko.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.parser arrays assocs
4 classes.parser classes.struct combinators
5 combinators.short-circuit definitions effects fry
6 gobject-introspection.common gobject-introspection.types kernel
7 math.parser namespaces parser quotations sequences
8 sequences.generalizations words words.constant ;
9 IN: gobject-introspection.ffi
11 : string>c-type ( str -- c-type )
12 dup CHAR: * swap index [ cut ] [ "" ] if*
13 [ replaced-c-types get-global ?at drop ] dip
16 : define-each ( nodes quot -- )
17 '[ dup @ >>ffi drop ] each ; inline
19 : function-ffi-invoker ( func -- quot )
21 [ return>> c-type>> string>c-type ]
22 [ drop current-lib get-global ]
24 [ parameters>> [ c-type>> string>c-type ] map ]
25 [ varargs?>> [ void* suffix ] when ]
26 } cleave function-quot ;
28 : function-ffi-effect ( func -- effect )
29 [ parameters>> [ name>> ] map ]
30 [ varargs?>> [ "varargs" suffix ] when ]
31 [ return>> type>> none-type? { } { "result" } ? ] tri
34 : define-ffi-function ( func -- word )
35 [ identifier>> create-in dup ]
36 [ function-ffi-invoker ] [ function-ffi-effect ] tri
39 : define-ffi-functions ( functions -- )
40 [ define-ffi-function ] define-each ;
42 : callback-ffi-invoker ( callback -- quot )
43 [ return>> c-type>> string>c-type ]
44 [ parameters>> [ c-type>> string>c-type ] map ] bi
47 : callback-ffi-effect ( callback -- effect )
48 [ parameters>> [ name>> ] map ]
49 [ return>> type>> none-type? { } { "result" } ? ] bi
52 : define-ffi-callback ( callback -- word )
53 [ c-type>> create-in [ void* swap typedef ] keep dup ] keep
54 [ callback-ffi-effect "callback-effect" set-word-prop ]
55 [ drop current-lib get-global "callback-library" set-word-prop ]
56 [ callback-ffi-invoker (( quot -- alien )) define-inline ] 2tri ;
58 : fix-signal-param-c-type ( param -- )
59 dup [ c-type>> ] [ type>> ] bi
65 } 1|| [ dup "*" tail? [ CHAR: * suffix ] unless ] unless
68 : define-ffi-signal ( signal -- word )
69 [ return>> fix-signal-param-c-type ]
70 [ parameters>> [ fix-signal-param-c-type ] each ]
71 [ define-ffi-callback ] tri ;
73 : define-ffi-signals ( signals -- )
74 [ define-ffi-signal ] define-each ;
76 : const-value ( const -- value )
77 [ value>> ] [ type>> name>> ] bi {
78 { "int" [ string>number ] }
79 { "double" [ string>number ] }
83 : define-ffi-enum ( enum -- word )
86 [ c-identifier>> create-in ]
87 [ value>> ] bi define-constant
89 ] [ c-type>> (CREATE-C-TYPE) [ int swap typedef ] keep ] bi ;
91 : define-ffi-enums ( enums -- )
92 [ define-ffi-enum ] define-each ;
94 : define-ffi-bitfields ( bitfields -- )
95 [ define-ffi-enum ] define-each ;
97 : fields>struct-slots ( fields -- slots )
101 [ c-type>> string>c-type ] [ array-info>> ] bi
102 [ fixed-size>> [ 2array ] when* ] when*
104 [ drop { } ] tri <struct-slot-spec>
107 : define-ffi-record-defer ( record -- word )
108 c-type>> create-in void* swap [ typedef ] keep ;
110 : define-ffi-records-defer ( records -- )
111 [ define-ffi-record-defer ] define-each ;
113 : define-ffi-record ( record -- word )
116 [ fields>> empty? not ]
117 [ c-type>> implement-structs get-global member? ]
120 [ c-type>> create-class-in dup ]
121 [ fields>> fields>struct-slots ] bi define-struct-class
123 [ disguised?>> void* void ? ]
124 [ c-type>> create-in ] bi [ typedef ] keep
127 : define-ffi-records ( records -- )
128 [ define-ffi-record ] define-each ;
130 : define-ffi-record-content ( record -- )
132 [ constructors>> define-ffi-functions ]
133 [ functions>> define-ffi-functions ]
134 [ methods>> define-ffi-functions ]
137 : define-ffi-records-content ( records -- )
138 [ define-ffi-record-content ] each ;
140 : define-ffi-union ( union -- word )
141 c-type>> create-in [ void* swap typedef ] keep ;
143 : define-ffi-unions ( unions -- )
144 [ define-ffi-union ] define-each ;
146 : define-ffi-callbacks ( callbacks -- )
147 [ define-ffi-callback ] define-each ;
149 : define-ffi-interface ( interface -- word )
150 c-type>> create-in [ void swap typedef ] keep ;
152 : define-ffi-interfaces ( interfaces -- )
153 [ define-ffi-interface ] define-each ;
155 : define-ffi-interface-content ( interface -- )
157 [ methods>> define-ffi-functions ]
160 : define-ffi-interfaces-content ( interfaces -- )
161 [ define-ffi-interface-content ] each ;
163 : get-type-invoker ( name -- quot )
164 [ "GType" current-lib get-global ] dip
165 { } \ alien-invoke 5 narray >quotation ;
167 : define-ffi-class ( class -- word )
168 c-type>> create-in [ void swap typedef ] keep ;
170 : define-ffi-classes ( class -- )
171 [ define-ffi-class ] define-each ;
173 : define-ffi-class-content ( class -- )
175 [ constructors>> define-ffi-functions ]
176 [ functions>> define-ffi-functions ]
177 [ methods>> define-ffi-functions ]
178 [ signals>> define-ffi-signals ]
181 : define-ffi-classes-content ( class -- )
182 [ define-ffi-class-content ] each ;
184 : define-get-type ( node -- word )
185 get-type>> dup { "intern" f } member? [ drop f ]
187 [ create-in dup ] [ get-type-invoker ] bi
188 { } { "type" } <effect> define-declared
191 : define-get-types ( namespace -- )
193 [ enums>> [ define-get-type drop ] each ]
194 [ bitfields>> [ define-get-type drop ] each ]
195 [ records>> [ define-get-type drop ] each ]
196 [ unions>> [ define-get-type drop ] each ]
197 [ interfaces>> [ define-get-type drop ] each ]
198 [ classes>> [ define-get-type drop ] each ]
201 : define-ffi-const ( const -- word )
202 [ c-identifier>> create-in dup ] [ const-value ] bi
205 : define-ffi-consts ( consts -- )
206 [ define-ffi-const ] define-each ;
208 : define-ffi-alias ( alias -- )
211 : define-ffi-aliases ( aliases -- )
212 [ define-ffi-alias ] each ;
214 : define-ffi-namespace ( namespace -- )
216 [ aliases>> define-ffi-aliases ]
217 [ consts>> define-ffi-consts ]
218 [ enums>> define-ffi-enums ]
219 [ bitfields>> define-ffi-bitfields ]
221 [ records>> define-ffi-records-defer ]
223 [ unions>> define-ffi-unions ]
224 [ interfaces>> define-ffi-interfaces ]
225 [ classes>> define-ffi-classes ]
226 [ callbacks>> define-ffi-callbacks ]
227 [ records>> define-ffi-records ]
229 [ records>> define-ffi-records-content ]
230 [ classes>> define-ffi-classes-content ]
231 [ interfaces>> define-ffi-interfaces-content ]
232 [ functions>> define-ffi-functions ]
235 : define-ffi-repository ( repository -- )
236 namespace>> define-ffi-namespace ;