factor/basis/combinators/smart/smart.factor

54 lines
1.4 KiB
Factor
Raw Normal View History

2009-01-08 19:56:49 -05:00
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors fry generalizations kernel macros math.order
2009-08-19 05:38:59 -04:00
stack-checker math sequences ;
2009-01-08 19:56:49 -05:00
IN: combinators.smart
MACRO: drop-outputs ( quot -- quot' )
2010-01-14 10:10:13 -05:00
dup outputs '[ @ _ ndrop ] ;
MACRO: keep-inputs ( quot -- quot' )
2010-01-14 10:10:13 -05:00
dup inputs '[ _ _ nkeep ] ;
2009-01-08 19:56:49 -05:00
MACRO: output>sequence ( quot exemplar -- newquot )
2010-01-14 10:10:13 -05:00
[ dup outputs ] dip
2009-01-08 19:56:49 -05:00
'[ @ _ _ nsequence ] ;
MACRO: output>array ( quot -- newquot )
'[ _ { } output>sequence ] ;
2009-01-08 19:56:49 -05:00
MACRO: input<sequence ( quot -- newquot )
2010-01-14 10:10:13 -05:00
[ inputs ] keep
2009-01-08 19:56:49 -05:00
'[ _ firstn @ ] ;
MACRO: input<sequence-unsafe ( quot -- newquot )
2010-01-14 10:10:13 -05:00
[ inputs ] keep
'[ _ firstn-unsafe @ ] ;
2009-01-09 16:39:47 -05:00
MACRO: reduce-outputs ( quot operation -- newquot )
2010-01-14 10:10:13 -05:00
[ dup outputs 1 [-] ] dip n*quot compose ;
2009-01-08 19:56:49 -05:00
MACRO: sum-outputs ( quot -- n )
'[ _ [ + ] reduce-outputs ] ;
MACRO: map-reduce-outputs ( quot mapper reducer -- newquot )
2010-01-14 10:10:13 -05:00
[ dup outputs ] 2dip
[ swap '[ _ _ napply ] ]
[ [ 1 [-] ] dip n*quot ] bi-curry* bi
'[ @ @ @ ] ;
MACRO: append-outputs-as ( quot exemplar -- newquot )
2010-01-14 10:10:13 -05:00
[ dup outputs ] dip '[ @ _ _ nappend-as ] ;
MACRO: append-outputs ( quot -- seq )
'[ _ { } append-outputs-as ] ;
2009-08-19 05:38:59 -04:00
MACRO: preserving ( quot -- )
2010-01-14 10:10:13 -05:00
[ inputs ] keep '[ _ ndup @ ] ;
2009-08-19 05:38:59 -04:00
MACRO: nullary ( quot -- quot' )
2010-01-14 10:10:13 -05:00
dup outputs '[ @ _ ndrop ] ;
2009-08-19 05:38:59 -04:00
MACRO: smart-if ( pred true false -- )
'[ _ preserving _ _ if ] ;