diff --git a/extra/dns/cache/rr/rr.factor b/extra/dns/cache/rr/rr.factor index 77d787ff27..cb80190452 100644 --- a/extra/dns/cache/rr/rr.factor +++ b/extra/dns/cache/rr/rr.factor @@ -1,7 +1,7 @@ USING: kernel sequences assocs sets locals combinators accessors system math math.functions unicode.case prettyprint - combinators.cleave dns ; + combinators.smart dns ; IN: dns.cache.rr @@ -16,7 +16,7 @@ TUPLE: time data ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : make-cache-key ( obj -- key ) - { [ name>> >lower ] [ type>> unparse ] [ class>> unparse ] } 1arr " " join ; + [ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index ca37691ba7..cf98154e7a 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -5,7 +5,7 @@ USING: kernel byte-arrays combinators strings arrays sequences splitting destructors io io.binary io.sockets io.encodings.binary accessors - combinators.cleave + combinators.smart newfx ; @@ -145,12 +145,13 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : query->ba ( query -- ba ) + [ { [ name>> dn->ba ] [ type>> type-table of uint16->ba ] [ class>> class-table of uint16->ba ] - } - concat ; + } cleave + ] output>array concat ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -169,6 +170,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : soa->ba ( rdata -- ba ) + [ { [ mname>> dn->ba ] [ rname>> dn->ba ] @@ -177,8 +179,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED [ retry>> uint32->ba ] [ expire>> uint32->ba ] [ minimum>> uint32->ba ] - } - concat ; + } cleave + ] output>array concat ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -198,6 +200,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : rr->ba ( rr -- ba ) + [ { [ name>> dn->ba ] [ type>> type-table of uint16->ba ] @@ -207,12 +210,13 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED [ type>> ] [ rdata>> ] bi rdata->ba [ length uint16->ba ] [ ] bi append ] - } - concat ; + } cleave + ] output>array concat ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : header-bits-ba ( message -- ba ) + [ { [ qr>> 15 shift ] [ opcode>> opcode-table of 11 shift ] @@ -222,10 +226,11 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED [ ra>> 7 shift ] [ z>> 4 shift ] [ rcode>> rcode-table of 0 shift ] - } - sum uint16->ba ; + } cleave + ] sum-outputs uint16->ba ; : message->ba ( message -- ba ) + [ { [ id>> uint16->ba ] [ header-bits-ba ] @@ -237,8 +242,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED [ answer-section>> [ rr->ba ] map concat ] [ authority-section>> [ rr->ba ] map concat ] [ additional-section>> [ rr->ba ] map concat ] - } - concat ; + } cleave + ] output>array concat ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -475,7 +480,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED : ask ( message -- message ) dns-server ask-server ; -: query->message ( query -- message ) swap {1} >>question-section ; +: query->message ( query -- message ) swap 1array >>question-section ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/dns/server/server.factor b/extra/dns/server/server.factor index d8a8adc88e..b14d765e8d 100644 --- a/extra/dns/server/server.factor +++ b/extra/dns/server/server.factor @@ -1,8 +1,8 @@ USING: kernel combinators sequences sets math threads namespaces continuations debugger io io.sockets unicode.case accessors destructors - combinators.cleave combinators.short-circuit - newfx fry + combinators.short-circuit combinators.smart + newfx fry arrays dns dns.util dns.misc ; IN: dns.server @@ -16,7 +16,7 @@ SYMBOL: records-var ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : {name-type-class} ( obj -- array ) - { [ name>> >lower ] [ type>> ] [ class>> ] } ; + [ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ; : rr=query? ( obj obj -- ? ) [ {name-type-class} ] bi@ = ; @@ -52,9 +52,9 @@ SYMBOL: records-var : rr->rdata-names ( rr -- names/f ) { - { [ dup type>> NS = ] [ rdata>> {1} ] } - { [ dup type>> MX = ] [ rdata>> exchange>> {1} ] } - { [ dup type>> CNAME = ] [ rdata>> {1} ] } + { [ dup type>> NS = ] [ rdata>> 1array ] } + { [ dup type>> MX = ] [ rdata>> exchange>> 1array ] } + { [ dup type>> CNAME = ] [ rdata>> 1array ] } { [ t ] [ drop f ] } } cond ; diff --git a/extra/update/util/util.factor b/extra/update/util/util.factor index b638b61528..beeddc7abb 100644 --- a/extra/update/util/util.factor +++ b/extra/update/util/util.factor @@ -1,6 +1,6 @@ USING: kernel classes strings quotations words math math.parser arrays - combinators.cleave + combinators.smart accessors system prettyprint splitting sequences combinators sequences.deep @@ -58,5 +58,5 @@ DEFER: to-strings : datestamp ( -- string ) now - { year>> month>> day>> hour>> minute>> } + [ { [ year>> ] [ month>> ] [ day>> ] [ hour>> ] [ minute>> ] } cleave ] output>array [ pad-00 ] map "-" join ;