2009-02-06 05:38:31 -05:00
|
|
|
! Copyright (C) 2009 Slava Pestov.
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2017-12-03 11:52:03 -05:00
|
|
|
USING: functors2 ;
|
2009-02-06 05:38:31 -05:00
|
|
|
IN: alien.complex.functor
|
|
|
|
|
|
2017-12-28 22:15:31 -05:00
|
|
|
INLINE-FUNCTOR: complex-type ( n: existing-word t: name -- ) [[
|
2017-12-26 15:04:00 -05:00
|
|
|
USING: alien alien.c-types classes.struct kernel quotations ;
|
|
|
|
|
QUALIFIED: math
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2017-12-26 15:04:00 -05:00
|
|
|
<<
|
2017-12-28 22:15:31 -05:00
|
|
|
STRUCT: ${t} { real ${n} } { imaginary ${n} } ;
|
2010-02-21 13:28:42 -05:00
|
|
|
|
2017-12-28 22:15:31 -05:00
|
|
|
: <${t}> ( z -- alien )
|
2017-12-29 02:31:02 -05:00
|
|
|
math::>rect ${t} <struct-boa> >c-ptr ;
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2017-12-28 22:15:31 -05:00
|
|
|
: *${t} ( alien -- z )
|
2017-12-29 02:31:02 -05:00
|
|
|
${t} memory>struct [ real>> ] [ imaginary>> ] bi math::rect> ; inline
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2017-12-26 15:04:00 -05:00
|
|
|
>>
|
|
|
|
|
|
2017-12-28 22:15:31 -05:00
|
|
|
\ ${t} lookup-c-type
|
|
|
|
|
[ <${t}> ] >>unboxer-quot
|
|
|
|
|
[ *${t} ] >>boxer-quot
|
2017-12-26 15:04:00 -05:00
|
|
|
complex >>boxed-class
|
|
|
|
|
drop
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2017-12-03 20:23:37 -05:00
|
|
|
]]
|
