Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
979e487fef
|
|
@ -27,7 +27,7 @@ HELP: HEXCOLOR:
|
|||
|
||||
ARTICLE: "colors.hex" "HEX colors"
|
||||
"The " { $vocab-link "colors.hex" } " vocabulary implements colors specified "
|
||||
"by their hexidecimal value."
|
||||
"by their hexadecimal value."
|
||||
{ $subsections
|
||||
hex>rgba
|
||||
rgba>hex
|
||||
|
|
|
|||
|
|
@ -32,17 +32,21 @@ HELP: casep
|
|||
{ $examples
|
||||
"The following two forms will output 1 with 0.2 probability, 2 with 0.3 probability and 3 with 0.5 probability"
|
||||
{ $code
|
||||
"USING: combinators.random ;"
|
||||
"{ { 0.2 [ 1 ] }"
|
||||
"USING: combinators.random prettyprint ;"
|
||||
"{"
|
||||
" { 0.2 [ 1 ] }"
|
||||
" { 0.3 [ 2 ] }"
|
||||
" { 0.5 [ 3 ] } } casep ."
|
||||
" { 0.5 [ 3 ] }"
|
||||
"} casep ."
|
||||
}
|
||||
$nl
|
||||
{ $code
|
||||
"USING: combinators.random ;"
|
||||
"{ { 0.2 [ 1 ] }"
|
||||
"USING: combinators.random prettyprint ;"
|
||||
"{"
|
||||
" { 0.2 [ 1 ] }"
|
||||
" { 0.3 [ 2 ] }"
|
||||
" { [ 3 ] } } casep ."
|
||||
" [ 3 ]"
|
||||
"} casep ."
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -62,17 +66,21 @@ HELP: casep*
|
|||
{ $examples
|
||||
"The following two forms will output 1 with 0.5 probability, 2 with 0.25 probability and 3 with 0.25 probability"
|
||||
{ $code
|
||||
"USING: combinators.random ;"
|
||||
"{ { 0.5 [ 1 ] }"
|
||||
"USING: combinators.random prettyprint ;"
|
||||
"{"
|
||||
" { 0.5 [ 1 ] }"
|
||||
" { 0.5 [ 2 ] }"
|
||||
" { 1 [ 3 ] } } casep* ."
|
||||
" { 1 [ 3 ] }"
|
||||
"} casep* ."
|
||||
}
|
||||
$nl
|
||||
{ $code
|
||||
"USING: combinators.random ;"
|
||||
"{ { 0.5 [ 1 ] }"
|
||||
"USING: combinators.random prettyprint ;"
|
||||
"{"
|
||||
" { 0.5 [ 1 ] }"
|
||||
" { 0.5 [ 2 ] }"
|
||||
" { [ 3 ] } } casep* ."
|
||||
" [ 3 ]"
|
||||
"} casep* ."
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -24,10 +24,10 @@ V{ } 5 test-bb
|
|||
|
||||
[ ] [ test-tdmsc ] unit-test
|
||||
|
||||
[ V{ 4 } ] [ 1 get 1array merge-set [ number>> ] map ] unit-test
|
||||
[ V{ 4 } ] [ 2 get 1array merge-set [ number>> ] map ] unit-test
|
||||
[ V{ } ] [ 0 get 1array merge-set ] unit-test
|
||||
[ V{ } ] [ 4 get 1array merge-set ] unit-test
|
||||
[ { 4 } ] [ 1 get 1array merge-set [ number>> ] map ] unit-test
|
||||
[ { 4 } ] [ 2 get 1array merge-set [ number>> ] map ] unit-test
|
||||
[ { } ] [ 0 get 1array merge-set ] unit-test
|
||||
[ { } ] [ 4 get 1array merge-set ] unit-test
|
||||
|
||||
V{ } 0 test-bb
|
||||
V{ } 1 test-bb
|
||||
|
|
@ -70,5 +70,5 @@ V{ } 7 test-bb
|
|||
|
||||
[ ] [ test-tdmsc ] unit-test
|
||||
|
||||
[ V{ 2 } ] [ { 2 3 4 5 } [ get ] map merge-set [ number>> ] map ] unit-test
|
||||
[ V{ } ] [ { 0 1 6 7 } [ get ] map merge-set ] unit-test
|
||||
[ { 2 } ] [ { 2 3 4 5 } [ get ] map merge-set [ number>> ] map ] unit-test
|
||||
[ { } ] [ { 0 1 6 7 } [ get ] map merge-set ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ IN: concurrency.distributed
|
|||
ARTICLE: "concurrency.distributed.example" "Distributed Concurrency Example"
|
||||
"In this example the Factor instance associated with port 9000 will run "
|
||||
"a thread that receives and prints messages "
|
||||
"in the listener. The code to start the thread is: "
|
||||
"in the listener. The code to start the thread is:"
|
||||
{ $examples
|
||||
{ $unchecked-example
|
||||
": log-message ( -- ) receive . flush log-message ;"
|
||||
|
|
|
|||
|
|
@ -22,7 +22,11 @@ HELP: os-env
|
|||
{ $description "Looks up the value of a shell environment variable." }
|
||||
{ $examples
|
||||
"This is an operating system-specific feature. On Unix, you can do:"
|
||||
{ $unchecked-example "\"USER\" os-env print" "jane" }
|
||||
{ $unchecked-example
|
||||
"USING: environment io ;"
|
||||
"\"USER\" os-env print"
|
||||
"jane"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: os-envs
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@ HELP: articles
|
|||
HELP: no-article
|
||||
{ $values { "name" "an article name" } }
|
||||
{ $description "Throws a " { $link no-article } " error." }
|
||||
{ $error-description "Thrown by " { $link help } " if the given help topic does not exist, or if the help topic being dispayed links to a help topic which does not exist." } ;
|
||||
{ $error-description "Thrown by " { $link help } " if the given help topic does not exist, or if the help topic being displayed links to a help topic which does not exist." } ;
|
||||
|
||||
HELP: article
|
||||
{ $values { "name" "an article name" } { "article" "an " { $link article } " object" } }
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ $nl
|
|||
{ { $slot "header" } { "An assoc of HTTP header values. See " { $link "http.headers" } } }
|
||||
{ { $slot "post-data" } { "See " { $link "http.post-data" } } }
|
||||
{ { $slot "cookies" } { "A sequence of HTTP cookies. See " { $link "http.cookies" } } }
|
||||
{ { $slot "redirects" } { "Number of redirects to attempt before throwing an error. Default is " { $snippet "max-redirects" } " ." } }
|
||||
{ { $slot "redirects" } { "Number of redirects to attempt before throwing an error. Default is " { $snippet "max-redirects" } "." } }
|
||||
} } ;
|
||||
|
||||
HELP: <response>
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: help.markup help.syntax ;
|
|||
IN: io.encodings.8-bit.latin9
|
||||
|
||||
HELP: latin9
|
||||
{ $var-description "This is the ISO-8859-15 encoding, also called Latin-9 and unoffically as Latin-0. It is an 8-bit superset of ASCII designed as a modification of Latin-1, removing little-used characters in favor of the Euro symbol and other characters." }
|
||||
{ $var-description "This is the ISO-8859-15 encoding, also called Latin-9 and unofficially as Latin-0. It is an 8-bit superset of ASCII designed as a modification of Latin-1, removing little-used characters in favor of the Euro symbol and other characters." }
|
||||
{ $see-also "encodings-introduction" } ;
|
||||
|
||||
ARTICLE: "io.encodings.8-bit.latin9" "Latin9 encoding"
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: help.markup help.syntax ;
|
|||
IN: io.encodings.shift-jis
|
||||
|
||||
ARTICLE: "io.encodings.shift-jis" "Shift JIS"
|
||||
"Shift JIS is a text encoding for Japanese. There are multiple versions, depending on whether the offical standard or the modified Microsoft version is required."
|
||||
"Shift JIS is a text encoding for Japanese. There are multiple versions, depending on whether the official standard or the modified Microsoft version is required."
|
||||
{ $subsections
|
||||
shift-jis
|
||||
windows-31j
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ M: icmp4 resolve-host 1array ;
|
|||
|
||||
TUPLE: icmp6 < ipv6 ;
|
||||
|
||||
C: <icmp6> icmp6
|
||||
: <icmp6> ( host -- icmp6 ) 0 icmp6 boa ;
|
||||
|
||||
M: ipv6 with-icmp host>> <icmp6> ;
|
||||
|
||||
|
|
|
|||
|
|
@ -41,7 +41,11 @@ io.sockets.secure.unix.debug ;
|
|||
] server-test
|
||||
] unit-test
|
||||
|
||||
[ client-test ] [ premature-close? ] must-fail-with
|
||||
! Actually, this should not be an error since many HTTPS servers
|
||||
! (eg, google.com) do this.
|
||||
|
||||
! [ client-test ] [ premature-close? ] must-fail-with
|
||||
[ "hello" ] [ client-test ] unit-test
|
||||
|
||||
! Now, try validating the certificate. This should fail because its
|
||||
! actually an invalid certificate
|
||||
|
|
|
|||
|
|
@ -143,7 +143,7 @@ HELP: <inet6>
|
|||
{ $description "Creates a new " { $link inet6 } " address specifier. A value of " { $link f } " as the host refers to localhost, while " { $link f } " as the port defers the port choice until a later time." } ;
|
||||
|
||||
HELP: <client>
|
||||
{ $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } { "local" "an address specifier" } }
|
||||
{ $values { "remote" "an address specifier" } { "encoding" "an encoding descriptor" } { "stream" "a bidirectional stream" } { "local" "an address specifier" } }
|
||||
{ $description "Opens a network connection and outputs a bidirectional stream using the given encoding, together with the local address the socket was bound to." }
|
||||
{ $errors "Throws an error if the connection cannot be established." }
|
||||
{ $notes "The " { $link with-client } " word is easier to use in most situations." }
|
||||
|
|
@ -225,7 +225,7 @@ HELP: with-local-address
|
|||
{ $description "Client sockets opened within the scope of the quotation passed to this combinator will have their local address bound to the given address." }
|
||||
{ $examples
|
||||
{ "Binds the local address of a newly created client socket within the quotation to 127.0.0.1."
|
||||
"This ensures that all traffic originates from the given address (the port is choosen by the TCP stack)." }
|
||||
"This ensures that all traffic originates from the given address (the port is chosen by the TCP stack)." }
|
||||
{ $code "\"127.0.0.1\" 0 <inet4> [ ] with-local-address" }
|
||||
$nl
|
||||
{ "Binds the local address of a newly created client socket within the quotation to the local address 192.168.0.1 and the local port 23000. "
|
||||
|
|
|
|||
|
|
@ -1,11 +1,12 @@
|
|||
USING: io.sockets io.sockets.private sequences math tools.test
|
||||
namespaces accessors kernel destructors calendar io.timeouts
|
||||
io.encodings.utf8 io concurrency.promises threads
|
||||
io.streams.string ;
|
||||
io.streams.string present ;
|
||||
IN: io.sockets.tests
|
||||
|
||||
[ T{ local f "/tmp/foo" } ] [ "/tmp/foo" <local> ] unit-test
|
||||
[ T{ inet4 f f 0 } ] [ f 0 <inet4> ] unit-test
|
||||
[ T{ inet6 f f 0 } ] [ f 0 <inet6> ] unit-test
|
||||
[ T{ inet6 f f 0 1 } ] [ f 1 <inet6> ] unit-test
|
||||
|
||||
[ T{ inet f "google.com" f } ] [ "google.com" f <inet> ] unit-test
|
||||
|
||||
|
|
@ -13,10 +14,23 @@ IN: io.sockets.tests
|
|||
[ T{ inet f "google.com" 80 } ] [ "google.com" 0 <inet> 80 with-port ] unit-test
|
||||
[ T{ inet4 f "8.8.8.8" 0 } ] [ "8.8.8.8" 0 <inet4> ] unit-test
|
||||
[ T{ inet4 f "8.8.8.8" 53 } ] [ "8.8.8.8" 0 <inet4> 53 with-port ] unit-test
|
||||
[ T{ inet6 f "5:5:5:5:6:6:6:6" 12 } ] [ "5:5:5:5:6:6:6:6" 0 <inet6> 12 with-port ] unit-test
|
||||
[ T{ inet6 f "5:5:5:5:6:6:6:6" 0 12 } ] [ "5:5:5:5:6:6:6:6" 0 <inet6> 12 with-port ] unit-test
|
||||
[ T{ inet6 f "fe80::1" 1 80 } ] [ T{ ipv6 f "fe80::1" 1 } 80 with-port ] unit-test
|
||||
|
||||
: test-sockaddr ( addrspec -- )
|
||||
[ dup make-sockaddr ] keep parse-sockaddr assert= ;
|
||||
|
||||
[ ] [ T{ inet4 f "8.8.8.8" 53 } test-sockaddr ] unit-test
|
||||
[ ] [ T{ inet6 f "5:5:5:5:6:6:6:6" 0 12 } test-sockaddr ] unit-test
|
||||
[ ] [ T{ inet6 f "fe80:0:0:0:0:0:0:1" 1 80 } test-sockaddr ] unit-test
|
||||
|
||||
[ T{ inet f "google.com" 80 } ] [ "google.com" 80 with-port ] unit-test
|
||||
|
||||
! Test present on addrspecs
|
||||
[ "4.4.4.4:12" ] [ "4.4.4.4" 12 <inet4> present ] unit-test
|
||||
[ "::1:12" ] [ "::1" 12 <inet6> present ] unit-test
|
||||
[ "fe80::1%1:12" ] [ "fe80::1" 1 12 inet6 boa present ] unit-test
|
||||
|
||||
[ B{ 1 2 3 4 } ]
|
||||
[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -125,9 +125,11 @@ M: inet4 present
|
|||
|
||||
M: inet4 protocol drop 0 ;
|
||||
|
||||
TUPLE: ipv6 { host ?string read-only } ;
|
||||
TUPLE: ipv6
|
||||
{ host ?string read-only }
|
||||
{ scope-id integer read-only } ;
|
||||
|
||||
C: <ipv6> ipv6
|
||||
: <ipv6> ( host -- ipv6 ) 0 ipv6 boa ;
|
||||
|
||||
M: ipv6 inet-ntop ( data addrspec -- str )
|
||||
drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
|
||||
|
|
@ -184,23 +186,31 @@ M: ipv6 make-sockaddr ( inet -- sockaddr )
|
|||
AF_INET6 >>family
|
||||
swap
|
||||
[ port>> htons >>port ]
|
||||
[ host>> "::" or ]
|
||||
[ inet-pton >>addr ] tri ;
|
||||
[ [ host>> "::" or ] keep inet-pton >>addr ]
|
||||
[ scope-id>> >>scopeid ]
|
||||
tri ;
|
||||
|
||||
M: ipv6 parse-sockaddr
|
||||
[ addr>> ] dip inet-ntop <ipv6> ;
|
||||
[ [ addr>> ] dip inet-ntop ] [ drop scopeid>> ] 2bi
|
||||
ipv6 boa ;
|
||||
|
||||
M: ipv6 present
|
||||
[ host>> ] [ scope-id>> ] bi
|
||||
[ number>string "%" glue ] unless-zero ;
|
||||
|
||||
TUPLE: inet6 < ipv6 { port integer read-only } ;
|
||||
|
||||
C: <inet6> inet6
|
||||
: <inet6> ( host port -- inet6 ) [ 0 ] dip inet6 boa ;
|
||||
|
||||
M: ipv6 with-port [ host>> ] dip <inet6> ;
|
||||
M: ipv6 with-port
|
||||
[ [ host>> ] [ scope-id>> ] bi ] dip
|
||||
inet6 boa ;
|
||||
|
||||
M: inet6 parse-sockaddr
|
||||
[ call-next-method ] [ drop port>> ntohs ] 2bi with-port ;
|
||||
|
||||
M: inet6 present
|
||||
[ host>> ] [ port>> number>string ] bi ":" glue ;
|
||||
[ call-next-method ] [ port>> number>string ] bi ":" glue ;
|
||||
|
||||
M: inet6 protocol drop 0 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -221,7 +221,7 @@ HELP: background
|
|||
"10 iota ["
|
||||
" \"Hello world\\n\""
|
||||
" swap 10 / 1 over - over 1 <rgba>"
|
||||
" background associate format nl"
|
||||
" background associate format"
|
||||
"] each"
|
||||
}
|
||||
} ;
|
||||
|
|
|
|||
|
|
@ -132,11 +132,11 @@ HELP: leach
|
|||
|
||||
HELP: foldl
|
||||
{ $values { "list" list } { "identity" "an object" } { "quot" { $quotation "( ... prev elt -- ... next )" } } { "result" "the final result" } }
|
||||
{ $description "Combines successive elements of the list (in a left-assocative order) using a binary operation and outputs the final result." } ;
|
||||
{ $description "Combines successive elements of the list (in a left-associative order) using a binary operation and outputs the final result." } ;
|
||||
|
||||
HELP: foldr
|
||||
{ $values { "list" list } { "identity" "an object" } { "quot" { $quotation "( ... prev elt -- ... next )" } } { "result" "the final result" } }
|
||||
{ $description "Combines successive elements of the list (in a right-assocative order) using a binary operation, and outputs the final result." } ;
|
||||
{ $description "Combines successive elements of the list (in a right-associative order) using a binary operation, and outputs the final result." } ;
|
||||
|
||||
HELP: lmap
|
||||
{ $values { "list" list } { "quot" { $quotation "( ... elt -- ... newelt )" } } { "result" "the final result" } }
|
||||
|
|
@ -144,7 +144,7 @@ HELP: lmap
|
|||
|
||||
HELP: lreverse
|
||||
{ $values { "list" list } { "newlist" list } }
|
||||
{ $description "Reverses the input list, outputing a new, reversed list. The output is a strict cons list." } ;
|
||||
{ $description "Reverses the input list, outputting a new, reversed list. The output is a strict cons list." } ;
|
||||
|
||||
HELP: list>array
|
||||
{ $values { "list" list } { "array" array } }
|
||||
|
|
|
|||
|
|
@ -127,7 +127,7 @@ TUPLE: counter adder subtractor ;
|
|||
<counter>
|
||||
[ adder>> call . ]
|
||||
[ adder>> call . ]
|
||||
[ subtractor>> call . ] tri """
|
||||
[ subtractor>> call . ] tri"""
|
||||
"""1
|
||||
2
|
||||
1"""
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@ HELP: MACRO:
|
|||
{ $examples
|
||||
"A macro that calls a quotation but preserves any values it consumes off the stack:"
|
||||
{ $code
|
||||
"USING: fry generalizations ;"
|
||||
"USING: fry generalizations kernel macros stack-checker ;"
|
||||
"MACRO: preserving ( quot -- )"
|
||||
" [ infer in>> length ] keep '[ _ ndup @ ] ;"
|
||||
" [ inputs ] keep '[ _ ndup @ ] ;"
|
||||
}
|
||||
"Using this macro, we can define a variant of " { $link if } " which takes a predicate quotation instead of a boolean; any values consumed by the predicate quotation are restored immediately after:"
|
||||
{ $code
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ HELP: all-permutations
|
|||
|
||||
HELP: each-permutation
|
||||
{ $values { "seq" sequence } { "quot" { $quotation "( seq -- )" } } }
|
||||
{ $description "Applies the quotation to each permuation of " { $snippet "seq" } " in order." } ;
|
||||
{ $description "Applies the quotation to each permutation of " { $snippet "seq" } " in order." } ;
|
||||
|
||||
HELP: inverse-permutation
|
||||
{ $values { "seq" sequence } { "permutation" sequence } }
|
||||
|
|
|
|||
|
|
@ -150,7 +150,7 @@ int-4{ f f t f } ."""
|
|||
$nl
|
||||
"Providing a SIMD boolean vector with element values other than the proper true and false representations as an input to the vector logical or test operations is undefined. Do not count on operations such as " { $link vall? } " or " { $link v? } " using bitwise operations to construct their results."
|
||||
$nl
|
||||
"This applies to the output of the following element comparison words: "
|
||||
"This applies to the output of the following element comparison words:"
|
||||
{ $list
|
||||
{ $link v< }
|
||||
{ $link v<= }
|
||||
|
|
|
|||
|
|
@ -319,7 +319,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers"
|
|||
"This parser when run with the string \"++--\" or the array "
|
||||
"{ CHAR: + CHAR: + CHAR: - CHAR: - } will succeed with an AST of { \"++\" \"--\" }. "
|
||||
"If you want to add whitespace handling to the grammar you need to put it "
|
||||
"between the terminals: "
|
||||
"between the terminals:"
|
||||
{ $examples
|
||||
{ $code
|
||||
"EBNF: foo"
|
||||
|
|
@ -332,7 +332,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers"
|
|||
"In a large grammar this gets tedious and makes the grammar hard to read. "
|
||||
"Instead you can write a rule to split the input sequence into tokens, and "
|
||||
"have the grammar operate on these tokens. This is how the previous example "
|
||||
"might look: "
|
||||
"might look:"
|
||||
{ $examples
|
||||
{ $code
|
||||
"EBNF: foo"
|
||||
|
|
@ -355,7 +355,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers"
|
|||
$nl
|
||||
"In this example I split the tokenizer into a separate parser and use "
|
||||
"'foreign' to call it from the main one. This allows testing of the "
|
||||
"tokenizer separately: "
|
||||
"tokenizer separately:"
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: prettyprint peg peg.ebnf kernel math.parser strings"
|
||||
|
|
@ -397,7 +397,7 @@ $nl
|
|||
"working in one pass. There is no tokenization occurring over the whole string "
|
||||
"followed by the parse of that result. It tokenizes as it needs to. You can even "
|
||||
"switch tokenizers multiple times during a grammar. Rules use the tokenizer that "
|
||||
"was defined lexically before the rule. This is usefull in the JavaScript grammar: "
|
||||
"was defined lexically before the rule. This is usefull in the JavaScript grammar:"
|
||||
{ $examples
|
||||
{ $code
|
||||
"EBNF: javascript"
|
||||
|
|
@ -440,7 +440,7 @@ ARTICLE: "peg.ebnf" "EBNF"
|
|||
POSTPONE: [EBNF
|
||||
POSTPONE: EBNF:
|
||||
}
|
||||
"The EBNF syntax is composed of a series of rules of the form: "
|
||||
"The EBNF syntax is composed of a series of rules of the form:"
|
||||
{ $code
|
||||
"rule1 = ..."
|
||||
"rule2 = ..."
|
||||
|
|
@ -448,7 +448,7 @@ ARTICLE: "peg.ebnf" "EBNF"
|
|||
"The last defined rule is the main rule for the EBNF. It is the first one run "
|
||||
"and it is expected that the remaining rules are used by that rule. Rules may be "
|
||||
"left recursive. "
|
||||
"Each rule can contain the following: "
|
||||
"Each rule can contain the following:"
|
||||
{ $subsections "peg.ebnf.strings"
|
||||
"peg.ebnf.any"
|
||||
"peg.ebnf.sequence"
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ ARTICLE: "inference-combinators" "Combinator stack effects"
|
|||
": perform ( value action -- result ) quot>> call( value -- result ) ;"
|
||||
}
|
||||
{ $subheading "Passing an unknown quotation to an inline combinator" }
|
||||
"Suppose we want to write :"
|
||||
"Suppose we want to write:"
|
||||
{ $code ": perform ( values action -- results ) quot>> map ;" }
|
||||
"However this fails to pass the stack checker since there is no guarantee the quotation has the right stack effect for " { $link map } ". It can be wrapped in a new quotation with a declaration:"
|
||||
{ $code ": perform ( values action -- results )" " quot>> [ call( value -- result ) ] curry map ;" }
|
||||
|
|
|
|||
|
|
@ -137,9 +137,16 @@ os macosx? [
|
|||
|
||||
[ ] [ "tools.deploy.test.20" shake-and-bake ] unit-test
|
||||
|
||||
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>Factor</foo>\n" ]
|
||||
[ deploy-test-command ascii [ contents ] with-process-reader ] unit-test
|
||||
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>Factor</foo>" ]
|
||||
[ deploy-test-command ascii [ readln ] with-process-reader ] unit-test
|
||||
|
||||
[ ] [ 800000 small-enough? ] unit-test
|
||||
|
||||
[ ] [ "tools.deploy.test.21" shake-and-bake ] unit-test
|
||||
|
||||
[ "1 2 3" ]
|
||||
[ deploy-test-command ascii [ readln ] with-process-reader ] unit-test
|
||||
|
||||
[ ] [ 600000 small-enough? ] unit-test
|
||||
|
||||
[ ] [ "benchmark.ui-panes" shake-and-bake run-temp-image ] unit-test
|
||||
|
|
|
|||
|
|
@ -0,0 +1,7 @@
|
|||
USING: formatting ;
|
||||
IN: tools.deploy.test.21
|
||||
|
||||
: formatting-test ( -- )
|
||||
1 2 3 "%d %d %d" printf ;
|
||||
|
||||
MAIN: formatting-test
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
USING: tools.deploy.config ;
|
||||
H{
|
||||
{ deploy-name "tools.deploy.test.21" }
|
||||
{ deploy-ui? f }
|
||||
{ deploy-c-types? f }
|
||||
{ deploy-console? t }
|
||||
{ deploy-unicode? f }
|
||||
{ "stop-after-last-window?" t }
|
||||
{ deploy-io 2 }
|
||||
{ deploy-reflection 1 }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-math? t }
|
||||
{ deploy-threads? t }
|
||||
{ deploy-word-defs? f }
|
||||
}
|
||||
|
|
@ -32,7 +32,7 @@ $nl
|
|||
{ $heading "Implementation" }
|
||||
"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } ") and an input area (instance of " { $link interactor } "). Clickable presentations can also be printed to the listener; see " { $link "ui-presentations" } "." ;
|
||||
|
||||
TIP: "You can read documentation by pressing F1." ;
|
||||
TIP: "You can read documentation by pressing " { $snippet "F1" } "." ;
|
||||
|
||||
TIP: "The listener tool remembers previous lines of input. Press " { $command interactor "completion" recall-previous } " and " { $command interactor "completion" recall-next } " to cycle through them." ;
|
||||
|
||||
|
|
|
|||
|
|
@ -323,7 +323,7 @@ HELP: assoc-stack
|
|||
|
||||
HELP: value-at*
|
||||
{ $values { "value" object } { "assoc" assoc } { "key/f" "the key associated to the value, or " { $link f } } { "?" boolean } }
|
||||
{ $description "Looks up the key associated with a value. The boolean flag can decide beteen the case of a missing key, and a key of " { $link f } "." } ;
|
||||
{ $description "Looks up the key associated with a value. The boolean flag can decide between the case of a missing key, and a key of " { $link f } "." } ;
|
||||
|
||||
HELP: value-at
|
||||
{ $values { "value" object } { "assoc" assoc } { "key/f" "the key associated to the value, or " { $link f } } }
|
||||
|
|
@ -438,7 +438,7 @@ HELP: assoc-map-as
|
|||
{ $values
|
||||
{ "assoc" assoc } { "quot" { $quotation "( ... key value -- ... newkey newvalue )" } } { "exemplar" assoc }
|
||||
{ "newassoc" assoc } }
|
||||
{ $description "Applies the quotation to each entry in the input assoc and collects the results in a new assoc of the stame type as the exemplar." }
|
||||
{ $description "Applies the quotation to each entry in the input assoc and collects the results in a new assoc of the same type as the exemplar." }
|
||||
{ $examples { $example "USING: prettyprint assocs hashtables math ;" " H{ { 1 2 } { 3 4 } } [ sq ] { } assoc-map-as ." "{ { 1 4 } { 3 16 } }" } } ;
|
||||
|
||||
HELP: extract-keys
|
||||
|
|
@ -467,7 +467,7 @@ HELP: search-alist
|
|||
{ "key" object } { "alist" "an array of key/value pairs" }
|
||||
{ "pair/f" "a key/value pair" } { "i/f" integer } }
|
||||
{ $description "Iterates over " { $snippet "alist" } " and stops when the key is matched or the end of the " { $snippet "alist" } " has been reached. If there is no match, both outputs are " { $link f } "." }
|
||||
{ $notes "This word is used to implement " { $link at* } " and " { $link set-at } " on sequences, and should not be called direclty." }
|
||||
{ $notes "This word is used to implement " { $link at* } " and " { $link set-at } " on sequences, and should not be called directly." }
|
||||
{ $examples { $example "USING: prettyprint assocs.private kernel ;"
|
||||
"3 { { 1 2 } { 3 4 } } search-alist [ . ] bi@"
|
||||
"{ 3 4 }\n1"
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ classes.predicate quotations ;
|
|||
IN: classes
|
||||
|
||||
ARTICLE: "class-predicates" "Class predicate words"
|
||||
"With a handful of exceptions, each class has a membership predicate word, named " { $snippet { $emphasis "class" } "?" } " . A quotation calling this predicate is stored in the " { $snippet "\"predicate\"" } " word property."
|
||||
"With a handful of exceptions, each class has a membership predicate word, named " { $snippet { $emphasis "class" } "?" } ". A quotation calling this predicate is stored in the " { $snippet "\"predicate\"" } " word property."
|
||||
$nl
|
||||
"When it comes to predicates, the exceptional classes are:"
|
||||
{ $table
|
||||
|
|
|
|||
|
|
@ -326,12 +326,14 @@ HELP: cond
|
|||
}
|
||||
{ $errors "Throws a " { $link no-cond } " error if none of the test quotations yield a true value." }
|
||||
{ $examples
|
||||
{ $code
|
||||
"{"
|
||||
" { [ dup 0 > ] [ \"positive\" ] }"
|
||||
" { [ dup 0 < ] [ \"negative\" ] }"
|
||||
" [ \"zero\" ]"
|
||||
"} cond"
|
||||
{ $example
|
||||
"USING: combinators io kernel math ;"
|
||||
"0 {"
|
||||
" { [ dup 0 > ] [ drop \"positive\" ] }"
|
||||
" { [ dup 0 < ] [ drop \"negative\" ] }"
|
||||
" [ drop \"zero\" ]"
|
||||
"} cond print"
|
||||
"zero"
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
@ -340,7 +342,7 @@ HELP: no-cond
|
|||
{ $error-description "Thrown by " { $link cond } " if none of the test quotations yield a true value. Some uses of " { $link cond } " include a default case where the test quotation is " { $snippet "[ t ]" } "; such a " { $link cond } " form will never throw this error." } ;
|
||||
|
||||
HELP: case
|
||||
{ $values { "obj" object } { "assoc" "a sequence of object/word,quotation pairs, with an optional quotation at the end" } }
|
||||
{ $values { "obj" object } { "assoc" "a sequence of object/word, quotation pairs, with an optional quotation at the end" } }
|
||||
{ $description
|
||||
"Compares " { $snippet "obj" } " against the first element of every pair, first evaluating the first element if it is a word. If some pair matches, removes " { $snippet "obj" } " from the stack and calls the second element of that pair, which must be a quotation."
|
||||
$nl
|
||||
|
|
@ -353,6 +355,7 @@ HELP: case
|
|||
{ $examples
|
||||
{ $example
|
||||
"USING: combinators io kernel ;"
|
||||
"IN: scratchpad"
|
||||
"SYMBOLS: yes no maybe ;"
|
||||
"maybe {"
|
||||
" { yes [ ] } ! Do nothing"
|
||||
|
|
|
|||
|
|
@ -265,7 +265,7 @@ HELP: return
|
|||
HELP: with-return
|
||||
{ $values
|
||||
{ "quot" quotation } }
|
||||
{ $description "Captures a continuation that can be reified by calling the " { $link return } " word. If so, it will resume execution immediatly after the " { $link with-return } " word. If " { $link return } " is not called, then execution proceeds as if this word were simply " { $link call } "." }
|
||||
{ $description "Captures a continuation that can be reified by calling the " { $link return } " word. If so, it will resume execution immediately after the " { $link with-return } " word. If " { $link return } " is not called, then execution proceeds as if this word were simply " { $link call } "." }
|
||||
{ $examples
|
||||
"Only \"Hi\" will print:"
|
||||
{ $example
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@ $nl
|
|||
$nl
|
||||
"Now, after some heavily editing and refactoring, the file looks like this:"
|
||||
{ $code
|
||||
"USING: namespaces ;"
|
||||
"USING: make ;"
|
||||
"IN: a"
|
||||
": hello ( -- ) \"Hello\" % ;"
|
||||
": hello-world ( -- str ) [ hello \" \" % world ] \"\" make ;"
|
||||
|
|
|
|||
|
|
@ -716,7 +716,7 @@ HELP: MATH:
|
|||
{ $description "Defines a new generic word which uses the " { $link math-combination } " method combination." } ;
|
||||
|
||||
HELP: HOOK:
|
||||
{ $syntax "HOOK: word variable ( stack -- effect ) " }
|
||||
{ $syntax "HOOK: word variable ( stack -- effect )" }
|
||||
{ $values { "word" "a new word to define" } { "variable" word } }
|
||||
{ $description "Defines a new hook word in the current vocabulary. Hook words are generic words which dispatch on the value of a variable, so methods are defined with " { $link POSTPONE: M: } ". Hook words differ from other generic words in that the dispatch value is removed from the stack before the chosen method is called." }
|
||||
{ $examples
|
||||
|
|
@ -850,7 +850,7 @@ HELP: C:
|
|||
"The following two lines are equivalent:"
|
||||
{ $code
|
||||
"C: <color> color"
|
||||
": <color> color boa ;"
|
||||
": <color> ( red green blue -- color ) color boa ;"
|
||||
}
|
||||
"In both cases, a word " { $snippet "<color>" } " is defined, which reads three values from the stack and creates a " { $snippet "color" } " instance having these values in the " { $snippet "red" } ", " { $snippet "green" } " and " { $snippet "blue" } " slots, respectively."
|
||||
} ;
|
||||
|
|
|
|||
|
|
@ -165,7 +165,7 @@ ARTICLE: "words" "Words"
|
|||
$nl
|
||||
"There are two ways of creating word definitions:"
|
||||
{ $list
|
||||
"using parsing words at parse time,"
|
||||
"using parsing words at parse time."
|
||||
"using defining words at run time."
|
||||
}
|
||||
"The latter is a more dynamic feature that can be used to implement code generation and such, and in fact parse time defining words are implemented in terms of run time defining words."
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ IN: bunny.model
|
|||
|
||||
: model-path ( -- path ) "bun_zipper.ply" temp-file ;
|
||||
|
||||
: model-url ( -- url ) "http://factorcode.org/slava/bun_zipper.ply" ;
|
||||
: model-url ( -- url ) "http://duriansoftware.com/joe/media/bun_zipper.ply" ;
|
||||
|
||||
: maybe-download ( -- path )
|
||||
model-path dup exists? [
|
||||
|
|
|
|||
|
|
@ -368,7 +368,6 @@ M: SOA rdata>byte-array
|
|||
: message>query-name ( message -- string )
|
||||
query>> first name>> dotted> ;
|
||||
|
||||
USE: nested-comments
|
||||
(*
|
||||
M: string resolve-host
|
||||
dup >lower "localhost" = [
|
||||
|
|
|
|||
|
|
@ -145,7 +145,7 @@ UNIFORM-TUPLE: loading-uniforms
|
|||
|
||||
: bunny-model-path ( -- path ) "bun_zipper.ply" temp-file ;
|
||||
|
||||
CONSTANT: bunny-model-url "http://factorcode.org/slava/bun_zipper.ply"
|
||||
CONSTANT: bunny-model-url "http://duriansoftware.com/joe/media/bun_zipper.ply"
|
||||
|
||||
: download-bunny ( -- path )
|
||||
bunny-model-path dup exists? [
|
||||
|
|
|
|||
|
|
@ -95,7 +95,7 @@ $nl
|
|||
|
||||
|
||||
$nl
|
||||
"Utility words for displaying images :"
|
||||
"Utility words for displaying images:"
|
||||
{ $subsections
|
||||
image. image-window }
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ IN: tools.dns
|
|||
[ write " has address " write ] [ print ] bi* ;
|
||||
|
||||
: a-message. ( message -- )
|
||||
[ message>query-name ] [ message>names ] bi
|
||||
[ message>query-name ] [ message>a-names ] bi
|
||||
[ a-line. ] with each ;
|
||||
|
||||
: mx-line. ( host pair -- )
|
||||
Loading…
Reference in New Issue