! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.parser arrays ascii
classes.parser classes.struct combinators combinators.short-circuit
-gobject-introspection.common gobject-introspection.repository
-gobject-introspection.types kernel locals make math.parser namespaces
-parser sequences splitting.monotonic vocabs.parser words
-words.constant ;
+gobject-introspection.repository gobject-introspection.types kernel
+locals make math.parser namespaces parser sequences
+splitting.monotonic vocabs.parser words words.constant ;
IN: gobject-introspection.ffi
-SYMBOL: constant-prefix
-
: def-c-type ( c-type-name base-c-type -- )
swap (CREATE-C-TYPE) typedef ;
: const-value ( const -- value )
[ value>> ] [ type>> ] bi parse-const-value ;
-: const-name ( const -- name )
- name>> constant-prefix get swap "_" glue ;
-
: def-const ( const -- )
- [ const-name create-in dup reset-generic ]
- [ const-value ] bi define-constant ;
+ [ c-identifier>> create-function ] [ const-value ] bi
+ define-constant ;
: def-consts ( consts -- )
[ def-const ] each ;
: define-enum-member ( member -- )
- [ c-identifier>> create-in dup reset-generic ]
- [ value>> ] bi define-constant ;
-
+ [ c-identifier>> create-function ] [ value>> ] bi
+ define-constant ;
+
: def-enum-type ( enum -- )
[ members>> [ define-enum-member ] each ]
[ c-type>> int def-c-type ] bi ;
] tri <struct-slot-spec> ;
: def-record-type ( record -- )
- dup c-type>> implement-structs get-global member?
+ dup fields>>
[
[ c-type>> create-class-in ]
[ fields>> [ field>struct-slot ] map ] bi
[ [ methods>> ] keep def-methods ]
} cleave ;
+: find-existing-boxed-type ( boxed -- type/f )
+ c-type>> search [
+ dup [ c-type? ] [ "c-type" word-prop ] bi or
+ [ drop f ] unless
+ ] [ f ] if* ;
+
: def-boxed-type ( boxed -- )
c-type>> void def-c-type ;
: defer-enums ( enums -- ) enum-info defer-types ;
: defer-bitfields ( bitfields -- ) bitfield-info defer-types ;
: defer-unions ( unions -- ) union-info defer-types ;
-: defer-boxeds ( boxeds -- ) boxed-info defer-types ;
: defer-callbacks ( callbacks -- ) callback-info defer-types ;
: defer-interfaces ( interfaces -- ) interface-info defer-types ;
: defer-classes ( class -- ) class-info defer-types ;
+: defer-boxeds ( boxeds -- )
+ [
+ [
+ dup find-existing-boxed-type
+ [ nip ] [ c-type>> defer-c-type ] if*
+ ]
+ [ name>> qualified-name ] bi
+ boxed-info new swap register-type
+ ] each ;
+
: defer-records ( records -- )
[ private-record? ] partition
[ begin-private record-info defer-types end-private ]
: def-enums ( enums -- ) [ def-enum-type ] each ;
: def-bitfields ( bitfields -- ) [ def-bitfield-type ] each ;
: def-unions ( unions -- ) [ def-union ] each ;
-: def-boxeds ( boxeds -- ) [ def-boxed-type ] each ;
: def-callbacks ( callbacks -- ) [ def-callback-type ] each ;
: def-interfaces ( interfaces -- ) [ def-interface ] each ;
: def-classes ( classes -- ) [ def-class ] each ;
+: def-boxeds ( boxeds -- )
+ [ find-existing-boxed-type ] reject
+ [ def-boxed-type ] each ;
+
: def-records ( records -- )
[ private-record? ] partition
[ begin-private [ def-record ] each end-private ]
: def-namespace ( namespace -- )
{
- [ symbol-prefixes>> first >upper constant-prefix set ]
[ consts>> def-consts ]
[ enums>> defer-enums ]