! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators.smart kernel math
-stack-checker tools.test ;
+stack-checker tools.test locals ;
IN: combinators.smart.tests
: test-bi ( -- 9 11 )
[ ] [ 2 2 [ + odd? ] [ ] smart-unless* ] unit-test
[ ( -- x ) ] [ [ [ ] [ call ] curry output>array ] infer ] unit-test
+
+:: map-reduce-test ( a b c -- d ) [ a b c ] [ a - ] [ b * + ] map-reduce-outputs ;
+
+[ ] [ 1 2 3 map-reduce-test ] unit-test
M: object infer-known* drop f ;
-: drop-inputs ( quot -- newquot )
+: drop-inputs ( quot -- )
inputs ndrop ; inline
: drop-outputs ( quot -- )
: keep-inputs ( quot -- )
[ ] [ inputs ] bi nkeep ; inline
-: output>sequence ( quot exemplar -- )
+: output>sequence ( quot exemplar -- seq )
[ [ call ] [ outputs ] bi ] dip nsequence ; inline
-: output>array ( quot -- )
+: output>array ( quot -- array )
{ } output>sequence ; inline
: input<sequence ( seq quot -- )
: input<sequence-unsafe ( seq quot -- )
[ inputs firstn-unsafe ] [ call ] bi ; inline
-MACRO: reduce-outputs ( quot operation -- newquot )
- [ [ ] [ outputs 1 [-] ] bi ] dip swap '[ @ _ _ call-n ] ;
+: reduce-outputs ( quot operation -- )
+ [ [ call ] [ [ drop ] compose outputs ] bi ] dip swap call-n ; inline
-MACRO: sum-outputs ( quot -- n )
- '[ _ [ + ] reduce-outputs ] ;
+: sum-outputs ( quot -- obj )
+ [ + ] reduce-outputs ; inline
: map-outputs ( quot mapper -- )
[ drop call ] [ swap outputs ] 2bi napply ; inline
: map-reduce-outputs ( quot mapper reducer -- )
[ '[ _ _ map-outputs ] ] dip reduce-outputs ; inline
-: append-outputs-as ( quot exemplar -- newquot )
+: append-outputs-as ( quot exemplar -- seq )
[ [ call ] [ outputs ] bi ] dip nappend-as ; inline
: append-outputs ( quot -- seq )
: dropping ( quot -- quot' )
inputs '[ _ ndrop ] ; inline
-: nullary ( quot -- quot' )
+: nullary ( quot -- )
dropping call ; inline
-: smart-if ( pred true false -- quot )
+: smart-if ( pred true false -- )
[ preserving ] 2dip if ; inline
-: smart-when ( pred true -- quot )
+: smart-when ( pred true -- )
[ ] smart-if ; inline
-: smart-unless ( pred false -- quot )
+: smart-unless ( pred false -- )
[ [ ] ] dip smart-if ; inline
-: smart-if* ( pred true false -- quot )
+: smart-if* ( pred true false -- )
[ [ [ preserving ] [ dropping ] bi ] dip swap ] dip compose if ; inline
-: smart-when* ( pred true -- quot )
+: smart-when* ( pred true -- )
[ ] smart-if* ; inline
-: smart-unless* ( pred false -- quot )
+: smart-unless* ( pred false -- )
[ [ ] ] dip smart-if* ; inline
-: smart-apply ( quot n -- quot )
+: smart-apply ( quot n -- )
[ dup inputs ] dip mnapply ; inline