unmaintained/shufflers/shufflers.factor

   1 USING: kernel sequences words math math.functions arrays
   2 shuffle quotations parser math.parser strings namespaces
   3 splitting effects sequences.lib ;
   4 IN: shufflers
   5
   6 : shuffle>string ( names shuffle -- string )
   7     swap [ [ nth ] curry map ] curry map
   8     first2 "-" swap 3append >string ;
   9
  10 : make-shuffles ( max-out max-in -- shuffles )
  11     [ 1+ dup rot strings [ 2array ] with map ]
  12     with map concat ;
  13
  14 : shuffle>quot ( shuffle -- quot )
  15     [
  16         first2 2dup [ - ] with map
  17         reverse [ , \ npick , \ >r , ] each
  18         swap , \ ndrop , length [ \ r> , ] times
  19     ] [ ] make ;
  20
  21 : put-effect ( word -- )
  22     dup word-name "-" split1
  23     [ >array [ 1string ] map ] bi@
  24     <effect> "declared-effect" set-word-prop ;
  25
  26 : in-shuffle ( -- ) in get ".shuffle" append set-in ;
  27 : out-shuffle ( -- ) in get ".shuffle" ?tail drop set-in ;
  28
  29 : define-shuffles ( names max-out -- )
  30     in-shuffle over length make-shuffles [
  31         [ shuffle>string create-in ] keep
  32         shuffle>quot dupd define put-effect
  33     ] with each out-shuffle ;
  34
  35 : SHUFFLE:
  36     scan scan string>number define-shuffles ; parsing