From ac591d1c675caf78ca57c2b217e8716b02921fd1 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 9 Jun 2008 23:00:21 -0500 Subject: [PATCH 01/13] newfx: Add stack-effects --- extra/newfx/newfx.factor | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/newfx/newfx.factor b/extra/newfx/newfx.factor index e017dc4b2b..be30dfe370 100644 --- a/extra/newfx/newfx.factor +++ b/extra/newfx/newfx.factor @@ -175,15 +175,15 @@ METHOD: as-mutate { object object assoc } set-at ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: 1st 0 at ; -: 2nd 1 at ; -: 3rd 2 at ; -: 4th 3 at ; -: 5th 4 at ; -: 6th 5 at ; -: 7th 6 at ; -: 8th 7 at ; -: 9th 8 at ; +: 1st ( seq -- obj ) 0 at ; +: 2nd ( seq -- obj ) 1 at ; +: 3rd ( seq -- obj ) 2 at ; +: 4th ( seq -- obj ) 3 at ; +: 5th ( seq -- obj ) 4 at ; +: 6th ( seq -- obj ) 5 at ; +: 7th ( seq -- obj ) 6 at ; +: 8th ( seq -- obj ) 7 at ; +: 9th ( seq -- obj ) 8 at ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 102b9aab76838a89015c13975bd1e8980396753b Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 9 Jun 2008 23:00:33 -0500 Subject: [PATCH 02/13] dns: Add stack-effects --- extra/dns/dns.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index 6386655a4e..48380a0d57 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -1,5 +1,6 @@ -USING: kernel byte-arrays combinators strings arrays sequences splitting +USING: kernel byte-arrays combinators strings arrays sequences splitting + grouping math math.functions math.parser random destructors io io.binary io.sockets io.encodings.binary @@ -382,7 +383,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: >> neg shift ; +: >> ( x n -- y ) neg shift ; : get-header-bits ( ba i -- qr opcode aa tc rd ra z rcode ) get-double From 95f5c78159478a15c356d40f25e1fed61556da05 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 9 Jun 2008 23:23:09 -0500 Subject: [PATCH 03/13] combinators.lib: New short-circuit combinators --- extra/combinators/lib/lib-docs.factor | 6 +-- extra/combinators/lib/lib.factor | 70 ++++++++++++++++++++------- 2 files changed, 55 insertions(+), 21 deletions(-) diff --git a/extra/combinators/lib/lib-docs.factor b/extra/combinators/lib/lib-docs.factor index 355d5647df..230d52c1b1 100755 --- a/extra/combinators/lib/lib-docs.factor +++ b/extra/combinators/lib/lib-docs.factor @@ -51,6 +51,6 @@ HELP: && { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } { $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ; -HELP: || -{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } -{ $description "Calls each quotation in turn; outputs " { $link t } " if one of the quotations output " { $link t } ", otherwise outputs " { $link f } ". As soon as a quotation outputs " { $link t } ", evaluation stops and subsequent quotations are not called." } ; +! HELP: || +! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } +! { $description "Calls each quotation in turn; outputs " { $link t } " if one of the quotations output " { $link t } ", otherwise outputs " { $link f } ". As soon as a quotation outputs " { $link t } ", evaluation stops and subsequent quotations are not called." } ; diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 3976b36cb9..a838b246e4 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -63,34 +63,68 @@ MACRO: napply ( n -- ) ! short circuiting words ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: short-circuit ( quots quot default -- quot ) - 1quotation -rot { } map>assoc alist>quot ; +! : short-circuit ( quots quot default -- quot ) +! 1quotation -rot { } map>assoc alist>quot ; -MACRO: && ( quots -- ? ) - [ [ not ] append [ f ] ] t short-circuit ; +! MACRO: && ( quots -- ? ) +! [ [ not ] append [ f ] ] t short-circuit ; -MACRO: <-&& ( quots -- ) - [ [ dup ] prepend [ not ] append [ f ] ] t short-circuit - [ nip ] append ; +! MACRO: <-&& ( quots -- ) +! [ [ dup ] prepend [ not ] append [ f ] ] t short-circuit +! [ nip ] append ; -MACRO: <--&& ( quots -- ) - [ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit - [ 2nip ] append ; +! MACRO: <--&& ( quots -- ) +! [ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit +! [ 2nip ] append ; ! or -MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ; +! MACRO: || ( quots -- ? ) [ [ t ] ] f short-circuit ; -MACRO: 0|| ( quots -- ? ) [ [ t ] ] f short-circuit ; +! MACRO: 0|| ( quots -- ? ) [ [ t ] ] f short-circuit ; -MACRO: 1|| ( quots -- ? ) - [ [ dup ] prepend [ t ] ] f short-circuit [ nip ] append ; +! MACRO: 1|| ( quots -- ? ) +! [ [ dup ] prepend [ t ] ] f short-circuit [ nip ] append ; -MACRO: 2|| ( quots -- ? ) - [ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ; +! MACRO: 2|| ( quots -- ? ) +! [ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ; -MACRO: 3|| ( quots -- ? ) - [ [ 3dup ] prepend [ t ] ] f short-circuit [ 3nip ] append ; +! MACRO: 3|| ( quots -- ? ) +! [ [ 3dup ] prepend [ t ] ] f short-circuit [ 3nip ] append ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MACRO: 0&& ( quots -- quot ) + [ '[ drop @ dup not ] [ drop f ] 2array ] map + { [ t ] [ ] } suffix + '[ f , cond ] ; + +MACRO: 1&& ( quots -- quot ) + [ '[ drop dup @ dup not ] [ drop drop f ] 2array ] map + { [ t ] [ nip ] } suffix + '[ f , cond ] ; + +MACRO: 2&& ( quots -- quot ) + [ '[ drop 2dup @ dup not ] [ drop 2drop f ] 2array ] map + { [ t ] [ 2nip ] } suffix + '[ f , cond ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MACRO: 0|| ( quots -- quot ) + [ '[ drop @ dup ] [ ] 2array ] map + { [ drop t ] [ f ] } suffix + '[ f , cond ] ; + +MACRO: 1|| ( quots -- quot ) + [ '[ drop dup @ dup ] [ nip ] 2array ] map + { [ drop drop t ] [ f ] } suffix + '[ f , cond ] ; + +MACRO: 2|| ( quots -- quot ) + [ '[ drop 2dup @ dup ] [ 2nip ] 2array ] map + { [ drop 2drop t ] [ f ] } suffix + '[ f , cond ] ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ifte From 5518229b0f6208efc8ed9365882166c9176ee3ca Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 9 Jun 2008 23:46:46 -0500 Subject: [PATCH 04/13] combinators.lib-docs: minor fix --- extra/combinators/lib/lib-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/combinators/lib/lib-docs.factor b/extra/combinators/lib/lib-docs.factor index 230d52c1b1..ccb1fca9a1 100755 --- a/extra/combinators/lib/lib-docs.factor +++ b/extra/combinators/lib/lib-docs.factor @@ -47,9 +47,9 @@ HELP: nkeep } { $see-also keep nslip } ; -HELP: && -{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } -{ $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ; +! HELP: && +! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } +! { $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ; ! HELP: || ! { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } From aa217980456e19252793c8b4832f8e90928c17d3 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 9 Jun 2008 23:58:16 -0500 Subject: [PATCH 05/13] help.lint: minor fix --- extra/help/lint/lint.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/help/lint/lint.factor b/extra/help/lint/lint.factor index a9ec7f9267..2a8ea03d03 100755 --- a/extra/help/lint/lint.factor +++ b/extra/help/lint/lint.factor @@ -55,7 +55,7 @@ IN: help.lint r> assert= t ] - } && 3drop ; + } 0&& 3drop ; : check-see-also ( word element -- ) nip \ $see-also swap elements [ From b6a262b62553595e9976f72e7510fd3b84fd8884 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 00:35:13 -0500 Subject: [PATCH 06/13] extra.logging: minor fix --- extra/logging/logging.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/logging/logging.factor b/extra/logging/logging.factor index 6fb7ebd6b1..3cedacc2ae 100755 --- a/extra/logging/logging.factor +++ b/extra/logging/logging.factor @@ -47,7 +47,7 @@ SYMBOL: log-service [ dup array? ] [ dup length 1 = ] [ dup first string? ] - } && nip ; + } 0&& nip ; : stack>message ( obj -- inputs>message ) dup one-string? [ first ] [ From 911b7cb4473782e4930b6fd2cc1501a6d2da7018 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 09:02:23 -0500 Subject: [PATCH 07/13] combinators.lib-tests: update some tests --- extra/combinators/lib/lib-tests.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor index 200a667b6b..78916bb027 100755 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -28,13 +28,13 @@ IN: combinators.lib.tests [ t ] [ 3 { [ dup number? ] [ dup odd? ] [ dup 0 > ] - } && nip + } 0&& nip ] unit-test [ f ] [ 3 { [ dup number? ] [ dup even? ] [ dup 0 > ] - } && nip + } 0&& nip ] unit-test ! || @@ -42,13 +42,13 @@ IN: combinators.lib.tests [ t ] [ 4 { [ dup array? ] [ dup number? ] [ 3 throw ] - } || nip + } 0|| nip ] unit-test [ f ] [ 4 { [ dup array? ] [ dup vector? ] [ dup float? ] - } || nip + } 0|| nip ] unit-test From e49de2fba09a84c94ad1b843e2643e331ebb4581 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 09:04:35 -0500 Subject: [PATCH 08/13] boids: minor update --- extra/boids/boids.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 40ce7adb35..4151b44cfb 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -114,7 +114,7 @@ over boid-vel -rot relative-position angle-between ; { [ cohesion-radius> in-range? ] [ cohesion-view-angle> in-view? ] [ eq? not ] } - <--&& ; + 2&& ; : cohesion-neighborhood ( self -- boids ) boids> [ within-cohesion-neighborhood? ] with filter ; @@ -134,7 +134,7 @@ over boid-vel -rot relative-position angle-between ; { [ separation-radius> in-range? ] [ separation-view-angle> in-view? ] [ eq? not ] } - <--&& ; + 2&& ; : separation-neighborhood ( self -- boids ) boids> [ within-separation-neighborhood? ] with filter ; @@ -154,7 +154,7 @@ over boid-vel -rot relative-position angle-between ; { [ alignment-radius> in-range? ] [ alignment-view-angle> in-view? ] [ eq? not ] } - <--&& ; + 2&& ; : alignment-neighborhood ( self -- boids ) boids> [ within-alignment-neighborhood? ] with filter ; From eeca9043ff8cb6f021c7791a56a9ec61910dd5d2 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 09:06:02 -0500 Subject: [PATCH 09/13] dns.forwarding: minor update --- extra/dns/forwarding/forwarding.factor | 4 ---- 1 file changed, 4 deletions(-) diff --git a/extra/dns/forwarding/forwarding.factor b/extra/dns/forwarding/forwarding.factor index 1c60532bbc..039b969ddd 100644 --- a/extra/dns/forwarding/forwarding.factor +++ b/extra/dns/forwarding/forwarding.factor @@ -39,10 +39,6 @@ IN: dns.forwarding ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: 1&& <-&& ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : rrs? ( obj -- ? ) { [ NX = not ] [ f = not ] } 1&& ; : query->answer/cache ( query -- rrs/NX/f ) From 1038a37ddb41df284677f2a2a124b9aa756cc2a5 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 09:07:45 -0500 Subject: [PATCH 10/13] lsys.strings: minor update --- extra/lsys/strings/strings.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/lsys/strings/strings.factor b/extra/lsys/strings/strings.factor index 3c9dfcab6c..f184ca5dfc 100644 --- a/extra/lsys/strings/strings.factor +++ b/extra/lsys/strings/strings.factor @@ -5,7 +5,7 @@ IN: lsys.strings ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: has-param? ( slice -- ? ) { [ length 1 > ] [ second CHAR: ( = ] } <-&& ; +: has-param? ( slice -- ? ) { [ length 1 > ] [ second CHAR: ( = ] } 1&& ; : next+rest ( slice -- next rest ) [ 1 head ] [ 1 tail-slice ] bi ; From 02b1d4dfa40e60ef272326488f1727e32b198b3a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 09:43:55 -0500 Subject: [PATCH 11/13] io.windows.nt.files: minor update --- extra/io/windows/nt/files/files.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 67161716a3..e8bdd8e4ec 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -23,7 +23,7 @@ M: winnt root-directory? ( path -- ? ) { [ dup empty? ] [ f ] } { [ dup [ path-separator? ] all? ] [ t ] } { [ dup right-trim-separators - { [ dup length 2 = ] [ dup second CHAR: : = ] } && nip ] [ + { [ dup length 2 = ] [ dup second CHAR: : = ] } 0&& nip ] [ t ] } [ f ] @@ -36,7 +36,7 @@ ERROR: not-absolute-path ; [ dup length 2 >= ] [ dup second CHAR: : = ] [ dup first Letter? ] - } && [ 2 head ] [ not-absolute-path ] if ; + } 0&& [ 2 head ] [ not-absolute-path ] if ; : prepend-prefix ( string -- string' ) dup unicode-prefix head? [ From 24eedc2e227359aeaabaf1ce168a3a7599754a9d Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 12:10:43 -0500 Subject: [PATCH 12/13] D to the N to the S --- extra/dns/server/server.factor | 117 ++++++++++++++++----------------- 1 file changed, 55 insertions(+), 62 deletions(-) diff --git a/extra/dns/server/server.factor b/extra/dns/server/server.factor index 7c33265d39..e1c32af970 100644 --- a/extra/dns/server/server.factor +++ b/extra/dns/server/server.factor @@ -6,9 +6,9 @@ USING: kernel io.sockets unicode.case accessors - combinators.cleave + combinators.cleave combinators.lib newfx - dns ; + dns dns.util ; IN: dns.server @@ -18,10 +18,6 @@ IN: dns.server ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: filter-by-name ( records name -- records ) swap [ name>> = ] with filter ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : {name-type-class} ( obj -- array ) { [ name>> >lower ] [ type>> ] [ class>> ] } ; @@ -32,80 +28,77 @@ IN: dns.server : matching-rrs ( query -- rrs ) records [ rr=query? ] with filter ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: matching-rrs? ( query -- query rrs/f ? ) dup matching-rrs dup empty? not ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: matching-cname? ( query -- query rr/f ? ) - dup clone CNAME >>type matching-rrs - dup empty? [ drop f f ] [ 1st t ] if ; - +! query->rrs ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DEFER: query->rrs -: query-canonical ( query rr -- rrs ) - tuck [ clone ] [ rdata>> ] bi* >>name query->rrs prefix-on ; +: matching-rrs? ( query -- rrs/f ) matching-rrs [ empty? ] [ drop f ] [ ] 1if ; -: query->rrs ( query -- rrs/f ) - { - { [ matching-rrs? ] [ nip ] } - { [ drop matching-cname? ] [ query-canonical ] } - { [ drop t ] [ drop f ] } - } - cond ; +: matching-cname? ( query -- rrs/f ) + [ ] [ clone CNAME >>type matching-rrs ] bi ! query rrs + [ empty? not ] + [ 1st swap clone over rdata>> >>name query->rrs prefix-on ] + [ 2drop f ] + 1if ; +: query->rrs ( query -- rrs/f ) { [ matching-rrs? ] [ matching-cname? ] } 1|| ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! have-answers +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: have-answers ( message -- message/f ) + dup message-query query->rrs ! message rrs/f + [ empty? ] [ 2drop f ] [ >>answer-section ] 1if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! have-delegates? ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : cdr-name ( name -- name ) dup CHAR: . index 1+ tail ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: is-soa? ( name -- ? ) SOA IN query boa matching-rrs empty? not ; -: delegate-servers? ( name -- name rrs ? ) - dup NS IN query boa matching-rrs dup empty? not ; +: have-ns? ( name -- rrs/f ) + NS IN query boa matching-rrs [ empty? ] [ drop f ] [ ] 1if ; + +: name->delegates ( name -- rrs-ns ) + { + [ "" = { } and ] + [ is-soa? { } and ] + [ have-ns? ] + [ cdr-name name->delegates ] + } + 1|| ; + +: have-delegates ( message -- message/f ) + dup message-query name>> name->delegates ! message rrs-ns + [ empty? ] + [ 2drop f ] + [ + dup [ rdata>> A IN query boa matching-rrs ] map concat + ! message rrs-ns rrs-a + [ >>authority-section ] + [ >>additional-section ] + bi* + ] + 1if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: delegate-servers ( name -- rrs ) - { - { [ dup "" = ] [ drop { } ] } - { [ delegate-servers? ] [ nip ] } - { [ drop t ] [ cdr-name delegate-servers ] } - } - cond ; - +! is-nx ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: delegate-addresses ( rrs-ns -- rrs-a ) - [ rdata>> A IN query boa matching-rrs ] map concat ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: have-delegates? ( query -- query rrs-ns ? ) - dup name>> delegate-servers dup empty? not ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: fill-additional ( message -- message ) - dup authority-section>> delegate-addresses >>additional-section ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: no-records-with-name? ( query -- query ? ) - dup name>> records [ name>> = ] with filter empty? ; +: is-nx ( message -- message/f ) + [ message-query name>> records [ name>> = ] with filter empty? ] + [ NAME-ERROR >>rcode ] + [ drop f ] + 1if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : find-answer ( message -- message ) - dup message-query ! message query - { - { [ dup query->rrs dup ] [ nip >>answer-section 1 >>aa ] } - { [ drop have-delegates? ] [ nip >>authority-section fill-additional ] } - { [ drop no-records-with-name? ] [ drop NAME-ERROR >>rcode ] } - { [ drop t ] [ ] } - } - cond ; + { [ have-answers ] [ have-delegates ] [ is-nx ] [ ] } 1|| ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -136,4 +129,4 @@ DEFER: query->rrs ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -MAIN: start \ No newline at end of file +MAIN: start From bdf77814e263285f586bb14eaacba731ba042892 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Tue, 10 Jun 2008 12:16:21 -0500 Subject: [PATCH 13/13] Add dns.util --- extra/dns/util/util.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 extra/dns/util/util.factor diff --git a/extra/dns/util/util.factor b/extra/dns/util/util.factor new file mode 100644 index 0000000000..bee1cc111e --- /dev/null +++ b/extra/dns/util/util.factor @@ -0,0 +1,11 @@ + +USING: kernel macros fry ; + +IN: dns.util + +: tri-chain ( obj p q r -- x y z ) + >r >r call dup r> call dup r> call ; inline + +MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ; + +! : 1if ( test then else -- ) >r >r >r dup r> call r> r> if ; inline ; \ No newline at end of file