steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

change alien.complex to use struct classes

db4
Joe Groff 2009-08-29 20:20:25 -05:00
parent 2e3f75fd87
commit db7eb4e27a
2 changed files with 16 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
basis/alien/complex/complex-tests.factor
View File

@ -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

23
basis/alien/complex/functor/functor.factor
View File

@ -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