basis/math/vectors/conversion/conversion.factor

   1 ! Copyright (C) 2009 Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien arrays assocs classes combinators
   4 combinators.short-circuit fry kernel locals math math.vectors
   5 math.vectors.simd math.vectors.simd.intrinsics sequences ;
   6 FROM: alien.c-types =>
   7     char uchar short ushort int uint longlong ulonglong
   8     float double heap-size ;
   9 IN: math.vectors.conversion
  10
  11 ERROR: bad-vconvert from-type to-type ;
  12 ERROR: bad-vconvert-input value expected-type ;
  13
  14 <PRIVATE
  15
  16 : float-type? ( c-type -- ? )
  17     { float double } member-eq? ;
  18 : unsigned-type? ( c-type -- ? )
  19     { uchar ushort uint ulonglong } member-eq? ;
  20
  21 : check-vconvert-type ( value expected-type -- value )
  22     2dup instance? [ drop ] [ bad-vconvert-input ] if ; inline
  23
  24 :: [vconvert] ( from-element to-element from-size to-size from-type to-type -- quot )
  25     {
  26         {
  27             [ from-element to-element eq? ]
  28             [ [ ] ]
  29         }
  30         {
  31             [ from-element to-element [ float-type? not ] both? ]
  32             [ [ underlying>> to-type boa ] ]
  33         }
  34         {
  35             [ from-element float-type? ]
  36             [ from-type new simd-rep '[ underlying>> _ (simd-v>integer) to-type boa ] ]
  37         }
  38         {
  39             [ to-element   float-type? ]
  40             [ from-type new simd-rep '[ underlying>> _ (simd-v>float)   to-type boa ] ]
  41         }
  42     } cond
  43     [ from-type check-vconvert-type ] prepose ;
  44
  45 :: check-vpack ( from-element to-element from-type to-type steps -- )
  46     {
  47         [ steps 1 = not ]
  48         [ from-element to-element [ float-type? ] bi@ xor ]
  49         [ from-element unsigned-type? to-element unsigned-type? not and ]
  50     } 0|| [ from-type to-type bad-vconvert ] when ;
  51
  52 :: ([vpack-unsigned]) ( from-type to-type -- quot )
  53     from-type new simd-rep
  54     '[
  55         [ from-type check-vconvert-type underlying>> ] bi@
  56         _ (simd-vpack-unsigned) to-type boa
  57     ] ;
  58
  59 :: ([vpack-signed]) ( from-type to-type -- quot )
  60     from-type new simd-rep
  61     '[
  62         [ from-type check-vconvert-type underlying>> ] bi@
  63         _ (simd-vpack-signed)   to-type boa
  64     ] ;
  65
  66 :: [vpack] ( from-element to-element from-size to-size from-type to-type -- quot )
  67     from-size to-size /i log2 :> steps
  68
  69     from-element to-element from-type to-type steps check-vpack
  70
  71     from-type to-type to-element unsigned-type?
  72     [ ([vpack-unsigned]) ] [ ([vpack-signed]) ] if ;
  73
  74 :: check-vunpack ( from-element to-element from-type to-type steps -- )
  75     {
  76         [ steps 1 = not ]
  77         [ from-element to-element [ float-type? ] bi@ xor ]
  78         [ from-element unsigned-type? not to-element unsigned-type? and ]
  79     } 0|| [ from-type to-type bad-vconvert ] when ;
  80
  81 :: ([vunpack]) ( from-type to-type -- quot )
  82     from-type new simd-rep
  83     '[
  84         from-type check-vconvert-type underlying>> _
  85         [ (simd-vunpack-head) to-type boa ]
  86         [ (simd-vunpack-tail) to-type boa ] 2bi
  87     ] ;
  88
  89 :: [vunpack] ( from-element to-element from-size to-size from-type to-type -- quot )
  90     to-size from-size /i log2 :> steps
  91     from-element to-element from-type to-type steps check-vunpack
  92     from-type to-type ([vunpack]) ;
  93
  94 PRIVATE>
  95
  96 MACRO:: vconvert ( from-type to-type -- quot )
  97     from-type new [ simd-element-type ] [ byte-length ] bi :> ( from-element from-length )
  98     to-type   new [ simd-element-type ] [ byte-length ] bi :> ( to-element   to-length   )
  99     from-element heap-size :> from-size
 100     to-element   heap-size :> to-size
 101
 102     from-length to-length = [ from-type to-type bad-vconvert ] unless
 103
 104     from-element to-element from-size to-size from-type to-type {
 105         { [ from-size to-size < ] [ [vunpack] ] }
 106         { [ from-size to-size = ] [ [vconvert] ] }
 107         { [ from-size to-size > ] [ [vpack] ] }
 108     } cond ;