basis/math/vectors/simd/cords/cords.factor

   1 USING: accessors alien.c-types arrays byte-arrays
   2 cpu.architecture effects functors generalizations kernel lexer
   3 math math.vectors.simd math.vectors.simd.intrinsics parser
   4 prettyprint.custom quotations sequences sequences.cords words
   5 classes ;
   6 IN: math.vectors.simd.cords
   7
   8 <<
   9 <PRIVATE
  10
  11 FUNCTOR: (define-simd-128-cord) ( A/2 A -- )
  12
  13 A-rep    IS            ${A/2}-rep
  14 >A/2     IS            >${A/2}
  15 A/2-boa  IS            ${A/2}-boa
  16 A/2-with IS            ${A/2}-with
  17 A/2-cast IS            ${A/2}-cast
  18
  19 >A     DEFINES       >${A}
  20 A-boa  DEFINES       ${A}-boa
  21 A-with DEFINES       ${A}-with
  22 A-cast DEFINES       ${A}-cast
  23 A{     DEFINES       ${A}{
  24
  25 N       [ A-rep rep-length ]
  26 BOA-EFFECT [ N 2 * "n" <array> { "v" } <effect> ]
  27
  28 WHERE
  29
  30 : >A ( seq -- A )
  31     [ N head-slice >A/2 ]
  32     [ N tail-slice >A/2 ] bi cord-append ;
  33
  34 \ A-boa
  35 { N ndip A/2-boa cord-append } { A/2-boa } >quotation prefix >quotation
  36 BOA-EFFECT define-inline
  37
  38 : A-with ( n -- v )
  39     [ A/2-with ] [ A/2-with ] bi cord-append ; inline
  40
  41 : A-cast ( v -- v' )
  42     [ A/2-cast ] cord-map ; inline
  43
  44 M: A new-sequence
  45     2drop
  46     N A/2 new new-sequence
  47     N A/2 new new-sequence
  48     \ A boa ;
  49
  50 M: A like
  51     over \ A instance? [ drop ] [ call-next-method ] if ;
  52
  53 M: A >pprint-sequence ;
  54 M: A pprint* pprint-object ;
  55
  56 M: A pprint-delims drop \ A{ \ } ;
  57 SYNTAX: A{ \ } [ >A ] parse-literal ;
  58
  59 <c-type>
  60     byte-array >>class
  61     A >>boxed-class
  62     [
  63         [      A-rep alien-vector A/2 boa ]
  64         [ 16 + A-rep alien-vector A/2 boa ] 2bi cord-append
  65     ] >>getter
  66     [
  67         [ [ head>> underlying>> ] 2dip      A-rep set-alien-vector ]
  68         [ [ tail>> underlying>> ] 2dip 16 + A-rep set-alien-vector ] 3bi
  69     ] >>setter
  70     32 >>size
  71     16 >>align
  72     A-rep >>rep
  73 \ A typedef
  74
  75 ;FUNCTOR
  76
  77 : define-simd-128-cord ( A/2 T -- )
  78     [ define-specialized-cord ]
  79     [ create-in (define-simd-128-cord) ] 2bi ;
  80
  81 SYNTAX: SIMD-128-CORD:
  82     scan-word scan define-simd-128-cord ;
  83
  84 PRIVATE>
  85 >>
  86
  87 SIMD-128-CORD: char-16     char-32
  88 SIMD-128-CORD: uchar-16    uchar-32
  89 SIMD-128-CORD: short-8     short-16
  90 SIMD-128-CORD: ushort-8    ushort-16
  91 SIMD-128-CORD: int-4       int-8
  92 SIMD-128-CORD: uint-4      uint-8
  93 SIMD-128-CORD: longlong-2  longlong-4
  94 SIMD-128-CORD: ulonglong-2 ulonglong-4
  95 SIMD-128-CORD: float-4     float-8
  96 SIMD-128-CORD: double-2    double-4
  97