Merge OneEyed's patch

[factor.git] / core / sorting / sorting.factor

diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index 47399b61767940882bfa83bc17878c441811e669..30ecb70ed9f4335219bf05445411b01eb37459da 100644 (file)
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -42,15 +42,28 @@ TUPLE: merge
         ] if
     ] if ; inline
 
-: l-elt   [ from1>> ] [ seq>> ] bi nth-unsafe ; inline
-: r-elt   [ from2>> ] [ seq>> ] bi nth-unsafe ; inline
-: l-done? [ from1>> ] [ to1>> ] bi number= ; inline
-: r-done? [ from2>> ] [ to2>> ] bi number= ; inline
-: dump-l  [ [ from1>> ] [ to1>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
-: dump-r  [ [ from2>> ] [ to2>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
-: l-next  [ [ l-elt ] [ [ 1+ ] change-from1 drop ] bi ] [ accum>> ] bi push ; inline
-: r-next  [ [ r-elt ] [ [ 1+ ] change-from2 drop ] bi ] [ accum>> ] bi push ; inline
-: decide  [ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline
+: l-elt ( merge -- elt ) [ from1>> ] [ seq>> ] bi nth-unsafe ; inline
+
+: r-elt ( merge -- elt ) [ from2>> ] [ seq>> ] bi nth-unsafe ; inline
+
+: l-done? ( merge -- ? ) [ from1>> ] [ to1>> ] bi eq? ; inline
+
+: r-done? ( merge -- ? ) [ from2>> ] [ to2>> ] bi eq? ; inline
+
+: dump-l ( merge -- )
+    [ [ from1>> ] [ to1>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
+
+: dump-r ( merge -- )
+    [ [ from2>> ] [ to2>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
+
+: l-next ( merge -- )
+    [ [ l-elt ] [ [ 1+ ] change-from1 drop ] bi ] [ accum>> ] bi push ; inline
+
+: r-next ( merge -- )
+    [ [ r-elt ] [ [ 1+ ] change-from2 drop ] bi ] [ accum>> ] bi push ; inline
+
+: decide ( merge -- ? )
+    [ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline
 
 : (merge) ( merge quot: ( elt1 elt2 -- <=> ) -- )
     over r-done? [ drop dump-l ] [
@@ -113,7 +126,7 @@ TUPLE: merge
 : sort-loop ( merge quot -- )
     [ 2 [ over seq>> length over > ] ] dip
     [ [ 1 shift 2dup ] dip sort-pass ] curry
-    [ ] while 2drop ; inline
+    while 2drop ; inline
 
 : each-pair ( seq quot -- )
     [ [ length 1+ 2/ ] keep ] dip
@@ -124,9 +137,9 @@ TUPLE: merge
         [ drop nip nth ] dip push
     ] [
         [
-            [ tuck [ nth-unsafe ] 2bi@ 2dup ] dip call +gt+ eq?
+            [ [ nth-unsafe ] curry bi@ 2dup ] dip call +gt+ eq?
             [ swap ] when
-        ] dip tuck [ push ] 2bi@
+        ] dip [ push ] curry bi@
     ] if ; inline
 
 : sort-pairs ( merge quot -- )