Merge OneEyed's patch

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

diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index 92146755d9db30cb2060510961b220340a825a00..65cb6541f422a4e84880869959242e95355f3c3e 100644 (file)
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -18,7 +18,7 @@ GENERIC: heap-size ( heap -- n )
 TUPLE: heap data ;
 
 : <heap> ( class -- heap )
-    >r V{ } clone r> boa ; inline
+    [ V{ } clone ] dip boa ; inline
 
 TUPLE: entry value key heap index ;
 
@@ -52,16 +52,16 @@ M: heap heap-size ( heap -- n )
     data>> nth-unsafe ; inline
 
 : up-value ( n heap -- entry )
-    >r up r> data-nth ; inline
+    [ up ] dip data-nth ; inline
 
 : left-value ( n heap -- entry )
-    >r left r> data-nth ; inline
+    [ left ] dip data-nth ; inline
 
 : right-value ( n heap -- entry )
-    >r right r> data-nth ; inline
+    [ right ] dip data-nth ; inline
 
 : data-set-nth ( entry n heap -- )
-    >r [ >>index drop ] 2keep r>
+    [ [ >>index drop ] 2keep ] dip
     data>> set-nth-unsafe ; inline
 
 : data-push ( entry heap -- n )
@@ -82,12 +82,13 @@ M: heap heap-size ( heap -- n )
     data>> first ; inline
 
 : data-exchange ( m n heap -- )
-    [ tuck data-nth >r data-nth r> ] 3keep
-    tuck >r >r data-set-nth r> r> data-set-nth ; inline
+    [ [ data-nth ] curry bi@ ]
+    [ [ data-set-nth ] curry bi@ ] 3bi ; inline
 
 GENERIC: heap-compare ( pair1 pair2 heap -- ? )
 
-: (heap-compare) drop [ key>> ] compare ; inline
+: (heap-compare) ( pair1 pair2 heap -- <=> )
+    drop [ key>> ] compare ; inline
 
 M: min-heap heap-compare (heap-compare) +gt+ eq? ;
 
@@ -97,10 +98,10 @@ M: max-heap heap-compare (heap-compare) +lt+ eq? ;
     heap-size >= ; inline
 
 : left-bounds-check? ( m heap -- ? )
-    >r left r> heap-bounds-check? ; inline
+    [ left ] dip heap-bounds-check? ; inline
 
 : right-bounds-check? ( m heap -- ? )
-    >r right r> heap-bounds-check? ; inline
+    [ right ] dip heap-bounds-check? ; inline
 
 : continue? ( m up[m] heap -- ? )
     [ data-nth swap ] keep [ data-nth ] keep
@@ -109,7 +110,7 @@ M: max-heap heap-compare (heap-compare) +lt+ eq? ;
 DEFER: up-heap
 
 : (up-heap) ( n heap -- )
-    >r dup up r>
+    [ dup up ] dip
     3dup continue? [
         [ data-exchange ] 2keep up-heap
     ] [
@@ -121,7 +122,7 @@ DEFER: up-heap
 
 : (child) ( m heap -- n )
     2dup right-value
-    >r 2dup left-value r>
+    [ 2dup left-value ] dip
     rot heap-compare
     [ right ] [ left ] if ;
 
@@ -189,7 +190,7 @@ 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 ;
 
 : slurp-heap ( heap quot: ( elt -- ) -- )
     over heap-empty? [ 2drop ] [