{ getter callable }
{ setter callable }
size
-align ;
-
-TUPLE: c-type < abstract-c-type
-boxer
-unboxer
-{ rep initial: int-rep }
-stack-align?
+align
array-class
array-constructor
direct-array-class
direct-array-constructor
sequence-mixin-class ;
+TUPLE: c-type < abstract-c-type
+boxer
+unboxer
+{ rep initial: int-rep }
+stack-align? ;
+
: <c-type> ( -- type )
\ c-type new ;
: ?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: array-c-type require-c-type-arrays
+M: c-type require-c-type-arrays
[ array-class>> ?require-word ]
[ sequence-mixin-class>> ?require-word ]
[ direct-array-class>> ?require-word ] tri ;
ERROR: specialized-array-vocab-not-loaded vocab word ;
-GENERIC: c-type-array-constructor ( c-type -- word ) foldable
-
-M: string c-type-array-constructor
- c-type c-type-array-constructor ;
-M: array c-type-array-constructor
- first c-type c-type-array-constructor ;
-M: array-c-type c-type-array-constructor
+: c-type-array-constructor ( c-type -- word )
array-constructor>> dup word?
- [ first2 specialized-array-vocab-not-loaded ] unless ;
-
-GENERIC: c-type-direct-array-constructor ( c-type -- word ) foldable
+ [ first2 specialized-array-vocab-not-loaded ] unless ; foldable
-M: string c-type-direct-array-constructor
- c-type c-type-direct-array-constructor ;
-M: array c-type-direct-array-constructor
- first c-type c-type-direct-array-constructor ;
-M: array-c-type c-type-direct-array-constructor
+: c-type-direct-array-constructor ( c-type -- word )
direct-array-constructor>> dup word?
- [ first2 specialized-array-vocab-not-loaded ] unless ;
+ [ first2 specialized-array-vocab-not-loaded ] unless ; foldable
GENERIC: <c-type-array> ( len c-type -- array )
M: object <c-type-array>
c-type-array-constructor execute( len -- array ) ; inline
+M: string <c-type-array>
+ c-type <c-type-array> ; inline
+M: array <c-type-array>
+ first c-type <c-type-array> ; inline
GENERIC: <c-type-direct-array> ( alien len c-type -- array )
M: object <c-type-direct-array>
c-type-direct-array-constructor execute( alien len -- array ) ; inline
+M: string <c-type-direct-array>
+ c-type <c-type-direct-array> ; inline
+M: array <c-type-direct-array>
+ first c-type <c-type-direct-array> ; inline
GENERIC: c-type-class ( name -- class )
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.structs alien.structs.fields alien.c-types
-math math.functions sequences arrays kernel functors
-vocabs.parser namespaces accessors quotations ;
+USING: alien.structs 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 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 current-vocab
+{ { N "real" } { N "imaginary" } }
+define-struct
T c-type
<T> 1quotation >>unboxer-quot
USING: accessors arrays assocs generic hashtables kernel kernel.private
math namespaces parser sequences strings words libc fry
alien.c-types alien.structs.fields cpu.architecture math.order
-quotations byte-arrays ;
+quotations byte-arrays struct-arrays ;
IN: alien.structs
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
M: struct-type c-type-stack-align? drop f ;
+M: struct-type <c-type-array> ( len c-type -- array )
+ dup c-type-array-constructor
+ [ execute( len -- array ) ]
+ [ <struct-array> ] ?if ; inline
+
+M: struct-type <c-type-direct-array> ( alien len c-type -- array )
+ dup c-type-direct-array-constructor
+ [ execute( alien len -- array ) ]
+ [ <direct-struct-array> ] ?if ; inline
+
: if-value-struct ( ctype true false -- )
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline