rewrite shuffle( -- ) to avoid locals primitives
parent
296a1ce0a9
commit
4ee82b19f6
|
@ -1,23 +1,22 @@
|
||||||
! 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: accessors assocs effects.parser generalizations
|
USING: accessors assocs combinators effects.parser generalizations
|
||||||
hashtables kernel locals locals.backend macros make math
|
hashtables kernel locals locals.backend macros make math
|
||||||
parser sequences ;
|
parser sequences ;
|
||||||
IN: shuffle
|
IN: shuffle
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: >locals-assoc ( sequence -- assoc )
|
: >index-assoc ( sequence -- assoc )
|
||||||
dup length dup 1- [ - ] curry map zip >hashtable ;
|
dup length zip >hashtable ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
MACRO: shuffle-effect ( effect -- )
|
MACRO: shuffle-effect ( effect -- )
|
||||||
[ out>> ] [ in>> >locals-assoc ] bi
|
[ out>> ] [ in>> >index-assoc ] bi
|
||||||
[
|
[
|
||||||
[ nip assoc-size , \ load-locals , ]
|
[ nip assoc-size , \ narray , ]
|
||||||
[ [ at , \ get-local , ] curry each ]
|
[ [ at \ swap \ nth [ ] 3sequence ] curry map , \ cleave , ] 2bi
|
||||||
[ nip assoc-size , \ drop-locals , ] 2tri
|
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
: shuffle(
|
: shuffle(
|
||||||
|
|
Loading…
Reference in New Issue