let the unique heap retain hashtable entries after elements are popped to ensure...

diff --git a/extra/assoc-heaps/assoc-heaps-docs.factor b/extra/assoc-heaps/assoc-heaps-docs.factor
index 6a80bcc6c62a752295a9c8fc7395718daec65d82..8beaf9c4b1525dcf27096fc25cfe72f6dd8f3808 100644 (file)
--- a/extra/assoc-heaps/assoc-heaps-docs.factor
+++ b/extra/assoc-heaps/assoc-heaps-docs.factor
@@ -10,16 +10,17 @@ HELP: <unique-max-heap>
 { $values
     
      { "unique-heap" assoc-heap } }
-{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap." } ;
+{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
 
 HELP: <unique-min-heap>
 { $values
-    
      { "unique-heap" assoc-heap } }
-{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap." } ;
+{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;
+
+{ <unique-max-heap> <unique-min-heap> } related-words
 
 HELP: assoc-heap
-{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap should update both the assoc and the heap." } ;
+{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap may update both the assoc and the heap or leave them out of sync if it's advantageous." } ;
 
 ARTICLE: "assoc-heaps" "Associative heaps"
 "The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl

diff --git a/extra/assoc-heaps/assoc-heaps.factor b/extra/assoc-heaps/assoc-heaps.factor
index d2154002b90a54902d42bccaa40c7db1b4bd8855..a495aed62634319a9f43f871f4d7961c47737920 100644 (file)
--- a/extra/assoc-heaps/assoc-heaps.factor
+++ b/extra/assoc-heaps/assoc-heaps.factor
@@ -21,8 +21,7 @@ M: assoc-heap heap-push* ( value key assoc-heap -- entry )
     ] if ;
 
 M: assoc-heap heap-pop ( assoc-heap -- value key )
-    [ heap>> heap-pop ] keep
-    [ over ] dip assoc>> delete-at ;
+    heap>> heap-pop ;
 
 M: assoc-heap heap-peek ( assoc-heap -- value key )
     heap>> heap-peek ;

diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor
index 90326d21cd325241e8cd95775dc552a9695d0b88..fb7757d4481fac396970055681b82ff0c7d33afe 100644 (file)
--- a/extra/spider/spider.factor
+++ b/extra/spider/spider.factor
@@ -8,7 +8,7 @@ combinators.short-circuit continuations calendar prettyprint ;
 IN: spider
 
 TUPLE: spider base count max-count sleep max-depth initial-links
-filters spidered todo nonmatching ;
+filters spidered todo nonmatching quiet ;
 ! secure? agent page-timeout data-timeout overall-timeout
 
 TUPLE: spider-result url depth headers fetch-time parsed-html
@@ -27,19 +27,19 @@ links processing-time timestamp ;
 
 <PRIVATE
 
+: relative-url? ( url -- ? ) protocol>> not ;
+
 : apply-filters ( links spider -- links' )
     filters>> [ '[ _ 1&& ] filter ] when* ;
 
+: push-links ( links level assoc-heap -- )
+    '[ _ _ heap-push ] each ;
+
 : add-todo ( links level spider -- )
-    tuck [ apply-filters ] 2dip
-    tuck
-    [ spidered>> keys diff ]
-    [ todo>> ] 2bi* '[ _ _ heap-push ] each ;
+    todo>> push-links ;
 
 : add-nonmatching ( links level spider -- )
-    nonmatching>> '[ _ _ heap-push ] each ;
-
-: relative-url? ( url -- ? ) protocol>> not ;
+    nonmatching>> push-links ;
 
 : filter-base ( spider spider-result -- base-links nonmatching-links )
     [ base>> host>> ] [ links>> prune ] bi*
@@ -51,26 +51,27 @@ links processing-time timestamp ;
     [ filter-base ] 2keep
     depth>> 1+ swap
     [ add-nonmatching ]
-    [ add-todo ] 2bi ;
-
-: print-spidering ( url depth -- )
-    "depth: " write number>string write
-    ", spidering: " write . yield ;
+    [ tuck [ apply-filters ] 2dip add-todo ] 2bi ;
 
 : normalize-hrefs ( links -- links' )
     [ >url ] map
     spider get base>> swap [ derive-url ] with map ;
 
+: print-spidering ( url depth -- )
+    "depth: " write number>string write
+    ", spidering: " write . yield ;
+
 : (spider-page) ( url depth -- spider-result )
-    2dup print-spidering
     f pick spider get spidered>> set-at
     over '[ _ http-get ] benchmark swap
     [ parse-html dup find-hrefs normalize-hrefs ] benchmark
     now spider-result boa
-    dup describe ;
 
 : spider-page ( url depth -- )
-    (spider-page) spider get swap add-spidered ;
+    spider get quiet>> [ 2dup print-spidering ] unless
+    (spider-page)
+    spider get [ quiet>> [ dup describe ] unless ]
+    [ swap add-spidered ] bi ;
 
 \ spider-page ERROR add-error-logging