diff --git a/extra/combinators/lib/lib-docs.factor b/extra/combinators/lib/lib-docs.factor index c88ce8d9f9..355d5647df 100755 --- a/extra/combinators/lib/lib-docs.factor +++ b/extra/combinators/lib/lib-docs.factor @@ -23,7 +23,7 @@ HELP: ndip { $example "USING: combinators.lib kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" } { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" } } -{ $see-also dip dipd } ; +{ $see-also dip 2dip } ; HELP: nslip { $values { "n" number } } diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index 54847dc8b3..200a667b6b 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -5,9 +5,6 @@ IN: combinators.lib.tests [ 5 ] [ [ 10 random ] [ 5 = ] generate ] unit-test [ t ] [ [ 10 random ] [ even? ] generate even? ] unit-test -{ 6 2 } [ 1 2 [ 5 + ] dip ] unit-test -{ 6 2 1 } [ 1 2 1 [ 5 + ] dipd ] unit-test - [ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer { 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index d4a9386649..4c4a988935 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -38,8 +38,6 @@ MACRO: napply ( n -- ) : 3apply ( obj obj obj quot -- ) 3 napply ; inline -: dipd ( x y quot -- y ) 2 ndip ; inline - : 2with ( param1 param2 obj quot -- obj curry ) with with ; inline diff --git a/extra/dns/cache/cache.factor b/extra/dns/cache/cache.factor index e497192b04..75bbf9de9d 100644 --- a/extra/dns/cache/cache.factor +++ b/extra/dns/cache/cache.factor @@ -47,15 +47,9 @@ TUPLE: entry time data ; SYMBOL: NX -: cache-nx ( query ttl -- ) - ttl->time NX entry boa - table-add ; +: cache-nx ( query ttl -- ) ttl->time NX entry boa table-add ; -: nx? ( obj -- ? ) - dup entry? - [ data>> NX = ] - [ drop f ] - if ; +: nx? ( obj -- ? ) dup entry? [ data>> NX = ] [ drop f ] if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -72,27 +66,15 @@ SYMBOL: NX ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: entry-expired? ( entry -- ? ) time>> time->ttl 0 <= ; +: expired? ( entry -- ? ) time>> time->ttl 0 <= ; : cache-get ( query -- result ) dup table-get ! query result { - { - [ dup f = ] ! not in the cache - [ 2drop f ] - } - { - [ dup entry-expired? ] ! here but expired - [ drop table-rem f ] - } - { - [ dup nx? ] ! negative result has been cached - [ 2drop NX ] - } - { - [ t ] - [ query+entry->rrs ] - } + { [ dup f = ] [ 2drop f ] } ! not in the cache + { [ dup expired? ] [ drop table-rem f ] } ! here but expired + { [ dup nx? ] [ 2drop NX ] } ! negative result cached + { [ t ] [ query+entry->rrs ] } ! good to go } cond ; @@ -114,22 +96,10 @@ SYMBOL: NX : cache-add ( query rr -- ) over table-get ! query rr entry { - { - [ dup f = ] ! not in the cache - [ drop rr->entry table-add ] - } - { - [ dup nx? ] - [ drop over table-rem rr->entry table-add ] - } - { - [ dup entry-expired? ] - [ drop rr->entry table-add ] - } - { - [ t ] - [ rot drop add-rr-to-entry ] - } + { [ dup f = ] [ drop rr->entry table-add ] } + { [ dup nx? ] [ drop over table-rem rr->entry table-add ] } + { [ dup expired? ] [ drop rr->entry table-add ] } + { [ t ] [ rot drop add-rr-to-entry ] } } cond ; diff --git a/extra/dns/resolver/resolver.factor b/extra/dns/resolver/resolver.factor index 2f77840d91..c8a9f22d08 100644 --- a/extra/dns/resolver/resolver.factor +++ b/extra/dns/resolver/resolver.factor @@ -6,6 +6,8 @@ IN: dns.resolver ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Need to cache records even in the case of name error + : cache-message ( message -- message ) dup dup rcode>> NAME-ERROR = [ diff --git a/extra/farkup/farkup-tests.factor b/extra/farkup/farkup-tests.factor index 7176486f8e..b6e46cfe7d 100755 --- a/extra/farkup/farkup-tests.factor +++ b/extra/farkup/farkup-tests.factor @@ -16,10 +16,18 @@ IN: farkup.tests [ "
**
" ] [ "\\**" convert-farkup ] unit-test [ "" ] [ "\n\n" convert-farkup ] unit-test +[ "" ] [ "\r\n\r\n" convert-farkup ] unit-test +[ "" ] [ "\r\r\r\r" convert-farkup ] unit-test +[ "\n" ] [ "\r\r\r" convert-farkup ] unit-test [ "\n" ] [ "\n\n\n" convert-farkup ] unit-test [ "foo
bar
" ] [ "foo\n\nbar" convert-farkup ] unit-test +[ "foo
bar
" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test +[ "foo
bar
" ] [ "foo\r\rbar" convert-farkup ] unit-test +[ "foo
bar
" ] [ "foo\r\r\nbar" convert-farkup ] unit-test [ "\nbar\n
" ] [ "\nbar\n" convert-farkup ] unit-test +[ "\nbar\n
" ] [ "\rbar\r" convert-farkup ] unit-test +[ "\nbar\n
" ] [ "\r\nbar\r\n" convert-farkup ] unit-test [ "foo
\nbar
" ] [ "foo\n\n\nbar" convert-farkup ] unit-test diff --git a/extra/farkup/farkup.factor b/extra/farkup/farkup.factor index 15b7b4b72c..51a5a10bd9 100755 --- a/extra/farkup/farkup.factor +++ b/extra/farkup/farkup.factor @@ -9,14 +9,14 @@ IN: farkup" swap "
" 3array ] unless @@ -163,7 +166,7 @@ PRIVATE> PEG: parse-farkup ( -- parser ) [ list , table , h1 , h2 , h3 , h4 , code , paragraph , 2nl , nl , - ] choice* repeat0 "\n" token optional 2seq ; + ] choice* repeat0 nl optional 2seq ; : write-farkup ( parse-result -- ) [ dup string? [ write ] [ drop ] if ] deep-each ; diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 42355f954e..9ce45b5c47 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -3,25 +3,27 @@ arrays shuffle unicode.case namespaces splitting http sequences.lib accessors io combinators http.client ; IN: html.parser.analyzer +TUPLE: link attributes clickable ; + : scrape-html ( url -- vector ) http-get parse-html ; : (find-relative) - [ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ; + [ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ; inline : find-relative ( seq quot n -- i elt ) >r over [ find drop ] dip r> swap pick - (find-relative) ; + (find-relative) ; inline : (find-all) ( n seq quot -- ) 2dup >r >r find-from [ dupd 2array , 1+ r> r> (find-all) ] [ r> r> 3drop - ] if* ; + ] if* ; inline : find-all ( seq quot -- alist ) - [ 0 -rot (find-all) ] { } make ; + [ 0 -rot (find-all) ] { } make ; inline : (find-nth) ( offset seq quot n count -- obj ) >r >r [ find-from ] 2keep 4 npick [ @@ -33,14 +35,14 @@ IN: html.parser.analyzer ] if ] [ 2drop r> r> 2drop - ] if ; + ] if ; inline : find-nth ( seq quot n -- i elt ) - 0 -roll 0 (find-nth) ; + 0 -roll 0 (find-nth) ; inline : find-nth-relative ( seq quot n offest -- i elt ) >r [ find-nth ] 3keep 2drop nip r> swap pick - (find-relative) ; + (find-relative) ; inline : remove-blank-text ( vector -- vector' ) [ @@ -120,9 +122,14 @@ IN: html.parser.analyzer [ [ name>> "a" = ] [ attributes>> "href" swap at ] bi and ] find-between-all ; +: ( vector -- link ) + [ first attributes>> ] + [ [ name>> { text "img" } member? ] filter ] bi + link boa ; + : link. ( vector -- ) - [ second text>> write bl ] - [ first tag-link write nl ] bi ; + [ attributes>> "href" swap at write nl ] + [ clickable>> [ bl bl text>> print ] each nl ] bi ; : find-by-text ( seq quot -- tag ) [ dup name>> text = ] prepose find drop ; @@ -136,12 +143,12 @@ IN: html.parser.analyzer : find-forms ( vector -- vector' ) "form" over find-opening-tags-by-name - over [ >r first2 r> find-between* ] curry map + swap [ >r first2 r> find-between* ] curry map [ [ name>> { "form" "input" } member? ] filter ] map ; : find-html-objects ( string vector -- vector' ) - find-opening-tags-by-name - over [ >r first2 r> find-between* ] curry map ; + [ find-opening-tags-by-name ] keep + [ >r first2 r> find-between* ] curry map ; : form-action ( vector -- string ) [ name>> "form" = ] find nip diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index 44c79fd962..cf5ff56331 100644 --- a/extra/lisp/parser/parser.factor +++ b/extra/lisp/parser/parser.factor @@ -19,7 +19,7 @@ dquote = '"' squote = "'" digit = [0-9] integer = ("-")? (digit)+ => [[ first2 append string>number ]] -float = integer "." (digit)* => [[ first3 >string [ number>string ] dipd 3append string>number ]] +float = integer "." (digit)* => [[ first3 >string [ number>string ] 2dip 3append string>number ]] rational = integer "/" (digit)+ => [[ first3 nip string>number / ]] number = float | rational diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index c3252de500..8a3a06c58d 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -50,7 +50,7 @@ C: