diff --git a/extra/persistent-heaps/persistent-heaps.factor b/extra/persistent-heaps/persistent-heaps.factor index 5b57898da0..e7e8213a4a 100644 --- a/extra/persistent-heaps/persistent-heaps.factor +++ b/extra/persistent-heaps/persistent-heaps.factor @@ -1,4 +1,4 @@ -USING: kernel accessors multi-methods locals combinators math arrays +USING: kernel accessors locals combinators math arrays assocs namespaces sequences ; IN: persistent-heaps ! These are minheaps @@ -36,14 +36,15 @@ PRIVATE> GENERIC: sift-down ( value prio left right -- heap ) -METHOD: sift-down { empty-heap empty-heap } ; - -METHOD: sift-down { singleton-heap empty-heap } +: sift-singleton ( value prio left right -- heap ) 3dup drop prio>> <= [ ] [ drop -rot [ [ value>> ] [ prio>> ] bi ] 2dip ] if ; +M: empty-heap sift-down + over empty-heap? [ ] [ sift-singleton ] if ; + :: reroot-left ( value prio left right -- heap ) left value>> left prio>> value prio left left>> left right>> sift-down @@ -54,7 +55,7 @@ METHOD: sift-down { singleton-heap empty-heap } value prio right left>> right right>> sift-down ; -METHOD: sift-down { branch branch } +M: branch sift-down 3dup [ prio>> <= ] both-with? [ ] [ 2dup [ prio>> ] bi@ <= [ reroot-left ] [ reroot-right ] if ] if ;