alien.structs: struct-type now has a class slot; fix specialized complex-float/double arrays

db4
Slava Pestov 2009-08-09 16:10:11 -05:00
parent cc5476c823
commit d19c403fee
4 changed files with 24 additions and 29 deletions

View File

@ -13,17 +13,19 @@ DEFER: *char
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
TUPLE: c-type
TUPLE: abstract-c-type
{ class class initial: object }
boxer
{ boxer-quot callable }
unboxer
{ unboxer-quot callable }
{ getter callable }
{ setter callable }
{ rep initial: int-rep }
size
align
align ;
TUPLE: c-type < abstract-c-type
boxer
unboxer
{ rep initial: int-rep }
stack-align? ;
: <c-type> ( -- type )
@ -70,7 +72,7 @@ M: string c-type ( name -- type )
GENERIC: c-type-class ( name -- class )
M: c-type c-type-class class>> ;
M: abstract-c-type c-type-class class>> ;
M: string c-type-class c-type c-type-class ;
@ -82,7 +84,7 @@ M: string c-type-boxer c-type c-type-boxer ;
GENERIC: c-type-boxer-quot ( name -- quot )
M: c-type c-type-boxer-quot boxer-quot>> ;
M: abstract-c-type c-type-boxer-quot boxer-quot>> ;
M: string c-type-boxer-quot c-type c-type-boxer-quot ;
@ -94,7 +96,7 @@ M: string c-type-unboxer c-type c-type-unboxer ;
GENERIC: c-type-unboxer-quot ( name -- quot )
M: c-type c-type-unboxer-quot unboxer-quot>> ;
M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ;
M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
@ -118,7 +120,7 @@ M: string c-type-setter c-type c-type-setter ;
GENERIC: c-type-align ( name -- n )
M: c-type c-type-align align>> ;
M: abstract-c-type c-type-align align>> ;
M: string c-type-align c-type c-type-align ;
@ -167,7 +169,7 @@ GENERIC: heap-size ( type -- size ) foldable
M: string heap-size c-type heap-size ;
M: c-type heap-size size>> ;
M: abstract-c-type heap-size size>> ;
GENERIC: stack-size ( type -- size ) foldable

View File

@ -30,6 +30,7 @@ define-struct
T c-type
<T> 1quotation >>unboxer-quot
*T 1quotation >>boxer-quot
number >>class
drop
;FUNCTOR

View File

@ -6,30 +6,12 @@ alien.c-types alien.structs.fields cpu.architecture math.order
quotations byte-arrays ;
IN: alien.structs
TUPLE: struct-type
size
align
fields
{ boxer-quot callable }
{ unboxer-quot callable }
{ getter callable }
{ setter callable }
return-in-registers? ;
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
M: struct-type c-type ;
M: struct-type heap-size size>> ;
M: struct-type c-type-class drop byte-array ;
M: struct-type c-type-align align>> ;
M: struct-type c-type-stack-align? drop f ;
M: struct-type c-type-boxer-quot boxer-quot>> ;
M: struct-type c-type-unboxer-quot unboxer-quot>> ;
: if-value-struct ( ctype true false -- )
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
@ -56,6 +38,7 @@ M: struct-type stack-size
: (define-struct) ( name size align fields -- )
[ [ align ] keep ] dip
struct-type new
byte-array >>class
swap >>fields
swap >>align
swap >>size

View File

@ -1,6 +1,7 @@
IN: math.vectors.specialization.tests
USING: compiler.tree.debugger math.vectors tools.test kernel
kernel.private math specialized-arrays.double
specialized-arrays.complex-float
specialized-arrays.float ;
[ V{ t } ] [
@ -9,4 +10,12 @@ specialized-arrays.float ;
[ V{ float } ] [
[ { float-array float } declare v*n norm ] final-classes
] unit-test
[ V{ number } ] [
[ { complex-float-array complex-float-array } declare v. ] final-classes
] unit-test
[ V{ real } ] [
[ { complex-float-array complex } declare v*n norm ] final-classes
] unit-test