: ?require-word ( word/pair -- )
dup word? [ drop ] [ first require ] ?if ;
+MIXIN: array-c-type
+INSTANCE: c-type array-c-type
+
GENERIC: require-c-type-arrays ( c-type -- )
M: object require-c-type-arrays
drop ;
-M: c-type require-c-type-arrays
+M: array-c-type require-c-type-arrays
[ array-class>> ?require-word ]
[ sequence-mixin-class>> ?require-word ]
[ direct-array-class>> ?require-word ] tri ;
c-type c-type-array-constructor ;
M: array c-type-array-constructor
first c-type c-type-array-constructor ;
-M: c-type c-type-array-constructor
+M: array-c-type c-type-array-constructor
array-constructor>> dup word?
[ first2 specialized-array-vocab-not-loaded ] unless ;
c-type c-type-direct-array-constructor ;
M: array c-type-direct-array-constructor
first c-type c-type-direct-array-constructor ;
-M: c-type c-type-direct-array-constructor
+M: array-c-type c-type-direct-array-constructor
direct-array-constructor>> dup word?
[ first2 specialized-array-vocab-not-loaded ] unless ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.structs alien.c-types math math.functions sequences
-arrays kernel functors vocabs.parser namespaces accessors
-quotations ;
+USING: alien.structs alien.structs.fields alien.c-types
+math math.functions sequences arrays kernel functors
+vocabs.parser namespaces accessors quotations ;
IN: alien.complex.functor
+TUPLE: complex-c-type < struct-type
+ array-class
+ array-constructor
+ direct-array-class
+ direct-array-constructor
+ sequence-mixin-class ;
+INSTANCE: complex-c-type array-c-type
+
FUNCTOR: define-complex-type ( N T -- )
T-real DEFINES ${T}-real
: *T ( alien -- z )
[ T-real ] [ T-imaginary ] bi rect> ; inline
-T current-vocab
-{ { N "real" } { N "imaginary" } }
-define-struct
+T N c-type-align [ 2 * ] [ ] bi
+T current-vocab N "real" <field-spec>
+T current-vocab N "imaginary" <field-spec> N c-type-align >>offset
+2array complex-c-type (define-struct)
T c-type
<T> 1quotation >>unboxer-quot
*T 1quotation >>boxer-quot
number >>boxed-class
+T set-array-class
drop
;FUNCTOR
: c-struct? ( type -- ? ) (c-type) struct-type? ;
-: (define-struct) ( name size align fields -- )
- [ [ align ] keep ] dip
- struct-type new
+: (define-struct) ( name size align fields class -- )
+ [ [ align ] keep ] 2dip new
byte-array >>class
byte-array >>boxed-class
swap >>fields
[ 2drop ] [ make-fields ] 3bi
[ struct-offsets ] keep
[ [ type>> ] map compute-struct-align ] keep
- [ (define-struct) ] keep
+ [ struct-type (define-struct) ] keep
[ define-field ] each ;
: define-union ( name members -- )
[ expand-constants ] map
[ [ heap-size ] [ max ] map-reduce ] keep
- compute-struct-align f (define-struct) ;
+ compute-struct-align f struct-type (define-struct) ;
: offset-of ( field struct -- offset )
c-types get at fields>>
[ "struct-align" word-prop ]
[ struct-slots [ slot>field ] map ]
} cleave
- (define-struct)
+ struct-type (define-struct)
] [
{
[ name>> c-type ]