Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-04-22 19:36:13 -05:00
commit 85426d1d7d
12 changed files with 29 additions and 27 deletions

View File

@ -3,11 +3,11 @@ compiler.tree stack-checker.errors ;
IN: compiler.tree.builder IN: compiler.tree.builder
HELP: build-tree HELP: build-tree
{ $values { "quot/word" { $or quotation word } } { "nodes" "a sequence of nodes" } } { $values { "word/quot" { $or word quotation } } { "nodes" "a sequence of nodes" } }
{ $description "Attempts to construct tree SSA IR from a quotation." } { $description "Attempts to construct tree SSA IR from a quotation." }
{ $notes "This is the first stage of the compiler." } { $notes "This is the first stage of the compiler." }
{ $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ; { $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;
HELP: build-sub-tree HELP: build-sub-tree
{ $values { "#call" #call } { "quot/word" { $or quotation word } } { "nodes" { $maybe "a sequence of nodes" } } } { $values { "#call" #call } { "word/quot" { $or word quotation } } { "nodes/f" { $maybe "a sequence of nodes" } } }
{ $description "Attempts to construct tree SSA IR from a quotation, starting with an initial data stack of values from the call site. Outputs " { $link f } " if stack effect inference fails." } ; { $description "Attempts to construct tree SSA IR from a quotation, starting with an initial data stack of values from the call site. Outputs " { $link f } " if stack effect inference fails." } ;

View File

@ -1,5 +1,5 @@
USING: help.markup help.syntax words definitions prettyprint USING: help.markup help.syntax words definitions prettyprint
tools.crossref.private math quotations assocs ; tools.crossref.private math quotations assocs kernel ;
IN: tools.crossref IN: tools.crossref
ARTICLE: "tools.crossref" "Definition cross referencing" ARTICLE: "tools.crossref" "Definition cross referencing"
@ -51,7 +51,7 @@ HELP: usage.
{ $examples { $code "\\ reverse usage." } } ; { $examples { $code "\\ reverse usage." } } ;
HELP: quot-uses HELP: quot-uses
{ $values { "quot" quotation } { "assoc" "an assoc with words as keys" } } { $values { "obj" object } { "assoc" "an assoc with words as keys" } }
{ $description "Outputs a set of words referenced by the quotation and any quotations it contains." } ; { $description "Outputs a set of words referenced by the quotation and any quotations it contains." } ;
{ usage usage. } related-words { usage usage. } related-words

View File

@ -160,11 +160,13 @@ ABOUT: "words"
HELP: execute ( word -- ) HELP: execute ( word -- )
{ $values { "word" word } } { $values { "word" word } }
{ $description "Executes a word." } { $description "Executes a word. Words which call execute must be inlined in order to compile when called from other words." }
{ $examples { $examples
{ $example "USING: kernel io words ;" "IN: scratchpad" ": twice ( word -- ) dup execute execute ;\n: hello ( -- ) \"Hello\" print ;\n\\ hello twice" "Hello\nHello" } { $example "USING: kernel io words ;" "IN: scratchpad" ": twice ( word -- ) dup execute execute ; inline\n: hello ( -- ) \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
} ; } ;
{ execute POSTPONE: execute( } related-words
HELP: deferred HELP: deferred
{ $class-description "The class of deferred words created by " { $link POSTPONE: DEFER: } "." } ; { $class-description "The class of deferred words created by " { $link POSTPONE: DEFER: } "." } ;

View File

@ -6,7 +6,7 @@ USING: kernel byte-arrays combinators strings arrays sequences splitting
io io.binary io.sockets io.encodings.binary io io.binary io.sockets io.encodings.binary
accessors accessors
combinators.smart combinators.smart
newfx assocs
; ;
IN: dns IN: dns
@ -148,8 +148,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
[ [
{ {
[ name>> dn->ba ] [ name>> dn->ba ]
[ type>> type-table of uint16->ba ] [ type>> type-table at uint16->ba ]
[ class>> class-table of uint16->ba ] [ class>> class-table at uint16->ba ]
} cleave } cleave
] output>array concat ; ] output>array concat ;
@ -203,8 +203,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
[ [
{ {
[ name>> dn->ba ] [ name>> dn->ba ]
[ type>> type-table of uint16->ba ] [ type>> type-table at uint16->ba ]
[ class>> class-table of uint16->ba ] [ class>> class-table at uint16->ba ]
[ ttl>> uint32->ba ] [ ttl>> uint32->ba ]
[ [
[ type>> ] [ rdata>> ] bi rdata->ba [ type>> ] [ rdata>> ] bi rdata->ba
@ -219,13 +219,13 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
[ [
{ {
[ qr>> 15 shift ] [ qr>> 15 shift ]
[ opcode>> opcode-table of 11 shift ] [ opcode>> opcode-table at 11 shift ]
[ aa>> 10 shift ] [ aa>> 10 shift ]
[ tc>> 9 shift ] [ tc>> 9 shift ]
[ rd>> 8 shift ] [ rd>> 8 shift ]
[ ra>> 7 shift ] [ ra>> 7 shift ]
[ z>> 4 shift ] [ z>> 4 shift ]
[ rcode>> rcode-table of 0 shift ] [ rcode>> rcode-table at 0 shift ]
} cleave } cleave
] sum-outputs uint16->ba ; ] sum-outputs uint16->ba ;
@ -301,8 +301,8 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
[ get-name ] [ get-name ]
[ [
skip-name skip-name
[ 0 + get-double type-table key-of ] [ 0 + get-double type-table value-at ]
[ 2 + get-double class-table key-of ] [ 2 + get-double class-table value-at ]
2bi 2bi
] ]
2bi query boa ; 2bi query boa ;
@ -364,10 +364,10 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
[ [
skip-name skip-name
{ {
[ 0 + get-double type-table key-of ] [ 0 + get-double type-table value-at ]
[ 2 + get-double class-table key-of ] [ 2 + get-double class-table value-at ]
[ 4 + get-quad ] [ 4 + get-quad ]
[ [ 10 + ] [ get-double type-table key-of ] 2bi get-rdata ] [ [ 10 + ] [ get-double type-table value-at ] 2bi get-rdata ]
} }
2cleave 2cleave
] ]
@ -393,13 +393,13 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
get-double get-double
{ {
[ 15 >> BIN: 1 bitand ] [ 15 >> BIN: 1 bitand ]
[ 11 >> BIN: 111 bitand opcode-table key-of ] [ 11 >> BIN: 111 bitand opcode-table value-at ]
[ 10 >> BIN: 1 bitand ] [ 10 >> BIN: 1 bitand ]
[ 9 >> BIN: 1 bitand ] [ 9 >> BIN: 1 bitand ]
[ 8 >> BIN: 1 bitand ] [ 8 >> BIN: 1 bitand ]
[ 7 >> BIN: 1 bitand ] [ 7 >> BIN: 1 bitand ]
[ 4 >> BIN: 111 bitand ] [ 4 >> BIN: 111 bitand ]
[ BIN: 1111 bitand rcode-table key-of ] [ BIN: 1111 bitand rcode-table value-at ]
} }
cleave ; cleave ;
@ -484,7 +484,7 @@ SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: message-query ( message -- query ) question-section>> 1st ; : message-query ( message -- query ) question-section>> first ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -1,6 +1,6 @@
USING: kernel combinators sequences splitting math USING: kernel combinators sequences splitting math
io.files io.encodings.utf8 random newfx dns.util ; io.files io.encodings.utf8 random dns.util ;
IN: dns.misc IN: dns.misc
@ -9,8 +9,8 @@ IN: dns.misc
: resolv-conf-servers ( -- seq ) : resolv-conf-servers ( -- seq )
"/etc/resolv.conf" utf8 file-lines "/etc/resolv.conf" utf8 file-lines
[ " " split ] map [ " " split ] map
[ 1st "nameserver" = ] filter [ first "nameserver" = ] filter
[ 2nd ] map ; [ second ] map ;
: resolv-conf-server ( -- ip ) resolv-conf-servers random ; : resolv-conf-server ( -- ip ) resolv-conf-servers random ;

View File

@ -2,7 +2,7 @@
USING: kernel combinators sequences sets math threads namespaces continuations USING: kernel combinators sequences sets math threads namespaces continuations
debugger io io.sockets unicode.case accessors destructors debugger io io.sockets unicode.case accessors destructors
combinators.short-circuit combinators.smart combinators.short-circuit combinators.smart
newfx fry arrays fry arrays
dns dns.util dns.misc ; dns dns.util dns.misc ;
IN: dns.server IN: dns.server
@ -64,7 +64,7 @@ SYMBOL: records-var
[ rr->rdata-names ] map concat ; [ rr->rdata-names ] map concat ;
: extract-names ( message -- names ) : extract-names ( message -- names )
[ message-query name>> ] [ extract-rdata-names ] bi prefix-on ; [ message-query name>> ] [ extract-rdata-names ] bi swap prefix ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! fill-authority ! fill-authority
@ -99,7 +99,7 @@ DEFER: query->rrs
: matching-cname? ( query -- rrs/f ) : matching-cname? ( query -- rrs/f )
[ ] [ clone CNAME >>type matching-rrs ] bi ! query rrs [ ] [ clone CNAME >>type matching-rrs ] bi ! query rrs
[ empty? not ] [ empty? not ]
[ 1st swap clone over rdata>> >>name query->rrs prefix-on ] [ first swap clone over rdata>> >>name query->rrs swap prefix ]
[ 2drop f ] [ 2drop f ]
1if ; 1if ;