Merge branch 'master' of git://github.com/slavapestov/factor
commit
e5cddba600
|
@ -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* ."
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -108,7 +108,7 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
|
||||||
|
|
||||||
: (unparse-cookie) ( cookie -- strings )
|
: (unparse-cookie) ( cookie -- strings )
|
||||||
[
|
[
|
||||||
dup name>> check-cookie-string >lower
|
dup name>> check-cookie-string
|
||||||
over value>> check-cookie-value unparse-cookie-value
|
over value>> check-cookie-value unparse-cookie-value
|
||||||
"$path" over path>> unparse-cookie-value
|
"$path" over path>> unparse-cookie-value
|
||||||
"$domain" over domain>> unparse-cookie-value
|
"$domain" over domain>> unparse-cookie-value
|
||||||
|
@ -120,7 +120,7 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s
|
||||||
|
|
||||||
: unparse-set-cookie ( cookie -- string )
|
: unparse-set-cookie ( cookie -- string )
|
||||||
[
|
[
|
||||||
dup name>> check-cookie-string >lower
|
dup name>> check-cookie-string
|
||||||
over value>> check-cookie-value unparse-cookie-value
|
over value>> check-cookie-value unparse-cookie-value
|
||||||
"path" over path>> unparse-cookie-value
|
"path" over path>> unparse-cookie-value
|
||||||
"domain" over domain>> unparse-cookie-value
|
"domain" over domain>> unparse-cookie-value
|
||||||
|
|
|
@ -11,6 +11,10 @@ IN: http.parsers.tests
|
||||||
[ "__s=12345567" parse-cookie ]
|
[ "__s=12345567" parse-cookie ]
|
||||||
unit-test
|
unit-test
|
||||||
|
|
||||||
|
[ { T{ cookie { name "CaseSensitive" } { value "aBc" } } } ]
|
||||||
|
[ "CaseSensitive=aBc" parse-cookie ]
|
||||||
|
unit-test
|
||||||
|
|
||||||
[ { T{ cookie { name "__s" } { value "12345567" } } } ]
|
[ { T{ cookie { name "__s" } { value "12345567" } } } ]
|
||||||
[ "__s=12345567;" parse-cookie ]
|
[ "__s=12345567;" parse-cookie ]
|
||||||
unit-test
|
unit-test
|
||||||
|
|
|
@ -135,7 +135,7 @@ PEG: parse-header-line ( string -- pair )
|
||||||
2choice case-sensitive ;
|
2choice case-sensitive ;
|
||||||
|
|
||||||
: 'attr' ( -- parser )
|
: 'attr' ( -- parser )
|
||||||
'token' case-insensitive ;
|
'token' case-sensitive ;
|
||||||
|
|
||||||
: 'av-pair' ( -- parser )
|
: 'av-pair' ( -- parser )
|
||||||
[
|
[
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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> ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
|
@ -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." } ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;"
|
||||||
|
|
|
@ -33,3 +33,9 @@ IN: math.polynomials.tests
|
||||||
|
|
||||||
[ { 10 200 3000 } ] [ { 1 10 100 1000 } pdiff ] unit-test
|
[ { 10 200 3000 } ] [ { 1 10 100 1000 } pdiff ] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
[ { -512 2304 -4608 5376 -4032 2016 -672 144 -18 1 } ]
|
||||||
|
[ { -2 1 } 9 p^ ] unit-test
|
||||||
|
|
||||||
|
[ 0 ]
|
||||||
|
[ 2 { -2 1 } 9 p^ polyval ] unit-test
|
||||||
|
|
|
@ -91,7 +91,10 @@ PRIVATE>
|
||||||
dup length iota v* rest ;
|
dup length iota v* rest ;
|
||||||
|
|
||||||
: polyval ( x p -- p[x] )
|
: polyval ( x p -- p[x] )
|
||||||
[ length swap powers ] [ nip ] 2bi v. ;
|
! Horner scheme
|
||||||
|
[ nip <reversed> unclip-slice swap ]
|
||||||
|
[ drop ] 2bi
|
||||||
|
'[ [ _ * ] dip + ] each ;
|
||||||
|
|
||||||
MACRO: polyval* ( p -- )
|
MACRO: polyval* ( p -- )
|
||||||
reverse
|
reverse
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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" }
|
{ $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." ;
|
||||||
|
|
||||||
|
|
|
@ -355,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"
|
||||||
|
|
|
@ -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 ;"
|
||||||
|
|
|
@ -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? [
|
||||||
|
|
|
@ -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" = [
|
||||||
|
|
|
@ -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? [
|
||||||
|
|
|
@ -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 -- )
|
Loading…
Reference in New Issue