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

Update code not to use combinators.cleave

db4
Slava Pestov 2009-03-11 08:44:27 -05:00
parent 515dcce34a
commit 52d1e4f9b5
4 changed files with 27 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/dns/cache/rr/rr.factor vendored
View File

@ -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: <entry> time data ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: make-cache-key ( obj -- key )
{ [ name>> >lower ] [ type>> unparse ] [ class>> unparse ] } 1arr " " join ;
[ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

29
extra/dns/dns.factor
View File

@ -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 ]
}
<arr> 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 ]
}
<arr> 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
]
}
<arr> 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 ]
}
<arr> 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 ]
}
<arr> 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 ) <message> swap {1} >>question-section ;
: query->message ( query -- message ) <message> swap 1array >>question-section ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

12
extra/dns/server/server.factor
View File

@ -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>> ] } <arr> ;
[ [ 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 ;

4
extra/update/util/util.factor
View File

@ -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>> } <arr>
[ { [ year>> ] [ month>> ] [ day>> ] [ hour>> ] [ minute>> ] } cleave ] output>array
[ pad-00 ] map "-" join ;