! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.libraries alien.syntax combinators kernel
system
-gir glib.ffi gobject.ffi ;
+gobject-introspection glib.ffi gobject.ffi ;
IN: atk.ffi
<<
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.destructors alien.syntax
alien.libraries cairo.ffi combinators kernel system
-gir gdk.pixbuf.ffi gio.ffi glib.ffi gmodule.ffi gobject.ffi
-pango.ffi ;
+gobject-introspection gdk.pixbuf.ffi gio.ffi glib.ffi gmodule.ffi
+gobject.ffi pango.ffi ;
IN: gdk.ffi
<<
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.libraries combinators kernel
system vocabs.parser words
-gir gdk.ffi gdk.pixbuf.ffi gio.ffi glib.ffi gmodule.ffi
-gobject.ffi pango.ffi ;
+gobject-introspection gdk.ffi gdk.pixbuf.ffi gio.ffi glib.ffi
+gmodule.ffi gobject.ffi pango.ffi ;
IN: gdk.gl.ffi
<<
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.libraries combinators kernel system
-gir gio.ffi glib.ffi gmodule.ffi gobject.ffi ;
+gobject-introspection gio.ffi glib.ffi gmodule.ffi gobject.ffi ;
EXCLUDE: alien.c-types => pointer ;
IN: gdk.pixbuf.ffi
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.libraries combinators kernel system
-gir glib.ffi gobject.ffi ;
+gobject-introspection glib.ffi gobject.ffi ;
EXCLUDE: alien.c-types => pointer ;
IN: gio.ffi
+++ /dev/null
-Anton Gorenko
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2010 Anton Gorenko.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs kernel namespaces ;
-IN: gir.common
-
-CONSTANT: ffi-vocab "ffi"
-
-SYMBOL: current-lib
-
-SYMBOL: type-infos
-type-infos [ H{ } ] initialize
-
-SYMBOL: aliases
-aliases [ H{ } ] initialize
-
-SYMBOL: implement-structs
-
+++ /dev/null
-! Copyright (C) 2009 Anton Gorenko.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.parser arrays
-classes.parser classes.struct combinators combinators.short-circuit
-definitions effects fry gir.common gir.types kernel math.parser
-namespaces parser quotations sequences sequences.generalizations words
-words.constant ;
-IN: gir.ffi
-
-: string>c-type ( str -- c-type )
- parse-c-type ;
-
-: define-each ( nodes quot -- )
- '[ dup @ >>ffi drop ] each ; inline
-
-: function-ffi-invoker ( func -- quot )
- {
- [ return>> c-type>> string>c-type ]
- [ drop current-lib get-global ]
- [ identifier>> ]
- [ parameters>> [ c-type>> string>c-type ] map ]
- [ varargs?>> [ void* suffix ] when ]
- } cleave function-quot ;
-
-: function-ffi-effect ( func -- effect )
- [ parameters>> [ name>> ] map ]
- [ varargs?>> [ "varargs" suffix ] when ]
- [ return>> type>> none-type? { } { "result" } ? ] tri
- <effect> ;
-
-: define-ffi-function ( func -- word )
- [ identifier>> create-in dup ]
- [ function-ffi-invoker ] [ function-ffi-effect ] tri
- define-declared ;
-
-: define-ffi-functions ( functions -- )
- [ define-ffi-function ] define-each ;
-
-: callback-ffi-invoker ( callback -- quot )
- [ return>> c-type>> string>c-type ]
- [ parameters>> [ c-type>> string>c-type ] map ] bi
- cdecl callback-quot ;
-
-: callback-ffi-effect ( callback -- effect )
- [ parameters>> [ name>> ] map ]
- [ return>> type>> none-type? { } { "result" } ? ] bi
- <effect> ;
-
-: define-ffi-callback ( callback -- word )
- [ c-type>> create-in [ void* swap typedef ] keep dup ] keep
- [ callback-ffi-effect "callback-effect" set-word-prop ]
- [ drop current-lib get-global "callback-library" set-word-prop ]
- [ callback-ffi-invoker (( quot -- alien )) define-inline ] 2tri ;
-
-: fix-signal-param-c-type ( param -- )
- dup [ c-type>> ] [ type>> ] bi
- {
- [ none-type? ]
- [ simple-type? ]
- [ enum-type? ]
- [ bitfield-type? ]
- } 1|| [ dup "*" tail? [ CHAR: * suffix ] unless ] unless
- >>c-type drop ;
-
-: define-ffi-signal ( signal -- word )
- [ return>> fix-signal-param-c-type ]
- [ parameters>> [ fix-signal-param-c-type ] each ]
- [ define-ffi-callback ] tri ;
-
-: define-ffi-signals ( signals -- )
- [ define-ffi-signal ] define-each ;
-
-: const-value ( const -- value )
- [ value>> ] [ type>> name>> ] bi {
- { "int" [ string>number ] }
- { "double" [ string>number ] }
- { "utf8" [ ] }
- } case ;
-
-: define-ffi-enum ( enum -- word )
- [
- members>> [
- [ c-identifier>> create-in ]
- [ value>> ] bi define-constant
- ] each
- ] [ c-type>> (CREATE-C-TYPE) [ int swap typedef ] keep ] bi ;
-
-: define-ffi-enums ( enums -- )
- [ define-ffi-enum ] define-each ;
-
-: define-ffi-bitfields ( bitfields -- )
- [ define-ffi-enum ] define-each ;
-
-: fields>struct-slots ( fields -- slots )
- [
- [ name>> ]
- [
- [ c-type>> string>c-type ] [ array-info>> ] bi
- [ fixed-size>> [ 2array ] when* ] when*
- ]
- [ drop { } ] tri <struct-slot-spec>
- ] map ;
-
-: define-ffi-record-defer ( record -- word )
- c-type>> create-in void* swap [ typedef ] keep ;
-
-: define-ffi-records-defer ( records -- )
- [ define-ffi-record-defer ] define-each ;
-
-: define-ffi-record ( record -- word )
- dup ffi>> forget
- dup {
- [ fields>> empty? not ]
- [ c-type>> implement-structs get-global member? ]
- } 1&&
- [
- [ c-type>> create-class-in dup ]
- [ fields>> fields>struct-slots ] bi define-struct-class
- ] [
- [ disguised?>> void* void ? ]
- [ c-type>> create-in ] bi [ typedef ] keep
- ] if ;
-
-: define-ffi-records ( records -- )
- [ define-ffi-record ] define-each ;
-
-: define-ffi-record-content ( record -- )
- {
- [ constructors>> define-ffi-functions ]
- [ functions>> define-ffi-functions ]
- [ methods>> define-ffi-functions ]
- } cleave ;
-
-: define-ffi-records-content ( records -- )
- [ define-ffi-record-content ] each ;
-
-: define-ffi-union ( union -- word )
- c-type>> create-in [ void* swap typedef ] keep ;
-
-: define-ffi-unions ( unions -- )
- [ define-ffi-union ] define-each ;
-
-: define-ffi-callbacks ( callbacks -- )
- [ define-ffi-callback ] define-each ;
-
-: define-ffi-interface ( interface -- word )
- c-type>> create-in [ void swap typedef ] keep ;
-
-: define-ffi-interfaces ( interfaces -- )
- [ define-ffi-interface ] define-each ;
-
-: define-ffi-interface-content ( interface -- )
- {
- [ methods>> define-ffi-functions ]
- } cleave ;
-
-: define-ffi-interfaces-content ( interfaces -- )
- [ define-ffi-interface-content ] each ;
-
-: get-type-invoker ( name -- quot )
- [ "GType" current-lib get-global ] dip
- { } \ alien-invoke 5 narray >quotation ;
-
-: define-ffi-class ( class -- word )
- c-type>> create-in [ void swap typedef ] keep ;
-
-: define-ffi-classes ( class -- )
- [ define-ffi-class ] define-each ;
-
-: define-ffi-class-content ( class -- )
- {
- [ constructors>> define-ffi-functions ]
- [ functions>> define-ffi-functions ]
- [ methods>> define-ffi-functions ]
- [ signals>> define-ffi-signals ]
- } cleave ;
-
-: define-ffi-classes-content ( class -- )
- [ define-ffi-class-content ] each ;
-
-: define-get-type ( node -- word )
- get-type>> dup { "intern" f } member? [ drop f ]
- [
- [ create-in dup ] [ get-type-invoker ] bi
- { } { "type" } <effect> define-declared
- ] if ;
-
-: define-get-types ( namespace -- )
- {
- [ enums>> [ define-get-type drop ] each ]
- [ bitfields>> [ define-get-type drop ] each ]
- [ records>> [ define-get-type drop ] each ]
- [ unions>> [ define-get-type drop ] each ]
- [ interfaces>> [ define-get-type drop ] each ]
- [ classes>> [ define-get-type drop ] each ]
- } cleave ;
-
-: define-ffi-const ( const -- word )
- [ c-identifier>> create-in dup ] [ const-value ] bi
- define-constant ;
-
-: define-ffi-consts ( consts -- )
- [ define-ffi-const ] define-each ;
-
-: define-ffi-alias ( alias -- )
- drop ;
-
-: define-ffi-aliases ( aliases -- )
- [ define-ffi-alias ] each ;
-
-: define-ffi-namespace ( namespace -- )
- {
- [ aliases>> define-ffi-aliases ]
- [ consts>> define-ffi-consts ]
- [ enums>> define-ffi-enums ]
- [ bitfields>> define-ffi-bitfields ]
-
- [ records>> define-ffi-records-defer ]
-
- [ unions>> define-ffi-unions ]
- [ interfaces>> define-ffi-interfaces ]
- [ classes>> define-ffi-classes ]
- [ callbacks>> define-ffi-callbacks ]
- [ records>> define-ffi-records ]
-
- [ records>> define-ffi-records-content ]
- [ classes>> define-ffi-classes-content ]
- [ interfaces>> define-ffi-interfaces-content ]
- [ functions>> define-ffi-functions ]
- } cleave ;
-
-: define-ffi-repository ( repository -- )
- namespace>> define-ffi-namespace ;
-
+++ /dev/null
-! Copyright (C) 2009 Anton Gorenko.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators gir.common gir.ffi gir.loader
-kernel lexer locals math namespaces sequences vocabs.parser xml ;
-IN: gir
-
-: with-child-vocab ( name quot -- )
- swap current-vocab name>>
- [ swap "." glue set-current-vocab call ] keep
- set-current-vocab ; inline
-
-:: define-gir-vocab ( file-name -- )
- file-name file>xml xml>repository
-
- current-vocab name>> dup ffi-vocab tail?
- [ ffi-vocab length 1 + head* current-lib set-global ]
- [ drop ] if ! throw the error
- {
- [ define-ffi-repository ]
- } cleave
- f implement-structs set-global ;
-
-SYNTAX: GIR: scan define-gir-vocab ;
-
-SYNTAX: IMPLEMENT-STRUCTS:
- ";" parse-tokens implement-structs set-global ;
+++ /dev/null
-! Copyright (C) 2009 Anton Gorenko.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors ascii combinators fry gir.common gir.repository
-gir.types kernel math.parser sequences splitting xml.data
-xml.traversal ;
-FROM: namespaces => set get ;
-IN: gir.loader
-
-SYMBOL: namespace-prefix
-SYMBOL: namespace-PREFIX
-
-: word-started? ( word letter -- ? )
- [ last letter? ] [ LETTER? ] bi* and ;
-
-: camel>PREFIX ( name -- name' )
- dup 1 head
- [ 2dup word-started? [ [ CHAR: _ suffix ] dip ] when suffix ]
- reduce rest >upper ;
-
-: set-prefix ( prefix -- )
- [ namespace-prefix set ]
- [ camel>PREFIX namespace-PREFIX set ] bi ;
-
-: camel>factor ( name -- name' )
- dup 1 head
- [ 2dup word-started? [ [ CHAR: - suffix ] dip ] when suffix ]
- reduce rest >lower ;
-
-: underscored>factor ( name -- name' )
- [ [ CHAR: _ = not ] keep CHAR: - ? ] map >lower ;
-
-: full-type-name>type ( name -- type )
- [ type new ] dip
- camel>factor "." split1 dup [ swap ] unless
- [ >>namespace ] [ >>name ] bi* absolute-type ;
-
-: node>type ( xml -- type )
- "name" attr full-type-name>type ;
-
-: xml>array-info ( xml -- array-info )
- [ array-info new ] dip {
- [ "zero-terminated" attr [ "1" = ] [ t ] if* >>zero-terminated? ]
- [ "length" attr [ string>number ] [ f ] if* >>length ]
- [ "fixed-size" attr [ string>number ] [ f ] if* >>fixed-size ]
- } cleave ;
-
-: xml>type ( xml -- array-info type )
- dup name>> main>> {
- { "array"
- [
- [ xml>array-info ]
- [ first-child-tag node>type ] bi
- ]
- }
- { "type" [ node>type f swap ] }
- { "varargs" [ drop f f ] }
- { "callback" [ drop f "any" f type boa ] }
- } case ;
-
-: load-parameter ( param xml -- param )
- [ "transfer-ownership" attr >>transfer-ownership ]
- [ first-child-tag "type" attr >>c-type ]
- [
- first-child-tag xml>type
- [ [ >>array-info ] [ >>type ] bi* ] [ 2drop f ] if*
- ] tri ;
-
-: load-type ( type xml -- type )
- {
- [ "name" attr camel>factor >>name ]
- [ node>type >>type ]
- [ "type" attr >>c-type ]
- [ "type-name" attr >>type-name ]
- [ "get-type" attr >>get-type ]
- } cleave ;
-
-: xml>parameter ( xml -- parameter )
- [ parameter new ] dip {
- [ "name" attr >>name ]
- [ "direction" attr dup "in" ? >>direction ]
- [ "allow-none" attr "1" = >>allow-none? ]
- [ load-parameter ]
- } cleave ;
-
-: xml>return ( xml -- return )
- [ return new ] dip {
- [ drop "result" >>name ]
- [ load-parameter ]
- } cleave ;
-
-: throws-parameter ( -- parameter )
- parameter new
- "error" >>name
- "in" >>direction
- "none" >>transfer-ownership
- "GError**" >>c-type
- "GLib.Error" full-type-name>type >>type ;
-
-: extract-parameters ( xml -- parameters )
- "parameters" tag-named "parameter" tags-named
- [ xml>parameter ] map ;
-
-: load-parameters ( callable xml -- callable )
- [
- [
- extract-parameters
- dup { f } tail? [ but-last [ t >>varargs? ] dip ] when
- ]
- [ "throws" attr "1" = [ throws-parameter suffix ] when ] bi
- >>parameters
- ]
- [ "return-value" tag-named xml>return >>return ] bi ;
-
-: xml>function ( xml -- function )
- [ function new ] dip {
- [ "name" attr underscored>factor >>name ]
- [ "identifier" attr >>identifier ]
- [ load-parameters ]
- } cleave ;
-
-: (type>param) ( type -- param )
- [ parameter new ] dip
- [ c-type>> CHAR: * suffix >>c-type ] [ type>> >>type ] bi
- "none" >>transfer-ownership
- "in" >>direction ;
-
-: type>self-param ( type -- self )
- (type>param) "self" >>name ;
-
-: type>sender-param ( type -- sender )
- (type>param) "sender" >>name ;
-
-: signal-data-param ( -- param )
- parameter new
- "user_data" >>name
- "gpointer" >>c-type
- type new "any" >>name >>type
- "none" >>transfer-ownership
- "in" >>direction ;
-
-: xml>property ( xml -- property )
- [ property new ] dip {
- [ "name" attr >>name ]
- [ "writable" attr "1" = >>writable? ]
- [ "readable" attr "0" = not >>readable? ]
- [ "construct" attr "1" = >>construct? ]
- [ "construct-only" attr "1" = >>construct-only? ]
- [ first-child-tag xml>type nip >>type ]
- } cleave ;
-
-: xml>callback ( xml -- callback )
- [ callback new ] dip {
- [ load-type ]
- [ load-parameters ]
- } cleave ;
-
-: xml>signal ( xml -- signal )
- [ signal new ] dip {
- [ "name" attr camel>factor >>name ]
- [ node>type >>type ]
- [ "type" attr >>c-type ]
- [
- load-parameters
- [ signal-data-param suffix ] change-parameters
- ]
- } cleave ;
-
-: load-functions ( xml tag-name -- functions )
- tags-named [ xml>function ] map ;
-
-: xml>class ( xml -- class )
- [ class new ] dip {
- [ load-type ]
- [ "abstract" attr "1" = >>abstract? ]
- [
- "parent" attr [ full-type-name>type ] [ f ] if*
- >>parent
- ]
- [ "type-struct" attr >>type-struct ]
- [ "constructor" load-functions >>constructors ]
- [ "function" load-functions >>functions ]
- [
- "method" load-functions over type>self-param
- '[ [ _ prefix ] change-parameters ] map
- >>methods
- ]
- [
- "signal" tags-named [ xml>signal ] map
- over type>sender-param
- '[ [ _ prefix ] change-parameters ] map
- over c-type>> CHAR: : suffix
- '[ dup name>> _ prepend >>c-type ] map
- >>signals
- ]
- } cleave ;
-
-: xml>interface ( xml -- interface )
- [ interface new ] dip {
- [ load-type ]
- [
- "method" load-functions over type>self-param
- '[ [ _ prefix ] change-parameters ] map
- >>methods
- ]
- } cleave ;
-
-: xml>member ( xml -- member )
- [ enum-member new ] dip {
- [ "name" attr underscored>factor >>name ]
- [ "identifier" attr >>c-identifier ]
- [ "value" attr string>number >>value ]
- } cleave ;
-
-: xml>enum ( xml -- enum )
- [ enum new ] dip {
- [ load-type ]
- [ "member" tags-named [ xml>member ] map >>members ]
- } cleave ;
-
-: xml>field ( xml -- field )
- [ field new ] dip {
- [ "name" attr >>name ]
- [ "writable" attr "1" = >>writable? ]
- ! Для некоторых field есть callback в качестве типа, решить, как лучше сделать
- [
- first-child-tag dup name>> main>> "callback" =
- [ drop "gpointer" ] [ "type" attr ] if
- >>c-type
- ]
- [
- first-child-tag xml>type
- [ [ >>array-info ] [ >>type ] bi* ] [ 2drop f ] if*
- ]
- } cleave ;
-
-: xml>record ( xml -- record )
- [ record new ] dip {
- [ load-type ]
- [ "disguised" attr "1" = >>disguised? ]
- [ "field" tags-named [ xml>field ] map >>fields ]
- [ "constructor" load-functions >>constructors ]
- [ "function" load-functions >>functions ]
- [
- "method" load-functions over type>self-param
- '[ [ _ prefix ] change-parameters ] map
- >>methods
- ]
- } cleave ;
-
-: xml>union ( xml -- union )
- [ union new ] dip load-type ;
-
-: xml>alias ( xml -- alias )
- [ alias new ] dip {
- [ node>type >>name ]
- [ "target" attr full-type-name>type >>target ]
- } cleave ;
-
-: xml>const ( xml -- const )
- [ const new ] dip {
- [ "name" attr >>name ]
- [
- "name" attr namespace-PREFIX get swap "_" glue
- >>c-identifier
- ]
- [ "value" attr >>value ]
- [ first-child-tag "type" attr >>c-type ]
- [ first-child-tag xml>type nip >>type ]
- } cleave ;
-
-: xml>namespace ( xml -- namespace )
- [ namespace new ] dip {
- [ "name" attr camel>factor >>name ]
- [ "prefix" attr [ set-prefix ] keep >>prefix ]
- [ "alias" tags-named [ xml>alias ] map >>aliases ]
- [ "record" tags-named [ xml>record ] map >>records ]
- [ "union" tags-named [ xml>union ] map >>unions ]
- [ "callback" tags-named [ xml>callback ] map >>callbacks ]
- [ "interface" tags-named [ xml>interface ] map >>interfaces ]
- [ "class" tags-named [ xml>class ] map >>classes ]
- [ "constant" tags-named [ xml>const ] map >>consts ]
- [ "enumeration" tags-named [ xml>enum ] map >>enums ]
- [ "bitfield" tags-named [ xml>enum ] map >>bitfields ]
- [ "function" load-functions >>functions ]
- } cleave ;
-
-: xml>repository ( xml -- repository )
- [ repository new ] dip {
- [
- "" "include" f <name> tags-named
- [ "name" attr camel>factor ] map >>includes
- ]
- [ "namespace" tag-named xml>namespace >>namespace ]
- } cleave ;
-
+++ /dev/null
-! Copyright (C) 2009 Anton Gorenko.
-! See http://factorcode.org/license.txt for BSD license.
-USING: ;
-IN: gir.repository
-
-TUPLE: node name ;
-
-TUPLE: repository includes namespace ;
-
-TUPLE: namespace < node
- prefix aliases consts classes interfaces records unions callbacks
- enums bitfields functions ;
-
-TUPLE: alias < node target ;
-
-TUPLE: typed < node type c-type ;
-
-TUPLE: const < typed
- value c-identifier ffi ;
-
-TUPLE: type-node < node
- type c-type type-name get-type ffi ;
-
-TUPLE: field < typed
- writable? length? array-info ;
-
-TUPLE: record < type-node
- fields constructors methods functions disguised? ;
-
-TUPLE: union < type-node ;
-
-TUPLE: class < record
- abstract? parent type-struct signals ;
-
-TUPLE: interface < type-node
- methods ;
-
-TUPLE: property < type-node
- readable? writable? construct? construct-only? ;
-
-TUPLE: callable < type-node
- return parameters varargs? ;
-
-TUPLE: function < callable identifier ;
-
-TUPLE: callback < type-node return parameters varargs? ;
-
-TUPLE: signal < callback ;
-
-TUPLE: parameter < typed
- direction allow-none? length? transfer-ownership array-info
- local ;
-
-TUPLE: return < typed
- transfer-ownership array-info local ;
-
-TUPLE: type name namespace ;
-
-TUPLE: array-info zero-terminated? fixed-size length ;
-
-TUPLE: enum-member < node value c-identifier ;
-
-TUPLE: enum < type-node members ;
-
+++ /dev/null
-GObjectIntrospection support
+++ /dev/null
-! Copyright (C) 2009 Anton Gorenko.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types assocs combinators.short-circuit
-gir.common gir.repository kernel namespaces specialized-arrays ;
-IN: gir.types
-
-TUPLE: gwrapper { underlying alien } ;
-TUPLE: grecord < gwrapper ;
-TUPLE: gobject < gwrapper ;
-
-SPECIALIZED-ARRAYS:
- void* bool int uint char uchar short ushort long ulong
- longlong ulonglong float double ;
-
-CONSTANT: simple-types H{
- { "any" {
- void* *void* >void*-array <direct-void*-array>
- } }
- { "boolean" {
- bool *bool >bool-array <direct-bool-array>
- } }
- { "int" {
- int *int >int-array <direct-int-array>
- } }
- { "uint" {
- uint *uint >uint-array <direct-uint-array>
- } }
- { "int8" {
- char *char >char-array <direct-char-array>
- } }
- { "uint8" {
- uchar *uchar >uchar-array <direct-uchar-array>
- } }
- { "int16" {
- short *short >short-array <direct-short-array>
- } }
- { "uint16" {
- ushort *ushort >ushort-array <direct-ushort-array>
- } }
- { "int32" {
- int *int >int-array <direct-int-array>
- } }
- { "uint32" {
- uint *uint >uint-array <direct-uint-array>
- } }
- { "int64" {
- longlong *longlong
- >longlong-array <direct-longlong-array>
- } }
- { "uint64" {
- ulonglong *ulonglong
- >ulonglong-array <direct-ulonglong-array>
- } }
- { "long" {
- long *long >long-array <direct-long-array>
- } }
- { "ulong" {
- ulong *ulong >ulong-array <direct-ulong-array>
- } }
- { "float" {
- float *float >float-array <direct-float-array>
- } }
- { "double" {
- double *double >double-array <direct-double-array>
- } }
- { "size_t" {
- ulong *ulong >ulong-array <direct-ulong-array>
- } }
- { "ssize_t" {
- long *long >long-array <direct-long-array>
- } }
- { "time_t" {
- long *long >long-array <direct-long-array>
- } }
- { "gtype" {
- ulong *ulong >ulong-array <direct-ulong-array>
- } }
-}
-
-TUPLE: type-info c-type-word type-word ;
-
-TUPLE: enum-info < type-info ;
-
-TUPLE: bitfield-info < type-info ;
-
-TUPLE: record-info < type-info ;
-
-TUPLE: union-info < type-info ;
-
-TUPLE: callback-info < type-info ;
-
-TUPLE: class-info < type-info ;
-
-TUPLE: interface-info < type-info ;
-
-: aliased-type ( alias -- type )
- aliases get ?at [ aliased-type ] when ;
-
-: get-type-info ( type -- info )
- aliased-type type-infos get at ;
-
-PREDICATE: none-type < type
- [ namespace>> not ] [ name>> "none" = ] bi and ;
-
-PREDICATE: simple-type < type
- aliased-type
- [ namespace>> not ] [ name>> simple-types key? ] bi and ;
-
-PREDICATE: utf8-type < type
- aliased-type
- [ namespace>> not ] [ name>> "utf8" = ] bi and ;
-
-PREDICATE: any-type < type
- aliased-type
- [ namespace>> not ] [ name>> "any" = ] bi and ;
-
-PREDICATE: enum-type < type get-type-info enum-info? ;
-
-PREDICATE: bitfield-type < type get-type-info bitfield-info? ;
-
-PREDICATE: record-type < type get-type-info record-info? ;
-
-PREDICATE: union-type < type get-type-info union-info? ;
-
-PREDICATE: callback-type < type get-type-info callback-info? ;
-
-PREDICATE: class-type < type get-type-info class-info? ;
-
-PREDICATE: interface-type < type get-type-info interface-info? ;
-
-: absolute-type ( type -- type' )
- dup {
- [ namespace>> ] [ simple-type? ]
- [ utf8-type? ] [ none-type? ]
- } 1|| [ current-lib get-global >>namespace ] unless ;
-
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.destructors
-alien.libraries alien.syntax combinators compiler.units gir
-kernel system vocabs.parser words ;
+alien.libraries alien.syntax combinators compiler.units
+gobject-introspection kernel system vocabs.parser words ;
IN: glib.ffi
<<
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.libraries combinators kernel system
-gir glib.ffi ;
+gobject-introspection glib.ffi ;
IN: gmodule.ffi
<<
--- /dev/null
+Anton Gorenko
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2010 Anton Gorenko.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs kernel namespaces ;
+IN: gobject-introspection.common
+
+CONSTANT: ffi-vocab "ffi"
+
+SYMBOL: current-lib
+
+SYMBOL: type-infos
+type-infos [ H{ } ] initialize
+
+SYMBOL: aliases
+aliases [ H{ } ] initialize
+
+SYMBOL: implement-structs
+
--- /dev/null
+! Copyright (C) 2009 Anton Gorenko.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.parser arrays
+classes.parser classes.struct combinators
+combinators.short-circuit definitions effects fry
+gobject-introspection.common gobject-introspection.types kernel
+math.parser namespaces parser quotations sequences
+sequences.generalizations words words.constant ;
+IN: gobject-introspection.ffi
+
+: string>c-type ( str -- c-type )
+ parse-c-type ;
+
+: define-each ( nodes quot -- )
+ '[ dup @ >>ffi drop ] each ; inline
+
+: function-ffi-invoker ( func -- quot )
+ {
+ [ return>> c-type>> string>c-type ]
+ [ drop current-lib get-global ]
+ [ identifier>> ]
+ [ parameters>> [ c-type>> string>c-type ] map ]
+ [ varargs?>> [ void* suffix ] when ]
+ } cleave function-quot ;
+
+: function-ffi-effect ( func -- effect )
+ [ parameters>> [ name>> ] map ]
+ [ varargs?>> [ "varargs" suffix ] when ]
+ [ return>> type>> none-type? { } { "result" } ? ] tri
+ <effect> ;
+
+: define-ffi-function ( func -- word )
+ [ identifier>> create-in dup ]
+ [ function-ffi-invoker ] [ function-ffi-effect ] tri
+ define-declared ;
+
+: define-ffi-functions ( functions -- )
+ [ define-ffi-function ] define-each ;
+
+: callback-ffi-invoker ( callback -- quot )
+ [ return>> c-type>> string>c-type ]
+ [ parameters>> [ c-type>> string>c-type ] map ] bi
+ cdecl callback-quot ;
+
+: callback-ffi-effect ( callback -- effect )
+ [ parameters>> [ name>> ] map ]
+ [ return>> type>> none-type? { } { "result" } ? ] bi
+ <effect> ;
+
+: define-ffi-callback ( callback -- word )
+ [ c-type>> create-in [ void* swap typedef ] keep dup ] keep
+ [ callback-ffi-effect "callback-effect" set-word-prop ]
+ [ drop current-lib get-global "callback-library" set-word-prop ]
+ [ callback-ffi-invoker (( quot -- alien )) define-inline ] 2tri ;
+
+: fix-signal-param-c-type ( param -- )
+ dup [ c-type>> ] [ type>> ] bi
+ {
+ [ none-type? ]
+ [ simple-type? ]
+ [ enum-type? ]
+ [ bitfield-type? ]
+ } 1|| [ dup "*" tail? [ CHAR: * suffix ] unless ] unless
+ >>c-type drop ;
+
+: define-ffi-signal ( signal -- word )
+ [ return>> fix-signal-param-c-type ]
+ [ parameters>> [ fix-signal-param-c-type ] each ]
+ [ define-ffi-callback ] tri ;
+
+: define-ffi-signals ( signals -- )
+ [ define-ffi-signal ] define-each ;
+
+: const-value ( const -- value )
+ [ value>> ] [ type>> name>> ] bi {
+ { "int" [ string>number ] }
+ { "double" [ string>number ] }
+ { "utf8" [ ] }
+ } case ;
+
+: define-ffi-enum ( enum -- word )
+ [
+ members>> [
+ [ c-identifier>> create-in ]
+ [ value>> ] bi define-constant
+ ] each
+ ] [ c-type>> (CREATE-C-TYPE) [ int swap typedef ] keep ] bi ;
+
+: define-ffi-enums ( enums -- )
+ [ define-ffi-enum ] define-each ;
+
+: define-ffi-bitfields ( bitfields -- )
+ [ define-ffi-enum ] define-each ;
+
+: fields>struct-slots ( fields -- slots )
+ [
+ [ name>> ]
+ [
+ [ c-type>> string>c-type ] [ array-info>> ] bi
+ [ fixed-size>> [ 2array ] when* ] when*
+ ]
+ [ drop { } ] tri <struct-slot-spec>
+ ] map ;
+
+: define-ffi-record-defer ( record -- word )
+ c-type>> create-in void* swap [ typedef ] keep ;
+
+: define-ffi-records-defer ( records -- )
+ [ define-ffi-record-defer ] define-each ;
+
+: define-ffi-record ( record -- word )
+ dup ffi>> forget
+ dup {
+ [ fields>> empty? not ]
+ [ c-type>> implement-structs get-global member? ]
+ } 1&&
+ [
+ [ c-type>> create-class-in dup ]
+ [ fields>> fields>struct-slots ] bi define-struct-class
+ ] [
+ [ disguised?>> void* void ? ]
+ [ c-type>> create-in ] bi [ typedef ] keep
+ ] if ;
+
+: define-ffi-records ( records -- )
+ [ define-ffi-record ] define-each ;
+
+: define-ffi-record-content ( record -- )
+ {
+ [ constructors>> define-ffi-functions ]
+ [ functions>> define-ffi-functions ]
+ [ methods>> define-ffi-functions ]
+ } cleave ;
+
+: define-ffi-records-content ( records -- )
+ [ define-ffi-record-content ] each ;
+
+: define-ffi-union ( union -- word )
+ c-type>> create-in [ void* swap typedef ] keep ;
+
+: define-ffi-unions ( unions -- )
+ [ define-ffi-union ] define-each ;
+
+: define-ffi-callbacks ( callbacks -- )
+ [ define-ffi-callback ] define-each ;
+
+: define-ffi-interface ( interface -- word )
+ c-type>> create-in [ void swap typedef ] keep ;
+
+: define-ffi-interfaces ( interfaces -- )
+ [ define-ffi-interface ] define-each ;
+
+: define-ffi-interface-content ( interface -- )
+ {
+ [ methods>> define-ffi-functions ]
+ } cleave ;
+
+: define-ffi-interfaces-content ( interfaces -- )
+ [ define-ffi-interface-content ] each ;
+
+: get-type-invoker ( name -- quot )
+ [ "GType" current-lib get-global ] dip
+ { } \ alien-invoke 5 narray >quotation ;
+
+: define-ffi-class ( class -- word )
+ c-type>> create-in [ void swap typedef ] keep ;
+
+: define-ffi-classes ( class -- )
+ [ define-ffi-class ] define-each ;
+
+: define-ffi-class-content ( class -- )
+ {
+ [ constructors>> define-ffi-functions ]
+ [ functions>> define-ffi-functions ]
+ [ methods>> define-ffi-functions ]
+ [ signals>> define-ffi-signals ]
+ } cleave ;
+
+: define-ffi-classes-content ( class -- )
+ [ define-ffi-class-content ] each ;
+
+: define-get-type ( node -- word )
+ get-type>> dup { "intern" f } member? [ drop f ]
+ [
+ [ create-in dup ] [ get-type-invoker ] bi
+ { } { "type" } <effect> define-declared
+ ] if ;
+
+: define-get-types ( namespace -- )
+ {
+ [ enums>> [ define-get-type drop ] each ]
+ [ bitfields>> [ define-get-type drop ] each ]
+ [ records>> [ define-get-type drop ] each ]
+ [ unions>> [ define-get-type drop ] each ]
+ [ interfaces>> [ define-get-type drop ] each ]
+ [ classes>> [ define-get-type drop ] each ]
+ } cleave ;
+
+: define-ffi-const ( const -- word )
+ [ c-identifier>> create-in dup ] [ const-value ] bi
+ define-constant ;
+
+: define-ffi-consts ( consts -- )
+ [ define-ffi-const ] define-each ;
+
+: define-ffi-alias ( alias -- )
+ drop ;
+
+: define-ffi-aliases ( aliases -- )
+ [ define-ffi-alias ] each ;
+
+: define-ffi-namespace ( namespace -- )
+ {
+ [ aliases>> define-ffi-aliases ]
+ [ consts>> define-ffi-consts ]
+ [ enums>> define-ffi-enums ]
+ [ bitfields>> define-ffi-bitfields ]
+
+ [ records>> define-ffi-records-defer ]
+
+ [ unions>> define-ffi-unions ]
+ [ interfaces>> define-ffi-interfaces ]
+ [ classes>> define-ffi-classes ]
+ [ callbacks>> define-ffi-callbacks ]
+ [ records>> define-ffi-records ]
+
+ [ records>> define-ffi-records-content ]
+ [ classes>> define-ffi-classes-content ]
+ [ interfaces>> define-ffi-interfaces-content ]
+ [ functions>> define-ffi-functions ]
+ } cleave ;
+
+: define-ffi-repository ( repository -- )
+ namespace>> define-ffi-namespace ;
+
--- /dev/null
+! Copyright (C) 2009 Anton Gorenko.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs combinators gobject-introspection.common
+gobject-introspection.ffi gobject-introspection.loader
+kernel lexer locals math namespaces sequences vocabs.parser xml ;
+IN: gobject-introspection
+
+: with-child-vocab ( name quot -- )
+ swap current-vocab name>>
+ [ swap "." glue set-current-vocab call ] keep
+ set-current-vocab ; inline
+
+:: define-gir-vocab ( file-name -- )
+ file-name file>xml xml>repository
+
+ current-vocab name>> dup ffi-vocab tail?
+ [ ffi-vocab length 1 + head* current-lib set-global ]
+ [ drop ] if ! throw the error
+ {
+ [ define-ffi-repository ]
+ } cleave
+ f implement-structs set-global ;
+
+SYNTAX: GIR: scan define-gir-vocab ;
+
+SYNTAX: IMPLEMENT-STRUCTS:
+ ";" parse-tokens implement-structs set-global ;
--- /dev/null
+! Copyright (C) 2009 Anton Gorenko.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors ascii combinators fry
+gobject-introspection.common gobject-introspection.repository
+gobject-introspection.types kernel math.parser sequences
+splitting xml.data xml.traversal ;
+FROM: namespaces => set get ;
+IN: gobject-introspection.loader
+
+SYMBOL: namespace-prefix
+SYMBOL: namespace-PREFIX
+
+: word-started? ( word letter -- ? )
+ [ last letter? ] [ LETTER? ] bi* and ;
+
+: camel>PREFIX ( name -- name' )
+ dup 1 head
+ [ 2dup word-started? [ [ CHAR: _ suffix ] dip ] when suffix ]
+ reduce rest >upper ;
+
+: set-prefix ( prefix -- )
+ [ namespace-prefix set ]
+ [ camel>PREFIX namespace-PREFIX set ] bi ;
+
+: camel>factor ( name -- name' )
+ dup 1 head
+ [ 2dup word-started? [ [ CHAR: - suffix ] dip ] when suffix ]
+ reduce rest >lower ;
+
+: underscored>factor ( name -- name' )
+ [ [ CHAR: _ = not ] keep CHAR: - ? ] map >lower ;
+
+: full-type-name>type ( name -- type )
+ [ type new ] dip
+ camel>factor "." split1 dup [ swap ] unless
+ [ >>namespace ] [ >>name ] bi* absolute-type ;
+
+: node>type ( xml -- type )
+ "name" attr full-type-name>type ;
+
+: xml>array-info ( xml -- array-info )
+ [ array-info new ] dip {
+ [ "zero-terminated" attr [ "1" = ] [ t ] if* >>zero-terminated? ]
+ [ "length" attr [ string>number ] [ f ] if* >>length ]
+ [ "fixed-size" attr [ string>number ] [ f ] if* >>fixed-size ]
+ } cleave ;
+
+: xml>type ( xml -- array-info type )
+ dup name>> main>> {
+ { "array"
+ [
+ [ xml>array-info ]
+ [ first-child-tag node>type ] bi
+ ]
+ }
+ { "type" [ node>type f swap ] }
+ { "varargs" [ drop f f ] }
+ { "callback" [ drop f "any" f type boa ] }
+ } case ;
+
+: load-parameter ( param xml -- param )
+ [ "transfer-ownership" attr >>transfer-ownership ]
+ [ first-child-tag "type" attr >>c-type ]
+ [
+ first-child-tag xml>type
+ [ [ >>array-info ] [ >>type ] bi* ] [ 2drop f ] if*
+ ] tri ;
+
+: load-type ( type xml -- type )
+ {
+ [ "name" attr camel>factor >>name ]
+ [ node>type >>type ]
+ [ "type" attr >>c-type ]
+ [ "type-name" attr >>type-name ]
+ [ "get-type" attr >>get-type ]
+ } cleave ;
+
+: xml>parameter ( xml -- parameter )
+ [ parameter new ] dip {
+ [ "name" attr >>name ]
+ [ "direction" attr dup "in" ? >>direction ]
+ [ "allow-none" attr "1" = >>allow-none? ]
+ [ load-parameter ]
+ } cleave ;
+
+: xml>return ( xml -- return )
+ [ return new ] dip {
+ [ drop "result" >>name ]
+ [ load-parameter ]
+ } cleave ;
+
+: throws-parameter ( -- parameter )
+ parameter new
+ "error" >>name
+ "in" >>direction
+ "none" >>transfer-ownership
+ "GError**" >>c-type
+ "GLib.Error" full-type-name>type >>type ;
+
+: extract-parameters ( xml -- parameters )
+ "parameters" tag-named "parameter" tags-named
+ [ xml>parameter ] map ;
+
+: load-parameters ( callable xml -- callable )
+ [
+ [
+ extract-parameters
+ dup { f } tail? [ but-last [ t >>varargs? ] dip ] when
+ ]
+ [ "throws" attr "1" = [ throws-parameter suffix ] when ] bi
+ >>parameters
+ ]
+ [ "return-value" tag-named xml>return >>return ] bi ;
+
+: xml>function ( xml -- function )
+ [ function new ] dip {
+ [ "name" attr underscored>factor >>name ]
+ [ "identifier" attr >>identifier ]
+ [ load-parameters ]
+ } cleave ;
+
+: (type>param) ( type -- param )
+ [ parameter new ] dip
+ [ c-type>> CHAR: * suffix >>c-type ] [ type>> >>type ] bi
+ "none" >>transfer-ownership
+ "in" >>direction ;
+
+: type>self-param ( type -- self )
+ (type>param) "self" >>name ;
+
+: type>sender-param ( type -- sender )
+ (type>param) "sender" >>name ;
+
+: signal-data-param ( -- param )
+ parameter new
+ "user_data" >>name
+ "gpointer" >>c-type
+ type new "any" >>name >>type
+ "none" >>transfer-ownership
+ "in" >>direction ;
+
+: xml>property ( xml -- property )
+ [ property new ] dip {
+ [ "name" attr >>name ]
+ [ "writable" attr "1" = >>writable? ]
+ [ "readable" attr "0" = not >>readable? ]
+ [ "construct" attr "1" = >>construct? ]
+ [ "construct-only" attr "1" = >>construct-only? ]
+ [ first-child-tag xml>type nip >>type ]
+ } cleave ;
+
+: xml>callback ( xml -- callback )
+ [ callback new ] dip {
+ [ load-type ]
+ [ load-parameters ]
+ } cleave ;
+
+: xml>signal ( xml -- signal )
+ [ signal new ] dip {
+ [ "name" attr camel>factor >>name ]
+ [ node>type >>type ]
+ [ "type" attr >>c-type ]
+ [
+ load-parameters
+ [ signal-data-param suffix ] change-parameters
+ ]
+ } cleave ;
+
+: load-functions ( xml tag-name -- functions )
+ tags-named [ xml>function ] map ;
+
+: xml>class ( xml -- class )
+ [ class new ] dip {
+ [ load-type ]
+ [ "abstract" attr "1" = >>abstract? ]
+ [
+ "parent" attr [ full-type-name>type ] [ f ] if*
+ >>parent
+ ]
+ [ "type-struct" attr >>type-struct ]
+ [ "constructor" load-functions >>constructors ]
+ [ "function" load-functions >>functions ]
+ [
+ "method" load-functions over type>self-param
+ '[ [ _ prefix ] change-parameters ] map
+ >>methods
+ ]
+ [
+ "signal" tags-named [ xml>signal ] map
+ over type>sender-param
+ '[ [ _ prefix ] change-parameters ] map
+ over c-type>> CHAR: : suffix
+ '[ dup name>> _ prepend >>c-type ] map
+ >>signals
+ ]
+ } cleave ;
+
+: xml>interface ( xml -- interface )
+ [ interface new ] dip {
+ [ load-type ]
+ [
+ "method" load-functions over type>self-param
+ '[ [ _ prefix ] change-parameters ] map
+ >>methods
+ ]
+ } cleave ;
+
+: xml>member ( xml -- member )
+ [ enum-member new ] dip {
+ [ "name" attr underscored>factor >>name ]
+ [ "identifier" attr >>c-identifier ]
+ [ "value" attr string>number >>value ]
+ } cleave ;
+
+: xml>enum ( xml -- enum )
+ [ enum new ] dip {
+ [ load-type ]
+ [ "member" tags-named [ xml>member ] map >>members ]
+ } cleave ;
+
+: xml>field ( xml -- field )
+ [ field new ] dip {
+ [ "name" attr >>name ]
+ [ "writable" attr "1" = >>writable? ]
+ [
+ first-child-tag dup name>> main>> "callback" =
+ [ drop "gpointer" ] [ "type" attr ] if
+ >>c-type
+ ]
+ [
+ first-child-tag xml>type
+ [ [ >>array-info ] [ >>type ] bi* ] [ 2drop f ] if*
+ ]
+ } cleave ;
+
+: xml>record ( xml -- record )
+ [ record new ] dip {
+ [ load-type ]
+ [ "disguised" attr "1" = >>disguised? ]
+ [ "field" tags-named [ xml>field ] map >>fields ]
+ [ "constructor" load-functions >>constructors ]
+ [ "function" load-functions >>functions ]
+ [
+ "method" load-functions over type>self-param
+ '[ [ _ prefix ] change-parameters ] map
+ >>methods
+ ]
+ } cleave ;
+
+: xml>union ( xml -- union )
+ [ union new ] dip load-type ;
+
+: xml>alias ( xml -- alias )
+ [ alias new ] dip {
+ [ node>type >>name ]
+ [ "target" attr full-type-name>type >>target ]
+ } cleave ;
+
+: xml>const ( xml -- const )
+ [ const new ] dip {
+ [ "name" attr >>name ]
+ [
+ "name" attr namespace-PREFIX get swap "_" glue
+ >>c-identifier
+ ]
+ [ "value" attr >>value ]
+ [ first-child-tag "type" attr >>c-type ]
+ [ first-child-tag xml>type nip >>type ]
+ } cleave ;
+
+: xml>namespace ( xml -- namespace )
+ [ namespace new ] dip {
+ [ "name" attr camel>factor >>name ]
+ [ "prefix" attr [ set-prefix ] keep >>prefix ]
+ [ "alias" tags-named [ xml>alias ] map >>aliases ]
+ [ "record" tags-named [ xml>record ] map >>records ]
+ [ "union" tags-named [ xml>union ] map >>unions ]
+ [ "callback" tags-named [ xml>callback ] map >>callbacks ]
+ [ "interface" tags-named [ xml>interface ] map >>interfaces ]
+ [ "class" tags-named [ xml>class ] map >>classes ]
+ [ "constant" tags-named [ xml>const ] map >>consts ]
+ [ "enumeration" tags-named [ xml>enum ] map >>enums ]
+ [ "bitfield" tags-named [ xml>enum ] map >>bitfields ]
+ [ "function" load-functions >>functions ]
+ } cleave ;
+
+: xml>repository ( xml -- repository )
+ [ repository new ] dip {
+ [
+ "" "include" f <name> tags-named
+ [ "name" attr camel>factor ] map >>includes
+ ]
+ [ "namespace" tag-named xml>namespace >>namespace ]
+ } cleave ;
+
--- /dev/null
+! Copyright (C) 2009 Anton Gorenko.
+! See http://factorcode.org/license.txt for BSD license.
+USING: ;
+IN: gobject-introspection.repository
+
+TUPLE: node name ;
+
+TUPLE: repository includes namespace ;
+
+TUPLE: namespace < node
+ prefix aliases consts classes interfaces records unions callbacks
+ enums bitfields functions ;
+
+TUPLE: alias < node target ;
+
+TUPLE: typed < node type c-type ;
+
+TUPLE: const < typed
+ value c-identifier ffi ;
+
+TUPLE: type-node < node
+ type c-type type-name get-type ffi ;
+
+TUPLE: field < typed
+ writable? length? array-info ;
+
+TUPLE: record < type-node
+ fields constructors methods functions disguised? ;
+
+TUPLE: union < type-node ;
+
+TUPLE: class < record
+ abstract? parent type-struct signals ;
+
+TUPLE: interface < type-node
+ methods ;
+
+TUPLE: property < type-node
+ readable? writable? construct? construct-only? ;
+
+TUPLE: callable < type-node
+ return parameters varargs? ;
+
+TUPLE: function < callable identifier ;
+
+TUPLE: callback < type-node return parameters varargs? ;
+
+TUPLE: signal < callback ;
+
+TUPLE: parameter < typed
+ direction allow-none? length? transfer-ownership array-info
+ local ;
+
+TUPLE: return < typed
+ transfer-ownership array-info local ;
+
+TUPLE: type name namespace ;
+
+TUPLE: array-info zero-terminated? fixed-size length ;
+
+TUPLE: enum-member < node value c-identifier ;
+
+TUPLE: enum < type-node members ;
+
--- /dev/null
+GObjectIntrospection support
--- /dev/null
+! Copyright (C) 2009 Anton Gorenko.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types assocs
+combinators.short-circuit gobject-introspection.common
+gobject-introspection.repository kernel namespaces
+specialized-arrays ;
+IN: gobject-introspection.types
+
+TUPLE: gwrapper { underlying alien } ;
+TUPLE: grecord < gwrapper ;
+TUPLE: gobject < gwrapper ;
+
+SPECIALIZED-ARRAYS:
+ void* bool int uint char uchar short ushort long ulong
+ longlong ulonglong float double ;
+
+CONSTANT: simple-types H{
+ { "any" {
+ void* *void* >void*-array <direct-void*-array>
+ } }
+ { "boolean" {
+ bool *bool >bool-array <direct-bool-array>
+ } }
+ { "int" {
+ int *int >int-array <direct-int-array>
+ } }
+ { "uint" {
+ uint *uint >uint-array <direct-uint-array>
+ } }
+ { "int8" {
+ char *char >char-array <direct-char-array>
+ } }
+ { "uint8" {
+ uchar *uchar >uchar-array <direct-uchar-array>
+ } }
+ { "int16" {
+ short *short >short-array <direct-short-array>
+ } }
+ { "uint16" {
+ ushort *ushort >ushort-array <direct-ushort-array>
+ } }
+ { "int32" {
+ int *int >int-array <direct-int-array>
+ } }
+ { "uint32" {
+ uint *uint >uint-array <direct-uint-array>
+ } }
+ { "int64" {
+ longlong *longlong
+ >longlong-array <direct-longlong-array>
+ } }
+ { "uint64" {
+ ulonglong *ulonglong
+ >ulonglong-array <direct-ulonglong-array>
+ } }
+ { "long" {
+ long *long >long-array <direct-long-array>
+ } }
+ { "ulong" {
+ ulong *ulong >ulong-array <direct-ulong-array>
+ } }
+ { "float" {
+ float *float >float-array <direct-float-array>
+ } }
+ { "double" {
+ double *double >double-array <direct-double-array>
+ } }
+ { "size_t" {
+ ulong *ulong >ulong-array <direct-ulong-array>
+ } }
+ { "ssize_t" {
+ long *long >long-array <direct-long-array>
+ } }
+ { "time_t" {
+ long *long >long-array <direct-long-array>
+ } }
+ { "gtype" {
+ ulong *ulong >ulong-array <direct-ulong-array>
+ } }
+}
+
+TUPLE: type-info c-type-word type-word ;
+
+TUPLE: enum-info < type-info ;
+
+TUPLE: bitfield-info < type-info ;
+
+TUPLE: record-info < type-info ;
+
+TUPLE: union-info < type-info ;
+
+TUPLE: callback-info < type-info ;
+
+TUPLE: class-info < type-info ;
+
+TUPLE: interface-info < type-info ;
+
+: aliased-type ( alias -- type )
+ aliases get ?at [ aliased-type ] when ;
+
+: get-type-info ( type -- info )
+ aliased-type type-infos get at ;
+
+PREDICATE: none-type < type
+ [ namespace>> not ] [ name>> "none" = ] bi and ;
+
+PREDICATE: simple-type < type
+ aliased-type
+ [ namespace>> not ] [ name>> simple-types key? ] bi and ;
+
+PREDICATE: utf8-type < type
+ aliased-type
+ [ namespace>> not ] [ name>> "utf8" = ] bi and ;
+
+PREDICATE: any-type < type
+ aliased-type
+ [ namespace>> not ] [ name>> "any" = ] bi and ;
+
+PREDICATE: enum-type < type get-type-info enum-info? ;
+
+PREDICATE: bitfield-type < type get-type-info bitfield-info? ;
+
+PREDICATE: record-type < type get-type-info record-info? ;
+
+PREDICATE: union-type < type get-type-info union-info? ;
+
+PREDICATE: callback-type < type get-type-info callback-info? ;
+
+PREDICATE: class-type < type get-type-info class-info? ;
+
+PREDICATE: interface-type < type get-type-info interface-info? ;
+
+: absolute-type ( type -- type' )
+ dup {
+ [ namespace>> ] [ simple-type? ]
+ [ utf8-type? ] [ none-type? ]
+ } 1|| [ current-lib get-global >>namespace ] unless ;
+
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax alien.destructors alien.libraries
combinators kernel literals math system
-gir glib.ffi ;
+gobject-introspection glib.ffi ;
EXCLUDE: alien.c-types => pointer ;
IN: gobject.ffi
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax alien.libraries combinators kernel
system
-gir glib.ffi gmodule.ffi gobject.ffi ;
+gobject-introspection glib.ffi gmodule.ffi gobject.ffi ;
EXCLUDE: alien.c-types => pointer ;
IN: gst.ffi
TYPEDEF: guint64 GstClockTime
TYPEDEF: gint64 GstClockTimeDiff
-! Временное исправление отсутвующих типов libxml2
+! types from libxml2
TYPEDEF: void* xmlNodePtr
TYPEDEF: void* xmlDocPtr
TYPEDEF: void* xmlNsPtr
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax alien.destructors alien.libraries
cairo.ffi combinators kernel system
-gir atk.ffi gdk.ffi gdk.pixbuf.ffi gio.ffi glib.ffi gmodule.ffi
-gobject.ffi pango.ffi ;
+gobject-introspection atk.ffi gdk.ffi gdk.pixbuf.ffi gio.ffi
+glib.ffi gmodule.ffi gobject.ffi pango.ffi ;
EXCLUDE: alien.c-types => pointer ;
IN: gtk.ffi
! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.libraries combinators kernel system
-gir gdk.ffi gdk.pixbuf.ffi gdk.gl.ffi gio.ffi glib.ffi
-gmodule.ffi gobject.ffi gtk.ffi ;
+gobject-introspection gdk.ffi gdk.pixbuf.ffi gdk.gl.ffi gio.ffi
+glib.ffi gmodule.ffi gobject.ffi gtk.ffi ;
EXCLUDE: alien.c-types => pointer ;
IN: gtk.gl.ffi
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.libraries alien.syntax cairo.ffi
combinators kernel system
-gir pango.ffi ;
+gobject-introspection pango.ffi ;
IN: pango.cairo.ffi
<<
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.destructors alien.libraries
alien.syntax combinators kernel system
-gir glib.ffi ;
+gobject-introspection glib.ffi ;
IN: pango.ffi
<<
} cond
>>
-TYPEDEF: void PangoLayoutRun ! не совсем верно
+TYPEDEF: void PangoLayoutRun
TYPEDEF: guint32 PangoGlyph
IMPLEMENT-STRUCTS: PangoRectangle ;
projects / factor.git / commitdiff