basis/gobject-introspection/types/types.factor

   1 ! Copyright (C) 2009 Anton Gorenko.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types assocs
   4 combinators.short-circuit gobject-introspection.common
   5 gobject-introspection.repository kernel namespaces
   6 specialized-arrays ;
   7 IN: gobject-introspection.types
   8
   9 TUPLE: gwrapper { underlying alien } ;
  10 TUPLE: grecord < gwrapper ;
  11 TUPLE: gobject < gwrapper ;
  12
  13 SPECIALIZED-ARRAYS:
  14     void* bool int uint char uchar short ushort long ulong
  15     longlong ulonglong float double ;
  16
  17 CONSTANT: simple-types H{
  18     { "any" {
  19         void* *void* >void*-array <direct-void*-array>
  20     } }
  21     { "boolean" {
  22         bool *bool >bool-array <direct-bool-array>
  23     } }
  24     { "int" {
  25         int *int >int-array <direct-int-array>
  26     } }
  27     { "uint" {
  28         uint *uint >uint-array <direct-uint-array>
  29     } }
  30     { "int8" {
  31         char *char >char-array <direct-char-array>
  32     } }
  33     { "uint8" {
  34         uchar *uchar >uchar-array <direct-uchar-array>
  35     } }
  36     { "int16" {
  37         short *short >short-array <direct-short-array>
  38     } }
  39     { "uint16" {
  40         ushort *ushort >ushort-array <direct-ushort-array>
  41     } }
  42     { "int32" {
  43         int *int >int-array <direct-int-array>
  44     } }
  45     { "uint32" {
  46         uint *uint >uint-array <direct-uint-array>
  47     } }
  48     { "int64" {
  49         longlong *longlong
  50         >longlong-array <direct-longlong-array>
  51     } }
  52     { "uint64" {
  53         ulonglong *ulonglong
  54         >ulonglong-array <direct-ulonglong-array>
  55     } }
  56     { "long" {
  57         long *long >long-array <direct-long-array>
  58     } }
  59     { "ulong" {
  60         ulong *ulong >ulong-array <direct-ulong-array>
  61     } }
  62     { "float" {
  63         float *float >float-array <direct-float-array>
  64     } }
  65     { "double" {
  66         double *double >double-array <direct-double-array>
  67     } }
  68      { "size_t" {
  69         ulong *ulong >ulong-array <direct-ulong-array>
  70     } }
  71     { "ssize_t" {
  72         long *long >long-array <direct-long-array>
  73     } }
  74     { "time_t" {
  75         long *long >long-array <direct-long-array>
  76     } }
  77      { "gtype" {
  78         ulong *ulong >ulong-array <direct-ulong-array>
  79     } }
  80 }
  81
  82 TUPLE: type-info c-type-word type-word ;
  83
  84 TUPLE: enum-info < type-info ;
  85
  86 TUPLE: bitfield-info < type-info ;
  87
  88 TUPLE: record-info < type-info ;
  89
  90 TUPLE: union-info < type-info ;
  91
  92 TUPLE: callback-info < type-info ;
  93
  94 TUPLE: class-info < type-info ;
  95
  96 TUPLE: interface-info < type-info ;
  97
  98 : aliased-type ( alias -- type )
  99     aliases get ?at [ aliased-type ] when ;
 100
 101 : get-type-info ( type -- info )
 102     aliased-type type-infos get at ;
 103
 104 PREDICATE: none-type < type
 105     [ namespace>> not ] [ name>> "none" = ] bi and ;
 106
 107 PREDICATE: simple-type < type
 108     aliased-type
 109     [ namespace>> not ] [ name>> simple-types key? ] bi and ;
 110
 111 PREDICATE: utf8-type < type
 112     aliased-type
 113     [ namespace>> not ] [ name>> "utf8" = ] bi and ;
 114
 115 PREDICATE: any-type < type
 116     aliased-type
 117     [ namespace>> not ] [ name>> "any" = ] bi and ;
 118
 119 PREDICATE: enum-type < type get-type-info enum-info? ;
 120
 121 PREDICATE: bitfield-type < type get-type-info bitfield-info? ;
 122
 123 PREDICATE: record-type < type get-type-info record-info? ;
 124
 125 PREDICATE: union-type < type get-type-info union-info? ;
 126
 127 PREDICATE: callback-type < type get-type-info callback-info? ;
 128
 129 PREDICATE: class-type < type get-type-info class-info? ;
 130
 131 PREDICATE: interface-type < type get-type-info interface-info? ;
 132
 133 : absolute-type ( type -- type' )
 134     dup {
 135         [ namespace>> ] [ simple-type? ]
 136         [ utf8-type? ] [ none-type? ]
 137     } 1|| [ current-lib get-global >>namespace ] unless ;
 138