2009-02-06 05:38:31 -05:00
|
|
|
! Copyright (C) 2009 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2014-11-29 23:10:37 -05:00
|
|
|
USING: accessors alien alien.c-types classes.struct functors
|
|
|
|
kernel math math.functions quotations ;
|
2009-02-06 05:38:31 -05:00
|
|
|
IN: alien.complex.functor
|
|
|
|
|
2017-08-05 21:41:19 -04:00
|
|
|
<FUNCTOR: define-complex-type ( N T -- )
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2010-02-21 13:28:42 -05:00
|
|
|
N-type IS ${N}
|
|
|
|
|
2009-08-29 21:20:25 -04:00
|
|
|
T-class DEFINES-CLASS ${T}
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2009-02-06 20:05:56 -05:00
|
|
|
<T> DEFINES <${T}>
|
|
|
|
*T DEFINES *${T}
|
2009-02-06 05:38:31 -05:00
|
|
|
|
|
|
|
WHERE
|
|
|
|
|
2010-02-21 13:28:42 -05:00
|
|
|
STRUCT: T-class { real N-type } { imaginary N-type } ;
|
2009-08-29 21:20:25 -04:00
|
|
|
|
2009-02-06 20:05:56 -05:00
|
|
|
: <T> ( z -- alien )
|
2009-08-30 00:18:31 -04:00
|
|
|
>rect T-class <struct-boa> >c-ptr ;
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2009-02-06 20:05:56 -05:00
|
|
|
: *T ( alien -- z )
|
2009-08-29 21:20:25 -04:00
|
|
|
T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline
|
2009-02-06 05:38:31 -05:00
|
|
|
|
2011-10-24 20:00:09 -04:00
|
|
|
T-class lookup-c-type
|
2009-02-09 16:01:41 -05:00
|
|
|
<T> 1quotation >>unboxer-quot
|
|
|
|
*T 1quotation >>boxer-quot
|
2009-09-24 07:58:33 -04:00
|
|
|
complex >>boxed-class
|
2009-02-06 05:38:31 -05:00
|
|
|
drop
|
|
|
|
|
2017-08-05 21:41:19 -04:00
|
|
|
;FUNCTOR>
|