diff --git a/contrib/README.txt b/contrib/README.txt index b01448205e..f2696e4997 100644 --- a/contrib/README.txt +++ b/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) diff --git a/contrib/all.factor b/contrib/all.factor index 67fb941fec..81bd8cc585 100644 --- a/contrib/all.factor +++ b/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/splay-trees contrib/sqlite contrib/textmate -contrib/topology contrib/units contrib/usb contrib/vars -contrib/vim contrib/xml ; +contrib/serialize contrib/shuffle contrib/slate +contrib/space-invaders contrib/splay-trees contrib/sqlite +contrib/textmate contrib/topology contrib/units contrib/usb +contrib/vars contrib/vim contrib/xml ; "x11" vocab [ "contrib/factory" require diff --git a/contrib/shuffle/load.factor b/contrib/shuffle/load.factor new file mode 100644 index 0000000000..166795ba92 --- /dev/null +++ b/contrib/shuffle/load.factor @@ -0,0 +1,7 @@ +USE: kernel + +PROVIDE: contrib/shuffle +{ +files+ { + "shuffle.factor" +} } +{ +tests+ { "test/shuffle.factor" } } ; diff --git a/contrib/shuffle/shuffle.factor b/contrib/shuffle/shuffle.factor new file mode 100644 index 0000000000..e55264917e --- /dev/null +++ b/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 diff --git a/contrib/shuffle/test/shuffle.factor b/contrib/shuffle/test/shuffle.factor new file mode 100644 index 0000000000..a16a1d8528 --- /dev/null +++ b/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