exile roll and -roll to basis/shuffle and mark them deprecated

Joe Groff 2009-10-30 17:11:45 -05:00
parent 967d70df35
commit eecef661cf
11 changed files with 22 additions and 26 deletions

View File

@ -4,7 +4,7 @@ USING: accessors cpu.architecture vocabs.loader system
sequences namespaces parser kernel kernel.private classes sequences namespaces parser kernel kernel.private classes
classes.private arrays hashtables vectors classes.tuple sbufs classes.private arrays hashtables vectors classes.tuple sbufs
hashtables.private sequences.private math classes.tuple.private hashtables.private sequences.private math classes.tuple.private
growable namespaces.private assocs words command-line vocabs io growable namespaces.private shuffle assocs words command-line vocabs io
io.encodings.string libc splitting math.parser memory compiler.units io.encodings.string libc splitting math.parser memory compiler.units
math.order quotations quotations.private assocs.private ; math.order quotations quotations.private assocs.private ;
FROM: compiler => enable-optimizer ; FROM: compiler => enable-optimizer ;

View File

@ -4,7 +4,7 @@ sbufs strings tools.test vectors words sequences.private
quotations classes classes.algebra classes.tuple.private quotations classes classes.algebra classes.tuple.private
continuations growable namespaces hints alien.accessors continuations growable namespaces hints alien.accessors
compiler.tree.builder compiler.tree.optimizer sequences.deep compiler.tree.builder compiler.tree.optimizer sequences.deep
compiler definitions generic.single ; compiler definitions generic.single shuffle ;
IN: compiler.tests.optimizer IN: compiler.tests.optimizer
GENERIC: xyz ( obj -- obj ) GENERIC: xyz ( obj -- obj )
@ -446,4 +446,4 @@ M: object bad-dispatch-position-test* ;
[ 1024 bignum ] [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class ] unit-test [ 1024 bignum ] [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class ] unit-test
! Not sure if I want to fix this... ! Not sure if I want to fix this...
! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with ! [ t [ [ f ] [ 3 ] if >fixnum ] compile-call ] [ no-method? ] must-fail-with

View File

@ -6,7 +6,7 @@ compiler.tree.tuple-unboxing compiler.tree.debugger
compiler.tree.recursive compiler.tree.normalization compiler.tree.recursive compiler.tree.normalization
compiler.tree.checker tools.test kernel math stack-checker.state compiler.tree.checker tools.test kernel math stack-checker.state
accessors combinators io prettyprint words sequences.deep accessors combinators io prettyprint words sequences.deep
sequences.private arrays classes kernel.private ; sequences.private arrays classes kernel.private shuffle ;
IN: compiler.tree.dead-code.tests IN: compiler.tree.dead-code.tests
: count-live-values ( quot -- n ) : count-live-values ( quot -- n )

View File

@ -0,0 +1,5 @@
USING: help.markup help.syntax ;
IN: shuffle
HELP: roll $complex-shuffle ;
HELP: -roll $complex-shuffle ;

View File

