diff --git a/basis/combinators/smart/smart.factor b/basis/combinators/smart/smart.factor index efdb1b9e05..9f837fd48c 100644 --- 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 99d57eded8..303d0d0926 100644 --- 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 ] '[ _ 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 [ '[ _ _ 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 69e4cca4ec..391bc41dcb 100644 --- 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