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

db4
Doug Coleman 2011-02-26 11:44:50 -06:00
commit 979e487fef
39 changed files with 192 additions and 121 deletions

View File

@ -27,7 +27,7 @@ HELP: HEXCOLOR:
ARTICLE: "colors.hex" "HEX colors" ARTICLE: "colors.hex" "HEX colors"
"The " { $vocab-link "colors.hex" } " vocabulary implements colors specified " "The " { $vocab-link "colors.hex" } " vocabulary implements colors specified "
"by their hexidecimal value." "by their hexadecimal value."
{ $subsections { $subsections
hex>rgba hex>rgba
rgba>hex rgba>hex

View File

@ -32,17 +32,21 @@ HELP: casep
{ $examples { $examples
"The following two forms will output 1 with 0.2 probability, 2 with 0.3 probability and 3 with 0.5 probability" "The following two forms will output 1 with 0.2 probability, 2 with 0.3 probability and 3 with 0.5 probability"
{ $code { $code
"USING: combinators.random ;" "USING: combinators.random prettyprint ;"
"{ { 0.2 [ 1 ] }" "{"
" { 0.3 [ 2 ] }" " { 0.2 [ 1 ] }"
" { 0.5 [ 3 ] } } casep ." " { 0.3 [ 2 ] }"
" { 0.5 [ 3 ] }"
"} casep ."
} }
$nl $nl
{ $code { $code
"USING: combinators.random ;" "USING: combinators.random prettyprint ;"
"{ { 0.2 [ 1 ] }" "{"
" { 0.3 [ 2 ] }" " { 0.2 [ 1 ] }"
" { [ 3 ] } } casep ." " { 0.3 [ 2 ] }"
" [ 3 ]"
"} casep ."
} }
} }
@ -62,17 +66,21 @@ HELP: casep*
{ $examples { $examples
"The following two forms will output 1 with 0.5 probability, 2 with 0.25 probability and 3 with 0.25 probability" "The following two forms will output 1 with 0.5 probability, 2 with 0.25 probability and 3 with 0.25 probability"
{ $code { $code
"USING: combinators.random ;" "USING: combinators.random prettyprint ;"
"{ { 0.5 [ 1 ] }" "{"
" { 0.5 [ 2 ] }" " { 0.5 [ 1 ] }"
" { 1 [ 3 ] } } casep* ." " { 0.5 [ 2 ] }"
" { 1 [ 3 ] }"
"} casep* ."
} }
$nl $nl
{ $code { $code
"USING: combinators.random ;" "USING: combinators.random prettyprint ;"
"{ { 0.5 [ 1 ] }" "{"
" { 0.5 [ 2 ] }" " { 0.5 [ 1 ] }"
" { [ 3 ] } } casep* ." " { 0.5 [ 2 ] }"
" [ 3 ]"
"} casep* ."
} }
} }

View File

@ -24,10 +24,10 @@ V{ } 5 test-bb
[ ] [ test-tdmsc ] unit-test [ ] [ test-tdmsc ] unit-test
[ V{ 4 } ] [ 1 get 1array merge-set [ number>> ] map ] unit-test [ { 4 } ] [ 1 get 1array merge-set [ number>> ] map ] unit-test
[ V{ 4 } ] [ 2 get 1array merge-set [ number>> ] map ] unit-test [ { 4 } ] [ 2 get 1array merge-set [ number>> ] map ] unit-test
[ V{ } ] [ 0 get 1array merge-set ] unit-test [ { } ] [ 0 get 1array merge-set ] unit-test
[ V{ } ] [ 4 get 1array merge-set ] unit-test [ { } ] [ 4 get 1array merge-set ] unit-test
V{ } 0 test-bb V{ } 0 test-bb
V{ } 1 test-bb V{ } 1 test-bb
@ -70,5 +70,5 @@ V{ } 7 test-bb
[ ] [ test-tdmsc ] unit-test [ ] [ test-tdmsc ] unit-test
[ V{ 2 } ] [ { 2 3 4 5 } [ get ] map merge-set [ number>> ] map ] unit-test [ { 2 } ] [ { 2 3 4 5 } [ get ] map merge-set [ number>> ] map ] unit-test
[ V{ } ] [ { 0 1 6 7 } [ get ] map merge-set ] unit-test [ { } ] [ { 0 1 6 7 } [ get ] map merge-set ] unit-test

View File

@ -4,7 +4,7 @@ IN: concurrency.distributed
ARTICLE: "concurrency.distributed.example" "Distributed Concurrency Example" ARTICLE: "concurrency.distributed.example" "Distributed Concurrency Example"
"In this example the Factor instance associated with port 9000 will run " "In this example the Factor instance associated with port 9000 will run "
"a thread that receives and prints messages " "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 { $examples
{ $unchecked-example { $unchecked-example
": log-message ( -- ) receive . flush log-message ;" ": log-message ( -- ) receive . flush log-message ;"
@ -40,7 +40,7 @@ ARTICLE: "concurrency.distributed" "Distributed message passing"
"The " { $vocab-link "concurrency.distributed" } " implements transparent distributed message passing, inspired by Erlang and Termite." $nl "The " { $vocab-link "concurrency.distributed" } " implements transparent distributed message passing, inspired by Erlang and Termite." $nl
"Instances of " { $link thread } " can be sent to remote threads, at which point they are converted to objects holding the thread ID and the current node's host name:" "Instances of " { $link thread } " can be sent to remote threads, at which point they are converted to objects holding the thread ID and the current node's host name:"
{ $subsections remote-thread } { $subsections remote-thread }
"The " { $vocab-link "serialize" } " vocabulary is used to convert Factor objects to byte arrays for transfer over a socket." "The " { $vocab-link "serialize" } " vocabulary is used to convert Factor objects to byte arrays for transfer over a socket."
{ $subsections "concurrency.distributed.example" } ; { $subsections "concurrency.distributed.example" } ;
ABOUT: "concurrency.distributed" ABOUT: "concurrency.distributed"

View File

@ -5,7 +5,7 @@ IN: environment
HELP: (os-envs) HELP: (os-envs)
{ $values { $values
{ "seq" sequence } } { "seq" sequence } }
{ $description "Returns a sequence of key/value pairs from the operating system." } { $description "Returns a sequence of key/value pairs from the operating system." }
{ $notes "In most cases, use " { $link os-envs } " instead." } ; { $notes "In most cases, use " { $link os-envs } " instead." } ;
@ -22,7 +22,11 @@ HELP: os-env
{ $description "Looks up the value of a shell environment variable." } { $description "Looks up the value of a shell environment variable." }
{ $examples { $examples
"This is an operating system-specific feature. On Unix, you can do:" "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 HELP: os-envs

View File

@ -8,7 +8,7 @@ HELP: articles
HELP: no-article HELP: no-article
{ $values { "name" "an article name" } } { $values { "name" "an article name" } }
{ $description "Throws a " { $link no-article } " error." } { $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 HELP: article
{ $values { "name" "an article name" } { "article" "an " { $link article } " object" } } { $values { "name" "an article name" } { "article" "an " { $link article } " object" } }

View File

@ -17,7 +17,7 @@ $nl
{ { $slot "header" } { "An assoc of HTTP header values. See " { $link "http.headers" } } } { { $slot "header" } { "An assoc of HTTP header values. See " { $link "http.headers" } } }
{ { $slot "post-data" } { "See " { $link "http.post-data" } } } { { $slot "post-data" } { "See " { $link "http.post-data" } } }
{ { $slot "cookies" } { "A sequence of HTTP cookies. See " { $link "http.cookies" } } } { { $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> HELP: <response>
@ -105,7 +105,7 @@ $nl
"Instances contain the following slots:" "Instances contain the following slots:"
{ $table { $table
{ { $slot "data" } { "The POST data. This can be in a higher-level form, such as an assoc of POST parameters, a string, or an XML document" } } { { $slot "data" } { "The POST data. This can be in a higher-level form, such as an assoc of POST parameters, a string, or an XML document" } }
{ { $slot "params" } { "Parameters passed in the POST request." } } { { $slot "params" } { "Parameters passed in the POST request." } }
{ { $slot "content-type" } { "A MIME type" } } { { $slot "content-type" } { "A MIME type" } }
{ { $slot "content-encoding" } { "Encoding used for the POST data" } } { { $slot "content-encoding" } { "Encoding used for the POST data" } }
} } ; } } ;

View File

@ -4,10 +4,10 @@ USING: help.markup help.syntax ;
IN: io.encodings.8-bit.latin9 IN: io.encodings.8-bit.latin9
HELP: 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" } ; { $see-also "encodings-introduction" } ;
ARTICLE: "io.encodings.8-bit.latin9" "Latin9 encoding" ARTICLE: "io.encodings.8-bit.latin9" "Latin9 encoding"
"The " { $vocab-link "io.encodings.8-bit.latin9" } " vocabulary provides the " { $link latin9 } " encoding." ; "The " { $vocab-link "io.encodings.8-bit.latin9" } " vocabulary provides the " { $link latin9 } " encoding." ;
ABOUT: "io.encodings.8-bit.latin9" ABOUT: "io.encodings.8-bit.latin9"

View File

@ -4,7 +4,7 @@ USING: help.markup help.syntax ;
IN: io.encodings.shift-jis IN: io.encodings.shift-jis
ARTICLE: "io.encodings.shift-jis" "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 { $subsections
shift-jis shift-jis
windows-31j windows-31j

View File

@ -41,7 +41,7 @@ M: icmp4 resolve-host 1array ;
TUPLE: icmp6 < ipv6 ; TUPLE: icmp6 < ipv6 ;
C: <icmp6> icmp6 : <icmp6> ( host -- icmp6 ) 0 icmp6 boa ;
M: ipv6 with-icmp host>> <icmp6> ; M: ipv6 with-icmp host>> <icmp6> ;

View File

@ -41,7 +41,11 @@ io.sockets.secure.unix.debug ;
] server-test ] server-test
] unit-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 ! Now, try validating the certificate. This should fail because its
! actually an invalid certificate ! actually an invalid certificate

View File

@ -110,7 +110,7 @@ HELP: local
HELP: inet HELP: inet
{ $class-description "Host name/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the host name and port name or number, respectively. New instances are created by calling " { $link <inet> } "." } { $class-description "Host name/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the host name and port name or number, respectively. New instances are created by calling " { $link <inet> } "." }
{ $notes { $notes
"This address specifier is only supported by " { $link <client> } ", which calls " { $link resolve-host } " to obtain a list of IP addresses associated with the host name, and attempts a connection to each one in turn until one succeeds. Other network words do not accept this address specifier, and " { $link resolve-host } " must be called directly; it is then up to the application to pick the correct address from the (possibly several) addresses associated to the host name." "This address specifier is only supported by " { $link <client> } ", which calls " { $link resolve-host } " to obtain a list of IP addresses associated with the host name, and attempts a connection to each one in turn until one succeeds. Other network words do not accept this address specifier, and " { $link resolve-host } " must be called directly; it is then up to the application to pick the correct address from the (possibly several) addresses associated to the host name."
} }
{ $examples { $examples
{ $code "\"www.apple.com\" 80 <inet>" } { $code "\"www.apple.com\" 80 <inet>" }
@ -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." } ; { $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> 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." } { $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." } { $errors "Throws an error if the connection cannot be established." }
{ $notes "The " { $link with-client } " word is easier to use in most situations." } { $notes "The " { $link with-client } " word is easier to use in most situations." }
@ -157,7 +157,7 @@ HELP: with-client
{ $errors "Throws an error if the connection cannot be established." } ; { $errors "Throws an error if the connection cannot be established." } ;
HELP: <server> HELP: <server>
{ $values { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } } { $values { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } }
{ $description { $description
"Begins listening for network connections to a local address. Server objects respond to two words:" "Begins listening for network connections to a local address. Server objects respond to two words:"
{ $list { $list
@ -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." } { $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 { $examples
{ "Binds the local address of a newly created client socket within the quotation to 127.0.0.1." { "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" } { $code "\"127.0.0.1\" 0 <inet4> [ ] with-local-address" }
$nl $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. " { "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. "

View File

@ -1,11 +1,12 @@
USING: io.sockets io.sockets.private sequences math tools.test USING: io.sockets io.sockets.private sequences math tools.test
namespaces accessors kernel destructors calendar io.timeouts namespaces accessors kernel destructors calendar io.timeouts
io.encodings.utf8 io concurrency.promises threads io.encodings.utf8 io concurrency.promises threads
io.streams.string ; io.streams.string present ;
IN: io.sockets.tests 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{ 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 [ 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{ 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" 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{ 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 [ 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 } ] [ B{ 1 2 3 4 } ]
[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test [ "1.2.3.4" T{ inet4 } inet-pton ] unit-test

View File

@ -125,9 +125,11 @@ M: inet4 present
M: inet4 protocol drop 0 ; 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 ) M: ipv6 inet-ntop ( data addrspec -- str )
drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ; drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
@ -184,23 +186,31 @@ M: ipv6 make-sockaddr ( inet -- sockaddr )
AF_INET6 >>family AF_INET6 >>family
swap swap
[ port>> htons >>port ] [ port>> htons >>port ]
[ host>> "::" or ] [ [ host>> "::" or ] keep inet-pton >>addr ]
[ inet-pton >>addr ] tri ; [ scope-id>> >>scopeid ]
tri ;
M: ipv6 parse-sockaddr 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 } ; 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 M: inet6 parse-sockaddr
[ call-next-method ] [ drop port>> ntohs ] 2bi with-port ; [ call-next-method ] [ drop port>> ntohs ] 2bi with-port ;
M: inet6 present M: inet6 present
[ host>> ] [ port>> number>string ] bi ":" glue ; [ call-next-method ] [ port>> number>string ] bi ":" glue ;
M: inet6 protocol drop 0 ; M: inet6 protocol drop 0 ;

View File

@ -221,7 +221,7 @@ HELP: background
"10 iota [" "10 iota ["
" \"Hello world\\n\"" " \"Hello world\\n\""
" swap 10 / 1 over - over 1 <rgba>" " swap 10 / 1 over - over 1 <rgba>"
" background associate format nl" " background associate format"
"] each" "] each"
} }
} ; } ;

View File

@ -62,11 +62,11 @@ ARTICLE: { "lists" "manipulation" } "Manipulating lists"
lcut lcut
} ; } ;
HELP: cons HELP: cons
{ $values { "car" "the head of the list cell" } { "cdr" "the tail of the list cell" } { "cons" list } } { $values { "car" "the head of the list cell" } { "cdr" "the tail of the list cell" } { "cons" list } }
{ $description "Constructs a cons cell." } ; { $description "Constructs a cons cell." } ;
HELP: swons HELP: swons
{ $values { "cdr" "the tail of the list cell" } { "car" "the head of the list cell" } { "cons" list } } { $values { "cdr" "the tail of the list cell" } { "car" "the head of the list cell" } { "cons" list } }
{ $description "Constructs a cons cell." } ; { $description "Constructs a cons cell." } ;
@ -82,11 +82,11 @@ HELP: cdr
{ car cdr } related-words { car cdr } related-words
HELP: nil HELP: nil
{ $values { "symbol" "The empty cons (+nil+)" } } { $values { "symbol" "The empty cons (+nil+)" } }
{ $description "Returns a symbol representing the empty list" } ; { $description "Returns a symbol representing the empty list" } ;
HELP: nil? HELP: nil?
{ $values { "object" object } { "?" "a boolean" } } { $values { "object" object } { "?" "a boolean" } }
{ $description "Return true if the cons object is the nil cons." } ; { $description "Return true if the cons object is the nil cons." } ;
@ -108,12 +108,12 @@ HELP: 3list
HELP: lnth HELP: lnth
{ $values { "n" "an integer index" } { "list" list } { "elt" "the element at the nth index" } } { $values { "n" "an integer index" } { "list" list } { "elt" "the element at the nth index" } }
{ $description "Outputs the nth element of the list." } { $description "Outputs the nth element of the list." }
{ $see-also llength cons car cdr } ; { $see-also llength cons car cdr } ;
HELP: llength HELP: llength
{ $values { "list" list } { "n" "a non-negative integer" } } { $values { "list" list } { "n" "a non-negative integer" } }
{ $description "Outputs the length of the list. This should not be called on an infinite list." } { $description "Outputs the length of the list. This should not be called on an infinite list." }
{ $see-also lnth cons car cdr } ; { $see-also lnth cons car cdr } ;
HELP: uncons HELP: uncons
@ -132,11 +132,11 @@ HELP: leach
HELP: foldl HELP: foldl
{ $values { "list" list } { "identity" "an object" } { "quot" { $quotation "( ... prev elt -- ... next )" } } { "result" "the final result" } } { $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 HELP: foldr
{ $values { "list" list } { "identity" "an object" } { "quot" { $quotation "( ... prev elt -- ... next )" } } { "result" "the final result" } } { $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 HELP: lmap
{ $values { "list" list } { "quot" { $quotation "( ... elt -- ... newelt )" } } { "result" "the final result" } } { $values { "list" list } { "quot" { $quotation "( ... elt -- ... newelt )" } } { "result" "the final result" } }
@ -144,9 +144,9 @@ HELP: lmap
HELP: lreverse HELP: lreverse
{ $values { "list" list } { "newlist" list } } { $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 HELP: list>array
{ $values { "list" list } { "array" array } } { $values { "list" list } { "array" array } }
{ $description "Convert a list into an array." } ; { $description "Convert a list into an array." } ;

View File

@ -55,7 +55,7 @@ $nl
{ $examples "See " { $link "locals-examples" } "." } ; { $examples "See " { $link "locals-examples" } "." } ;
{ POSTPONE: MEMO: POSTPONE: MEMO:: } related-words { POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
HELP: M:: HELP: M::
{ $syntax "M:: class generic ( vars... -- outputs... ) body... ;" } { $syntax "M:: class generic ( vars... -- outputs... ) body... ;" }
{ $description "Defines a new method on " { $snippet "generic" } " for " { $snippet "class" } " with named inputs. The method binds its input values to lexical variables from left to right, then executes the body with those bindings in scope." { $description "Defines a new method on " { $snippet "generic" } " for " { $snippet "class" } " with named inputs. The method binds its input values to lexical variables from left to right, then executes the body with those bindings in scope."
@ -127,7 +127,7 @@ TUPLE: counter adder subtractor ;
<counter> <counter>
[ adder>> call . ] [ adder>> call . ]
[ adder>> call . ] [ adder>> call . ]
[ subtractor>> call . ] tri """ [ subtractor>> call . ] tri"""
"""1 """1
2 2
1""" 1"""
@ -149,7 +149,7 @@ mutable-example [ call . ] bi@"""
6 6
6 6
6""" 6"""
} }
"In " { $snippet "rebinding-example" } ", the binding of " { $snippet "a" } " to " { $snippet "5" } " is closed over in the first quotation, and the binding of " { $snippet "a" } " to " { $snippet "6" } " is closed over in the second, so calling both quotations results in " { $snippet "5" } " and " { $snippet "6" } " respectively. By contrast, in " { $snippet "mutable-example" } ", both quotations close over a single binding of " { $snippet "a" } ". Even though " { $snippet "a" } " is assigned to " { $snippet "6" } " after the first quotation is made, calling either quotation will output the new value of " { $snippet "a" } "." "In " { $snippet "rebinding-example" } ", the binding of " { $snippet "a" } " to " { $snippet "5" } " is closed over in the first quotation, and the binding of " { $snippet "a" } " to " { $snippet "6" } " is closed over in the second, so calling both quotations results in " { $snippet "5" } " and " { $snippet "6" } " respectively. By contrast, in " { $snippet "mutable-example" } ", both quotations close over a single binding of " { $snippet "a" } ". Even though " { $snippet "a" } " is assigned to " { $snippet "6" } " after the first quotation is made, calling either quotation will output the new value of " { $snippet "a" } "."
{ $heading "Lexical variables in literals" } { $heading "Lexical variables in literals" }
"Some kinds of literals can include references to lexical variables as described in " { $link "locals-literals" } ". For example, the " { $link 3array } " word could be implemented as follows:" "Some kinds of literals can include references to lexical variables as described in " { $link "locals-literals" } ". For example, the " { $link 3array } " word could be implemented as follows:"
@ -161,7 +161,7 @@ IN: scratchpad
1 "two" 3.0 my-3array .""" 1 "two" 3.0 my-3array ."""
"""{ 1 "two" 3.0 }""" """{ 1 "two" 3.0 }"""
} ; } ;
ARTICLE: "locals-literals" "Lexical variables in literals" ARTICLE: "locals-literals" "Lexical variables in literals"
"Certain data type literals are permitted to contain lexical variables. Any such literals are rewritten into code which constructs an instance of the type with the values of the variables spliced in. Conceptually, this is similar to the transformation applied to quotations containing free variables." "Certain data type literals are permitted to contain lexical variables. Any such literals are rewritten into code which constructs an instance of the type with the values of the variables spliced in. Conceptually, this is similar to the transformation applied to quotations containing free variables."
$nl $nl

View File

@ -16,9 +16,9 @@ HELP: MACRO:
{ $examples { $examples
"A macro that calls a quotation but preserves any values it consumes off the stack:" "A macro that calls a quotation but preserves any values it consumes off the stack:"
{ $code { $code
"USING: fry generalizations ;" "USING: fry generalizations kernel macros stack-checker ;"
"MACRO: preserving ( quot -- )" "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:" "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 { $code

View File

@ -4,7 +4,7 @@ IN: math.combinatorics
HELP: factorial HELP: factorial
{ $values { "n" "a non-negative integer" } { "n!" integer } } { $values { "n" "a non-negative integer" } { "n!" integer } }
{ $description "Outputs the product of all positive integers less than or equal to " { $snippet "n" } "." } { $description "Outputs the product of all positive integers less than or equal to " { $snippet "n" } "." }
{ $examples { $examples
{ $example "USING: math.combinatorics prettyprint ;" { $example "USING: math.combinatorics prettyprint ;"
"4 factorial ." "24" } "4 factorial ." "24" }
} ; } ;
@ -46,7 +46,7 @@ HELP: all-permutations
HELP: each-permutation HELP: each-permutation
{ $values { "seq" sequence } { "quot" { $quotation "( seq -- )" } } } { $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 HELP: inverse-permutation
{ $values { "seq" sequence } { "permutation" sequence } } { $values { "seq" sequence } { "permutation" sequence } }
@ -121,7 +121,7 @@ HELP: selections
{ $description { $description
"Returns all the ways to take n (possibly the same) items from the " "Returns all the ways to take n (possibly the same) items from the "
"sequence of items." "sequence of items."
} }
{ $examples { $examples
{ $example { $example
"USING: math.combinatorics prettyprint ;" "USING: math.combinatorics prettyprint ;"

View File

@ -150,7 +150,7 @@ int-4{ f f t f } ."""
$nl $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." "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 $nl
"This applies to the output of the following element comparison words: " "This applies to the output of the following element comparison words:"
{ $list { $list
{ $link v< } { $link v< }
{ $link v<= } { $link v<= }

View File

@ -319,7 +319,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers"
"This parser when run with the string \"++--\" or the array " "This parser when run with the string \"++--\" or the array "
"{ CHAR: + CHAR: + CHAR: - CHAR: - } will succeed with an AST of { \"++\" \"--\" }. " "{ 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 " "If you want to add whitespace handling to the grammar you need to put it "
"between the terminals: " "between the terminals:"
{ $examples { $examples
{ $code { $code
"EBNF: foo" "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. " "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 " "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 " "have the grammar operate on these tokens. This is how the previous example "
"might look: " "might look:"
{ $examples { $examples
{ $code { $code
"EBNF: foo" "EBNF: foo"
@ -355,7 +355,7 @@ ARTICLE: "peg.ebnf.tokenizers" "Tokenizers"
$nl $nl
"In this example I split the tokenizer into a separate parser and use " "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 " "'foreign' to call it from the main one. This allows testing of the "
"tokenizer separately: " "tokenizer separately:"
{ $examples { $examples
{ $example { $example
"USING: prettyprint peg peg.ebnf kernel math.parser strings" "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 " "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 " "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 " "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 { $examples
{ $code { $code
"EBNF: javascript" "EBNF: javascript"
@ -440,7 +440,7 @@ ARTICLE: "peg.ebnf" "EBNF"
POSTPONE: [EBNF POSTPONE: [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 { $code
"rule1 = ..." "rule1 = ..."
"rule2 = ..." "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 " "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 " "and it is expected that the remaining rules are used by that rule. Rules may be "
"left recursive. " "left recursive. "
"Each rule can contain the following: " "Each rule can contain the following:"
{ $subsections "peg.ebnf.strings" { $subsections "peg.ebnf.strings"
"peg.ebnf.any" "peg.ebnf.any"
"peg.ebnf.sequence" "peg.ebnf.sequence"

View File

@ -48,7 +48,7 @@ ARTICLE: "inference-combinators" "Combinator stack effects"
": perform ( value action -- result ) quot>> call( value -- result ) ;" ": perform ( value action -- result ) quot>> call( value -- result ) ;"
} }
{ $subheading "Passing an unknown quotation to an inline combinator" } { $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 ;" } { $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:" "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 ;" } { $code ": perform ( values action -- results )" " quot>> [ call( value -- result ) ] curry map ;" }

View File

@ -137,9 +137,16 @@ os macosx? [
[ ] [ "tools.deploy.test.20" shake-and-bake ] unit-test [ ] [ "tools.deploy.test.20" shake-and-bake ] unit-test
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>Factor</foo>\n" ] [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><foo>Factor</foo>" ]
[ deploy-test-command ascii [ contents ] with-process-reader ] unit-test [ deploy-test-command ascii [ readln ] with-process-reader ] unit-test
[ ] [ 800000 small-enough? ] 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 [ ] [ "benchmark.ui-panes" shake-and-bake run-temp-image ] unit-test

View File

@ -0,0 +1,7 @@
USING: formatting ;
IN: tools.deploy.test.21
: formatting-test ( -- )
1 2 3 "%d %d %d" printf ;
MAIN: formatting-test

View File

@ -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 }
}

View File

@ -32,7 +32,7 @@ $nl
{ $heading "Implementation" } { $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" } "." ; "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." ; 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." ;

View File

@ -323,7 +323,7 @@ HELP: assoc-stack
HELP: value-at* HELP: value-at*
{ $values { "value" object } { "assoc" assoc } { "key/f" "the key associated to the value, or " { $link f } } { "?" boolean } } { $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 HELP: value-at
{ $values { "value" object } { "assoc" assoc } { "key/f" "the key associated to the value, or " { $link f } } } { $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 { $values
{ "assoc" assoc } { "quot" { $quotation "( ... key value -- ... newkey newvalue )" } } { "exemplar" assoc } { "assoc" assoc } { "quot" { $quotation "( ... key value -- ... newkey newvalue )" } } { "exemplar" assoc }
{ "newassoc" 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 } }" } } ; { $examples { $example "USING: prettyprint assocs hashtables math ;" " H{ { 1 2 } { 3 4 } } [ sq ] { } assoc-map-as ." "{ { 1 4 } { 3 16 } }" } } ;
HELP: extract-keys HELP: extract-keys
@ -457,7 +457,7 @@ HELP: push-at
{ $values { $values
{ "value" object } { "key" object } { "assoc" assoc } } { "value" object } { "key" object } { "assoc" assoc } }
{ $description "Pushes the " { $snippet "value" } " onto a " { $snippet "vector" } " stored at the " { $snippet "key" } " in the " { $snippet "assoc" } ". If the " { $snippet "key" } " does not yet exist, creates a new " { $snippet "vector" } " at that " { $snippet "key" } " and pushes the " { $snippet "value" } "." } { $description "Pushes the " { $snippet "value" } " onto a " { $snippet "vector" } " stored at the " { $snippet "key" } " in the " { $snippet "assoc" } ". If the " { $snippet "key" } " does not yet exist, creates a new " { $snippet "vector" } " at that " { $snippet "key" } " and pushes the " { $snippet "value" } "." }
{ $examples { $example "USING: prettyprint assocs kernel ;" { $examples { $example "USING: prettyprint assocs kernel ;"
"H{ { \"cats\" V{ \"Mittens\" } } } \"Mew\" \"cats\" pick push-at ." "H{ { \"cats\" V{ \"Mittens\" } } } \"Mew\" \"cats\" pick push-at ."
"H{ { \"cats\" V{ \"Mittens\" \"Mew\" } } }" "H{ { \"cats\" V{ \"Mittens\" \"Mew\" } } }"
} } ; } } ;
@ -467,7 +467,7 @@ HELP: search-alist
{ "key" object } { "alist" "an array of key/value pairs" } { "key" object } { "alist" "an array of key/value pairs" }
{ "pair/f" "a key/value pair" } { "i/f" integer } } { "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 } "." } { $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 ;" { $examples { $example "USING: prettyprint assocs.private kernel ;"
"3 { { 1 2 } { 3 4 } } search-alist [ . ] bi@" "3 { { 1 2 } { 3 4 } } search-alist [ . ] bi@"
"{ 3 4 }\n1" "{ 3 4 }\n1"

View File

@ -5,7 +5,7 @@ classes.predicate quotations ;
IN: classes IN: classes
ARTICLE: "class-predicates" "Class predicate words" 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 $nl
"When it comes to predicates, the exceptional classes are:" "When it comes to predicates, the exceptional classes are:"
{ $table { $table
@ -94,7 +94,7 @@ $low-level-note ;
HELP: superclass HELP: superclass
{ $values { "class" class } { "super" class } } { $values { "class" class } { "super" class } }
{ $description "Outputs the superclass of a class. All instances of this class are also instances of the superclass." } { $description "Outputs the superclass of a class. All instances of this class are also instances of the superclass." }
{ $examples { $examples
{ $example "USING: classes prettyprint ;" { $example "USING: classes prettyprint ;"
"t superclass ." "t superclass ."
"word" "word"
@ -106,7 +106,7 @@ HELP: superclasses
{ "class" class } { "class" class }
{ "supers" sequence } } { "supers" sequence } }
{ $description "Outputs a sequence of superclasses of a class along with the class itself." } { $description "Outputs a sequence of superclasses of a class along with the class itself." }
{ $examples { $examples
{ $example "USING: classes prettyprint ;" { $example "USING: classes prettyprint ;"
"t superclasses ." "t superclasses ."
"{ word t }" "{ word t }"
@ -120,7 +120,7 @@ HELP: subclass-of?
{ "?" boolean } { "?" boolean }
} }
{ $description "Outputs a boolean value indicating whether " { $snippet "class" } " is at any level a subclass of " { $snippet "superclass" } "." } { $description "Outputs a boolean value indicating whether " { $snippet "class" } " is at any level a subclass of " { $snippet "superclass" } "." }
{ $examples { $examples
{ $example "USING: classes classes.tuple prettyprint words ;" { $example "USING: classes classes.tuple prettyprint words ;"
"tuple-class \\ class subclass-of? ." "tuple-class \\ class subclass-of? ."
"t" "t"

View File

@ -326,12 +326,14 @@ HELP: cond
} }
{ $errors "Throws a " { $link no-cond } " error if none of the test quotations yield a true value." } { $errors "Throws a " { $link no-cond } " error if none of the test quotations yield a true value." }
{ $examples { $examples
{ $code { $example
"{" "USING: combinators io kernel math ;"
" { [ dup 0 > ] [ \"positive\" ] }" "0 {"
" { [ dup 0 < ] [ \"negative\" ] }" " { [ dup 0 > ] [ drop \"positive\" ] }"
" [ \"zero\" ]" " { [ dup 0 < ] [ drop \"negative\" ] }"
"} cond" " [ 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." } ; { $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 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 { $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." "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 $nl
@ -353,6 +355,7 @@ HELP: case
{ $examples { $examples
{ $example { $example
"USING: combinators io kernel ;" "USING: combinators io kernel ;"
"IN: scratchpad"
"SYMBOLS: yes no maybe ;" "SYMBOLS: yes no maybe ;"
"maybe {" "maybe {"
" { yes [ ] } ! Do nothing" " { yes [ ] } ! Do nothing"

View File

@ -265,7 +265,7 @@ HELP: return
HELP: with-return HELP: with-return
{ $values { $values
{ "quot" quotation } } { "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 { $examples
"Only \"Hi\" will print:" "Only \"Hi\" will print:"
{ $example { $example

View File

@ -34,7 +34,7 @@ $nl
$nl $nl
"Now, after some heavily editing and refactoring, the file looks like this:" "Now, after some heavily editing and refactoring, the file looks like this:"
{ $code { $code
"USING: namespaces ;" "USING: make ;"
"IN: a" "IN: a"
": hello ( -- ) \"Hello\" % ;" ": hello ( -- ) \"Hello\" % ;"
": hello-world ( -- str ) [ hello \" \" % world ] \"\" make ;" ": hello-world ( -- str ) [ hello \" \" % world ] \"\" make ;"

View File

@ -716,7 +716,7 @@ HELP: MATH:
{ $description "Defines a new generic word which uses the " { $link math-combination } " method combination." } ; { $description "Defines a new generic word which uses the " { $link math-combination } " method combination." } ;
HELP: HOOK: HELP: HOOK:
{ $syntax "HOOK: word variable ( stack -- effect ) " } { $syntax "HOOK: word variable ( stack -- effect )" }
{ $values { "word" "a new word to define" } { "variable" word } } { $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." } { $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 { $examples
@ -850,7 +850,7 @@ HELP: C:
"The following two lines are equivalent:" "The following two lines are equivalent:"
{ $code { $code
"C: <color> color" "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." "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."
} ; } ;

View File

@ -98,17 +98,17 @@ $nl
{ { { $snippet "\"inline\"" } ", " { $snippet "\"foldable\"" } ", " { $snippet "flushable" } } { $link "declarations" } } { { { $snippet "\"inline\"" } ", " { $snippet "\"foldable\"" } ", " { $snippet "flushable" } } { $link "declarations" } }
{ { $snippet "\"loc\"" } { "Location information - " { $link where } } } { { $snippet "\"loc\"" } { "Location information - " { $link where } } }
{ { { $snippet "\"methods\"" } ", " { $snippet "\"combination\"" } } { "Set on generic words - " { $link "generic" } } } { { { $snippet "\"methods\"" } ", " { $snippet "\"combination\"" } } { "Set on generic words - " { $link "generic" } } }
{ { { $snippet "\"reading\"" } ", " { $snippet "\"writing\"" } } { "Set on slot accessor words - " { $link "slots" } } } { { { $snippet "\"reading\"" } ", " { $snippet "\"writing\"" } } { "Set on slot accessor words - " { $link "slots" } } }
{ { $snippet "\"declared-effect\"" } { $link "effects" } } { { $snippet "\"declared-effect\"" } { $link "effects" } }
{ { { $snippet "\"help\"" } ", " { $snippet "\"help-loc\"" } ", " { $snippet "\"help-parent\"" } } { "Where word help is stored - " { $link "writing-help" } } } { { { $snippet "\"help\"" } ", " { $snippet "\"help-loc\"" } ", " { $snippet "\"help-parent\"" } } { "Where word help is stored - " { $link "writing-help" } } }
{ { $snippet "\"specializer\"" } { $link "hints" } } { { $snippet "\"specializer\"" } { $link "hints" } }
{ { $snippet "\"predicating\"" } " Set on class predicates, stores the corresponding class word" } { { $snippet "\"predicating\"" } " Set on class predicates, stores the corresponding class word" }
} }
"Properties which are defined for classes only:" "Properties which are defined for classes only:"
@ -117,13 +117,13 @@ $nl
{ { $snippet "\"class\"" } { "A boolean indicating whether this word is a class - " { $link "classes" } } } { { $snippet "\"class\"" } { "A boolean indicating whether this word is a class - " { $link "classes" } } }
{ { $snippet "\"coercer\"" } { "A quotation for converting the top of the stack to an instance of this class" } } { { $snippet "\"coercer\"" } { "A quotation for converting the top of the stack to an instance of this class" } }
{ { $snippet "\"constructor\"" } { $link "tuple-constructors" } } { { $snippet "\"constructor\"" } { $link "tuple-constructors" } }
{ { $snippet "\"type\"" } { $link "builtin-classes" } } { { $snippet "\"type\"" } { $link "builtin-classes" } }
{ { { $snippet "\"superclass\"" } ", " { $snippet "\"predicate-definition\"" } } { $link "predicates" } } { { { $snippet "\"superclass\"" } ", " { $snippet "\"predicate-definition\"" } } { $link "predicates" } }
{ { $snippet "\"members\"" } { $link "unions" } } { { $snippet "\"members\"" } { $link "unions" } }
{ { $snippet "\"slots\"" } { $link "slots" } } { { $snippet "\"slots\"" } { $link "slots" } }
@ -165,7 +165,7 @@ ARTICLE: "words" "Words"
$nl $nl
"There are two ways of creating word definitions:" "There are two ways of creating word definitions:"
{ $list { $list
"using parsing words at parse time," "using parsing words at parse time."
"using defining words at run 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." "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."

View File

@ -42,7 +42,7 @@ IN: bunny.model
: model-path ( -- path ) "bun_zipper.ply" temp-file ; : 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 ) : maybe-download ( -- path )
model-path dup exists? [ model-path dup exists? [

View File

@ -368,7 +368,6 @@ M: SOA rdata>byte-array
: message>query-name ( message -- string ) : message>query-name ( message -- string )
query>> first name>> dotted> ; query>> first name>> dotted> ;
USE: nested-comments
(* (*
M: string resolve-host M: string resolve-host
dup >lower "localhost" = [ dup >lower "localhost" = [

View File

@ -145,7 +145,7 @@ UNIFORM-TUPLE: loading-uniforms
: bunny-model-path ( -- path ) "bun_zipper.ply" temp-file ; : 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 ) : download-bunny ( -- path )
bunny-model-path dup exists? [ bunny-model-path dup exists? [

View File

@ -1,6 +1,6 @@
! Copyright (C) 2010 Jon Harper. ! Copyright (C) 2010 Jon Harper.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel strings io.pathnames images USING: help.markup help.syntax kernel strings io.pathnames images
models opengl.textures classes ui.gadgets ; models opengl.textures classes ui.gadgets ;
IN: images.viewer IN: images.viewer
@ -69,10 +69,10 @@ HELP: stop-control
} }
{ $description "Removes the connection between the gadget and it's model" } ; { $description "Removes the connection between the gadget and it's model" } ;
ARTICLE: "images.viewer" "Displaying Images" ARTICLE: "images.viewer" "Displaying Images"
"The " { $vocab-link "images.viewer" } " vocabulary uses the " { $vocab-link "opengl.textures" } "The " { $vocab-link "images.viewer" } " vocabulary uses the " { $vocab-link "opengl.textures" }
" vocabulary to display any instance of " { $link image } "."$nl " vocabulary to display any instance of " { $link image } "."$nl
"An " { $link image-gadget } " can be used for static images and " { $instance image-control } "An " { $link image-gadget } " can be used for static images and " { $instance image-control }
" for changing images (for example a video feed). For changing images, the image should be containted in " { $instance model } " for changing images (for example a video feed). For changing images, the image should be containted in " { $instance model }
". Change the model value with " { $link set-model } " or mutate the image and call " ". Change the model value with " { $link set-model } " or mutate the image and call "
{ $link notify-connections } " when you want to update the image. To stop refreshing the image, call " { $link stop-control } "." { $link notify-connections } " when you want to update the image. To stop refreshing the image, call " { $link stop-control } "."
" To start refreshing again, call " { $link start-control } "." " To start refreshing again, call " { $link start-control } "."
@ -83,19 +83,19 @@ $nl
{ $subsections <image-gadget> <image-control> } { $subsections <image-gadget> <image-control> }
"The " { $link image } " or " { $link model } "The " { $link image } " or " { $link model }
" can also be given after the construction of the object. In this case, use " " can also be given after the construction of the object. In this case, use "
{ $link new-image-gadget } " and " { $link set-image } "." { $link new-image-gadget } " and " { $link set-image } "."
" The gadget will automatically detect if the image changes size or format and reallocate a new texture if needed." " The gadget will automatically detect if the image changes size or format and reallocate a new texture if needed."
" This means images can be set even after the gadget has been grafted. Grafted gadgets without an image will display a blank screen." " This means images can be set even after the gadget has been grafted. Grafted gadgets without an image will display a blank screen."
{ $notes "The image can be set after the gadget has been grafted. However, for " { $instance image-gadget } ", this can " { $notes "The image can be set after the gadget has been grafted. However, for " { $instance image-gadget } ", this can "
" be done only once. If your image is changing, you should be using " { $instance image-control } " and " { $instance model } "." " be done only once. If your image is changing, you should be using " { $instance image-control } " and " { $instance model } "."
$nl $nl
" Performance will be greatly reduced if you are using images that have more than 512 pixels on one of their" " Performance will be greatly reduced if you are using images that have more than 512 pixels on one of their"
" axis." } " axis." }
$nl $nl
"Utility words for displaying images :" "Utility words for displaying images:"
{ $subsections { $subsections
image. image-window } image. image-window }

View File

@ -7,7 +7,7 @@ IN: tools.dns
[ write " has address " write ] [ print ] bi* ; [ write " has address " write ] [ print ] bi* ;
: a-message. ( message -- ) : a-message. ( message -- )
[ message>query-name ] [ message>names ] bi [ message>query-name ] [ message>a-names ] bi
[ a-line. ] with each ; [ a-line. ] with each ;
: mx-line. ( host pair -- ) : mx-line. ( host pair -- )