-USING: accessors alien.c-types byte-arrays classes combinators
-cpu.architecture fry functors generalizations generic
+USING: accessors alien.c-types arrays byte-arrays classes combinators
+cpu.architecture effects fry functors generalizations generic
generic.parser kernel lexer literals macros math math.functions
math.vectors math.vectors.private namespaces parser
prettyprint.custom quotations sequences sequences.private vocabs
-vocabs.loader ;
+vocabs.loader words ;
QUALIFIED-WITH: alien.c-types c
IN: math.vectors.simd
SET-NTH [ ELT dup c:c-setter c:array-accessor ]
+BOA-EFFECT [ N "n" <repetition> >array { "v" } <effect> ]
+
WHERE
TUPLE: A < simd-128 ;
: A-with ( n -- v ) \ A new simd-with ; inline
: A-cast ( v -- v' ) \ A new simd-cast ; inline
-: A-boa ( ...n -- v ) \ A new simd-boa ; inline
-M: A pprint-delims drop \ A{ \ } ;
-SYNTAX: A{ \ } [ >A ] parse-literal ;
+\ A-boa { \ A simd-boa } >quotation BOA-EFFECT define-inline
+
+! M: A pprint-delims drop \ A{ \ } ;
+! SYNTAX: A{ \ } [ >A ] parse-literal ;
c:<c-type>
byte-array >>class
[ nip [ 16 (byte-array) ] make-underlying ]
[ length bad-simd-length ] if ; inline
-M: simd-128 >pprint-sequence ;
-M: simd-128 pprint* pprint-object ;
+! M: simd-128 >pprint-sequence ;
+! M: simd-128 pprint* pprint-object ;
INSTANCE: simd-128 sequence
: simd-with ( n seq -- v )
[ (simd-with) ] simd-construct-op ; inline
-MACRO: simd-boa ( seq -- )
- dup length {
- { 2 [ '[ _ dup [ (simd-gather-2) ] simd-construct-op ] ] }
- { 4 [ '[ _ dup [ (simd-gather-4) ] simd-construct-op ] ] }
- [ '[ _ _ nsequence ] ]
+MACRO: simd-boa ( class -- )
+ new dup length {
+ { 2 [ '[ _ [ (simd-gather-2) ] simd-construct-op ] ] }
+ { 4 [ '[ _ [ (simd-gather-4) ] simd-construct-op ] ] }
+ [ swap '[ _ _ nsequence ] ]
} case ;
: simd-cast ( v seq -- v' )