sorting: simplify l-next, r-next.
parent
2b31e95270
commit
32584c5335
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue