heaps: cleanup some code, faster heap-compare.

diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index 6193d9fa2c41afaa4a79c59b4c8ba580cbc6e517..db275b0741cd8cba89c38cc10eae39c94bb03d11 100644 (file)
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -64,14 +64,15 @@ M: heap heap-size ( heap -- n )
     [ right ] dip data-nth ; inline
 
 : data-set-nth ( entry n heap -- )
-    [ [ >>index drop ] [ ] 2bi ] dip
+    [ [ swap index<< ] 2keep ] dip
     data>> set-nth-unsafe ; inline
 
 : data-push ( entry heap -- n )
     dup heap-size [
-        swap 2dup data>> ensure 2drop data-set-nth
-    ] [
-    ] bi ; inline
+        swap
+        [ data>> ensure 2drop ]
+        [ data-set-nth ] 2bi
+    ] keep ; inline
 
 : data-first ( heap -- entry )
     data>> first ; inline
@@ -82,12 +83,12 @@ M: heap heap-size ( heap -- n )
 
 GENERIC: heap-compare ( entry1 entry2 heap -- ? )
 
-: (heap-compare) ( entry1 entry2 heap -- <=> )
-    drop [ key>> ] compare ; inline
+: entry<=> ( entry1 entry2 -- <=> )
+    { entry entry } declare [ key>> ] compare ; inline
 
-M: min-heap heap-compare (heap-compare) +gt+ eq? ;
+M: min-heap heap-compare drop entry<=> +gt+ eq? ;
 
-M: max-heap heap-compare (heap-compare) +lt+ eq? ;
+M: max-heap heap-compare drop entry<=> +lt+ eq? ;
 
 : heap-bounds-check? ( m heap -- ? )
     heap-size >= ; inline
@@ -135,12 +136,13 @@ DEFER: down-heap
     ] if ; inline recursive
 
 : down-heap ( m heap -- )
-    2dup left-bounds-check? [ 2drop ] [ (down-heap) ] if ; inline recursive
+    2dup left-bounds-check?
+    [ 2drop ] [ (down-heap) ] if ; inline recursive
 
 PRIVATE>
 
 M: heap heap-push* ( value key heap -- entry )
-    [ <entry> dup ] [ data-push ] [ ] tri up-heap ;
+    [ <entry> dup ] [ data-push ] [ up-heap ] tri ;
 
 : heap-push ( value key heap -- ) heap-push* drop ;
 
@@ -163,22 +165,20 @@ M: bad-heap-delete summary
     index>> { fixnum } declare ; inline
 
 M: heap heap-delete ( entry heap -- )
-    [ entry>index ] [ ] bi
+    [ entry>index ] keep
     2dup heap-size 1 - = [
         nip data>> pop*
     ] [
         [ nip data>> pop ]
         [ data-set-nth ]
-        [ ] 2tri
-        down-heap
+        [ down-heap ] 2tri
     ] if ;
 
 M: heap heap-pop* ( heap -- )
     [ data-first ] keep heap-delete ;
 
 M: heap heap-pop ( heap -- value key )
-    [ data-first ] keep
-    [ heap-delete ] [ drop ] 2bi >entry< ;
+    [ data-first dup ] keep heap-delete >entry< ;
 
 : heap-pop-all ( heap -- alist )
     [ dup heap-empty? not ]