extra/shuffle/shuffle.factor

   1 ! Copyright (C) 2007 Chris Double, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences namespaces math inference.transforms
   4        combinators macros quotations math.ranges bake ;
   5
   6 IN: shuffle
   7
   8 MACRO: npick ( n -- ) 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
   9
  10 MACRO: ndup ( n -- ) dup [ npick ] curry n*quot ;
  11
  12 MACRO: nrot ( n -- ) 1- dup saver swap [ r> swap ] n*quot append ;
  13
  14 MACRO: -nrot ( n -- ) 1- dup [ swap >r ] n*quot swap restorer append ;
  15
  16 MACRO: ndrop ( n -- ) [ drop ] n*quot ;
  17
  18 : nnip ( n -- ) swap >r ndrop r> ; inline
  19
  20 MACRO: ntuck ( n -- ) 2 + [ dup , -nrot ] bake ;
  21
  22 : 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
  23
  24 : nipd ( a b c -- b c ) rot drop ; inline
  25
  26 : 3nip ( a b c d -- d ) 3 nnip ; inline
  27
  28 : 4nip ( a b c d e -- e ) 4 nnip ; inline
  29
  30 : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline
  31
  32 : 4drop ( a b c d -- ) 3drop drop ; inline
  33
  34 : tuckd ( x y z -- z x y z ) 2 ntuck ; inline
  35
  36 MACRO: nrev ( n -- quot )
  37   [ 1+ ] map
  38   reverse
  39   [ [ -nrot ] curry ] map concat ;