@ -1,5 +1,10 @@
USING: shuffle tools.test ; USING: shuffle tools.test ;
IN: shuffle.tests
[ 1 2 3 4 ] [ 3 4 1 2 2swap ] unit-test [ 1 2 3 4 ] [ 3 4 1 2 2swap ] unit-test
[ 4 2 3 ] [ 1 2 3 4 shuffle( a b c d -- d b c ) ] unit-test [ 4 2 3 ] [ 1 2 3 4 shuffle( a b c d -- d b c ) ] unit-test
[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
[ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test

View File

@ -22,6 +22,10 @@ MACRO: shuffle-effect ( effect -- )
SYNTAX: shuffle( SYNTAX: shuffle(
")" parse-effect suffix! \ shuffle-effect suffix! ; ")" parse-effect suffix! \ shuffle-effect suffix! ;
: roll ( x y z t -- y z t x ) [ rot ] dip swap ; inline deprecated
: -roll ( x y z t -- t x y z ) swap [ -rot ] dip ; inline deprecated
: 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline
: 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline

View File

@ -27,8 +27,6 @@ HELP: -rot ( x y z -- z x y ) $complex-shuffle ;
HELP: dupd ( x y -- x x y ) $complex-shuffle ; HELP: dupd ( x y -- x x y ) $complex-shuffle ;
HELP: swapd ( x y z -- y x z ) $complex-shuffle ; HELP: swapd ( x y z -- y x z ) $complex-shuffle ;
HELP: tuck ( x y -- y x y ) $complex-shuffle ; HELP: tuck ( x y -- y x y ) $complex-shuffle ;
HELP: roll $complex-shuffle ;
HELP: -roll $complex-shuffle ;
HELP: datastack ( -- ds ) HELP: datastack ( -- ds )
{ $values { "ds" array } } { $values { "ds" array } }
@ -280,11 +278,6 @@ HELP: 3bi
"[ p ] [ q ] 3bi" "[ p ] [ q ] 3bi"
"3dup p q" "3dup p q"
} }
"If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y z -- w )" } ", then the following two lines are equivalent:"
{ $code
"[ p ] [ q ] 3bi"
"3dup p -roll q"
}
"In general, the following two lines are equivalent:" "In general, the following two lines are equivalent:"
{ $code { $code
"[ p ] [ q ] 3bi" "[ p ] [ q ] 3bi"
@ -835,8 +828,6 @@ $nl
swapd swapd
rot rot
-rot -rot
roll
-roll
spin spin
} ; } ;

View File

@ -48,9 +48,6 @@ IN: kernel.tests
[ -7 <byte-array> ] must-fail [ -7 <byte-array> ] must-fail
[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
[ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test
[ 3 ] [ t 3 and ] unit-test [ 3 ] [ t 3 and ] unit-test
[ f ] [ f 3 and ] unit-test [ f ] [ f 3 and ] unit-test
[ f ] [ 3 f and ] unit-test [ f ] [ 3 f and ] unit-test

View File

@ -10,10 +10,6 @@ DEFER: 3dip
! Stack stuff ! Stack stuff
: spin ( x y z -- z y x ) swap rot ; inline : spin ( x y z -- z y x ) swap rot ; inline
: roll ( x y z t -- y z t x ) [ rot ] dip swap ; inline
: -roll ( x y z t -- t x y z ) swap [ -rot ] dip ; inline
: 2over ( x y z -- x y z x y ) pick pick ; inline : 2over ( x y z -- x y z x y ) pick pick ; inline
: clear ( -- ) { } set-datastack ; : clear ( -- ) { } set-datastack ;
@ -63,9 +59,9 @@ DEFER: if
: dip ( x quot -- x ) swap [ call ] dip ; : dip ( x quot -- x ) swap [ call ] dip ;
: 2dip ( x y quot -- x y ) -rot [ call ] 2dip ; : 2dip ( x y quot -- x y ) swap [ dip ] dip ;
: 3dip ( x y z quot -- x y z ) -roll [ call ] 3dip ; : 3dip ( x y z quot -- x y z ) swap [ 2dip ] dip ;
: 4dip ( w x y z quot -- w x y z ) swap [ 3dip ] dip ; inline : 4dip ( w x y z quot -- w x y z ) swap [ 3dip ] dip ; inline

View File

@ -10,7 +10,6 @@ IN: reports.noise
: badness ( word -- n ) : badness ( word -- n )
H{ H{
{ -nrot 5 } { -nrot 5 }
{ -roll 4 }
{ -rot 3 } { -rot 3 }
{ bi@ 1 } { bi@ 1 }
{ 2curry 1 } { 2curry 1 }
@ -54,7 +53,6 @@ IN: reports.noise
{ nwith 4 } { nwith 4 }
{ over 2 } { over 2 }
{ pick 4 } { pick 4 }
{ roll 4 }
{ rot 3 } { rot 3 }
{ spin 3 } { spin 3 }
{ swap 1 } { swap 1 }

View File

@ -2,7 +2,7 @@ USING: accessors arrays combinators.short-circuit grouping kernel lists
lists.lazy locals math math.functions math.parser math.ranges lists.lazy locals math math.functions math.parser math.ranges
models.product monads random sequences sets ui ui.gadgets.controls models.product monads random sequences sets ui ui.gadgets.controls
ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
ui.gadgets.labels ; ui.gadgets.labels shuffle ;
IN: sudokus IN: sudokus
: row ( index -- row ) 1 + 9 / ceiling ; : row ( index -- row ) 1 + 9 / ceiling ;
@ -37,4 +37,4 @@ IN: sudokus
] with-self , ] <vbox> { 280 220 } >>pref-dim ] with-self , ] <vbox> { 280 220 } >>pref-dim
"Sudoku Sleuth" open-window ] with-ui ; "Sudoku Sleuth" open-window ] with-ui ;
MAIN: do-sudoku MAIN: do-sudoku