steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move heap-slurp-when to spider

db4
Slava Pestov 2008-10-01 20:54:58 -05:00
parent 0b57ce6c52
commit 4ce980b9ac
4 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/heaps/heaps-docs.factor
View File

@ -91,8 +91,3 @@ HELP: slurp-heap
{ $values { $values
{ "heap" "a heap" } { "quot" quotation } } { "heap" "a heap" } { "quot" quotation } }
{ $description "Removes values from a heap and processes them with the quotation until the heap is empty." } ; { $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." } ;

6
basis/heaps/heaps.factor
View File

@ -195,9 +195,3 @@ M: heap heap-pop ( heap -- value key )
over heap-empty? [ 2drop ] [ over heap-empty? [ 2drop ] [
[ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi
] if ; inline recursive ] 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

5
extra/spider/spider-docs.factor
View File

@ -22,6 +22,11 @@ HELP: spider
HELP: spider-result HELP: spider-result
{ $description "" } ; { $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" ARTICLE: "spider-tutorial" "Spider tutorial"
"To create a new spider, call the " { $link <spider> } " word with a link to the site you wish to spider." "To create a new spider, call the " { $link <spider> } " word with a link to the site you wish to spider."
{ $code <" "http://concatentative.org" <spider> "> } { $code <" "http://concatentative.org" <spider> "> }

6
extra/spider/spider.factor
View File

@ -81,6 +81,12 @@ links processing-time timestamp ;
[ initial-links>> normalize-hrefs 0 ] keep [ initial-links>> normalize-hrefs 0 ] keep
[ add-todo ] 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> PRIVATE>
: run-spider ( spider -- spider ) : run-spider ( spider -- spider )