add contrib/shuffle

contrib/README.txt

@@ -44,6 +44,7 @@ Available libraries:
 - rss -- Code to retrieve and parse an RSS2 file (Chris Double)
 - sequences -- Non-core sequence words (Eduardo Cavazos)
 - serialize -- Binary object serialization (Chris Double)
+- shuffle -- Shuffle words not in the core library (Doug Coleman)
 - slate -- Graphics canvas for the UI (Eduardo Cavazos)
 - slate-examples -- Examples of how to use slate (Eduardo Cavazos)
 - space-invaders -- Intel 8080-based Space Invaders arcade machine emulator (Chris Double)

contrib/all.factor

@@ -11,10 +11,10 @@ contrib/jni contrib/json contrib/lambda contrib/lazy-lists
 contrib/lindenmayer contrib/match contrib/math
 contrib/parser-combinators contrib/postgresql contrib/process
 contrib/random-tester contrib/rss contrib/sequences
-contrib/serialize contrib/slate contrib/space-invaders
+contrib/serialize contrib/shuffle contrib/slate
-contrib/splay-trees contrib/sqlite contrib/textmate
+contrib/space-invaders contrib/splay-trees contrib/sqlite
-contrib/topology contrib/units contrib/usb contrib/vars
+contrib/textmate contrib/topology contrib/units contrib/usb
-contrib/vim contrib/xml ;
+contrib/vars contrib/vim contrib/xml ;
 
 "x11" vocab [
     "contrib/factory" require

contrib/shuffle/load.factor

@@ -0,0 +1,7 @@
+USE: kernel
+
+PROVIDE: contrib/shuffle
+{ +files+ {
+    "shuffle.factor"
+} }
+{ +tests+ { "test/shuffle.factor" } } ;

contrib/shuffle/shuffle.factor

@@ -0,0 +1,23 @@
+USING: kernel sequences ;
+IN: shuffle
+
+: reach ( a b c d -- a b c d a )
+    >r pick r> swap ; inline
+
+: roll ( a b c d -- b c d a )
+    >r rot r> swap ; inline
+
+: -roll ( a b c d -- d a b c )
+    -rot >r >r swap r> r> ; inline
+
+: 3nip ( a b c d -- d )
+    2nip nip ; inline
+
+: keepd ( obj obj quot -- obj )
+    pick >r call r> ; inline
+
+: with2 ( obj obj quot elt -- obj obj quot )
+    >r 3dup r> -rot >r >r swap >r swap call r> r> r> ; inline
+
+: map-with2 ( obj obj list quot -- newseq )
+    swap [ with2 roll ] map 3nip ; inline

contrib/shuffle/test/shuffle.factor

@@ -0,0 +1,7 @@
+USING: shuffle kernel math test ;
+
+[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
+[ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test
+[ 1 2 3 4 1 ] [ 1 2 3 4 reach ] unit-test
+[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
+[ 8 ] [ 5 6 7 8 3nip ] unit-test