diff --git a/core/heaps/heaps-docs.factor b/core/heaps/heaps-docs.factor
old mode 100644
new mode 100755
index 3605ec519a..e912355a5c
--- a/core/heaps/heaps-docs.factor
+++ b/core/heaps/heaps-docs.factor
@@ -11,9 +11,9 @@ $nl
 { $subsection min-heap? }
 { $subsection <min-heap> }
 "Max-heaps sort their elements so that the maximum element is first:"
-{ $subsection min-heap }
-{ $subsection min-heap? }
-{ $subsection <min-heap> }
+{ $subsection max-heap }
+{ $subsection max-heap? }
+{ $subsection <max-heap> }
 "Both obey a protocol."
 $nl
 "Queries:"
@@ -22,58 +22,61 @@ $nl
 { $subsection heap-peek }
 "Insertion:"
 { $subsection heap-push }
+{ $subsection heap-push* }
 { $subsection heap-push-all }
 "Removal:"
 { $subsection heap-pop* }
-{ $subsection heap-pop } ;
+{ $subsection heap-pop }
+{ $subsection heap-delete } ;
 
 ABOUT: "heaps"
 
 HELP: <min-heap>
 { $values { "min-heap" min-heap } }
-{ $description "Create a new " { $link min-heap } "." }
-{ $see-also <max-heap> } ;
+{ $description "Create a new " { $link min-heap } "." } ;
 
 HELP: <max-heap>
 { $values { "max-heap" max-heap } }
-{ $description "Create a new " { $link max-heap } "." }
-{ $see-also <min-heap> } ;
+{ $description "Create a new " { $link max-heap } "." } ;
 
 HELP: heap-push
 { $values { "key" "a comparable object" } { "value" object } { "heap" heap } }
-{ $description "Push an pair onto a heap.  The key must be comparable with all other keys by the " { $link <=> } " generic word." }
-{ $side-effects "heap" }
-{ $see-also heap-push-all heap-pop } ;
+{ $description "Push a pair onto a heap. The key must be comparable with all other keys by the " { $link <=> } " generic word." }
+{ $side-effects "heap" } ;
+
+HELP: heap-push*
+{ $values { "key" "a comparable object" } { "value" object } { "heap" heap } { "entry" entry } }
+{ $description "Push a pair onto a heap, and output an entry which may later be passed to " { $link heap-delete } "." }
+{ $side-effects "heap" } ;
 
 HELP: heap-push-all
 { $values { "assoc" assoc } { "heap" heap } }
 { $description "Push every key/value pair of an assoc onto a heap." }
-{ $side-effects "heap" }
-{ $see-also heap-push heap-pop } ;
+{ $side-effects "heap" } ;
 
 HELP: heap-peek
 { $values { "heap" heap } { "key" object } { "value" object } }
-{ $description "Outputs the first element in the heap, leaving it in the heap." }
-{ $see-also heap-pop heap-pop* } ;
+{ $description "Output the first element in the heap, leaving it in the heap." } ;
 
 HELP: heap-pop*
 { $values { "heap" heap } }
-{ $description "Removes the first element from the heap." }
-{ $side-effects "heap" }
-{ $see-also heap-pop heap-push heap-peek } ;
+{ $description "Remove the first element from the heap." }
+{ $side-effects "heap" } ;
 
 HELP: heap-pop
 { $values { "heap" heap } { "key" object } { "value" object } }
-{ $description "Outputs the first element in the heap and removes it from the heap." }
-{ $side-effects "heap" }
-{ $see-also heap-pop* heap-push heap-peek } ;
+{ $description "Output and remove the first element in the heap." }
+{ $side-effects "heap" } ;
 
 HELP: heap-empty?
 { $values { "heap" heap } { "?" "a boolean" } }
-{ $description "Tests if a " { $link heap } " has no nodes." }
-{ $see-also heap-length heap-peek } ;
+{ $description "Tests if a " { $link heap } " has no nodes." } ;
 
-HELP: heap-length
+HELP: heap-size
 { $values { "heap" heap } { "n" integer } }
