diff --git a/basis/heaps/heaps-docs.factor b/basis/heaps/heaps-docs.factor index 90298c6edf..3c1c61faec 100755 --- a/basis/heaps/heaps-docs.factor +++ b/basis/heaps/heaps-docs.factor @@ -29,10 +29,8 @@ $nl { $subsection heap-pop* } { $subsection heap-pop } { $subsection heap-delete } -$nl "Processing heaps:" -{ $subsection slurp-heap } -{ $subsection slurp-heap-when } ; +{ $subsection slurp-heap } ; ABOUT: "heaps" @@ -91,8 +89,3 @@ HELP: slurp-heap { $values { "heap" "a heap" } { "quot" quotation } } { $description "Removes values from a heap and processes them with the quotation until the heap is empty." } ; - -HELP: slurp-heap-when -{ $values - { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } } -{ $description "Removes values from a heap that match the predicate quotation " { $snippet "quot1" } " and processes them with " { $snippet "quot2" } " until the predicate quotation no longer matches." } ; diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor index 50aad826f5..6c387632ed 100755 --- a/basis/heaps/heaps.factor +++ b/basis/heaps/heaps.factor @@ -195,9 +195,3 @@ M: heap heap-pop ( heap -- value key ) over heap-empty? [ 2drop ] [ [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi ] if ; inline recursive - -: slurp-heap-when ( heap quot1 quot2: ( value key -- ) -- ) - pick heap-empty? [ 3drop ] [ - [ [ heap-pop dup ] 2dip slip [ t ] compose [ 2drop f ] if ] - [ roll [ slurp-heap-when ] [ 3drop ] if ] 3bi - ] if ; inline recursive diff --git a/extra/spider/spider-docs.factor b/extra/spider/spider-docs.factor index 27238e4f19..458c1d14d8 100644 --- a/extra/spider/spider-docs.factor +++ b/extra/spider/spider-docs.factor @@ -22,6 +22,11 @@ HELP: spider HELP: spider-result { $description "" } ; +HELP: slurp-heap-when +{ $values + { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } } +{ $description "Removes values from a heap that match the predicate quotation " { $snippet "quot1" } " and processes them with " { $snippet "quot2" } " until the predicate quotation no longer matches." } ; + ARTICLE: "spider-tutorial" "Spider tutorial" "To create a new spider, call the " { $link } " word with a link to the site you wish to spider." { $code <" "http://concatentative.org" "> } diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index fb7757d448..fa1cd2ac0f 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -82,6 +82,12 @@ links processing-time timestamp ; [ initial-links>> normalize-hrefs 0 ] keep [ add-todo ] keep ; +: slurp-heap-when ( heap quot1 quot2: ( value key -- ) -- ) + pick heap-empty? [ 3drop ] [ + [ [ heap-pop dup ] 2dip slip [ t ] compose [ 2drop f ] if ] + [ roll [ slurp-heap-when ] [ 3drop ] if ] 3bi + ] if ; inline recursive + PRIVATE> : run-spider ( spider -- spider ) diff --git a/extra/suffix-arrays/suffix-arrays.factor b/extra/suffix-arrays/suffix-arrays.factor index 719496243c..b181ba9d60 100755 --- a/extra/suffix-arrays/suffix-arrays.factor +++ b/extra/suffix-arrays/suffix-arrays.factor @@ -22,10 +22,9 @@ IN: suffix-arrays : ( from/f to/f seq -- slice ) [ tuck - [ drop [ 0 ] unless* ] - [ dupd length ? ] 2bi* + [ drop 0 or ] [ length or ] 2bi* [ min ] keep - ] keep ; + ] keep ; inline PRIVATE> @@ -35,6 +34,6 @@ PRIVATE> : SA{ \ } [ >suffix-array ] parse-literal ; parsing : query ( begin suffix-array -- matches ) - 2dup find-index + 2dup find-index dup [ -rot [ from-to ] keep [ seq>> ] map prune ] - [ 2drop { } ] if* ; + [ 3drop { } ] if ;