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 )
2array {
{ { { ?a } { } } drop }
{ { { ?a ?b } { } } 2drop }
{ { { ?a ?b ?c } { } } 3drop }
{ { { ?a } { ?a ?a } } dup }
{ { { ?a ?b } { ?a ?b ?a ?b } } 2dup }
{ { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } 3dup }
{ { { ?a ?b } { ?a ?b ?a } } over }
{ { { ?b ?a } { ?a ?b } } swap }
{ { { ?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 } { ?a } } [ ] }
{ { { ?a ?b } { ?a ?b } } [ ] }
{ { { ?a ?b ?c } { ?a ?b ?c } } [ ] }
{ { { ?a } { } } [ drop ] }
{ { { ?a ?b } { } } [ 2drop ] }
{ { { ?a ?b ?c } { } } [ 3drop ] }
{ { { ?a } { ?a ?a } } [ dup ] }
{ { { ?a ?b } { ?a ?b ?a ?b } } [ 2dup ] }
{ { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } [ 3dup ] }
{ { { ?a ?b } { ?a ?b ?a } } [ over ] }
{ { { ?b ?a } { ?a ?b } } [ swap ] }
{ { { ?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 }
} match-choose ;
M: #shuffle node>quot
dup [ in-d>> ] [ out-d>> ] bi pretty-shuffle
[ , ] [ >r drop t r> ] if*
[ % ] [ >r drop t r> ] if*
dup effect-str "#shuffle: " prepend comment, ;
: pushed-literals ( node -- seq )