use reject instead of [ ... not ] filter.

[factor.git] / basis / gobject-introspection / ffi / ffi.factor

diff --git a/basis/gobject-introspection/ffi/ffi.factor b/basis/gobject-introspection/ffi/ffi.factor
index ff0eb9a85b2b2df206fc71210071ffb9d9225a36..0735b582414bc5f5691c33307f97f8a6b07b04f2 100644 (file)
--- a/basis/gobject-introspection/ffi/ffi.factor
+++ b/basis/gobject-introspection/ffi/ffi.factor
@@ -1,20 +1,12 @@
 ! Copyright (C) 2010 Anton Gorenko.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.parser arrays assocs
-classes.parser classes.struct combinators
-combinators.short-circuit definitions effects fry
-gobject-introspection.common gobject-introspection.types kernel
-math.parser namespaces parser quotations sequences
-
-gobject-introspection.standard-types
-prettyprint ascii gobject-introspection.repository locals
-compiler.units make splitting.monotonic
-
-sequences.generalizations words words.constant ;
+USING: accessors alien.c-types alien.parser arrays ascii
+classes.parser classes.struct combinators combinators.short-circuit
+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 ;
 
@@ -86,20 +78,17 @@ M: utf8-type parse-const-value drop ;
 : 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 ;
@@ -214,7 +203,7 @@ M: array-type field-type>c-type type>c-type ;
     ] 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
@@ -232,6 +221,14 @@ M: array-type field-type>c-type type>c-type ;
 : def-union-type ( union -- )
     c-type>> void def-c-type ;
 
+: private-record? ( record -- ? )
+    {
+        [ struct-for>> ]
+        [ name>> "Class" tail? ]
+        [ name>> "Private" tail? ]
+        [ name>> "Iface" tail? ]
+    } 1|| ;
+
 : def-union ( union -- )
     {
         [ def-union-type ]
@@ -240,6 +237,12 @@ M: array-type field-type>c-type type>c-type ;
         [ [ 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 ;
 
@@ -292,25 +295,44 @@ M: array-type field-type>c-type type>c-type ;
 
 : defer-enums ( enums -- ) enum-info defer-types ;
 : defer-bitfields ( bitfields -- ) bitfield-info defer-types ;
-: defer-records ( records -- ) record-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 ]
+    [ record-info defer-types ] bi* ;
+
 : def-enums ( enums -- ) [ def-enum-type ] each ;
 : def-bitfields ( bitfields -- ) [ def-bitfield-type ] each ;
-: def-records ( records -- ) [ def-record ] 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-record ] each ] bi* ;
+
 : def-namespace ( namespace -- )
     {
-        [ symbol-prefixes>> first >upper constant-prefix set ]
         [ consts>> def-consts ]
 
         [ enums>> defer-enums ]