Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / heaps / heaps.factor

diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index aa1ebf77865cca0dc8f05a2bebbc2986156ddace..677daca69de52e85006fbfe78c9b4388248614f2 100644 (file)
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -2,7 +2,7 @@
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math sequences arrays assocs sequences.private
-growable accessors math.order summary ;
+growable accessors math.order summary vectors ;
 IN: heaps
 
 GENERIC: heap-push* ( value key heap -- entry )
@@ -15,14 +15,14 @@ GENERIC: heap-size ( heap -- n )
 
 <PRIVATE
 
-TUPLE: heap data ;
+TUPLE: heap { data vector } ;
 
 : <heap> ( class -- heap )
     [ V{ } clone ] dip boa ; inline
 
 TUPLE: entry value key heap index ;
 
-: <entry> ( value key heap -- entry ) f entry boa ;
+: <entry> ( value key heap -- entry ) f entry boa ; inline
 
 PRIVATE>
 
@@ -46,14 +46,11 @@ M: heap heap-size ( heap -- n )
 
 : right ( n -- m ) 1 shift 2 + ; inline
 
-: up ( n -- m ) 1- 2/ ; inline
+: up ( n -- m ) 1 - 2/ ; inline
 
 : data-nth ( n heap -- entry )
     data>> nth-unsafe ; inline
 
-: up-value ( n heap -- entry )
-    [ up ] dip data-nth ; inline
-
 : left-value ( n heap -- entry )
     [ left ] dip data-nth ; inline
 
@@ -75,15 +72,12 @@ M: heap heap-size ( heap -- n )
 : data-pop* ( heap -- )
     data>> pop* ; inline
 
-: data-peek ( heap -- entry )
-    data>> peek ; inline
-
 : data-first ( heap -- entry )
     data>> first ; inline
 
 : data-exchange ( m n heap -- )
-    [ tuck data-nth [ data-nth ] dip ] 3keep
-    tuck [ data-set-nth ] 2dip data-set-nth ; inline
+    [ [ data-nth ] curry bi@ ]
+    [ [ data-set-nth ] curry bi@ ] 3bi ; inline
 
 GENERIC: heap-compare ( pair1 pair2 heap -- ? )
 
@@ -115,10 +109,10 @@ DEFER: up-heap
         [ data-exchange ] 2keep up-heap
     ] [
         3drop
-    ] if ;
+    ] if ; inline recursive
 
 : up-heap ( n heap -- )
-    over 0 > [ (up-heap) ] [ 2drop ] if ;
+    over 0 > [ (up-heap) ] [ 2drop ] if ; inline recursive
 
 : (child) ( m heap -- n )
     2dup right-value
@@ -130,9 +124,6 @@ DEFER: up-heap
     2dup right-bounds-check?
     [ drop left ] [ (child) ] if ;
 
-: swap-down ( m heap -- )
-    [ child ] 2keep data-exchange ;
-
 DEFER: down-heap
 
 : (down-heap) ( m heap -- )
@@ -141,10 +132,10 @@ DEFER: down-heap
         3drop
     ] [
         [ data-exchange ] 2keep down-heap
-    ] if ;
+    ] if ; inline recursive
 
 : down-heap ( m heap -- )
-    2dup left-bounds-check? [ 2drop ] [ (down-heap) ] if ;
+    2dup left-bounds-check? [ 2drop ] [ (down-heap) ] if ; inline recursive
 
 PRIVATE>
 
@@ -157,7 +148,7 @@ M: heap heap-push* ( value key heap -- entry )
     [ swapd heap-push ] curry assoc-each ;
 
 : >entry< ( entry -- key value )
-    [ value>> ] [ key>> ] bi ;
+    [ value>> ] [ key>> ] bi ; inline
 
 M: heap heap-peek ( heap -- value key )
     data-first >entry< ;
@@ -173,7 +164,7 @@ M: bad-heap-delete summary
 
 M: heap heap-delete ( entry heap -- )
     [ entry>index ] keep
-    2dup heap-size 1- = [
+    2dup heap-size 1 - = [
         nip data-pop*
     ] [
         [ nip data-pop ] 2keep
@@ -190,7 +181,10 @@ M: heap heap-pop ( heap -- value key )
 : heap-pop-all ( heap -- alist )
     [ dup heap-empty? not ]
     [ dup heap-pop swap 2array ]
-    [ ] produce nip ;
+    produce nip ;
+
+: heap-values ( heap -- alist )
+    data>> [ value>> ] { } map-as ;
 
 : slurp-heap ( heap quot: ( elt -- ) -- )
     over heap-empty? [ 2drop ] [