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! ]
- ] ;
USING: arrays kernel math math.order prettyprint tools.testest transducers ; QUALIFIED-WITH: sequences s IN: transducers.tests ERROR: not-lazy-enough ; : into-vector ( -- finalizer initializer step: ( a x -- a' ) ) [ ] [ V{ } clone f ] [ s:suffix! f ] ; : run-tests ( -- ) "reduce-seq" describe#{ "immutable accumulator" it#{ <{ { 1 2 3 4 5 6 } [ ] [ 10 f ] [ + f ] reduce-seq -> 31 }> }# "mutable accumulator" it#{ <{ { 1 2 3 4 5 6 } into-vector reduce-seq -> V{ 1 2 3 4 5 6 } }> }# }# "reduce-seq with transducers" describe#{ "map" it#{ <{ { 1 2 3 4 5 6 } into-vector [ 1 + 2 * ] map reduce-seq -> V{ 4 6 8 10 12 14 } }> }# "map <- map" it#{ <{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ 1 + ] map reduce-seq -> V{ 4 6 8 10 12 14 } }> }# "filter" it#{ <{ { 1 2 3 4 5 6 } into-vector [ even? ] filter reduce-seq -> V{ 2 4 6 } }> }# "map <- filter <- map" it#{ <{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ even? ] filter [ 1 - ] map reduce-seq -> V{ 0 4 8 } }> }# "take-while" it#{ <{ { 1 2 3 4 5 6 } into-vector [ 4 = not ] take-while reduce-seq -> V{ 1 2 3 } }> }# "take-n" describe#{ "simple" it#{ <{ { 1 2 3 4 5 6 } into-vector 3 take-n reduce-seq -> V{ 1 2 3 } }> }# "0" it#{ <{ { 1 2 3 4 5 6 } into-vector 0 take-n reduce-seq -> V{ } }> }# "take-n <- take-n" it#{ <{ { 1 2 3 4 5 6 } into-vector 3 take-n 3 take-n reduce-seq -> V{ 1 2 3 } }> }# "early termination" it#{ <{ { [ 1 ] [ 2 ] [ not-lazy-enough ] } into-vector 2 take-n [ call ] map reduce-seq -> V{ 1 2 } }> }# "0, early termination" it#{ <{ { [ not-lazy-enough ] } into-vector 0 take-n [ call ] map reduce-seq -> V{ } }> }# }# "drop-while" it#{ <{ { 1 2 3 4 5 6 } into-vector [ 4 = not ] drop-while reduce-seq -> V{ 4 5 6 } }> }# "drop-n" it#{ <{ { 1 2 3 4 5 6 } into-vector 3 drop-n reduce-seq -> V{ 4 5 6 } }> }# "cats" describe#{ "cat-seqs" it#{ <{ { { 1 2 3 } { 4 5 6 } } into-vector cat-seqs reduce-seq -> V{ 1 2 3 4 5 6 } }> }# "take-n <- cat-seqs" it#{ <{ { { 1 2 3 } { 4 5 6 } { 7 8 9 } } into-vector 4 take-n cat-seqs reduce-seq -> V{ 1 2 3 4 } }> }# "mapcat" it#{ <{ { 1 2 3 } into-vector [ [ [ ] [ f ] ] 2dip take-n 0 [ 1 + ] iterate .s ] mapcat reduce-seq -> V{ 0 0 1 0 1 2 } }> }# "cat-seqs*" it#{ <{ { { 1 2 3 } { 4 5 6 } } into-vector cat-seqs* reduce-seq -> V{ 1 2 3 4 5 6 } }> }# "take-n <- cat-seqs*" it#{ <{ { { 1 2 3 } { 4 5 6 } { 7 8 9 } } into-vector 4 take-n cat-seqs* reduce-seq -> V{ 1 2 3 4 } }> }# }# "group-using-arrays" describe#{ "exact" it#{ <{ { 1 2 3 4 5 6 } into-vector 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }> }# "with remainder" it#{ <{ { 1 2 3 4 5 6 7 } into-vector 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }> }# "exact, cut source" it#{ <{ { 1 2 3 4 5 6 7 8 } into-vector 3 group-using-arrays 6 take-n reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }> }# "with remainder, cut source" it#{ <{ { 1 2 3 4 5 6 7 8 } into-vector 3 group-using-arrays 7 take-n reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }> }# "cut destination at end, full" it#{ <{ { 1 2 3 4 5 6 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }> }# "cut destination at end, partial (avoid leaking `reduced`)" it#{ <{ { 1 2 3 4 5 6 7 } into-vector 3 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }> }# "cut destination, dropping partial" it#{ <{ { 1 2 3 4 5 6 7 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }> }# "cut destination, dropping full" it#{ <{ { 1 2 3 4 5 6 7 8 9 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }> }# }# }# "reduce-seq* with transducers" describe#{ "map <- filter <- map" it#{ <{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ even? ] filter [ 1 - ] map reduce-seq -> V{ 0 4 8 } }> }# }# "iterate (0->1 arity)" describe#{ "low-level" describe#{ "lazy enough (1, cut to 0)" it#{ <{ [ "x" t ] [ not-lazy-enough ] 1 [ not-lazy-enough ] iterate drop call -> "x" t }> }# "lazy enough (1)" it#{ <{ [ "x" f ] [ nip f ] 1 [ not-lazy-enough ] iterate drop call -> 1 f }> }# "lazy enough (2)" it#{ <{ [ "x" f ] [ nip f ] 1 [ 1 = [ 2 ] [ not-lazy-enough ] if ] iterate [ call drop ] dip call -> 2 f }> }# }# "reduce" describe#{ "take-n <- iterate" describe#{ "works" it#{ <{ into-vector 6 take-n 1 [ 1 + ] iterate reduce -> V{ 1 2 3 4 5 6 } }> }# "lazy enough (0)" it#{ <{ into-vector 0 take-n 1 [ not-lazy-enough ] iterate reduce -> V{ } }> }# "lazy enough (1)" it#{ <{ into-vector 1 take-n 1 [ not-lazy-enough ] iterate reduce -> V{ 1 } }> }# "lazy enough (2)" it#{ <{ into-vector 2 take-n 1 [ 1 = [ 2 ] [ not-lazy-enough ] if ] iterate reduce -> V{ 1 2 } }> }# }# "number to digits" it#{ <{ into-vector [ 10 mod ] map [ 0 > ] take-while 123456789 [ 10 /i ] iterate reduce -> V{ 9 8 7 6 5 4 3 2 1 } }> }# }# }# "multiary intermediates" describe#{ "map(2->1) <- map(1->2) with-index-from" it#{ <{ V{ 10 20 30 } into-vector [ 2array ] map 1 count-from reduce-seq -> V{ { 10 1 } { 20 2 } { 30 3 } } }> }# "map(2->1) <- ...(0->0 and 1->1) <- map(1->2) with-index-from" it#{ <{ V{ 10 20 30 40 50 60 } into-vector [ 2array ] map 3 take-n [ [ 3 + ] [ 1 + ] bi* ] map [ 1 + ] map ! any arity [ [ drop ] [ 4 = not ] bi* ] filter ! must be able to drop inputs and keep accumulators [ [ 20 = not ] [ 2 = not ] bi* and ] filter 1 count-from reduce-seq -> V{ { 13 3 } { 33 5 } { 53 7 } } }> }# "multiple accumulators" it#{ <{ { 10 35 20 5 30 } [ ] [ 99 -99 f ] [ [ min ] [ max ] bi-curry bi* f ] reduce-seq* -> 5 35 }> <{ { 10 35 20 5 30 } [ [ { } s:like ] 3dip [ { } s:like ] dip ] [ V{ } clone 99 V{ } clone -99 f ] [ f ] [ [ min [ s:suffix! ] keep ] [ max [ s:suffix! ] keep ] bi-curry 2bi* ] map reduce-seq* -> { 10 10 10 5 5 } 5 { 10 35 35 35 35 } 35 }> }# }# "user-controlled state below reducers" describe#{ "into-vector <- count-from for comparison" it#{ <{ into-vector 3 take-n 1 count-from reduce -> V{ 1 2 3 } }> }# "into-vector <- map" it#{ ! map with 0 inputs, so only accumulator below, finalizer hidden by reduce; ! the state could be in an accumulator as well, but this way doesn't involve initializers/finalizers <{ 1 into-vector 3 take-n [ over [ 1 + ] 2dip ] map reduce -> 4 V{ 1 2 3 } }> }# "reduce-seq should hide finalizers too" it#{ <{ 1 { 7 8 9 } into-vector 3 take-n [ drop over [ 1 + ] 2dip ] map reduce-seq -> 4 V{ 1 2 3 } }> }# }# ; MAIN: run-tests
- USING: arrays kernel math math.order prettyprint tools.testest transducers ;
- QUALIFIED-WITH: sequences s
- IN: transducers.tests
- ERROR: not-lazy-enough ;
- : into-vector ( -- finalizer initializer step: ( a x -- a' ) )
- [ ] [ V{ } clone f ] [ s:suffix! f ] ;
- : run-tests ( -- )
- "reduce-seq" describe#{
- "immutable accumulator" it#{
- <{ { 1 2 3 4 5 6 } [ ] [ 10 f ] [ + f ] reduce-seq -> 31 }>
- }#
- "mutable accumulator" it#{
- <{ { 1 2 3 4 5 6 } into-vector reduce-seq -> V{ 1 2 3 4 5 6 } }>
- }#
- }#
- "reduce-seq with transducers" describe#{
- "map" it#{
- <{ { 1 2 3 4 5 6 } into-vector [ 1 + 2 * ] map reduce-seq -> V{ 4 6 8 10 12 14 } }>
- }#
- "map <- map" it#{
- <{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ 1 + ] map reduce-seq -> V{ 4 6 8 10 12 14 } }>
- }#
- "filter" it#{
- <{ { 1 2 3 4 5 6 } into-vector [ even? ] filter reduce-seq -> V{ 2 4 6 } }>
- }#
- "map <- filter <- map" it#{
- <{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ even? ] filter [ 1 - ] map reduce-seq -> V{ 0 4 8 } }>
- }#
- "take-while" it#{
- <{ { 1 2 3 4 5 6 } into-vector [ 4 = not ] take-while reduce-seq -> V{ 1 2 3 } }>
- }#
- "take-n" describe#{
- "simple" it#{
- <{ { 1 2 3 4 5 6 } into-vector 3 take-n reduce-seq -> V{ 1 2 3 } }>
- }#
- "0" it#{
- <{ { 1 2 3 4 5 6 } into-vector 0 take-n reduce-seq -> V{ } }>
- }#
- "take-n <- take-n" it#{
- <{ { 1 2 3 4 5 6 } into-vector 3 take-n 3 take-n reduce-seq -> V{ 1 2 3 } }>
- }#
- "early termination" it#{
- <{ { [ 1 ] [ 2 ] [ not-lazy-enough ] } into-vector 2 take-n [ call ] map reduce-seq -> V{ 1 2 } }>
- }#
- "0, early termination" it#{
- <{ { [ not-lazy-enough ] } into-vector 0 take-n [ call ] map reduce-seq -> V{ } }>
- }#
- }#
- "drop-while" it#{
- <{ { 1 2 3 4 5 6 } into-vector [ 4 = not ] drop-while reduce-seq -> V{ 4 5 6 } }>
- }#
- "drop-n" it#{
- <{ { 1 2 3 4 5 6 } into-vector 3 drop-n reduce-seq -> V{ 4 5 6 } }>
- }#
- "cats" describe#{
- "cat-seqs" it#{
- <{ { { 1 2 3 } { 4 5 6 } } into-vector cat-seqs reduce-seq -> V{ 1 2 3 4 5 6 } }>
- }#
- "take-n <- cat-seqs" it#{
- <{ { { 1 2 3 } { 4 5 6 } { 7 8 9 } } into-vector 4 take-n cat-seqs reduce-seq -> V{ 1 2 3 4 } }>
- }#
- "mapcat" it#{
- <{ { 1 2 3 } into-vector [ [ [ ] [ f ] ] 2dip take-n 0 [ 1 + ] iterate .s ] mapcat reduce-seq -> V{ 0 0 1 0 1 2 } }>
- }#
- "cat-seqs*" it#{
- <{ { { 1 2 3 } { 4 5 6 } } into-vector cat-seqs* reduce-seq -> V{ 1 2 3 4 5 6 } }>
- }#
- "take-n <- cat-seqs*" it#{
- <{ { { 1 2 3 } { 4 5 6 } { 7 8 9 } } into-vector 4 take-n cat-seqs* reduce-seq -> V{ 1 2 3 4 } }>
- }#
- }#
- "group-using-arrays" describe#{
- "exact" it#{
- <{ { 1 2 3 4 5 6 } into-vector 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
- }#
- "with remainder" it#{
- <{ { 1 2 3 4 5 6 7 } into-vector 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }>
- }#
- "exact, cut source" it#{
- <{ { 1 2 3 4 5 6 7 8 } into-vector 3 group-using-arrays 6 take-n reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
- }#
- "with remainder, cut source" it#{
- <{ { 1 2 3 4 5 6 7 8 } into-vector 3 group-using-arrays 7 take-n reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }>
- }#
- "cut destination at end, full" it#{
- <{ { 1 2 3 4 5 6 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
- }#
- "cut destination at end, partial (avoid leaking `reduced`)" it#{
- <{ { 1 2 3 4 5 6 7 } into-vector 3 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }>
- }#
- "cut destination, dropping partial" it#{
- <{ { 1 2 3 4 5 6 7 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
- }#
- "cut destination, dropping full" it#{
- <{ { 1 2 3 4 5 6 7 8 9 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
- }#
- }#
- }#
- "reduce-seq* with transducers" describe#{
- "map <- filter <- map" it#{
- <{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ even? ] filter [ 1 - ] map reduce-seq -> V{ 0 4 8 } }>
- }#
- }#
- "iterate (0->1 arity)" describe#{
- "low-level" describe#{
- "lazy enough (1, cut to 0)" it#{
- <{ [ "x" t ] [ not-lazy-enough ] 1 [ not-lazy-enough ] iterate drop call -> "x" t }>
- }#
- "lazy enough (1)" it#{
- <{ [ "x" f ] [ nip f ] 1 [ not-lazy-enough ] iterate drop call -> 1 f }>
- }#
- "lazy enough (2)" it#{
- <{ [ "x" f ] [ nip f ] 1 [ 1 = [ 2 ] [ not-lazy-enough ] if ] iterate [ call drop ] dip call -> 2 f }>
- }#
- }#
- "reduce" describe#{
- "take-n <- iterate" describe#{
- "works" it#{
- <{ into-vector 6 take-n 1 [ 1 + ] iterate reduce -> V{ 1 2 3 4 5 6 } }>
- }#
- "lazy enough (0)" it#{
- <{ into-vector 0 take-n 1 [ not-lazy-enough ] iterate reduce -> V{ } }>
- }#
- "lazy enough (1)" it#{
- <{ into-vector 1 take-n 1 [ not-lazy-enough ] iterate reduce -> V{ 1 } }>
- }#
- "lazy enough (2)" it#{
- <{ into-vector 2 take-n 1 [ 1 = [ 2 ] [ not-lazy-enough ] if ] iterate reduce -> V{ 1 2 } }>
- }#
- }#
- "number to digits" it#{
- <{ into-vector [ 10 mod ] map [ 0 > ] take-while 123456789 [ 10 /i ] iterate reduce -> V{ 9 8 7 6 5 4 3 2 1 } }>
- }#
- }#
- }#
- "multiary intermediates" describe#{
- "map(2->1) <- map(1->2) with-index-from" it#{
- <{ V{ 10 20 30 } into-vector [ 2array ] map 1 count-from reduce-seq -> V{ { 10 1 } { 20 2 } { 30 3 } } }>
- }#
- "map(2->1) <- ...(0->0 and 1->1) <- map(1->2) with-index-from" it#{
- <{ V{ 10 20 30 40 50 60 } into-vector
- [ 2array ] map
- 3 take-n
- [ [ 3 + ] [ 1 + ] bi* ] map
- [ 1 + ] map ! any arity
- [ [ drop ] [ 4 = not ] bi* ] filter ! must be able to drop inputs and keep accumulators
- [ [ 20 = not ] [ 2 = not ] bi* and ] filter
- 1 count-from
- reduce-seq
- -> V{ { 13 3 } { 33 5 } { 53 7 } } }>
- }#
- "multiple accumulators" it#{
- <{ { 10 35 20 5 30 } [ ] [ 99 -99 f ] [ [ min ] [ max ] bi-curry bi* f ] reduce-seq* -> 5 35 }>
- <{ { 10 35 20 5 30 } [ [ { } s:like ] 3dip [ { } s:like ] dip ] [ V{ } clone 99 V{ } clone -99 f ] [ f ]
- [ [ min [ s:suffix! ] keep ] [ max [ s:suffix! ] keep ] bi-curry 2bi* ] map
- reduce-seq*
- -> { 10 10 10 5 5 } 5 { 10 35 35 35 35 } 35 }>
- }#
- }#
- "user-controlled state below reducers" describe#{
- "into-vector <- count-from for comparison" it#{
- <{ into-vector 3 take-n 1 count-from reduce -> V{ 1 2 3 } }>
- }#
- "into-vector <- map" it#{
- ! map with 0 inputs, so only accumulator below, finalizer hidden by reduce;
- ! the state could be in an accumulator as well, but this way doesn't involve initializers/finalizers
- <{ 1 into-vector 3 take-n [ over [ 1 + ] 2dip ] map reduce -> 4 V{ 1 2 3 } }>
- }#
- "reduce-seq should hide finalizers too" it#{
- <{ 1 { 7 8 9 } into-vector 3 take-n [ drop over [ 1 + ] 2dip ] map reduce-seq -> 4 V{ 1 2 3 } }>
- }#
- }#
- ;
- MAIN: run-tests
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)
def expected = DB['select b from (values (true), (false)) bs(b)'].to_a
compare_with(expected)
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! ]
] ;
USING: arrays kernel math math.order prettyprint tools.testest transducers ;
QUALIFIED-WITH: sequences s
IN: transducers.tests
ERROR: not-lazy-enough ;
: into-vector ( -- finalizer initializer step: ( a x -- a' ) )
[ ] [ V{ } clone f ] [ s:suffix! f ] ;
: run-tests ( -- )
"reduce-seq" describe#{
"immutable accumulator" it#{
<{ { 1 2 3 4 5 6 } [ ] [ 10 f ] [ + f ] reduce-seq -> 31 }>
}#
"mutable accumulator" it#{
<{ { 1 2 3 4 5 6 } into-vector reduce-seq -> V{ 1 2 3 4 5 6 } }>
}#
}#
"reduce-seq with transducers" describe#{
"map" it#{
<{ { 1 2 3 4 5 6 } into-vector [ 1 + 2 * ] map reduce-seq -> V{ 4 6 8 10 12 14 } }>
}#
"map <- map" it#{
<{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ 1 + ] map reduce-seq -> V{ 4 6 8 10 12 14 } }>
}#
"filter" it#{
<{ { 1 2 3 4 5 6 } into-vector [ even? ] filter reduce-seq -> V{ 2 4 6 } }>
}#
"map <- filter <- map" it#{
<{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ even? ] filter [ 1 - ] map reduce-seq -> V{ 0 4 8 } }>
}#
"take-while" it#{
<{ { 1 2 3 4 5 6 } into-vector [ 4 = not ] take-while reduce-seq -> V{ 1 2 3 } }>
}#
"take-n" describe#{
"simple" it#{
<{ { 1 2 3 4 5 6 } into-vector 3 take-n reduce-seq -> V{ 1 2 3 } }>
}#
"0" it#{
<{ { 1 2 3 4 5 6 } into-vector 0 take-n reduce-seq -> V{ } }>
}#
"take-n <- take-n" it#{
<{ { 1 2 3 4 5 6 } into-vector 3 take-n 3 take-n reduce-seq -> V{ 1 2 3 } }>
}#
"early termination" it#{
<{ { [ 1 ] [ 2 ] [ not-lazy-enough ] } into-vector 2 take-n [ call ] map reduce-seq -> V{ 1 2 } }>
}#
"0, early termination" it#{
<{ { [ not-lazy-enough ] } into-vector 0 take-n [ call ] map reduce-seq -> V{ } }>
}#
}#
"drop-while" it#{
<{ { 1 2 3 4 5 6 } into-vector [ 4 = not ] drop-while reduce-seq -> V{ 4 5 6 } }>
}#
"drop-n" it#{
<{ { 1 2 3 4 5 6 } into-vector 3 drop-n reduce-seq -> V{ 4 5 6 } }>
}#
"group-using-arrays" describe#{
"exact" it#{
<{ { 1 2 3 4 5 6 } into-vector 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
}#
"with remainder" it#{
<{ { 1 2 3 4 5 6 7 } into-vector 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }>
}#
"exact, cut source" it#{
<{ { 1 2 3 4 5 6 7 8 } into-vector 3 group-using-arrays 6 take-n reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
}#
"with remainder, cut source" it#{
<{ { 1 2 3 4 5 6 7 8 } into-vector 3 group-using-arrays 7 take-n reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }>
}#
"cut destination at end, full" it#{
<{ { 1 2 3 4 5 6 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
}#
"cut destination at end, partial (avoid leaking `reduced`)" it#{
<{ { 1 2 3 4 5 6 7 } into-vector 3 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } V{ 7 } } }>
}#
"cut destination, dropping partial" it#{
<{ { 1 2 3 4 5 6 7 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
}#
"cut destination, dropping full" it#{
<{ { 1 2 3 4 5 6 7 8 9 } into-vector 2 take-n 3 group-using-arrays reduce-seq -> V{ V{ 1 2 3 } V{ 4 5 6 } } }>
}#
}#
}#
"reduce-seq* with transducers" describe#{
"map <- filter <- map" it#{
<{ { 1 2 3 4 5 6 } into-vector [ 2 * ] map [ even? ] filter [ 1 - ] map reduce-seq -> V{ 0 4 8 } }>
}#
}#
"iterate (0->1 arity)" describe#{
"low-level" describe#{
"lazy enough (1, cut to 0)" it#{
<{ [ "x" t ] [ not-lazy-enough ] 1 [ not-lazy-enough ] iterate drop call -> "x" t }>
}#
"lazy enough (1)" it#{
<{ [ "x" f ] [ nip f ] 1 [ not-lazy-enough ] iterate drop call -> 1 f }>
}#
"lazy enough (2)" it#{
<{ [ "x" f ] [ nip f ] 1 [ 1 = [ 2 ] [ not-lazy-enough ] if ] iterate [ call drop ] dip call -> 2 f }>
}#
}#
"reduce" describe#{
"take-n <- iterate" describe#{
"works" it#{
<{ into-vector 6 take-n 1 [ 1 + ] iterate reduce -> V{ 1 2 3 4 5 6 } }>
}#
"lazy enough (0)" it#{
<{ into-vector 0 take-n 1 [ not-lazy-enough ] iterate reduce -> V{ } }>
}#
"lazy enough (1)" it#{
<{ into-vector 1 take-n 1 [ not-lazy-enough ] iterate reduce -> V{ 1 } }>
}#
"lazy enough (2)" it#{
<{ into-vector 2 take-n 1 [ 1 = [ 2 ] [ not-lazy-enough ] if ] iterate reduce -> V{ 1 2 } }>
}#
}#
"number to digits" it#{
<{ into-vector [ 10 mod ] map [ 0 > ] take-while 123456789 [ 10 /i ] iterate reduce -> V{ 9 8 7 6 5 4 3 2 1 } }>
}#
}#
}#
"multiary intermediates" describe#{
"map(2->1) <- map(1->2) with-index-from" it#{
<{ V{ 10 20 30 } into-vector [ 2array ] map 1 count-from reduce-seq -> V{ { 10 1 } { 20 2 } { 30 3 } } }>
}#
"map(2->1) <- ...(0->0 and 1->1) <- map(1->2) with-index-from" it#{
<{ V{ 10 20 30 40 50 60 } into-vector
[ 2array ] map
3 take-n
[ [ 3 + ] [ 1 + ] bi* ] map
[ 1 + ] map ! any arity
[ [ drop ] [ 4 = not ] bi* ] filter ! must be able to drop inputs and keep accumulators
[ [ 20 = not ] [ 2 = not ] bi* and ] filter
1 count-from
reduce-seq
-> V{ { 13 3 } { 33 5 } { 53 7 } } }>
}#
"multiple accumulators" it#{
<{ { 10 35 20 5 30 } [ ] [ 99 -99 f ] [ [ min ] [ max ] bi-curry bi* f ] reduce-seq* -> 5 35 }>
<{ { 10 35 20 5 30 } [ [ { } s:like ] 3dip [ { } s:like ] dip ] [ V{ } clone 99 V{ } clone -99 f ] [ f ]
[ [ min [ s:suffix! ] keep ] [ max [ s:suffix! ] keep ] bi-curry 2bi* ] map
reduce-seq*
-> { 10 10 10 5 5 } 5 { 10 35 35 35 35 } 35 }>
}#
}#
"user-controlled state below reducers" describe#{
"into-vector <- count-from for comparison" it#{
<{ into-vector 3 take-n 1 count-from reduce -> V{ 1 2 3 } }>
}#
"into-vector <- map" it#{
! map with 0 inputs, so only accumulator below, finalizer hidden by reduce;
! the state could be in an accumulator as well, but this way doesn't involve initializers/finalizers
<{ 1 into-vector 3 take-n [ over [ 1 + ] 2dip ] map reduce -> 4 V{ 1 2 3 } }>
}#
"reduce-seq should hide finalizers too" it#{
<{ 1 { 7 8 9 } into-vector 3 take-n [ drop over [ 1 + ] 2dip ] map reduce-seq -> 4 V{ 1 2 3 } }>
}#
}#
;
MAIN: run-tests
print('\u25b6\u25b6\ufe0e\u25b6\ufe0f')
describe "Example" do it "Will log error" do Test.expect(true) Test.expect(false, "This is an error<:LF:>This is a log") Test.assert_equals(false, true, "This is an error<:LF:>This is a log") Test.assert_not_equals("error", "error", "This is an error<:LF:>This is a log") end end
- describe "Example" do
- it "Will log error" do
- Test.expect(true)
# Test.expect(false, "This is an error\nThis is a log")# Test.assert_equals(false, true, "This is an error\nThis is a log")# Test.assert_not_equals("error", "error", "This is an error\nThis is a log")- Test.expect(false, "This is an error<:LF:>This is a log")
- Test.assert_equals(false, true, "This is an error<:LF:>This is a log")
- Test.assert_not_equals("error", "error", "This is an error<:LF:>This is a log")
- end
- end
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
#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);
- }
#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);
- }
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);
}
#include <criterion/criterion.h>
typedef double v4d __attribute__((__vector_size__(32)));
v4d add(v4d xs, v4d ys);
Test(add_function, should_add_vectors_of_doubles) {
v4d xs = (v4d){1, 2, 3, 4}, ys = (v4d){10, 20, 30, 40};
v4d e = xs + ys, a = add(xs, ys);
cr_assert_eq(a[0], e[0]);
}
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);
}
Describe(add_function) {
It(should_add_vectors_of_doubles) {
auto xs = v4d{1, 2, 3, 4}, ys = v4d{10, 20, 30, 40};
auto e = xs + ys, a = add(xs, ys);
Assert::That(a[0], Equals(e[0]));
}
};
class PhpQualityTest extends TestCase { public function testPhpIsNice() { $this->assertEquals('php is good', describePhp()); } }
class TestPhpQualities extends TestCase {- class PhpQualityTest extends TestCase {
- public function testPhpIsNice() {
- $this->assertEquals('php is good', describePhp());
- }
- }
add(X, Y, R) :- R is X + Y + 1.
ref_add(X, Y, R) :- R is X + Y.
fixed_test(x = 1, y = 2, expected = 3).
fixed_test(x = 3, y = 4, expected = 7).
fixed_test(x = X, y = Y, expected = E) :-
member((X, Y, E), [(1, 2, 3), (3, 4, 7)]).
random_test(x = X, y = Y, expected = E) :-
random_between(-100, 100, X),
random_between(-100, 100, Y),
ref_add(X, Y, E).
repeated_random_test(X, Y, E) :-
between(1, 5, _),
random_test(X, Y, E).
:- begin_tests(adder).
:- include(adder).
do_test(x = X, y = Y, expected = E) :-
findall(R, add(X, Y, R), R),
assertion(R == [E]).
test(fixed, [forall(fixed_test(X, Y, E))]) :- do_test(X, Y, E).
test(random, [forall(repeated_random_test(X, Y, E))]) :- do_test(X, Y, E).
:- end_tests(adder).
add(X, Y, R) :- R is X + Y + 1.
with(_ : C) :- C.
:- begin_tests(adder).
:- include(adder).
test(showing_input) :-
X = 1, Y = 2, E = 3,
add(X, Y, R),
assertion(with((x = X, y = Y, expected = E): (R == E))).
:- end_tests(adder).
add(X, Y, R) :- R is X + Y.
add0(_, _, _).
add_or_sub(X, Y, R) :- R is X + Y; R is X - Y.
:- include(foo).
:- begin_tests(foo).
test(add_assertion) :- add(1, 2, R), assertion(R == 4).
test(add_true, [true(R == 4)]) :- add(1, 2, R).
test(add_true_a, [true(R =:= 4)]) :- add(1, 2, R).
test(add0_assertion) :- add0(1, 2, S), assertion(R == 4).
test(add0_true, [true(R == 4)]) :- add0(1, 2, R).
test(add0_true_a, [true(R =:= 4)]) :- add0(1, 2, R).
test(add_fail_not) :- \+ add(1, 2, 3).
test(add_fail_fail, [fail]) :- add(1, 2, 3).
test(add_or_sub_all, all(R == [-1, 3])) :- add_or_sub(1, 2, R).
test(add_or_sub_all, set(R == [-1, 4])) :- add_or_sub(1, 2, R).
:- end_tests(foo).