basis: use lint.vocabs tool to trim using lists

[factor.git] / basis / heaps / heaps.factor

diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index ab8dc1d68f8b5db77b7e9e856d3d70fb0cd2d5d6..2c6d4c8102b06ebf247a540cdfb92b7d2ba6a31d 100644 (file)
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Ryan Murphy, Doug Coleman,
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs fry kernel kernel.private locals
+USING: accessors arrays assocs fry kernel kernel.private
 math math.order math.private sequences sequences.private summary
 vectors ;
 IN: heaps
@@ -35,11 +35,9 @@ TUPLE: max-heap < heap ;
 
 : <max-heap> ( -- max-heap ) max-heap <heap> ;
 
-M: heap heap-empty? ( heap -- ? )
-    data>> empty? ; inline
+M: heap heap-empty? data>> empty? ; inline
 
-M: heap heap-size ( heap -- n )
-    data>> length ; inline
+M: heap heap-size data>> length ; inline
 
 <PRIVATE
 
@@ -75,11 +73,15 @@ PRIVATE>
 : >entry< ( entry -- value key )
     [ value>> ] [ key>> ] bi ; inline
 
-M: heap heap-peek ( heap -- value key )
+M: heap heap-peek
     data>> first >entry< ;
 
 <PRIVATE
 
+! names and optimizations inspired by cpython/Lib/heapq.py,
+! refer to it from in depth explanations of the optimizations.
+
+! called bubble-up in the literature... but we keep cpython's name.
 :: sift-down ( heap from to -- )
     heap data>>      :> data
     to data data-nth :> tmp
@@ -109,6 +111,11 @@ M: heap heap-push*
 
 <PRIVATE
 
+! called bubble-down in the literature... but we keep cpython's name.
+! A quote from cpython's implementation:
+! > We *could* break out of the loop as soon as we find a pos where newitem <=
+! > both its children, but turns out that's not a good idea [...]
+! Indeed the code is 33% slower if we remove this optimization.
 :: sift-up ( heap n -- )
     heap data>>     :> data
     data length     :> end
@@ -130,11 +137,8 @@ M: heap heap-push*
 PRIVATE>
 
 M: heap heap-pop*
-    dup data>> dup length 1 > [
-        [ first f >>index drop ] [ pop ] [ set-first ] tri 0 sift-up
-    ] [
-        pop f >>index 2drop
-    ] if ; inline
+    dup data>> f over first index<< [ pop ] keep
+    [ 2drop ] [ set-first 0 sift-up ] if-empty ;
 
 : heap-pop ( heap -- value key )
     [ heap-peek ] [ heap-pop* ] bi ;
@@ -161,15 +165,16 @@ M: bad-heap-delete summary
 
 PRIVATE>
 
-M: heap heap-delete
-    [ entry>index ] [ f rot index<< ] 2bi
-    2dup heap-size 1 - = [
-        nip data>> pop*
-    ] [
-        [ nip data>> pop ]
-        [ data>> data-set-nth ]
-        [ swap sift-up ] 2tri
-    ] if ;
+M:: heap heap-delete ( entry heap -- )
+    entry heap entry>index :> n
+    heap data>>            :> data
+    data pop               :> nth-entry
+    f entry index<<
+    n data length = [
+        nth-entry n data data-set-nth
+        n 0 = [ t ] [ nth-entry n up data data-nth heap heap-compare ] if
+        [ heap n sift-up ] [ heap 0 n sift-down ] if
+    ] unless ;
 
 : >min-heap ( assoc -- min-heap )
     dup assoc-size <vector> min-heap boa