-{ $description "Returns the number of key/value pairs in the heap." }
-{ $see-also heap-empty? } ;
+{ $description "Returns the number of key/value pairs in the heap." } ;
+
+HELP: heap-delete
+{ $values { "heap" heap } { "key" object } { "value" object } }
+{ $description "Output and remove the first element in the heap." }
+{ $side-effects "heap" } ;
diff --git a/core/heaps/heaps-tests.factor b/core/heaps/heaps-tests.factor
old mode 100644
new mode 100755
index 9c7f1e9b2f..ce9a417476
--- a/core/heaps/heaps-tests.factor
+++ b/core/heaps/heaps-tests.factor
@@ -1,8 +1,8 @@
-! Copyright 2007 Ryan Murphy
+! Copyright 2007, 2008 Ryan Murphy, Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 
 USING: arrays kernel math namespaces tools.test
-heaps heaps.private ;
+heaps heaps.private math.parser random assocs sequences sorting ;
 IN: temporary
 
 [ <min-heap> heap-pop ] must-fail
@@ -15,16 +15,8 @@ IN: temporary
 
 ! Binary Min Heap
 { 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test
-{ t } [ { 5 t } { 3 t } T{ min-heap } heap-compare ] unit-test
-{ f } [ { 5 t } { 3 t } T{ max-heap } heap-compare ] unit-test
-
-[ T{ min-heap T{ heap f V{ { -6 t } { -4 t } { 2 t } { 1 t } { 5 t } { 3 t } { 2 t } { 4 t } { 3 t } { 7 t } { 6 t } { 8 t } { 3 t } { 4 t } { 4 t } { 6 t } { 5 t } { 5 t } } } } ]
-[ <min-heap> { { 3 t } { 5 t } { 4 t } { 6 t } { 7 t } { 8 t } { 2 t } { 4 t } { 3 t } { 5 t } { 6 t } { 1 t } { 3 t } { 2 t } { 4 t } { 5 t } { -6 t } { -4 t } } over heap-push-all ] unit-test
-
-[ T{ min-heap T{ heap f V{ { 5 t } { 6 t } { 6 t } { 7 t } { 8 t } } } } ] [
-    <min-heap> { { 3 t } { 5 t } { 4 t } { 6 t } { 5 t } { 7 t } { 6 t } { 8 t } } over heap-push-all
-    3 [ dup heap-pop* ] times
-] unit-test
+{ t } [ t 5 <entry> t 3 <entry> T{ min-heap } heap-compare ] unit-test
+{ f } [ t 5 <entry> t 3 <entry> T{ max-heap } heap-compare ] unit-test
 
 [ t 2 ] [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push heap-pop ] unit-test
 
@@ -32,5 +24,51 @@ IN: temporary
 
 [ t 400 ] [ <max-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push t 1 pick heap-push heap-pop ] unit-test
 
-[ 0 ] [ <max-heap> heap-length ] unit-test
-[ 1 ] [ <max-heap> t 1 pick heap-push heap-length ] unit-test
+[ 0 ] [ <max-heap> heap-size ] unit-test
+[ 1 ] [ <max-heap> t 1 pick heap-push heap-size ] unit-test
+
+: heap-sort ( alist -- keys )
+    <min-heap> [ heap-push-all ] keep heap-pop-all ;
+
+: random-alist ( n -- alist )
+    [
+        [
+            (random) dup number>string swap set
+        ] times
+    ] H{ } make-assoc ;
+
+: test-heap-sort ( n -- ? )
+    random-alist dup >alist sort-keys swap heap-sort = ;
+
+14 [
+    [ t ] swap [ 2^ test-heap-sort ] curry unit-test
+] each
+
+: test-entry-indices ( n -- ? )
+    random-alist
+    <min-heap> [ heap-push-all ] keep
+    heap-data dup length swap [ entry-index ] map sequence= ;
+
+14 [
+    [ t ] swap [ 2^ test-entry-indices ] curry unit-test
+] each
+
+: delete-random ( seq -- elt )
+    dup length random dup pick nth >r swap delete-nth r> ;
+
+: sort-entries ( entries -- entries' )
+    [ [ entry-key ] compare ] sort ;
+
+: delete-test ( n -- ? )
+    [
+        random-alist
+        <min-heap> [ heap-push-all ] keep
+        dup heap-data clone swap
+    ] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times
+    heap-data
+    [ [ entry-key ] map ] 2apply
+    [ natural-sort ] 2apply ;
+
+11 [
+    [ t ] swap [ 2^ delete-test sequence= ] curry unit-test
+] each
diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor
old mode 100644
new mode 100755
index 870346995c..64571b6990
--- a/core/heaps/heaps.factor
+++ b/core/heaps/heaps.factor
@@ -1,30 +1,30 @@
-! Copyright (C) 2007 Ryan Murphy, Doug Coleman.
+! Copyright (C) 2007, 2008 Ryan Murphy, Doug Coleman,
+! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences arrays assocs ;
+USING: kernel math sequences arrays assocs sequences.private
+growable ;
 IN: heaps
 
 MIXIN: priority-queue
 
-GENERIC: heap-push ( value key heap -- )
+GENERIC: heap-push* ( value key heap -- entry )
 GENERIC: heap-peek ( heap -- value key )
 GENERIC: heap-pop* ( heap -- )
 GENERIC: heap-pop ( heap -- value key )
-GENERIC: heap-delete ( key heap -- )
-GENERIC: heap-delete* ( key heap -- old ? )
+GENERIC: heap-delete ( entry -- )
 GENERIC: heap-empty? ( heap -- ? )
 GENERIC: heap-size ( heap -- n )
 
 <PRIVATE
 
-TUPLE: heap data ;
+: heap-data delegate ; inline
 
 : <heap> ( class -- heap )
-    >r V{ } clone heap construct-boa r>
-    construct-delegate ; inline
+    >r V{ } clone r> construct-delegate ; inline
 
 TUPLE: entry value key index ;
 
-: <entry> f entry construct-boa ;
+: <entry> ( value key -- entry ) f entry construct-boa ;
 
 PRIVATE>
 
@@ -47,44 +47,48 @@ M: priority-queue heap-size ( heap -- n )
 
 <PRIVATE
 
-: left ( n -- m ) 1 shift 1+ ; inline
+: left ( n -- m ) 1 shift 1 + ; inline
 
 : right ( n -- m ) 1 shift 2 + ; inline
 
 : up ( n -- m ) 1- 2/ ; inline
 
-: data-nth ( n heap -- obj )
-    heap-data nth ; inline
+: data-nth ( n heap -- entry )
+    heap-data nth-unsafe ; inline
 
-: up-value ( n heap -- obj )
+: up-value ( n heap -- entry )
     >r up r> data-nth ; inline
 
-: left-value ( n heap -- obj )
+: left-value ( n heap -- entry )
     >r left r> data-nth ; inline
 
-: right-value ( n heap -- obj )
+: right-value ( n heap -- entry )
     >r right r> data-nth ; inline
 
-: data-push ( obj heap -- )
-    heap-data push ; inline
+: data-set-nth ( entry n heap -- )
+    >r [ swap set-entry-index ] 2keep r>
+    heap-data set-nth-unsafe ;
 
-: data-pop ( heap -- obj )
+: data-push ( entry heap -- n )
+    dup heap-size [
+        swap 2dup heap-data ensure 2drop data-set-nth
+    ] keep ; inline
+
+: data-pop ( heap -- entry )
     heap-data pop ; inline
 
-: data-pop* ( heap -- obj )
+: data-pop* ( heap -- )
     heap-data pop* ; inline
 
-: data-peek ( heap -- obj )
+: data-peek ( heap -- entry )
     heap-data peek ; inline
 
-: data-first ( heap -- obj )
+: data-first ( heap -- entry )
     heap-data first ; inline
 
-: data-set-first ( obj heap -- )
-    heap-data set-first ; inline
-
 : data-exchange ( m n heap -- )
-    heap-data exchange ; inline
+    [ tuck data-nth >r data-nth r> ] 3keep
+    tuck >r >r data-set-nth r> r> data-set-nth ; inline
 
 GENERIC: heap-compare ( pair1 pair2 heap -- ? )
 
@@ -103,18 +107,23 @@ M: max-heap heap-compare (heap-compare) < ;
 : right-bounds-check? ( m heap -- ? )
     >r right r> heap-bounds-check? ; inline
 
-: up-heap-continue? ( m up[m] heap -- ? )
+: continue? ( m up[m] heap -- ? )
     [ data-nth swap ] keep [ data-nth ] keep
     heap-compare ; inline
 
-: up-heap ( n heap -- )
+DEFER: up-heap
+
+: (up-heap) ( n heap -- )
     >r dup up r>
-    3dup up-heap-continue? [
+    3dup continue? [
         [ data-exchange ] 2keep up-heap
     ] [
-        2drop
+        3drop
     ] if ;
 
+: up-heap ( n heap -- )
+    over 0 > [ (up-heap) ] [ 2drop ] if ;
+
 : (child) ( m heap -- n )
     2dup right-value
     >r 2dup left-value r>
@@ -122,7 +131,8 @@ M: max-heap heap-compare (heap-compare) < ;
     [ right ] [ left ] if ;
 
 : child ( m heap -- n )
-    2dup right-bounds-check? [ drop left ] [ (child) ] if ;
+    2dup right-bounds-check?
+    [ drop left ] [ (child) ] if ;
 
 : swap-down ( m heap -- )
     [ child ] 2keep data-exchange ;
@@ -130,11 +140,11 @@ M: max-heap heap-compare (heap-compare) < ;
 DEFER: down-heap
 
 : (down-heap) ( m heap -- )
-    2dup [ data-nth ] 2keep child pick
-    dupd [ data-nth swapd ] keep heap-compare [
-        -rot [ swap-down ] keep down-heap
-    ] [
+    [ child ] 2keep swapd
+    3dup continue? [
         3drop
+    ] [
+        [ data-exchange ] 2keep down-heap
     ] if ;
 
 : down-heap ( m heap -- )
@@ -142,23 +152,37 @@ DEFER: down-heap
 
 PRIVATE>
 
-M: priority-queue heap-push ( value key heap -- )
-    [ >r <heap-entry> r> data-push ] keep up-heap ;
+M: priority-queue heap-push* ( value key heap -- entry )
+    >r <entry> dup r> [ data-push ] keep up-heap ;
+
+: heap-push ( value key heap -- ) heap-push* drop ;
 
 : heap-push-all ( assoc heap -- )
     [ swapd heap-push ] curry assoc-each ;
 
-M: priority-queue heap-peek ( heap -- value key )
-    data-first { entry-value entry-key } get-slots ;
+: >entry< ( entry -- key value )
+    { entry-value entry-key } get-slots ;
 
-M: priority-queue heap-pop* ( heap -- )
-    dup heap-size 1 > [
-        [ heap-pop ] keep
-        [ set-data-first ] keep
-        0 swap down-heap
+M: priority-queue heap-peek ( heap -- value key )
+    data-first >entry< ;
+
+M: priority-queue heap-delete ( entry heap -- )
+    >r entry-index r>
+    2dup heap-size 1- = [
+        nip data-pop*
     ] [
-        data-pop*
+        [ nip data-pop ] 2keep
+        [ data-set-nth ] 2keep
+        down-heap
     ] if ;
 
+M: priority-queue heap-pop* ( heap -- )
+    dup data-first swap heap-delete ;
+
 M: priority-queue heap-pop ( heap -- value key )
-    dup heap-peek rot heap-pop* ;
+    dup data-first [ swap heap-delete ] keep >entry< ;
+
+: heap-pop-all ( heap -- alist )
+    [ dup heap-empty? not ]
+    [ dup heap-pop swap 2array ]
+    [ ] unfold nip ;