### with cats

Code
Diff
• ``````USING: accessors combinators combinators.smart fry kernel locals math quotations ;
USING: vectors prettyprint ;
QUALIFIED-WITH: sequences s
IN: transducers

! TODO: effects for multiacc, surround, polyvariadic map quot, group to transducer, flatmap

! reducer = finalizer: ( ..yz -- ..zs ) initializer: ( -- ..xs done? ) step: ( ..xs -- ..ys done? )
! ..xs/..ys are some values, normally accumulators followed by intermediate values being processed,
! the number of intermediate values can change between steps, while accumulators are always there,
! but they are on the stack and can be accessed at any time, thus not much different from other values

: reduce ( finalizer: ( ..as -- ..bs ) initializer: ( -- ..as done? ) step: ( ..xs -- ..ys done? ) -- ..bs )
rot [ [ call ] dip [ swap ] [ [ call ] keep ] until drop ] dip call ; inline

! specialized via sequences:any?
: reduce-seq ( xs finalizer: ( a -- a' ) initializer: ( -- a done? ) step: ( a x -- a' done? ) -- a' )
rot [ [ call ] dip swap [ drop nip ] [ swapd s:any? drop ] if ] dip call ; inline

: iterate ( i-from: ( -- a d? ) r-from: ( a x -- a' d? ) x quot: ( x -- x' ) -- i-to: ( -- a d? ) r-to: ( a -- a' d? ) )
[ [ swap curry '[ [ t ] _ if ] compose ] 2keep ] dip
swap [let :> x! '[ x @ [ x! ] keep ] prepose ] ; inline

: map ( r-from: ( ..ys -- d? ) quot: ( ..xs -- ..ys ) -- r-to: ( ..xs -- d? ) )
prepose ;

: filter ( r-from: ( ..xs -- d? ) quot: ( ..xs+ -- ..xs ? ) -- r-to: ( ..xs -- d? ) )
swap [ [ f ] smart-if* ] 2curry ;

: take-while ( r-from: ( ..xs -- d? ) quot: ( ..xs+ -- ..xs ? ) -- r-to: ( ..xs -- d? ) )
swap [ [ t ] smart-if* ] 2curry ;

: take-n ( i-from: ( -- d? ) r-from: ( ..xs -- d? ) n -- i-to: ( -- a d? ) r-to: ( ..xs -- d? ) )
[ [ [ drop t ] compose ] dip ] [ [let :> i!
[ i 1 - [ drop t ] [ i! ] if-zero ] compose
] ] if-zero ;

: drop-while ( r-from: ( ..xs -- d? ) quot: ( ..xs -- ..xs ? ) -- r-to: ( ..xs -- ..xs d? ) )
[let f :> b! [ {
{ [ b ] [ drop call ] }
{ [ overd call ] [ 2drop f ] }
[ t b! call ]
} cond ] 2curry ] ;

: drop-n ( r-from: ( ..xs -- d? ) n -- r-to: ( ..xs -- d? ) )
[let :> i! '[ i _ [ 1 - i! drop f ] if-zero ] ] ;

! via sequences:any?
: cat-seqs ( r-from: ( ..xs y -- d? ) -- r-to: ( ..xs ys -- d? ) )
'[ _ s:any? ] ;

: mapcat ( r-from: ( ..xs y -- d? ) quot: ( r-outer: ( ..xs y -- d? ) z -- f-inner: ( -- ) i-inner: ( -- d? ) r-inner: ( z -- y d? )  ) -- r-to: ( ..xs z -- d? ) )
[let f :> done! '[ _ [ dup done! ] compose swap @ reduce done ] ] ;

! via mapcat
: cat-seqs* ( r-from: ( ..xs y -- d? ) -- r-to: ( ..xs ys -- d? ) )
[ [ [ ] [ f ] ] 2dip [ '[ _ s:nth ] map ] [ s:length '[ _ < ] take-while ] bi 0 [ 1 + ] iterate ] mapcat ;

! reduce-seq as map <- take-while <- iterate
: reduce-seq* ( xs finalizer: ( a -- a' ) initializer: ( -- a done? ) step: ( a x -- done? ) -- a' )
roll [ '[ _ s:nth ] map ] [ s:length '[ _ < ] take-while ] bi 0 [ 1 + ] iterate reduce ; inline

: count-from ( r-from: ( ..xs i -- d? ) n -- r-to: ( ..xs -- d? ) )
[let :> i! [ i [ 1 + i! ] keep ] ] prepose ;

! TODO: generalize
! a temporary variant for testing
: group-using-arrays ( f-from: ( a -- a' ) i-from: ( -- a d? ) r-from: ( a x -- a' d? ) n -- f-to: ( a -- a' ) i-to: ( -- a d? ) r-to: ( a x -- a' d? ) )
[let dup V{ } clone :> ( r-from n i! g! )
[ [ i n = [ g r-from call drop ] unless ] prepose ] dip
[ g s:push i 1 - [ g r-from call V{ } clone g! n ] [ [ f ] dip ] if-zero i! ]
] ;
``````
• USING: accessors combinators combinators.smart fry kernel locals math quotations ;
• USING: vectors prettyprint ;
• QUALIFIED-WITH: sequences s
• IN: transducers
• ! TODO: effects for multiacc, surround, polyvariadic map quot, group to transducer, flatmap
• ! reducer = finalizer: ( ..yz -- ..zs ) initializer: ( -- ..xs done? ) step: ( ..xs -- ..ys done? )
• ! ..xs/..ys are some values, normally accumulators followed by intermediate values being processed,
• ! the number of intermediate values can change between steps, while accumulators are always there,
• ! but they are on the stack and can be accessed at any time, thus not much different from other values
• : reduce ( finalizer: ( ..as -- ..bs ) initializer: ( -- ..as done? ) step: ( ..xs -- ..ys done? ) -- ..bs )
• rot [ [ call ] dip [ swap ] [ [ call ] keep ] until drop ] dip call ; inline
• ! specialized via sequences:any?
• : reduce-seq ( xs finalizer: ( a -- a' ) initializer: ( -- a done? ) step: ( a x -- a' done? ) -- a' )
• rot [ [ call ] dip swap [ drop nip ] [ swapd s:any? drop ] if ] dip call ; inline
• : iterate ( i-from: ( -- a d? ) r-from: ( a x -- a' d? ) x quot: ( x -- x' ) -- i-to: ( -- a d? ) r-to: ( a -- a' d? ) )
• [ [ swap curry '[ [ t ] _ if ] compose ] 2keep ] dip
• swap [let :> x! '[ x @ [ x! ] keep ] prepose ] ; inline
• : map ( r-from: ( ..ys -- d? ) quot: ( ..xs -- ..ys ) -- r-to: ( ..xs -- d? ) )
• prepose ;
• : filter ( r-from: ( ..xs -- d? ) quot: ( ..xs+ -- ..xs ? ) -- r-to: ( ..xs -- d? ) )
• swap [ [ f ] smart-if* ] 2curry ;
• : take-while ( r-from: ( ..xs -- d? ) quot: ( ..xs+ -- ..xs ? ) -- r-to: ( ..xs -- d? ) )
• swap [ [ t ] smart-if* ] 2curry ;
• : take-n ( i-from: ( -- d? ) r-from: ( ..xs -- d? ) n -- i-to: ( -- a d? ) r-to: ( ..xs -- d? ) )
• [ [ [ drop t ] compose ] dip ] [ [let :> i!
• [ i 1 - [ drop t ] [ i! ] if-zero ] compose
• ] ] if-zero ;
• : drop-while ( r-from: ( ..xs -- d? ) quot: ( ..xs -- ..xs ? ) -- r-to: ( ..xs -- ..xs d? ) )
• [let f :> b! [ {
• { [ b ] [ drop call ] }
• { [ overd call ] [ 2drop f ] }
• [ t b! call ]
• } cond ] 2curry ] ;
• : drop-n ( r-from: ( ..xs -- d? ) n -- r-to: ( ..xs -- d? ) )
• [let :> i! '[ i _ [ 1 - i! drop f ] if-zero ] ] ;
• ! via sequences:any?
• : cat-seqs ( r-from: ( ..xs y -- d? ) -- r-to: ( ..xs ys -- d? ) )
• '[ _ s:any? ] ;
• : mapcat ( r-from: ( ..xs y -- d? ) quot: ( r-outer: ( ..xs y -- d? ) z -- f-inner: ( -- ) i-inner: ( -- d? ) r-inner: ( z -- y d? ) ) -- r-to: ( ..xs z -- d? ) )
• [let f :> done! '[ _ [ dup done! ] compose swap @ reduce done ] ] ;
• ! via mapcat
• : cat-seqs* ( r-from: ( ..xs y -- d? ) -- r-to: ( ..xs ys -- d? ) )
• [ [ [ ] [ f ] ] 2dip [ '[ _ s:nth ] map ] [ s:length '[ _ < ] take-while ] bi 0 [ 1 + ] iterate ] mapcat ;
• ! reduce-seq as map <- take-while <- iterate
• : reduce-seq* ( xs finalizer: ( a -- a' ) initializer: ( -- a done? ) step: ( a x -- done? ) -- a' )
• roll [ '[ _ s:nth ] map ] [ s:length '[ _ < ] take-while ] bi 0 [ 1 + ] iterate reduce ; inline
• : count-from ( r-from: ( ..xs i -- d? ) n -- r-to: ( ..xs -- d? ) )
• [let :> i! [ i [ 1 + i! ] keep ] ] prepose ;
• ! TODO: generalize
• ! a temporary variant for testing
• : group-using-arrays ( f-from: ( a -- a' ) i-from: ( -- a d? ) r-from: ( a x -- a' d? ) n -- f-to: ( a -- a' ) i-to: ( -- a d? ) r-to: ( a x -- a' d? ) )
• [let dup V{ } clone :> ( r-from n i! g! )
• [ [ i n = [ g r-from call drop ] unless ] prepose ] dip
• [ g s:push i 1 - [ g r-from call V{ } clone g! n ] [ [ f ] dip ] if-zero i! ]
• ] ;
Failed Tests

### Counting something

``````fn rand(x: &mut u32) -> u32 {
*x ^= *x << 13;
*x ^= *x >> 17;
*x ^= *x << 5;
*x
}

const N_ITER: u32 = 800000000;
const SEED: u32 = 42;

fn count_0() -> [u32; 3] {
let mut ks = [0, 0, 0];
let mut x = SEED;
for _ in 0..N_ITER {
match rand(&mut x) % 3 {
0 => ks[0] += 1,
1 => ks[1] += 1,
_ => ks[2] += 1,
}
}
ks
}

fn count_1() -> [u32; 3] {
let mut ks = [0, 0, 0];
let mut x = SEED;
for _ in 0..N_ITER {
let r = rand(&mut x) % 3;
ks[0] += (r == 0) as u32;
ks[1] += (r == 1) as u32;
ks[2] += (r == 2) as u32;
}
ks
}

fn count_2() -> [u32; 3] {
let mut ks = [0, 0, 0];
let mut x = SEED;
for _ in 0..N_ITER {
ks[(rand(&mut x) % 3) as usize] += 1;
}
ks
}

fn main() {
print!("{:?}\n", count_X());
}``````
Failed Tests

### Not really missing column

``select b from (values (false), (true)) bs(b)``

### Transducers

Based on Clojure transducers (and Clojure is in many aspects the closest language to Factor of what I've seen).

I thought I'd at least add something more interesting before publishing, like `group`ing with inner transducers, but I'm not interested enough in improving this now, it's not even a kata, so I guess I'll just publish it in its current middle-of-experimenting state.

Transducers in Clojure hide interior mutability, which seems less necessary in Factor, so simple cases with mapping and filtering finite collections aren't much different from using `make`. So it looks like in Factor this is more about grouping step functions with initialization and finalization functions so that they can be passed around and composed as triplets.

``````USING: accessors combinators combinators.smart fry kernel locals math quotations ;
USING: vectors prettyprint ;
QUALIFIED-WITH: sequences s
IN: transducers

! TODO: effects for multiacc, surround, polyvariadic map quot, group to transducer, flatmap

! reducer = finalizer: ( ..yz -- ..zs ) initializer: ( -- ..xs done? ) step: ( ..xs -- ..ys done? )
! ..xs/..ys are some values, normally accumulators followed by intermediate values being processed,
! the number of intermediate values can change between steps, while accumulators are always there,
! but they are on the stack and can be accessed at any time, thus not much different from other values

: reduce ( finalizer: ( ..as -- ..bs ) initializer: ( -- ..as done? ) step: ( ..xs -- ..ys done? ) -- ..bs )
rot [ [ call ] dip [ swap ] [ [ call ] keep ] until drop ] dip call ; inline

! specialized via sequences:any?
: reduce-seq ( xs finalizer: ( a -- a' ) initializer: ( -- a done? ) step: ( a x -- a' done? ) -- a' )
rot [ [ call ] dip swap [ drop nip ] [ swapd s:any? drop ] if ] dip call ; inline

: iterate ( i-from: ( -- a d? ) r-from: ( a x -- a' d? ) x quot: ( x -- x' ) -- i-to: ( -- a d? ) r-to: ( a -- a' d? ) )
[ [ swap curry '[ [ t ] _ if ] compose ] 2keep ] dip
swap [let :> x! '[ x @ [ x! ] keep ] prepose ] ; inline

: map ( r-from: ( ..ys -- d? ) quot: ( ..xs -- ..ys ) -- r-to: ( ..xs -- d? ) )
prepose ;

: filter ( r-from: ( ..xs -- d? ) quot: ( ..xs+ -- ..xs ? ) -- r-to: ( ..xs -- d? ) )
swap [ [ f ] smart-if* ] 2curry ;

: take-while ( r-from: ( ..xs -- d? ) quot: ( ..xs+ -- ..xs ? ) -- r-to: ( ..xs -- d? ) )
swap [ [ t ] smart-if* ] 2curry ;

: take-n ( i-from: ( -- d? ) r-from: ( ..xs -- d? ) n -- i-to: ( -- a d? ) r-to: ( ..xs -- d? ) )
[ [ [ drop t ] compose ] dip ] [ [let :> i!
[ i 1 - [ drop t ] [ i! ] if-zero ] compose
] ] if-zero ;

: drop-while ( r-from: ( ..xs -- d? ) quot: ( ..xs -- ..xs ? ) -- r-to: ( ..xs -- ..xs d? ) )
[let f :> b! [ {
{ [ b ] [ drop call ] }
{ [ overd call ] [ 2drop f ] }
[ t b! call ]
} cond ] 2curry ] ;

: drop-n ( r-from: ( ..xs -- d? ) n -- r-to: ( ..xs -- d? ) )
[let :> i! '[ i _ [ 1 - i! drop f ] if-zero ] ] ;

! reduce-seq as map <- take-while <- iterate
: reduce-seq* ( xs finalizer: ( a -- a' ) initializer: ( -- a done? ) step: ( a x -- done? ) -- a' )
roll [ '[ _ s:nth ] map ] [ s:length '[ _ < ] take-while ] bi 0 [ 1 + ] iterate reduce ; inline

: count-from ( r-from: ( ..xs i -- d? ) n -- r-to: ( ..xs -- d? ) )
[let :> i! [ i [ 1 + i! ] keep ] ] prepose ;

! TODO: generalize
! a temporary variant for testing
: group-using-arrays ( f-from: ( a -- a' ) i-from: ( -- a d? ) r-from: ( a x -- a' d? ) n -- f-to: ( a -- a' ) i-to: ( -- a d? ) r-to: ( a x -- a' d? ) )
[let dup V{ } clone :> ( r-from n i! g! )
[ [ i n = [ g r-from call drop ] unless ] prepose ] dip
[ g s:push i 1 - [ g r-from call V{ } clone g! n ] [ [ f ] dip ] if-zero i! ]
] ;``````
Failed Tests

### Arrows without and with variation selectors

``print('\u25b6\u25b6\ufe0e\u25b6\ufe0f')``
Failed Tests

Failed Tests

### `require` JSON

``````const {execSync} = require('child_process');
execSync(`echo '{"foo": "bar"}' >file.json`);
console.log(require('./file.json'));
execSync(`echo '{"baz": "qux"}' >file.json`);
console.log(require('./file.json')); // cached``````

### AVX

Code
Diff
• ``````#include <immintrin.h>

typedef double v4d __attribute__((__vector_size__(32)));

__attribute__((__target__("avx")))
v4d add(v4d xs, v4d ys) {
}``````
• #include <immintrin.h>
• typedef double v4d __attribute__((__vector_size__(32)));
• __attribute__((__target__("avx")))
• v4d add(v4d xs, v4d ys) {
• }

### AVX

Code
Diff
• ``````#include <immintrin.h>

using v4d = double __attribute__((__vector_size__(32)));

__attribute__((__target__("avx")))
v4d add(v4d xs, v4d ys) {
}``````
• #include <immintrin.h>
• using v4d = double __attribute__((__vector_size__(32)));
• __attribute__((__target__("avx")))
• v4d add(v4d xs, v4d ys) {
• }
Failed Tests

### AVX

solution.c:6:10: error: always_inline function '_mm256_add_pd' requires target feature 'avx', but would be inlined into function 'add' that is compiled without support for 'avx'

``````#include <immintrin.h>

typedef double v4d __attribute__((__vector_size__(32)));

v4d add(v4d xs, v4d ys) {
}``````
Failed Tests

### AVX

main.cpp:10:10: error: always_inline function '_mm256_add_pd' requires target feature 'avx', but would be inlined into function 'add' that is compiled without support for 'avx'

``````#include <immintrin.h>

using v4d = double __attribute__((__vector_size__(32)));

v4d add(v4d xs, v4d ys) {
}``````
Failed Tests

Failed Tests

### Organizing tests

``add(X, Y, R) :- R is X + Y + 1.``
Failed Tests

### Showing input

``add(X, Y, R) :- R is X + Y + 1.``
Failed Tests

### Test test test

``````add(X, Y, R) :- R is X + Y.