basis/shuffle/shuffle.factor

   1 ! Copyright (C) 2007 Chris Double, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs effects.parser generalizations
   4 hashtables kernel locals locals.backend macros make math
   5 parser sequences ;
   6 IN: shuffle
   7
   8 <PRIVATE
   9
  10 : >locals-assoc ( sequence -- assoc )
  11     dup length dup 1- [ - ] curry map zip >hashtable ;
  12
  13 PRIVATE>
  14
  15 MACRO: shuffle-effect ( effect -- )
  16     [ out>> ] [ in>> >locals-assoc ] bi
  17     [
  18         [ nip assoc-size , \ load-locals , ]
  19         [ [ at , \ get-local , ] curry each ]
  20         [ nip assoc-size , \ drop-locals , ] 2tri
  21     ] [ ] make ;
  22
  23 : shuffle(
  24     ")" parse-effect parsed \ shuffle-effect parsed ; parsing
  25
  26 : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline
  27
  28 : nipd ( a b c -- b c ) rot drop ; inline
  29
  30 : 3nip ( a b c d -- d ) 3 nnip ; inline
  31
  32 : 4nip ( a b c d e -- e ) 4 nnip ; inline
  33
  34 : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline
  35
  36 : 4drop ( a b c d -- ) 3drop drop ; inline
  37
  38 : tuckd ( x y z -- z x y z ) 2 ntuck ; inline