gobject-introspection: clean up;

db4
Anton Gorenko 2011-03-06 14:06:00 +06:00
parent 2704822cc7
commit 479304d0a7
4 changed files with 27 additions and 18 deletions

View File

@ -1,9 +1,12 @@
! Copyright (C) 2010 Anton Gorenko. ! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces ; USING: namespaces sequences ;
IN: gobject-introspection.common IN: gobject-introspection.common
SYMBOL: current-namespace-name SYMBOL: current-namespace-name
SYMBOL: implement-structs SYMBOL: implement-structs
implement-structs [ V{ } ] initialize implement-structs [ V{ } ] initialize
: implement-struct? ( c-type -- ? )
implement-structs get-global member? ;

View File

@ -2,14 +2,11 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.parser arrays ascii USING: accessors alien.c-types alien.parser arrays ascii
classes.parser classes.struct combinators combinators.short-circuit classes.parser classes.struct combinators combinators.short-circuit
gobject-introspection.common gobject-introspection.repository gobject-introspection.repository gobject-introspection.types kernel
gobject-introspection.types kernel locals make math.parser namespaces locals make math.parser namespaces parser sequences
parser sequences splitting.monotonic vocabs.parser words splitting.monotonic vocabs.parser words words.constant ;
words.constant ;
IN: gobject-introspection.ffi IN: gobject-introspection.ffi
SYMBOL: constant-prefix
: def-c-type ( c-type-name base-c-type -- ) : def-c-type ( c-type-name base-c-type -- )
swap (CREATE-C-TYPE) typedef ; swap (CREATE-C-TYPE) typedef ;
@ -81,11 +78,8 @@ M: utf8-type parse-const-value drop ;
: const-value ( const -- value ) : const-value ( const -- value )
[ value>> ] [ type>> ] bi parse-const-value ; [ value>> ] [ type>> ] bi parse-const-value ;
: const-name ( const -- name )
name>> constant-prefix get swap "_" glue ;
: def-const ( const -- ) : def-const ( const -- )
[ const-name create-in dup reset-generic ] [ c-identifier>> create-in dup reset-generic ]
[ const-value ] bi define-constant ; [ const-value ] bi define-constant ;
: def-consts ( consts -- ) : def-consts ( consts -- )
@ -209,7 +203,7 @@ M: array-type field-type>c-type type>c-type ;
] tri <struct-slot-spec> ; ] tri <struct-slot-spec> ;
: def-record-type ( record -- ) : def-record-type ( record -- )
dup c-type>> implement-structs get-global member? dup fields>>
[ [
[ c-type>> create-class-in ] [ c-type>> create-class-in ]
[ fields>> [ field>struct-slot ] map ] bi [ fields>> [ field>struct-slot ] map ] bi
@ -321,7 +315,6 @@ M: array-type field-type>c-type type>c-type ;
: def-namespace ( namespace -- ) : def-namespace ( namespace -- )
{ {
[ symbol-prefixes>> first >upper constant-prefix set ]
[ consts>> def-consts ] [ consts>> def-consts ]
[ enums>> defer-enums ] [ enums>> defer-enums ]

View File

@ -1,7 +1,8 @@
! Copyright (C) 2010 Anton Gorenko. ! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators gobject-introspection.repository kernel USING: accessors ascii combinators gobject-introspection.common
literals math.parser sequences splitting xml.data xml.traversal ; gobject-introspection.repository kernel literals math.parser
sequences splitting xml.data xml.traversal ;
IN: gobject-introspection.loader IN: gobject-introspection.loader
: xml>simple-type ( xml -- type ) : xml>simple-type ( xml -- type )
@ -128,7 +129,11 @@ CONSTANT: type-tags
: xml>record ( xml -- record ) : xml>record ( xml -- record )
[ record new ] dip { [ record new ] dip {
[ load-type ] [ load-type ]
[ "field" tags-named [ xml>field ] map >>fields ] [
over c-type>> implement-struct?
[ "field" tags-named [ xml>field ] map >>fields ]
[ drop ] if
]
[ "constructor" load-functions >>constructors ] [ "constructor" load-functions >>constructors ]
[ "method" load-functions >>methods ] [ "method" load-functions >>methods ]
[ "function" load-functions >>functions ] [ "function" load-functions >>functions ]
@ -192,6 +197,13 @@ CONSTANT: type-tags
[ boxed new ] dip [ boxed new ] dip
load-type ; load-type ;
: fix-conts ( namespace -- )
[ symbol-prefixes>> first >upper "_" append ] [ consts>> ] bi
[ [ name>> append ] keep c-identifier<< ] with each ;
: postprocess-namespace ( namespace -- )
fix-conts ;
: xml>namespace ( xml -- namespace ) : xml>namespace ( xml -- namespace )
[ namespace new ] dip { [ namespace new ] dip {
[ "name" attr >>name ] [ "name" attr >>name ]
@ -208,7 +220,7 @@ CONSTANT: type-tags
[ "class" tags-named [ xml>class ] map >>classes ] [ "class" tags-named [ xml>class ] map >>classes ]
[ "interface" tags-named [ xml>interface ] map >>interfaces ] [ "interface" tags-named [ xml>interface ] map >>interfaces ]
[ "function" load-functions >>functions ] [ "function" load-functions >>functions ]
} cleave ; } cleave [ postprocess-namespace ] keep ;
: xml>repository ( xml -- repository ) : xml>repository ( xml -- repository )
[ repository new ] dip [ repository new ] dip

View File

@ -46,7 +46,8 @@ TUPLE: alias
TUPLE: const TUPLE: const
name name
value value
type ; type
c-identifier ;
TUPLE: type TUPLE: type
name name