From 06e675d90399394dc05c5886b0458306990caf3d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Philipp=20Br=C3=BCschweiler?= <blei42@gmail.com>
Date: Mon, 29 Aug 2011 15:11:24 +0200
Subject: [PATCH] gobject-introspection: don't generate C-TYPEs for boxed types
 that already exist, fixes #60

---
 basis/glib/ffi/ffi.factor                  |  6 +++---
 basis/gobject-introspection/ffi/ffi.factor | 22 ++++++++++++++++++++--
 basis/gobject/ffi/ffi.factor               |  5 ++++-
 3 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/basis/glib/ffi/ffi.factor b/basis/glib/ffi/ffi.factor
index 4ed80c0a7a..30f681203e 100644
--- a/basis/glib/ffi/ffi.factor
+++ b/basis/glib/ffi/ffi.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2010 Anton Gorenko.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.destructors alien.libraries
-alien.strings alien.syntax combinators io.encodings.utf8 kernel
-gobject.ffi gobject-introspection gobject-introspection.standard-types
+alien.strings alien.syntax combinators gobject-introspection
+gobject-introspection.standard-types io.encodings.utf8 kernel
 system ;
 IN: glib.ffi
 
@@ -16,7 +16,7 @@ LIBRARY: glib
 } cond
 >>
 
-IMPLEMENT-STRUCTS: GPollFD GSource GSourceFuncs ;
+IMPLEMENT-STRUCTS: GError GPollFD GSource GSourceFuncs ;
 
 CONSTANT: G_MININT8   HEX: -80
 CONSTANT: G_MAXINT8   HEX:  7f
diff --git a/basis/gobject-introspection/ffi/ffi.factor b/basis/gobject-introspection/ffi/ffi.factor
index 82a1d638dd..40561da87f 100644
--- a/basis/gobject-introspection/ffi/ffi.factor
+++ b/basis/gobject-introspection/ffi/ffi.factor
@@ -237,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 ;
 
@@ -290,11 +296,20 @@ 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-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 ]
@@ -303,11 +318,14 @@ M: array-type field-type>c-type type>c-type ;
 : 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 not ] filter
+    [ def-boxed-type ] each ;
+
 : def-records ( records -- )
     [ private-record? ] partition
     [ begin-private [ def-record ] each end-private ]
diff --git a/basis/gobject/ffi/ffi.factor b/basis/gobject/ffi/ffi.factor
index eac9f34fca..c9d9c21af8 100644
--- a/basis/gobject/ffi/ffi.factor
+++ b/basis/gobject/ffi/ffi.factor
@@ -4,9 +4,12 @@ USING: alien alien.destructors alien.libraries alien.syntax kernel
 combinators gobject-introspection literals math system vocabs.loader ;
 IN: gobject.ffi
 
+! these two are needed for the definition of GError and others.
+! otherwise we generate GError and some others in this vocab as well.
 <<
 "glib.ffi" require
 >>
+USE: glib.ffi
 
 LIBRARY: gobject
 
@@ -17,7 +20,7 @@ LIBRARY: gobject
 } cond
 >>
 
-IMPLEMENT-STRUCTS: GError GValue GParamSpecVariant ;
+IMPLEMENT-STRUCTS: GValue GParamSpecVariant ;
 
 GIR: vocab:gobject/GObject-2.0.gir