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

sorting: simplify l-next, r-next.

factor-shell
John Benediktsson 2018-01-22 11:45:54 -08:00
parent 2b31e95270
commit 32584c5335
1 changed files with 4 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
core/sorting/sorting.factor
View File

@ -41,20 +41,18 @@ TUPLE: merge-state
push-all-unsafe ; inline push-all-unsafe ; inline
: l-next ( merge -- ) : l-next ( merge -- )
[ [ l-elt ] [ [ 1 + ] change-from1 drop ] bi ] [ accum>> ] bi [ l-elt ] [ [ 1 + ] change-from1 accum>> ] bi push-unsafe ; inline
push-unsafe ; inline
: r-next ( merge -- ) : r-next ( merge -- )
[ [ r-elt ] [ [ 1 + ] change-from2 drop ] bi ] [ accum>> ] bi [ r-elt ] [ [ 1 + ] change-from2 accum>> ] bi push-unsafe ; inline
push-unsafe ; inline
: decide ( merge quot: ( elt1 elt2 -- <=> ) -- ? ) : decide? ( merge quot: ( elt1 elt2 -- <=> ) -- ? )
[ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline [ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline
: (merge) ( merge quot: ( elt1 elt2 -- <=> ) -- ) : (merge) ( merge quot: ( elt1 elt2 -- <=> ) -- )
over r-done? [ drop dump-l ] [ over r-done? [ drop dump-l ] [
over l-done? [ drop dump-r ] [ over l-done? [ drop dump-r ] [
2dup decide 2dup decide?
[ over r-next ] [ over l-next ] if [ over r-next ] [ over l-next ] if
(merge) (merge)
] if ] if