change alien.complex to use struct classes
parent
2e3f75fd87
commit
db7eb4e27a
|
@ -1,22 +1,21 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test alien.complex kernel alien.c-types alien.syntax
|
||||
namespaces math ;
|
||||
USING: accessors tools.test alien.complex classes.struct kernel
|
||||
alien.c-types alien.syntax namespaces math ;
|
||||
IN: alien.complex.tests
|
||||
|
||||
C-STRUCT: complex-holder
|
||||
{ "complex-float" "z" } ;
|
||||
STRUCT: complex-holder
|
||||
{ z complex-float } ;
|
||||
|
||||
: <complex-holder> ( z -- alien )
|
||||
"complex-holder" <c-object>
|
||||
[ set-complex-holder-z ] keep ;
|
||||
complex-holder <struct-boa> ;
|
||||
|
||||
[ ] [
|
||||
C{ 1.0 2.0 } <complex-holder> "h" set
|
||||
] unit-test
|
||||
|
||||
[ C{ 1.0 2.0 } ] [ "h" get complex-holder-z ] unit-test
|
||||
[ C{ 1.0 2.0 } ] [ "h" get z>> ] unit-test
|
||||
|
||||
[ number ] [ "complex-float" c-type-boxed-class ] unit-test
|
||||
|
||||
[ number ] [ "complex-double" c-type-boxed-class ] unit-test
|
||||
[ number ] [ "complex-double" c-type-boxed-class ] unit-test
|
||||
|
|
|
@ -1,33 +1,28 @@
|
|||
! 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: accessors alien.structs alien.c-types classes.struct math
|
||||
math.functions sequences arrays kernel functors vocabs.parser
|
||||
namespaces quotations ;
|
||||
IN: alien.complex.functor
|
||||
|
||||
FUNCTOR: define-complex-type ( N T -- )
|
||||
|
||||
T-real DEFINES ${T}-real
|
||||
T-imaginary DEFINES ${T}-imaginary
|
||||
set-T-real DEFINES set-${T}-real
|
||||
set-T-imaginary DEFINES set-${T}-imaginary
|
||||
T-class DEFINES-CLASS ${T}
|
||||
|
||||
<T> DEFINES <${T}>
|
||||
*T DEFINES *${T}
|
||||
|
||||
WHERE
|
||||
|
||||
STRUCT: T-class { real N } { imaginary N } ;
|
||||
|
||||
: <T> ( z -- alien )
|
||||
>rect T <c-object> [ set-T-imaginary ] [ set-T-real ] [ ] tri ; inline
|
||||
>rect T-class <struct-boa> ;
|
||||
|
||||
: *T ( alien -- z )
|
||||
[ T-real ] [ T-imaginary ] bi rect> ; inline
|
||||
T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline
|
||||
|
||||
T current-vocab
|
||||
{ { N "real" } { N "imaginary" } }
|
||||
define-struct
|
||||
|
||||
T c-type
|
||||
T-class c-type
|
||||
<T> 1quotation >>unboxer-quot
|
||||
*T 1quotation >>boxer-quot
|
||||
number >>boxed-class
|
||||
|
|
Loading…
Reference in New Issue