basis/combinators/smart/smart.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors fry generalizations kernel macros math.order
   4 stack-checker math sequences ;
   5 IN: combinators.smart
   6
   7 MACRO: drop-outputs ( quot -- quot' )
   8     dup outputs '[ @ _ ndrop ] ;
   9
  10 MACRO: keep-inputs ( quot -- quot' )
  11     dup inputs '[ _ _ nkeep ] ;
  12
  13 MACRO: output>sequence ( quot exemplar -- newquot )
  14     [ dup outputs ] dip
  15     '[ @ _ _ nsequence ] ;
  16
  17 MACRO: output>array ( quot -- newquot )
  18     '[ _ { } output>sequence ] ;
  19
  20 MACRO: input<sequence ( quot -- newquot )
  21     [ inputs ] keep
  22     '[ _ firstn @ ] ;
  23
  24 MACRO: input<sequence-unsafe ( quot -- newquot )
  25     [ inputs ] keep
  26     '[ _ firstn-unsafe @ ] ;
  27
  28 MACRO: reduce-outputs ( quot operation -- newquot )
  29     [ dup outputs 1 [-] ] dip n*quot compose ;
  30
  31 MACRO: sum-outputs ( quot -- n )
  32     '[ _ [ + ] reduce-outputs ] ;
  33
  34 MACRO: map-reduce-outputs ( quot mapper reducer -- newquot )
  35     [ dup outputs ] 2dip
  36     [ swap '[ _ _ napply ] ]
  37     [ [ 1 [-] ] dip n*quot ] bi-curry* bi
  38     '[ @ @ @ ] ;
  39
  40 MACRO: append-outputs-as ( quot exemplar -- newquot )
  41     [ dup outputs ] dip '[ @ _ _ nappend-as ] ;
  42
  43 MACRO: append-outputs ( quot -- seq )
  44     '[ _ { } append-outputs-as ] ;
  45
  46 MACRO: preserving ( quot -- )
  47     [ inputs ] keep '[ _ ndup @ ] ;
  48
  49 MACRO: nullary ( quot -- quot' )
  50     dup outputs '[ @ _ ndrop ] ;
  51
  52 MACRO: smart-if ( pred true false -- )
  53     '[ _ preserving _ _ if ] ; inline