basis/alien/complex/functor/functor.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.structs alien.structs.fields alien.c-types
   4 math math.functions sequences arrays kernel functors
   5 vocabs.parser namespaces accessors quotations ;
   6 IN: alien.complex.functor
   7
   8 TUPLE: complex-c-type < struct-type
   9     array-class
  10     array-constructor
  11     direct-array-class
  12     direct-array-constructor
  13     sequence-mixin-class ;
  14 INSTANCE: complex-c-type array-c-type
  15
  16 FUNCTOR: define-complex-type ( N T -- )
  17
  18 T-real DEFINES ${T}-real
  19 T-imaginary DEFINES ${T}-imaginary
  20 set-T-real DEFINES set-${T}-real
  21 set-T-imaginary DEFINES set-${T}-imaginary
  22
  23 <T> DEFINES <${T}>
  24 *T DEFINES *${T}
  25
  26 WHERE
  27
  28 : <T> ( z -- alien )
  29     >rect T <c-object> [ set-T-imaginary ] [ set-T-real ] [ ] tri ; inline
  30
  31 : *T ( alien -- z )
  32     [ T-real ] [ T-imaginary ] bi rect> ; inline
  33
  34 T  N c-type-align [ 2 * ] [ ] bi
  35 T current-vocab N "real" <field-spec>
  36 T current-vocab N "imaginary" <field-spec> N c-type-align >>offset
  37 2array complex-c-type (define-struct)
  38
  39 T c-type
  40 <T> 1quotation >>unboxer-quot
  41 *T 1quotation >>boxer-quot
  42 number >>boxed-class
  43 T set-array-class
  44 drop
  45
  46 ;FUNCTOR