 
 GENERIC: heap-compare ( entry1 entry2 heap -- ? )
 
-: (heap-compare) ( entry1 entry2 heap -- <=> )
-    drop [ key>> ] compare ; inline
-
-M: min-heap heap-compare (heap-compare) +gt+ eq? ;
-
-M: max-heap heap-compare (heap-compare) +lt+ eq? ;
+: entry<=> ( entry1 entry2 -- <=> )
+    { entry entry } declare [ key>> ] compare ; inline
+
+M: min-heap heap-compare drop entry<=> +gt+ eq? ;
+
+M: max-heap heap-compare drop entry<=> +lt+ eq? ;
 
 : heap-bounds-check? ( m heap -- ? )
     heap-size >= ; inline

    index>> { fixnum } declare ; inline

M: heap heap-delete ( entry heap -- )
    [ entry>index ] [ ] bi
    2dup heap-size 1 - = [
        nip data>> pop*
    ] [
        [ nip data>> pop ]
        [ data-set-nth ]
        [ ] 2tri
        down-heap
    ] if ;

M: heap heap-pop* ( heap -- )
    [ data-first ] keep heap-delete ;

M: heap heap-pop ( heap -- value key )
    [ data-first ] keep
    [ heap-delete ] [ drop ] 2bi >entry< ;

: heap-pop-all ( heap -- alist )
    [ dup heap-empty? not ]

    ] if ; inline recursive

: down-heap ( m heap -- )
    2dup left-bounds-check?
    [ 2drop ] [ (down-heap) ] if ; inline recursive

PRIVATE>

M: heap heap-push* ( value key heap -- entry )
    [ <entry> dup ] [ data-push ] [ up-heap ] tri ;

: heap-push ( value key heap -- ) heap-push* drop ;

