combinators.smart: Fix reduce-outputs, rename quot*n to call-n, rewrite more macros...

diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor
index efdb1b9e05504dc04df8f3e40a66387452ea13e6..9f837fd48cc1d553e5725bec60dc8787ff8ad0ab 100644 (file)
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@@ -40,6 +40,9 @@ M: input-parameter infer-known* \ inputs/outputs unknown-macro-input ;
 
 M: object infer-known* \ inputs/outputs bad-macro-input ;
 
+: drop-inputs ( quot -- newquot )
+    inputs ndrop ; inline
+
 : drop-outputs ( quot -- )
     [ call ] [ outputs ndrop ] bi ; inline
 
@@ -59,7 +62,7 @@ M: object infer-known* \ inputs/outputs bad-macro-input ;
     [ inputs firstn-unsafe ] [ call ] bi ; inline
 
 MACRO: reduce-outputs ( quot operation -- newquot )
-    [ dup outputs 1 [-] ] dip n*quot compose ;
+    [ [ ] [ outputs 1 [-] ] bi ] dip swap '[ @ _ _ call-n ] ;
 
 : sum-outputs ( quot -- n )
     [ + ] reduce-outputs ; inline
@@ -70,37 +73,38 @@ MACRO: reduce-outputs ( quot operation -- newquot )
 : map-reduce-outputs ( quot mapper reducer -- )
     [ '[ _ _ map-outputs ] ] dip reduce-outputs ; inline
 
-MACRO: append-outputs-as ( quot exemplar -- newquot )
-    [ dup outputs ] dip '[ @ _ _ nappend-as ] ;
+: append-outputs-as ( quot exemplar -- newquot )
+    [ [ call ] [ outputs ] bi ] dip nappend-as ; inline
 
-MACRO: append-outputs ( quot -- seq )
-    '[ _ { } append-outputs-as ] ;
+: append-outputs ( quot -- seq )
+    { } append-outputs-as ; inline
 
-MACRO: preserving ( quot -- )
-    [ inputs ] keep '[ _ ndup @ ] ;
+: preserving ( quot -- )
+    [ inputs ndup ] [ call ] bi ; inline
 
-MACRO: dropping ( quot -- quot' )
-    inputs '[ [ _ ndrop ] ] ;
+: dropping ( quot -- quot' )
+    inputs '[ _ ndrop ] ; inline
 
-MACRO: nullary ( quot -- quot' ) dropping ;
+: nullary ( quot -- quot' )
+    dropping call ; inline
 
-MACRO: smart-if ( pred true false -- quot )
-    '[ _ preserving _ _ if ] ;
+: smart-if ( pred true false -- quot )
+    [ preserving ] 2dip if ; inline
 
-MACRO: smart-when ( pred true -- quot )
-    '[ _ _ [ ] smart-if ] ;
+: smart-when ( pred true -- quot )
+    [ ] smart-if ; inline
 
-MACRO: smart-unless ( pred false -- quot )
-    '[ _ [ ] _ smart-if ] ;
+: smart-unless ( pred false -- quot )
+    [ [ ] ] dip smart-if ; inline
 
-MACRO: smart-if* ( pred true false -- quot )
-    '[ _ [ preserving ] [ dropping ] bi _ swap _ compose if ] ;
+: smart-if* ( pred true false -- quot )
+    [ [ [ preserving ] [ dropping ] bi ] dip swap ] dip compose if ; inline
 
-MACRO: smart-when* ( pred true -- quot )
-    '[ _ _ [ ] smart-if* ] ;
+: smart-when* ( pred true -- quot )
+    [ ] smart-if* ; inline
 
-MACRO: smart-unless* ( pred false -- quot )
-    '[ _ [ ] _ smart-if* ] ;
+: smart-unless* ( pred false -- quot )
+    [ [ ] ] dip smart-if* ; inline
 
-MACRO: smart-apply ( quot n -- quot )
-    [ dup inputs ] dip '[ _ _ _ mnapply ] ;
+: smart-apply ( quot n -- quot )
+    [ dup inputs ] dip mnapply ; inline

diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 99d57eded8f2e38dd6ff1622fac83ab059f8440e..303d0d092610859dfdbd4807467a8e4507b8c5a5 100644 (file)
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -6,11 +6,15 @@ combinators macros math.order math.ranges quotations fry effects
 memoize.private arrays ;
 IN: generalizations
 
+! These words can be inline combinators the word does no math on
+! the input parameters, e.g. n. 
+! If math is done, the word needs to be a macro so the math can
+! be done at compile-time.
 <<
 
 ALIAS: n*quot (n*quot)
 
-MACRO: quot*n ( n -- )
+MACRO: call-n ( n -- )
     [ call ] <repetition> '[ _ cleave ] ;
 
 : repeat ( n obj quot -- ) swapd times ; inline
@@ -27,7 +31,7 @@ MACRO: nover ( n -- )
     dup 1 + '[ _ npick ] n*quot ;
 
 : ndup ( n -- )
-    [ '[ _ npick ] ] keep quot*n ; inline
+    [ '[ _ npick ] ] keep call-n ; inline
 
 MACRO: dupn ( n -- )
     [ [ drop ] ]
@@ -40,25 +44,25 @@ MACRO: -nrot ( n -- )
     1 - [ ] [ '[ swap _ dip ] ] repeat ;
 
 : ndrop ( n -- )
-    [ drop ] swap quot*n ; inline
+    [ drop ] swap call-n ; inline
 
 : nnip ( n -- )
     '[ _ ndrop ] dip ; inline
 
 : ndip ( n -- )
-    [ [ dip ] curry ] swap quot*n call ; inline
+    [ [ dip ] curry ] swap call-n call ; inline
 
 : nkeep ( n -- )
     dup '[ [ _ ndup ] dip _ ndip ] call ; inline
 
 : ncurry ( n -- )
-    [ curry ] swap quot*n ; inline
+    [ curry ] swap call-n ; inline
 
 : nwith ( n -- )
-    [ with ] swap quot*n ; inline
+    [ with ] swap call-n ; inline
 
-MACRO: nbi ( n -- )
-    '[ [ _ nkeep ] dip call ] ;
+: nbi ( quot1 quot2 n -- )
+    [ nip nkeep ] [ drop nip call ] 3bi ; inline
 
 MACRO: ncleave ( quots n -- )
     [ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi
@@ -115,5 +119,5 @@ MACRO: nweave ( n -- )
     [ dup iota <reversed> [ '[ _ _ mnswap ] ] with map ] keep
     '[ _ _ ncleave ] ;
 
-MACRO: nbi-curry ( n -- )
-    [ bi-curry ] n*quot ;
+: nbi-curry ( n -- )
+    [ bi-curry ] swap call-n ; inline

diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor
index 69e4cca4ec80d192b699315b49be79405a69348a..391bc41dcba5381ef52a37330d62d5ee7cf95e27 100644 (file)
--- a/basis/roman/roman.factor
+++ b/basis/roman/roman.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs effects fry generalizations
-grouping kernel lexer macros math math.order math.vectors
-namespaces parser effects.parser quotations sequences
-sequences.private splitting.monotonic stack-checker strings
-unicode.case words ;
+USING: accessors arrays assocs combinators.smart effects
+effects.parser fry generalizations grouping kernel lexer macros
+math math.order math.vectors namespaces parser quotations
+sequences sequences.private splitting.monotonic stack-checker
+strings unicode.case words ;
 IN: roman
 
 <PRIVATE

diff --git a/basis/xml/tests/xmltest.factor b/basis/xml/tests/xmltest.factor
index 2cbc5890b16da57b5239cb54b7918889532f6da1..dd55a2f3a5c7a61e94cee2a296add09fd4feb604 100644 (file)
--- a/basis/xml/tests/xmltest.factor
+++ b/basis/xml/tests/xmltest.factor
@@ -20,9 +20,6 @@ TUPLE: xml-test id uri sections description type ;
 
 CONSTANT: base "vocab:xml/tests/xmltest/"
 
-MACRO: drop-inputs ( quot -- newquot )
-    inputs '[ _ ndrop ] ;
-
 : fails? ( quot -- ? )
     [ drop-outputs f ] [ nip drop-inputs t ] bi-curry recover ; inline