basis/alien/complex/functor/functor.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types classes.struct functors
   4 kernel math quotations ;
   5 IN: alien.complex.functor
   6
   7 <FUNCTOR: define-complex-type ( N T -- )
   8
   9 N-type IS ${N}
  10
  11 T-class DEFINES-CLASS ${T}
  12
  13 <T> DEFINES <${T}>
  14 *T DEFINES *${T}
  15
  16 WHERE
  17
  18 STRUCT: T-class { real N-type } { imaginary N-type } ;
  19
  20 : <T> ( z -- alien )
  21     >rect T-class boa >c-ptr ;
  22
  23 : *T ( alien -- z )
  24     T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline
  25
  26 T-class lookup-c-type
  27 <T> 1quotation >>unboxer-quot
  28 *T 1quotation >>boxer-quot
  29 complex >>boxed-class
  30 drop
  31
  32 ;FUNCTOR>