sorting: 6% performance improvement using -unsafe words.

diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index 2863f7add7ff45313417deee001ff67e98a8d579..c1719f61524ec87ee529db4857453d72e3102540 100644 (file)
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -23,24 +23,13 @@ TUPLE: merge
 { from2  array-capacity }
 { to2    array-capacity } ;
 
-: dump ( from to seq accum -- )
-    #! Optimize common case where to - from = 1, 2, or 3.
-    [ 2dup swap - ] 2dip pick 1 = 
-    [ [ [ 2drop ] dip nth-unsafe ] dip push ] [
-        pick 2 = [
-            [
-                [ 2drop dup 1 + ] dip
-                [ nth-unsafe ] curry bi@
-            ] dip [ push ] curry bi@
-        ] [
-            pick 3 = [
-                [
-                    [ 2drop dup 1 + dup 1 + ] dip
-                    [ nth-unsafe ] curry tri@
-                ] dip [ push ] curry tri@
-            ] [ [ nip subseq ] dip push-all ] if
-        ] if
-    ] if ; inline
+: push-unsafe ( elt seq -- )
+    [ length ] keep
+    [ set-nth-unsafe ] [ [ 1 + ] dip length<< ] 2bi ; inline
+
+: push-all-unsafe ( from to src dst -- )
+    [ over - swap ] 2dip [ pick ] dip [ length ] keep
+    [ [ + ] dip length<< ] 2keep <copy> (copy) drop ; inline
 
 : l-elt ( merge -- elt ) [ from1>> ] [ seq>> ] bi nth-unsafe ; inline
 
@@ -51,18 +40,22 @@ TUPLE: merge
 : r-done? ( merge -- ? ) [ from2>> ] [ to2>> ] bi eq? ; inline
 
 : dump-l ( merge -- )
-    [ [ from1>> ] [ to1>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
+    [ [ from1>> ] [ to1>> ] [ seq>> ] tri ] [ accum>> ] bi
+    push-all-unsafe ; inline
 
 : dump-r ( merge -- )
-    [ [ from2>> ] [ to2>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
+    [ [ from2>> ] [ to2>> ] [ seq>> ] tri ] [ accum>> ] bi
+    push-all-unsafe ; inline
 
 : l-next ( merge -- )
-    [ [ l-elt ] [ [ 1 + ] change-from1 drop ] bi ] [ accum>> ] bi push ; inline
+    [ [ l-elt ] [ [ 1 + ] change-from1 drop ] bi ] [ accum>> ] bi
+    push-unsafe ; inline
 
 : r-next ( merge -- )
-    [ [ r-elt ] [ [ 1 + ] change-from2 drop ] bi ] [ accum>> ] bi push ; inline
+    [ [ r-elt ] [ [ 1 + ] change-from2 drop ] bi ] [ accum>> ] bi
+    push-unsafe ; inline
 
-: decide ( merge -- ? )
+: decide ( merge quot: ( elt1 elt2 -- <=> ) -- ? )
     [ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline
 
 : (merge) ( merge quot: ( elt1 elt2 -- <=> ) -- )
@@ -89,8 +82,7 @@ TUPLE: merge
         over >vector >>accum1
         swap length <vector> >>accum2
         dup accum1>> underlying>> >>seq
-        dup accum2>> >>accum
-        dup accum>> 0 >>length drop ; inline
+        dup accum2>> >>accum ; inline
 
 : compute-midpoint ( merge -- merge )
     dup [ from1>> ] [ to2>> ] bi + 2/ >>to1 ; inline
@@ -124,7 +116,7 @@ TUPLE: merge
     [ merge ] 2curry each-chunk ; inline
 
 : sort-loop ( merge quot -- )
-    [ 2 [ over seq>> length over > ] ] dip
+    [ 2 over seq>> length [ over > ] curry ] dip
     [ [ 1 shift 2dup ] dip sort-pass ] curry
     while 2drop ; inline
 
@@ -134,12 +126,12 @@ TUPLE: merge
 
 : (sort-pairs) ( i1 i2 seq quot accum -- )
     [ 2dup length = ] 2dip rot [
-        [ drop nip nth ] dip push
+        [ drop nip nth-unsafe ] dip push-unsafe
     ] [
         [
             [ [ nth-unsafe ] curry bi@ 2dup ] dip call +gt+ eq?
             [ swap ] when
-        ] dip [ push ] curry bi@
+        ] dip [ push-unsafe ] curry bi@
     ] if ; inline
 
 : sort-pairs ( merge quot -- )