alien.structs: struct-type now has a class slot; fix specialized complex-float/double arrays
parent
cc5476c823
commit
d19c403fee
|
@ -13,17 +13,19 @@ DEFER: *char
|
||||||
|
|
||||||
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
|
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
|
||||||
|
|
||||||
TUPLE: c-type
|
TUPLE: abstract-c-type
|
||||||
{ class class initial: object }
|
{ class class initial: object }
|
||||||
boxer
|
|
||||||
{ boxer-quot callable }
|
{ boxer-quot callable }
|
||||||
unboxer
|
|
||||||
{ unboxer-quot callable }
|
{ unboxer-quot callable }
|
||||||
{ getter callable }
|
{ getter callable }
|
||||||
{ setter callable }
|
{ setter callable }
|
||||||
{ rep initial: int-rep }
|
|
||||||
size
|
size
|
||||||
align
|
align ;
|
||||||
|
|
||||||
|
TUPLE: c-type < abstract-c-type
|
||||||
|
boxer
|
||||||
|
unboxer
|
||||||
|
{ rep initial: int-rep }
|
||||||
stack-align? ;
|
stack-align? ;
|
||||||
|
|
||||||
: <c-type> ( -- type )
|
: <c-type> ( -- type )
|
||||||
|
@ -70,7 +72,7 @@ M: string c-type ( name -- type )
|
||||||
|
|
||||||
GENERIC: c-type-class ( name -- class )
|
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 ;
|
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 )
|
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 ;
|
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 )
|
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 ;
|
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 )
|
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 ;
|
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: 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
|
GENERIC: stack-size ( type -- size ) foldable
|
||||||
|
|
||||||
|
|
|
@ -30,6 +30,7 @@ define-struct
|
||||||
T c-type
|
T c-type
|
||||||
<T> 1quotation >>unboxer-quot
|
<T> 1quotation >>unboxer-quot
|
||||||
*T 1quotation >>boxer-quot
|
*T 1quotation >>boxer-quot
|
||||||
|
number >>class
|
||||||
drop
|
drop
|
||||||
|
|
||||||
;FUNCTOR
|
;FUNCTOR
|
||||||
|
|
|
@ -6,30 +6,12 @@ alien.c-types alien.structs.fields cpu.architecture math.order
|
||||||
quotations byte-arrays ;
|
quotations byte-arrays ;
|
||||||
IN: alien.structs
|
IN: alien.structs
|
||||||
|
|
||||||
TUPLE: struct-type
|
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
|
||||||
size
|
|
||||||
align
|
|
||||||
fields
|
|
||||||
{ boxer-quot callable }
|
|
||||||
{ unboxer-quot callable }
|
|
||||||
{ getter callable }
|
|
||||||
{ setter callable }
|
|
||||||
return-in-registers? ;
|
|
||||||
|
|
||||||
M: struct-type c-type ;
|
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-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 -- )
|
: if-value-struct ( ctype true false -- )
|
||||||
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
||||||
|
|
||||||
|
@ -56,6 +38,7 @@ M: struct-type stack-size
|
||||||
: (define-struct) ( name size align fields -- )
|
: (define-struct) ( name size align fields -- )
|
||||||
[ [ align ] keep ] dip
|
[ [ align ] keep ] dip
|
||||||
struct-type new
|
struct-type new
|
||||||
|
byte-array >>class
|
||||||
swap >>fields
|
swap >>fields
|
||||||
swap >>align
|
swap >>align
|
||||||
swap >>size
|
swap >>size
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
IN: math.vectors.specialization.tests
|
IN: math.vectors.specialization.tests
|
||||||
USING: compiler.tree.debugger math.vectors tools.test kernel
|
USING: compiler.tree.debugger math.vectors tools.test kernel
|
||||||
kernel.private math specialized-arrays.double
|
kernel.private math specialized-arrays.double
|
||||||
|
specialized-arrays.complex-float
|
||||||
specialized-arrays.float ;
|
specialized-arrays.float ;
|
||||||
|
|
||||||
[ V{ t } ] [
|
[ V{ t } ] [
|
||||||
|
@ -9,4 +10,12 @@ specialized-arrays.float ;
|
||||||
|
|
||||||
[ V{ float } ] [
|
[ V{ float } ] [
|
||||||
[ { float-array float } declare v*n norm ] final-classes
|
[ { 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
|
] unit-test
|
Loading…
Reference in New Issue