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

alien.complex.functor: functors2

modern-harvey2
Doug Coleman 2017-12-03 10:52:03 -06:00
parent dbfeeebe38
commit 49981c22db
1 changed files with 10 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,32 +1,22 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types classes.struct functors USING: functors2 ;
kernel math math.functions quotations ;
IN: alien.complex.functor IN: alien.complex.functor
<FUNCTOR: define-complex-type ( N T -- ) FUNCTOR: define-complex-type ( N: name T: name -- ) [[
N-type IS ${N} STRUCT: ${T}-class { real ${N}-type } { imaginary ${N}-type } ;
T-class DEFINES-CLASS ${T} : <${T}> ( z -- alien )
>rect ${T}-class <struct-boa> >c-ptr ;
<T> DEFINES <${T}> : *${T} ( alien -- z )
*T DEFINES *${T}
WHERE
STRUCT: T-class { real N-type } { imaginary N-type } ;
: <T> ( z -- alien )
>rect T-class <struct-boa> >c-ptr ;
: *T ( alien -- z )
T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline
T-class lookup-c-type ${T}-class lookup-c-type
<T> 1quotation >>unboxer-quot <${T}> 1quotation >>unboxer-quot
*T 1quotation >>boxer-quot *${T} 1quotation >>boxer-quot
complex >>boxed-class complex >>boxed-class
drop drop
;FUNCTOR> ]]