Fix bugs in heap-delete

When an entry is kept to be use later with `heap-delete`, its `index`
in the owning heap is automatically updated as the entry sifts up
or down.

However, if the entry is removed from the heap via either a `heap-pop`
or a `heap-delete` operation, its index is not invalidated and
the entry can still be used later with `heap-delete` and remove the
wrong element from the heap.

This patch invalidates entries when they leave the heap by setting
their index to `f`, and check the index in `entry>index`.

basis/heaps/heaps-tests.factor

@@ -79,3 +79,31 @@ IN: heaps.tests
 11 [
     [ t ] swap [ 2^ delete-test sequence= ] curry unit-test
 ] each-integer
+
+[| |
+ <min-heap> :> heap
+ t 1 heap heap-push* :> entry
+ heap heap-pop 2drop
+ t 2 heap heap-push
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
+
+[| |
+ <min-heap> :> heap
+ t 1 heap heap-push* :> entry
+ t 2 heap heap-push
+ heap heap-pop 2drop
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
+
+[| |
+ <min-heap> :> heap
+ t 1 heap heap-push* :> entry
+ t 2 heap heap-push
+ entry heap heap-delete
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with
+
+[| |
+ <min-heap> :> heap
+ t 0 heap heap-push
+ t 1 heap heap-push* :> entry
+ entry heap heap-delete
+ entry heap heap-delete ] [ bad-heap-delete? ] must-fail-with

basis/heaps/heaps.factor

@@ -131,9 +131,9 @@ PRIVATE>
 
 M: heap heap-pop*
     dup data>> dup length 1 > [
-        [ pop ] [ set-first ] bi 0 sift-up
+        [ first f >>index drop ] [ pop ] [ set-first ] tri 0 sift-up
     ] [
-        pop* drop
+        pop f >>index 2drop
     ] if ; inline
 
 : heap-pop ( heap -- value key )
@@ -156,12 +156,13 @@ M: bad-heap-delete summary
 
 : entry>index ( entry heap -- n )
     over heap>> eq? [ bad-heap-delete ] unless
-    index>> { fixnum } declare ; inline
+    index>> dup [ bad-heap-delete ] unless
+    { fixnum } declare ; inline
 
 PRIVATE>
 
 M: heap heap-delete
-    [ entry>index ] keep
+    [ entry>index ] [ f rot index<< ] 2bi
     2dup heap-size 1 - = [
         nip data>> pop*
     ] [