steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update

db4
Slava Pestov 2008-07-08 12:35:42 -05:00
parent 267a24c0de
commit 475ffb17ac
1 changed files with 1 additions and 21 deletions
extra/shuffle

22
extra/shuffle/shuffle.factor
View File

@ -1,24 +1,9 @@
! Copyright (C) 2007 Chris Double, Doug Coleman. ! Copyright (C) 2007 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences namespaces math inference.transforms USING: kernel generalizations ;
combinators macros quotations math.ranges fry ;
IN: shuffle IN: shuffle
MACRO: npick ( n -- ) 1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;
MACRO: ndup ( n -- ) dup [ npick ] curry n*quot ;
MACRO: nrot ( n -- ) 1- dup saver swap [ r> swap ] n*quot append ;
MACRO: -nrot ( n -- ) 1- dup [ swap >r ] n*quot swap restorer append ;
MACRO: ndrop ( n -- ) [ drop ] n*quot ;
: nnip ( n -- ) swap >r ndrop r> ; inline
MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ;
: 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline : 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
: nipd ( a b c -- b c ) rot drop ; inline : nipd ( a b c -- b c ) rot drop ; inline
@ -32,8 +17,3 @@ MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ;
: 4drop ( a b c d -- ) 3drop drop ; inline : 4drop ( a b c d -- ) 3drop drop ; inline
: tuckd ( x y z -- z x y z ) 2 ntuck ; inline : tuckd ( x y z -- z x y z ) 2 ntuck ; inline
MACRO: nrev ( n -- quot )
[ 1+ ] map
reverse
[ [ -nrot ] curry ] map concat ;