Ad
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! ]
    • ] ;
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());
}
select b from (values (false), (true)) bs(b)

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 grouping 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! ]
  ] ;
print('\u25b6\u25b6\ufe0e\u25b6\ufe0f')
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
Code
Diff
  • #include <immintrin.h>
    
    typedef double v4d __attribute__((__vector_size__(32)));
    
    __attribute__((__target__("avx")))
    v4d add(v4d xs, v4d ys) {
      return _mm256_add_pd(xs, ys);
    }
    • #include <immintrin.h>
    • typedef double v4d __attribute__((__vector_size__(32)));
    • __attribute__((__target__("avx")))
    • v4d add(v4d xs, v4d ys) {
    • return _mm256_add_pd(xs, ys);
    • }
Code
Diff
  • #include <immintrin.h>
    
    using v4d = double __attribute__((__vector_size__(32)));
    
    __attribute__((__target__("avx")))
    v4d add(v4d xs, v4d ys) {
      return _mm256_add_pd(xs, ys);
    }
    • #include <immintrin.h>
    • using v4d = double __attribute__((__vector_size__(32)));
    • __attribute__((__target__("avx")))
    • v4d add(v4d xs, v4d ys) {
    • return _mm256_add_pd(xs, ys);
    • }
UnnamedFailed 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'
return _mm256_add_pd(xs, ys);

#include <immintrin.h>

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

v4d add(v4d xs, v4d ys) {
  return _mm256_add_pd(xs, ys);
}
UnnamedFailed 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'
return _mm256_add_pd(xs, ys);

#include <immintrin.h>

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

v4d add(v4d xs, v4d ys) {
  return _mm256_add_pd(xs, ys);
}
add(X, Y, R) :- R is X + Y + 1.
add(X, Y, R) :- R is X + Y + 1.
add(X, Y, R) :- R is X + Y.
add0(_, _, _).
add_or_sub(X, Y, R) :- R is X + Y; R is X - Y.
Loading more items...