Merge branch 'master' of git://factorcode.org/git/factor
commit
0c51a5b1ec
|
@ -114,7 +114,7 @@ over boid-vel -rot relative-position angle-between ;
|
||||||
{ [ cohesion-radius> in-range? ]
|
{ [ cohesion-radius> in-range? ]
|
||||||
[ cohesion-view-angle> in-view? ]
|
[ cohesion-view-angle> in-view? ]
|
||||||
[ eq? not ] }
|
[ eq? not ] }
|
||||||
<--&& ;
|
2&& ;
|
||||||
|
|
||||||
: cohesion-neighborhood ( self -- boids )
|
: cohesion-neighborhood ( self -- boids )
|
||||||
boids> [ within-cohesion-neighborhood? ] with filter ;
|
boids> [ within-cohesion-neighborhood? ] with filter ;
|
||||||
|
@ -134,7 +134,7 @@ over boid-vel -rot relative-position angle-between ;
|
||||||
{ [ separation-radius> in-range? ]
|
{ [ separation-radius> in-range? ]
|
||||||
[ separation-view-angle> in-view? ]
|
[ separation-view-angle> in-view? ]
|
||||||
[ eq? not ] }
|
[ eq? not ] }
|
||||||
<--&& ;
|
2&& ;
|
||||||
|
|
||||||
: separation-neighborhood ( self -- boids )
|
: separation-neighborhood ( self -- boids )
|
||||||
boids> [ within-separation-neighborhood? ] with filter ;
|
boids> [ within-separation-neighborhood? ] with filter ;
|
||||||
|
@ -154,7 +154,7 @@ over boid-vel -rot relative-position angle-between ;
|
||||||
{ [ alignment-radius> in-range? ]
|
{ [ alignment-radius> in-range? ]
|
||||||
[ alignment-view-angle> in-view? ]
|
[ alignment-view-angle> in-view? ]
|
||||||
[ eq? not ] }
|
[ eq? not ] }
|
||||||
<--&& ;
|
2&& ;
|
||||||
|
|
||||||
: alignment-neighborhood ( self -- boids )
|
: alignment-neighborhood ( self -- boids )
|
||||||
boids> [ within-alignment-neighborhood? ] with filter ;
|
boids> [ within-alignment-neighborhood? ] with filter ;
|
||||||
|
|
|
@ -47,10 +47,10 @@ HELP: nkeep
|
||||||
}
|
}
|
||||||
{ $see-also keep nslip } ;
|
{ $see-also keep nslip } ;
|
||||||
|
|
||||||
HELP: &&
|
! HELP: &&
|
||||||
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
|
! { $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." } ;
|
! { $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: ||
|
! HELP: ||
|
||||||
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
|
! { $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." } ;
|
! { $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." } ;
|
||||||
|
|
|
@ -28,13 +28,13 @@ IN: combinators.lib.tests
|
||||||
[ t ] [
|
[ t ] [
|
||||||
3 {
|
3 {
|
||||||
[ dup number? ] [ dup odd? ] [ dup 0 > ]
|
[ dup number? ] [ dup odd? ] [ dup 0 > ]
|
||||||
} && nip
|
} 0&& nip
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [
|
[ f ] [
|
||||||
3 {
|
3 {
|
||||||
[ dup number? ] [ dup even? ] [ dup 0 > ]
|
[ dup number? ] [ dup even? ] [ dup 0 > ]
|
||||||
} && nip
|
} 0&& nip
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! ||
|
! ||
|
||||||
|
@ -42,13 +42,13 @@ IN: combinators.lib.tests
|
||||||
[ t ] [
|
[ t ] [
|
||||||
4 {
|
4 {
|
||||||
[ dup array? ] [ dup number? ] [ 3 throw ]
|
[ dup array? ] [ dup number? ] [ 3 throw ]
|
||||||
} || nip
|
} 0|| nip
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [
|
[ f ] [
|
||||||
4 {
|
4 {
|
||||||
[ dup array? ] [ dup vector? ] [ dup float? ]
|
[ dup array? ] [ dup vector? ] [ dup float? ]
|
||||||
} || nip
|
} 0|| nip
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -63,34 +63,68 @@ MACRO: napply ( n -- )
|
||||||
! short circuiting words
|
! short circuiting words
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: short-circuit ( quots quot default -- quot )
|
! : short-circuit ( quots quot default -- quot )
|
||||||
1quotation -rot { } map>assoc <reversed> alist>quot ;
|
! 1quotation -rot { } map>assoc <reversed> alist>quot ;
|
||||||
|
|
||||||
MACRO: && ( quots -- ? )
|
! MACRO: && ( quots -- ? )
|
||||||
[ [ not ] append [ f ] ] t short-circuit ;
|
! [ [ not ] append [ f ] ] t short-circuit ;
|
||||||
|
|
||||||
MACRO: <-&& ( quots -- )
|
! MACRO: <-&& ( quots -- )
|
||||||
[ [ dup ] prepend [ not ] append [ f ] ] t short-circuit
|
! [ [ dup ] prepend [ not ] append [ f ] ] t short-circuit
|
||||||
[ nip ] append ;
|
! [ nip ] append ;
|
||||||
|
|
||||||
MACRO: <--&& ( quots -- )
|
! MACRO: <--&& ( quots -- )
|
||||||
[ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit
|
! [ [ 2dup ] prepend [ not ] append [ f ] ] t short-circuit
|
||||||
[ 2nip ] append ;
|
! [ 2nip ] append ;
|
||||||
|
|
||||||
! or
|
! 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 -- ? )
|
! MACRO: 1|| ( quots -- ? )
|
||||||
[ [ dup ] prepend [ t ] ] f short-circuit [ nip ] append ;
|
! [ [ dup ] prepend [ t ] ] f short-circuit [ nip ] append ;
|
||||||
|
|
||||||
MACRO: 2|| ( quots -- ? )
|
! MACRO: 2|| ( quots -- ? )
|
||||||
[ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ;
|
! [ [ 2dup ] prepend [ t ] ] f short-circuit [ 2nip ] append ;
|
||||||
|
|
||||||
MACRO: 3|| ( quots -- ? )
|
! MACRO: 3|| ( quots -- ? )
|
||||||
[ [ 3dup ] prepend [ t ] ] f short-circuit [ 3nip ] append ;
|
! [ [ 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
|
! ifte
|
||||||
|
|
|
@ -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
|
math math.functions math.parser random
|
||||||
destructors
|
destructors
|
||||||
io io.binary io.sockets io.encodings.binary
|
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-header-bits ( ba i -- qr opcode aa tc rd ra z rcode )
|
||||||
get-double
|
get-double
|
||||||
|
|
|
@ -39,10 +39,6 @@ IN: dns.forwarding
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: 1&& <-&& ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: rrs? ( obj -- ? ) { [ NX = not ] [ f = not ] } 1&& ;
|
: rrs? ( obj -- ? ) { [ NX = not ] [ f = not ] } 1&& ;
|
||||||
|
|
||||||
: query->answer/cache ( query -- rrs/NX/f )
|
: query->answer/cache ( query -- rrs/NX/f )
|
||||||
|
|
|
@ -6,9 +6,9 @@ USING: kernel
|
||||||
io.sockets
|
io.sockets
|
||||||
unicode.case
|
unicode.case
|
||||||
accessors
|
accessors
|
||||||
combinators.cleave
|
combinators.cleave combinators.lib
|
||||||
newfx
|
newfx
|
||||||
dns ;
|
dns dns.util ;
|
||||||
|
|
||||||
IN: dns.server
|
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-type-class} ( obj -- array )
|
||||||
{ [ name>> >lower ] [ type>> ] [ class>> ] } <arr> ;
|
{ [ name>> >lower ] [ type>> ] [ class>> ] } <arr> ;
|
||||||
|
|
||||||
|
@ -32,80 +28,77 @@ IN: dns.server
|
||||||
: matching-rrs ( query -- rrs ) records [ rr=query? ] with filter ;
|
: matching-rrs ( query -- rrs ) records [ rr=query? ] with filter ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
! query->rrs
|
||||||
: 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 ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
DEFER: query->rrs
|
DEFER: query->rrs
|
||||||
|
|
||||||
: query-canonical ( query rr -- rrs )
|
: matching-rrs? ( query -- rrs/f ) matching-rrs [ empty? ] [ drop f ] [ ] 1if ;
|
||||||
tuck [ clone ] [ rdata>> ] bi* >>name query->rrs prefix-on ;
|
|
||||||
|
|
||||||
: query->rrs ( query -- rrs/f )
|
: matching-cname? ( query -- rrs/f )
|
||||||
{
|
[ ] [ clone CNAME >>type matching-rrs ] bi ! query rrs
|
||||||
{ [ matching-rrs? ] [ nip ] }
|
[ empty? not ]
|
||||||
{ [ drop matching-cname? ] [ query-canonical ] }
|
[ 1st swap clone over rdata>> >>name query->rrs prefix-on ]
|
||||||
{ [ drop t ] [ drop f ] }
|
[ 2drop f ]
|
||||||
}
|
1if ;
|
||||||
cond ;
|
|
||||||
|
|
||||||
|
: 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 ;
|
: 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 ? )
|
: have-ns? ( name -- rrs/f )
|
||||||
dup NS IN query boa matching-rrs dup empty? not ;
|
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 ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
! is-nx
|
||||||
: delegate-servers ( name -- rrs )
|
|
||||||
{
|
|
||||||
{ [ dup "" = ] [ drop { } ] }
|
|
||||||
{ [ delegate-servers? ] [ nip ] }
|
|
||||||
{ [ drop t ] [ cdr-name delegate-servers ] }
|
|
||||||
}
|
|
||||||
cond ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: delegate-addresses ( rrs-ns -- rrs-a )
|
: is-nx ( message -- message/f )
|
||||||
[ rdata>> A IN query boa matching-rrs ] map concat ;
|
[ message-query name>> records [ name>> = ] with filter empty? ]
|
||||||
|
[ NAME-ERROR >>rcode ]
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
[ drop f ]
|
||||||
|
1if ;
|
||||||
: 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? ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: find-answer ( message -- message )
|
: find-answer ( message -- message )
|
||||||
dup message-query ! message query
|
{ [ have-answers ] [ have-delegates ] [ is-nx ] [ ] } 1|| ;
|
||||||
{
|
|
||||||
{ [ 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 ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
|
@ -55,7 +55,7 @@ IN: help.lint
|
||||||
r> assert=
|
r> assert=
|
||||||
t
|
t
|
||||||
]
|
]
|
||||||
} && 3drop ;
|
} 0&& 3drop ;
|
||||||
|
|
||||||
: check-see-also ( word element -- )
|
: check-see-also ( word element -- )
|
||||||
nip \ $see-also swap elements [
|
nip \ $see-also swap elements [
|
||||||
|
|
|
@ -23,7 +23,7 @@ M: winnt root-directory? ( path -- ? )
|
||||||
{ [ dup empty? ] [ f ] }
|
{ [ dup empty? ] [ f ] }
|
||||||
{ [ dup [ path-separator? ] all? ] [ t ] }
|
{ [ dup [ path-separator? ] all? ] [ t ] }
|
||||||
{ [ dup right-trim-separators
|
{ [ dup right-trim-separators
|
||||||
{ [ dup length 2 = ] [ dup second CHAR: : = ] } && nip ] [
|
{ [ dup length 2 = ] [ dup second CHAR: : = ] } 0&& nip ] [
|
||||||
t
|
t
|
||||||
] }
|
] }
|
||||||
[ f ]
|
[ f ]
|
||||||
|
@ -36,7 +36,7 @@ ERROR: not-absolute-path ;
|
||||||
[ dup length 2 >= ]
|
[ dup length 2 >= ]
|
||||||
[ dup second CHAR: : = ]
|
[ dup second CHAR: : = ]
|
||||||
[ dup first Letter? ]
|
[ dup first Letter? ]
|
||||||
} && [ 2 head ] [ not-absolute-path ] if ;
|
} 0&& [ 2 head ] [ not-absolute-path ] if ;
|
||||||
|
|
||||||
: prepend-prefix ( string -- string' )
|
: prepend-prefix ( string -- string' )
|
||||||
dup unicode-prefix head? [
|
dup unicode-prefix head? [
|
||||||
|
|
|
@ -47,7 +47,7 @@ SYMBOL: log-service
|
||||||
[ dup array? ]
|
[ dup array? ]
|
||||||
[ dup length 1 = ]
|
[ dup length 1 = ]
|
||||||
[ dup first string? ]
|
[ dup first string? ]
|
||||||
} && nip ;
|
} 0&& nip ;
|
||||||
|
|
||||||
: stack>message ( obj -- inputs>message )
|
: stack>message ( obj -- inputs>message )
|
||||||
dup one-string? [ first ] [
|
dup one-string? [ first ] [
|
||||||
|
|
|
@ -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 ;
|
: next+rest ( slice -- next rest ) [ 1 head ] [ 1 tail-slice ] bi ;
|
||||||
|
|
||||||
|
|
|
@ -175,15 +175,15 @@ METHOD: as-mutate { object object assoc } set-at ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: 1st 0 at ;
|
: 1st ( seq -- obj ) 0 at ;
|
||||||
: 2nd 1 at ;
|
: 2nd ( seq -- obj ) 1 at ;
|
||||||
: 3rd 2 at ;
|
: 3rd ( seq -- obj ) 2 at ;
|
||||||
: 4th 3 at ;
|
: 4th ( seq -- obj ) 3 at ;
|
||||||
: 5th 4 at ;
|
: 5th ( seq -- obj ) 4 at ;
|
||||||
: 6th 5 at ;
|
: 6th ( seq -- obj ) 5 at ;
|
||||||
: 7th 6 at ;
|
: 7th ( seq -- obj ) 6 at ;
|
||||||
: 8th 7 at ;
|
: 8th ( seq -- obj ) 7 at ;
|
||||||
: 9th 8 at ;
|
: 9th ( seq -- obj ) 8 at ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue