From 10387f8df910f5449b79ed484f2a2ddb05448b6c Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 28 Nov 2011 16:18:51 -0800
Subject: [PATCH] combinators.smart: Implement reduce-outputs using compose,
 fix some stack effects, add using

---
 basis/combinators/smart/smart-tests.factor    |  6 +++-
 basis/combinators/smart/smart.factor          | 32 +++++++++----------
 .../stack-checker/stack-checker-tests.factor  |  2 +-
 3 files changed, 22 insertions(+), 18 deletions(-)

diff --git a/basis/combinators/smart/smart-tests.factor b/basis/combinators/smart/smart-tests.factor
index fde17fb81d..c7c11401c9 100644
--- a/basis/combinators/smart/smart-tests.factor
+++ b/basis/combinators/smart/smart-tests.factor
@@ -1,7 +1,7 @@
 ! 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 )
@@ -78,3 +78,7 @@ IN: combinators.smart.tests
 [ ] [ 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
diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index cacc335d08..d36fc56557 100644
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@@ -46,7 +46,7 @@ M: input-parameter infer-known* \ inputs/outputs unknown-macro-input ;
 
 M: object infer-known* drop f ;
 
-: drop-inputs ( quot -- newquot )
+: drop-inputs ( quot -- )
     inputs ndrop ; inline
 
 : drop-outputs ( quot -- )
@@ -55,10 +55,10 @@ M: object infer-known* drop f ;
 : 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 -- )
@@ -67,11 +67,11 @@ M: object infer-known* drop f ;
 : 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
@@ -79,7 +79,7 @@ MACRO: sum-outputs ( quot -- n )
 : 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 )
@@ -91,26 +91,26 @@ MACRO: sum-outputs ( quot -- n )
 : 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
diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index a050a259f6..2b67d0cc77 100644
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -7,7 +7,7 @@ sorting assocs definitions prettyprint io inspector
 classes.tuple classes.union classes.predicate debugger
 threads.private io.streams.string io.timeouts io.thread
 sequences.private destructors combinators eval locals.backend
-system compiler.units shuffle vocabs ;
+system compiler.units shuffle vocabs combinators.smart ;
 IN: stack-checker.tests
 
 [ 1234 infer ] must-fail