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`.
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
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 )
: 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*
] [