steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improve optimized-quot.

db4
Slava Pestov 2008-07-11 20:05:32 -05:00
parent 2f560ffbe0
commit 610d38720a
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
extra/optimizer/debugger/debugger.factor
View File

@ -47,24 +47,28 @@ MATCH-VARS: ?a ?b ?c ;
: pretty-shuffle ( in out -- word/f ) : pretty-shuffle ( in out -- word/f )
2array { 2array {
{ { { ?a } { } } drop } { { { ?a } { ?a } } [ ] }
{ { { ?a ?b } { } } 2drop } { { { ?a ?b } { ?a ?b } } [ ] }
{ { { ?a ?b ?c } { } } 3drop } { { { ?a ?b ?c } { ?a ?b ?c } } [ ] }
{ { { ?a } { ?a ?a } } dup } { { { ?a } { } } [ drop ] }
{ { { ?a ?b } { ?a ?b ?a ?b } } 2dup } { { { ?a ?b } { } } [ 2drop ] }
{ { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } 3dup } { { { ?a ?b ?c } { } } [ 3drop ] }
{ { { ?a ?b } { ?a ?b ?a } } over } { { { ?a } { ?a ?a } } [ dup ] }
{ { { ?b ?a } { ?a ?b } } swap } { { { ?a ?b } { ?a ?b ?a ?b } } [ 2dup ] }
{ { { ?a ?b ?c } { ?a ?b ?c ?a } } pick } { { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } [ 3dup ] }
{ { { ?a ?b ?c } { ?c ?a ?b } } -rot } { { { ?a ?b } { ?a ?b ?a } } [ over ] }
{ { { ?a ?b ?c } { ?b ?c ?a } } rot } { { { ?b ?a } { ?a ?b } } [ swap ] }
{ { { ?a ?b } { ?b } } nip } { { { ?a ?b ?c } { ?a ?b ?c ?a } } [ pick ] }
{ { { ?a ?b ?c } { ?c ?a ?b } } [ -rot ] }
{ { { ?a ?b ?c } { ?b ?c ?a } } [ rot ] }
{ { { ?a ?b } { ?b } } [ nip ] }
{ { { ?a ?b ?c } { ?c } } [ 2nip ] }
{ _ f } { _ f }
} match-choose ; } match-choose ;
M: #shuffle node>quot M: #shuffle node>quot
dup [ in-d>> ] [ out-d>> ] bi pretty-shuffle dup [ in-d>> ] [ out-d>> ] bi pretty-shuffle
[ , ] [ >r drop t r> ] if* [ % ] [ >r drop t r> ] if*
dup effect-str "#shuffle: " prepend comment, ; dup effect-str "#shuffle: " prepend comment, ;
: pushed-literals ( node -- seq ) : pushed-literals ( node -- seq )