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

db4
Daniel Ehrenberg 2009-01-27 13:38:29 -06:00
commit cd6b494e78
28 changed files with 174 additions and 125 deletions

View File

@ -53,7 +53,8 @@ ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous sends"
{ $subsection reply-synchronous } { $subsection reply-synchronous }
"An example:" "An example:"
{ $example { $example
"USING: concurrency.messaging kernel threads ;" "USING: concurrency.messaging kernel prettyprint threads ;"
"IN: scratchpad"
": pong-server ( -- )" ": pong-server ( -- )"
" receive [ \"pong\" ] dip reply-synchronous ;" " receive [ \"pong\" ] dip reply-synchronous ;"
"[ pong-server t ] \"pong-server\" spawn-server" "[ pong-server t ] \"pong-server\" spawn-server"

View File

@ -11,7 +11,7 @@ HELP: eval>string
{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string." } ; { $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string." } ;
ARTICLE: "eval" "Evaluating strings at runtime" ARTICLE: "eval" "Evaluating strings at runtime"
"Evaluating strings at runtime:" "The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings at runtime."
{ $subsection eval } { $subsection eval }
{ $subsection eval>string } ; { $subsection eval>string } ;

View File

@ -0,0 +1,4 @@
IN: eval.tests
USING: eval tools.test ;
[ "4\n" ] [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-testv

View File

@ -1,14 +1,24 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: splitting parser compiler.units kernel namespaces USING: splitting parser compiler.units kernel namespaces
debugger io.streams.string ; debugger io.streams.string fry ;
IN: eval IN: eval
: parse-string ( str -- )
[ string-lines parse-lines ] with-compilation-unit ;
: (eval) ( str -- )
parse-string call ;
: eval ( str -- ) : eval ( str -- )
[ string-lines parse-fresh ] with-compilation-unit call ; [ (eval) ] with-file-vocabs ;
: (eval>string) ( str -- output )
[
"quiet" on
parser-notes off
'[ _ (eval) ] try
] with-string-writer ;
: eval>string ( str -- output ) : eval>string ( str -- output )
[ [ (eval>string) ] with-file-vocabs ;
parser-notes off
[ [ eval ] keep ] try drop
] with-string-writer ;

View File

@ -1,4 +1,4 @@
! Copyright (C) 2006, 2008 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors sequences parser kernel help help.markup USING: fry accessors sequences parser kernel help help.markup
help.topics words strings classes tools.vocabs namespaces make help.topics words strings classes tools.vocabs namespaces make
@ -6,21 +6,24 @@ io io.streams.string prettyprint definitions arrays vectors
combinators combinators.short-circuit splitting debugger combinators combinators.short-circuit splitting debugger
hashtables sorting effects vocabs vocabs.loader assocs editors hashtables sorting effects vocabs vocabs.loader assocs editors
continuations classes.predicate macros math sets eval continuations classes.predicate macros math sets eval
vocabs.parser words.symbol values ; vocabs.parser words.symbol values grouping unicode.categories
sequences.deep ;
IN: help.lint IN: help.lint
: check-example ( element -- ) SYMBOL: vocabs-quot
rest [
but-last "\n" join 1vector
[
use [ clone ] change
[ eval>string ] with-datastack
] with-scope peek "\n" ?tail drop
] keep
peek assert= ;
: check-examples ( word element -- ) : check-example ( element -- )
nip \ $example swap elements [ check-example ] each ; [
rest [
but-last "\n" join 1vector
[ (eval>string) ] with-datastack
peek "\n" ?tail drop
] keep
peek assert=
] vocabs-quot get call ;
: check-examples ( element -- )
\ $example swap elements [ check-example ] each ;
: extract-values ( element -- seq ) : extract-values ( element -- seq )
\ $values swap elements dup empty? [ \ $values swap elements dup empty? [
@ -64,8 +67,13 @@ IN: help.lint
] ]
} 2|| [ "$values don't match stack effect" throw ] unless ; } 2|| [ "$values don't match stack effect" throw ] unless ;
: check-see-also ( word element -- ) : check-nulls ( element -- )
nip \ $see-also swap elements [ \ $values swap elements
null swap deep-member?
[ "$values should not contain null" throw ] when ;
: check-see-also ( element -- )
\ $see-also swap elements [
rest dup prune [ length ] bi@ assert= rest dup prune [ length ] bi@ assert=
] each ; ] each ;
@ -79,43 +87,78 @@ IN: help.lint
] each ; ] each ;
: check-rendering ( element -- ) : check-rendering ( element -- )
[ print-topic ] with-string-writer drop ; [ print-content ] with-string-writer drop ;
: check-strings ( str -- )
[
"\n\t" intersects?
[ "Paragraph text should not contain \\n or \\t" throw ] when
] [
" " swap subseq?
[ "Paragraph text should not contain double spaces" throw ] when
] bi ;
: check-whitespace ( str1 str2 -- )
[ " " tail? ] [ " " head? ] bi* or
[ "Missing whitespace between strings" throw ] unless ;
: check-bogus-nl ( element -- )
{ { $nl } { { $nl } } } [ head? ] with contains?
[ "Simple element should not begin with a paragraph break" throw ] when ;
: check-elements ( element -- )
{
[ check-bogus-nl ]
[ [ string? ] filter [ check-strings ] each ]
[ [ simple-element? ] filter [ check-elements ] each ]
[ 2 <clumps> [ [ string? ] all? ] filter [ first2 check-whitespace ] each ]
} cleave ;
: check-markup ( element -- )
{
[ check-elements ]
[ check-rendering ]
[ check-examples ]
[ check-modules ]
} cleave ;
: all-word-help ( words -- seq ) : all-word-help ( words -- seq )
[ word-help ] filter ; [ word-help ] filter ;
TUPLE: help-error topic error ; TUPLE: help-error error topic ;
C: <help-error> help-error C: <help-error> help-error
M: help-error error. M: help-error error.
"In " write dup topic>> pprint nl [ "In " write topic>> pprint nl ]
error>> error. ; [ error>> error. ]
bi ;
: check-something ( obj quot -- ) : check-something ( obj quot -- )
flush [ <help-error> , ] recover ; inline flush '[ _ assert-depth ] swap '[ _ <help-error> , ] recover ; inline
: check-word ( word -- ) : check-word ( word -- )
[ with-file-vocabs ] vocabs-quot set
dup word-help [ dup word-help [
[ dup '[
dup word-help '[ _ dup word-help
_ _ { [ check-values ]
[ check-examples ] [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2bi
[ check-values ]
[ check-see-also ]
[ [ check-rendering ] [ check-modules ] bi* ]
} 2cleave
] assert-depth
] check-something ] check-something
] [ drop ] if ; ] [ drop ] if ;
: check-words ( words -- ) [ check-word ] each ; : check-words ( words -- ) [ check-word ] each ;
: check-article-title ( article -- )
article-title first LETTER?
[ "Article title must begin with a capital letter" throw ] unless ;
: check-article ( article -- ) : check-article ( article -- )
[ [ with-interactive-vocabs ] vocabs-quot set
dup article-content dup '[
'[ _ check-rendering _ check-modules ] _
assert-depth [ check-article-title ]
[ article-content check-markup ] bi
] check-something ; ] check-something ;
: files>vocabs ( -- assoc ) : files>vocabs ( -- assoc )
@ -135,7 +178,7 @@ M: help-error error.
] keep ; ] keep ;
: check-about ( vocab -- ) : check-about ( vocab -- )
[ vocab-help [ article drop ] when* ] check-something ; dup '[ _ vocab-help [ article drop ] when* ] check-something ;
: check-vocab ( vocab -- seq ) : check-vocab ( vocab -- seq )
"Checking " write dup write "..." print "Checking " write dup write "..." print

View File

@ -94,7 +94,7 @@ $nl
"For example, we'd like it to identify the following as a palindrome:" "For example, we'd like it to identify the following as a palindrome:"
{ $code "\"A man, a plan, a canal: Panama.\"" } { $code "\"A man, a plan, a canal: Panama.\"" }
"However, right now, the simplistic algorithm we use says this is not a palindrome:" "However, right now, the simplistic algorithm we use says this is not a palindrome:"
{ $example "\"A man, a plan, a canal: Panama.\" palindrome?" "f" } { $unchecked-example "\"A man, a plan, a canal: Panama.\" palindrome?" "f" }
"We would like it to output " { $link t } " there. We can encode this requirement with a unit test that we add to " { $snippet "palindrome-tests.factor" } ":" "We would like it to output " { $link t } " there. We can encode this requirement with a unit test that we add to " { $snippet "palindrome-tests.factor" } ":"
{ $code "[ t ] [ \"A man, a plan, a canal: Panama.\" palindrome? ] unit-test" } { $code "[ t ] [ \"A man, a plan, a canal: Panama.\" palindrome? ] unit-test" }
"If you now run unit tests, you will see a unit test failure:" "If you now run unit tests, you will see a unit test failure:"
@ -106,12 +106,12 @@ $nl
"Start by pushing a character on the stack; notice that characters are really just integers:" "Start by pushing a character on the stack; notice that characters are really just integers:"
{ $code "CHAR: a" } { $code "CHAR: a" }
"Now, use the " { $link Letter? } " word to test if it is an alphabetical character, upper or lower case:" "Now, use the " { $link Letter? } " word to test if it is an alphabetical character, upper or lower case:"
{ $example "Letter? ." "t" } { $unchecked-example "Letter? ." "t" }
"This gives the expected result." "This gives the expected result."
$nl $nl
"Now try with a non-alphabetical character:" "Now try with a non-alphabetical character:"
{ $code "CHAR: #" } { $code "CHAR: #" }
{ $example "Letter? ." "f" } { $unchecked-example "Letter? ." "f" }
"What we want to do is given a string, remove all characters which do not match the " { $link Letter? } " predicate. Let's push a string on the stack:" "What we want to do is given a string, remove all characters which do not match the " { $link Letter? } " predicate. Let's push a string on the stack:"
{ $code "\"A man, a plan, a canal: Panama.\"" } { $code "\"A man, a plan, a canal: Panama.\"" }
"Now, place a quotation containing " { $link Letter? } " on the stack; quoting code places it on the stack instead of executing it immediately:" "Now, place a quotation containing " { $link Letter? } " on the stack; quoting code places it on the stack instead of executing it immediately:"

View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman. ! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays destructors io io.backend io.buffers USING: alien alien.c-types arrays destructors io io.backend
io.files io.ports io.binary io.timeouts io.encodings.8-bit io.buffers io.files io.ports io.binary io.timeouts
windows.errors strings kernel math namespaces sequences windows windows.errors strings kernel math namespaces sequences windows
windows.kernel32 windows.shell32 windows.types windows.winsock windows.kernel32 windows.shell32 windows.types windows.winsock
splitting continuations math.bitwise system accessors ; splitting continuations math.bitwise system accessors ;
@ -51,6 +51,4 @@ HOOK: add-completion io-backend ( port -- )
: default-security-attributes ( -- obj ) : default-security-attributes ( -- obj )
"SECURITY_ATTRIBUTES" <c-object> "SECURITY_ATTRIBUTES" <c-object>
"SECURITY_ATTRIBUTES" heap-size "SECURITY_ATTRIBUTES" heap-size
over set-SECURITY_ATTRIBUTES-nLength ; over set-SECURITY_ATTRIBUTES-nLength ;
M: windows console-encoding windows-1252 ;

View File

@ -134,6 +134,7 @@ $nl
} }
"In a word with locals, literals expand into code which constructs the literal, and so every invocation pushes a new object:" "In a word with locals, literals expand into code which constructs the literal, and so every invocation pushes a new object:"
{ $example { $example
"USE: locals"
"IN: scratchpad" "IN: scratchpad"
"TUPLE: person first-name last-name ;" "TUPLE: person first-name last-name ;"
":: ordinary-word-test ( -- tuple )" ":: ordinary-word-test ( -- tuple )"

View File

@ -6,7 +6,7 @@ ARTICLE: "complex-numbers-zero" "Embedding of real numbers in complex numbers"
"Constructing a complex number with an imaginary component equal to an integer zero simply returns the real number corresponding to the real component:" "Constructing a complex number with an imaginary component equal to an integer zero simply returns the real number corresponding to the real component:"
{ $example "USING: math prettyprint ;" "C{ 1 2 } C{ 3 -2 } + ." "4" } { $example "USING: math prettyprint ;" "C{ 1 2 } C{ 3 -2 } + ." "4" }
"Constructing a complex number with an imaginary component equal to floating point zero will still output a new complex number, however:" "Constructing a complex number with an imaginary component equal to floating point zero will still output a new complex number, however:"
{ $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ 2.0 0.0 }" } { $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ -2.0 0.0 }" }
"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero." ; "Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero." ;
ARTICLE: "complex-numbers" "Complex numbers" ARTICLE: "complex-numbers" "Complex numbers"

View File

@ -5,8 +5,8 @@ ARTICLE: "math.libm" "C standard library math functions"
"The words in the " { $vocab-link "math.libm" } " vocabulary call C standard library math functions. They are used to implement words in the " { $vocab-link "math.functions" } " vocabulary." "The words in the " { $vocab-link "math.libm" } " vocabulary call C standard library math functions. They are used to implement words in the " { $vocab-link "math.functions" } " vocabulary."
$nl $nl
"They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:" "They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
{ $example "2 acos ." "C{ 0.0 1.316957896924817 }" } { $example "USE: math.functions" "2 acos ." "C{ 0.0 1.316957896924817 }" }
{ $example "2 facos ." "0.0/0.0" } { $example "USE: math.libm" "2 facos ." "0.0/0.0" }
"Trigonometric functions:" "Trigonometric functions:"
{ $subsection fcos } { $subsection fcos }
{ $subsection fsin } { $subsection fsin }

View File

@ -21,7 +21,7 @@ $nl
ARTICLE: "inference-combinators" "Combinator stack effects" ARTICLE: "inference-combinators" "Combinator stack effects"
"Without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the inferencer encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised." "Without further information, one cannot say what the stack effect of " { $link call } " is; it depends on the given quotation. If the inferencer encounters a " { $link call } " without further information, a " { $link literal-expected } " error is raised."
{ $example "[ dup call ] infer." "... an error ..." } { $example "[ dup call ] infer." "Literal value expected\n\nType :help for debugging help." }
"On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point:" "On the other hand, the stack effect of applying " { $link call } " to a literal quotation or a " { $link curry } " of a literal quotation is easy to compute; it behaves as if the quotation was substituted at that point:"
{ $example "[ [ 2 + ] call ] infer." "( object -- object )" } { $example "[ [ 2 + ] call ] infer." "( object -- object )" }
"Consider a combinator such as " { $link keep } ". The combinator itself does not have a stack effect, because it applies " { $link call } " to a potentially arbitrary quotation. However, since the combinator is declared " { $link POSTPONE: inline } ", a given usage of it can have a stack effect:" "Consider a combinator such as " { $link keep } ". The combinator itself does not have a stack effect, because it applies " { $link call } " to a potentially arbitrary quotation. However, since the combinator is declared " { $link POSTPONE: inline } ", a given usage of it can have a stack effect:"
@ -35,7 +35,15 @@ $nl
"Here is an example where the stack effect cannot be inferred:" "Here is an example where the stack effect cannot be inferred:"
{ $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." } { $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." }
"However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":" "However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":"
{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" } ; { $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" }
"Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:"
{ $example
"[ [ reverse ] swap [ reverse ] map swap call ] infer." "Literal value expected\n\nType :help for debugging help."
}
"To make this work, pass the quotation on the retain stack instead:"
{ $example
"[ [ reverse ] [ [ reverse ] map ] dip call ] infer." "( object -- object )"
} ;
ARTICLE: "inference-branches" "Branch stack effects" ARTICLE: "inference-branches" "Branch stack effects"
"Conditionals such as " { $link if } " and combinators built on " { $link if } " present a problem, in that if the two branches leave the stack at a different height, it is not clear what the stack effect should be. In this case, inference throws a " { $link unbalanced-branches-error } "." "Conditionals such as " { $link if } " and combinators built on " { $link if } " present a problem, in that if the two branches leave the stack at a different height, it is not clear what the stack effect should be. In this case, inference throws a " { $link unbalanced-branches-error } "."
@ -58,12 +66,14 @@ $nl
$nl $nl
"If a recursive word takes quotation parameters from the stack and calls them, it must be declared " { $link POSTPONE: inline } " (as documented in " { $link "inference-combinators" } ") as well as " { $link POSTPONE: recursive } "." "If a recursive word takes quotation parameters from the stack and calls them, it must be declared " { $link POSTPONE: inline } " (as documented in " { $link "inference-combinators" } ") as well as " { $link POSTPONE: recursive } "."
$nl $nl
"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example," "Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example, the following will not infer:"
{ $see loop } { $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Literal value expected\n\nType :help for debugging help." }
"An inline recursive word cannot pass a quotation through the recursive call. For example, the following will not infer:" "The following is correct:"
{ $code ": foo ( a b c -- d e f ) [ f foo drop ] when 2dup call ; inline" "[ 1 [ 1+ ] foo ] infer." } { $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }
"An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:"
{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Literal value expected\n\nType :help for debugging help." }
"However a small change can be made:" "However a small change can be made:"
{ $example ": foo ( a b c -- d ) [ 2dup f foo drop ] when call ; inline" "[ 1 [ 1+ ] t foo ] infer." "( -- object )" } { $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" }
"An inline recursive word must have a fixed stack effect in its base case. The following will not infer:" "An inline recursive word must have a fixed stack effect in its base case. The following will not infer:"
{ $code { $code
": foo ( quot ? -- ) [ f foo ] [ call ] if ; inline" ": foo ( quot ? -- ) [ f foo ] [ call ] if ; inline"

View File

@ -21,7 +21,7 @@ ARTICLE: "enums" "Enumerations"
{ $subsection enum } { $subsection enum }
{ $subsection <enum> } { $subsection <enum> }
"Inverting a permutation using enumerations:" "Inverting a permutation using enumerations:"
{ $example "USING: assocs sorting prettyprint ;" ": invert <enum> >alist sort-values keys ;" "{ 2 0 4 1 3 } invert ." "{ 1 3 0 4 2 }" } ; { $example "USING: assocs sorting prettyprint ;" "IN: scratchpad" ": invert ( perm -- perm' )" " <enum> >alist sort-values keys ;" "{ 2 0 4 1 3 } invert ." "{ 1 3 0 4 2 }" } ;
HELP: enum HELP: enum
{ $class-description "An associative structure which wraps a sequence and maps integers to the corresponding elements of the sequence." { $class-description "An associative structure which wraps a sequence and maps integers to the corresponding elements of the sequence."
@ -405,11 +405,12 @@ HELP: search-alist
{ $values { $values
{ "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 "Performs an in-order traversal of a " { $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 } "." }
{ $examples { $example "USING: prettyprint assocs kernel ;" { $notes "This word is used to implement " { $link at* } " and " { $link set-at } " on sequences, and should not be called direclty." }
{ $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"
} { $example "USING: prettyprint assocs kernel ;" } { $example "USING: prettyprint assocs.private kernel ;"
"6 { { 1 2 } { 3 4 } } search-alist [ . ] bi@" "6 { { 1 2 } { 3 4 } } search-alist [ . ] bi@"
"f\nf" "f\nf"
} }

View File

@ -38,6 +38,9 @@ M: assoc assoc-like drop ;
: substituter ( assoc -- quot ) : substituter ( assoc -- quot )
[ dupd at* [ nip ] [ drop ] if ] curry ; inline [ dupd at* [ nip ] [ drop ] if ] curry ; inline
: with-assoc ( assoc quot: ( value key -- assoc ) -- quot: ( key value -- ) )
curry [ swap ] prepose ; inline
PRIVATE> PRIVATE>
: assoc-find ( assoc quot -- key value ? ) : assoc-find ( assoc quot -- key value ? )
@ -81,7 +84,7 @@ PRIVATE>
M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
[ dup assoc-size ] dip new-assoc [ dup assoc-size ] dip new-assoc
[ [ swapd set-at ] curry assoc-each ] keep ; [ [ set-at ] with-assoc assoc-each ] keep ;
: keys ( assoc -- keys ) : keys ( assoc -- keys )
[ drop ] { } assoc>map ; [ drop ] { } assoc>map ;
@ -93,7 +96,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
[ at* ] 2keep delete-at ; [ at* ] 2keep delete-at ;
: rename-at ( newkey key assoc -- ) : rename-at ( newkey key assoc -- )
[ delete-at* ] keep [ swapd set-at ] curry [ 2drop ] if ; [ delete-at* ] keep [ set-at ] with-assoc [ 2drop ] if ;
: assoc-empty? ( assoc -- ? ) : assoc-empty? ( assoc -- ? )
assoc-size 0 = ; assoc-size 0 = ;
@ -102,7 +105,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
[ length 1- ] keep (assoc-stack) ; flushable [ length 1- ] keep (assoc-stack) ; flushable
: assoc-subset? ( assoc1 assoc2 -- ? ) : assoc-subset? ( assoc1 assoc2 -- ? )
[ swapd at* [ = ] [ 2drop f ] if ] curry assoc-all? ; [ at* [ = ] [ 2drop f ] if ] with-assoc assoc-all? ;
: assoc= ( assoc1 assoc2 -- ? ) : assoc= ( assoc1 assoc2 -- ? )
[ assoc-subset? ] [ swap assoc-subset? ] 2bi and ; [ assoc-subset? ] [ swap assoc-subset? ] 2bi and ;
@ -114,7 +117,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
swap [ nip key? ] curry assoc-filter ; swap [ nip key? ] curry assoc-filter ;
: update ( assoc1 assoc2 -- ) : update ( assoc1 assoc2 -- )
swap [ swapd set-at ] curry assoc-each ; swap [ set-at ] with-assoc assoc-each ;
: assoc-union ( assoc1 assoc2 -- union ) : assoc-union ( assoc1 assoc2 -- union )
[ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep [ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep

View File

@ -10,18 +10,6 @@ ARTICLE: "singletons" "Singleton classes"
{ $subsection singleton-class? } { $subsection singleton-class? }
{ $subsection singleton-class } ; { $subsection singleton-class } ;
HELP: SINGLETON:
{ $syntax "SINGLETON: class" }
{ $values
{ "class" "a new singleton to define" }
}
{ $description
"Defines a new singleton class. The class word itself is the sole instance of the singleton class."
}
{ $examples
{ $example "USING: classes.singleton kernel io ;" "IN: scratchpad" "SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
} ;
HELP: define-singleton-class HELP: define-singleton-class
{ $values { "word" "a new word" } } { $values { "word" "a new word" } }
{ $description { $description

View File

@ -14,15 +14,11 @@ HOOK: init-io io-backend ( -- )
HOOK: (init-stdio) io-backend ( -- stdin stdout stderr ) HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )
HOOK: console-encoding os ( -- encoding )
M: object console-encoding utf8 ;
: init-stdio ( -- ) : init-stdio ( -- )
(init-stdio) (init-stdio)
[ console-encoding <decoder> input-stream set-global ] [ utf8 <decoder> input-stream set-global ]
[ console-encoding <encoder> output-stream set-global ] [ utf8 <encoder> output-stream set-global ]
[ console-encoding <encoder> error-stream set-global ] tri* ; [ utf8 <encoder> error-stream set-global ] tri* ;
HOOK: io-multiplex io-backend ( us -- ) HOOK: io-multiplex io-backend ( us -- )

View File

@ -1 +0,0 @@
Daniel Ehrenberg

View File

@ -1,11 +0,0 @@
USING: help.syntax help.markup ;
IN: io.encodings.binary
HELP: binary
{ $class-description "Encoding descriptor for binary I/O." } ;
ARTICLE: "io.encodings.binary" "Binary encoding"
"Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings."
{ $subsection binary } ;
ABOUT: "io.encodings.binary"

View File

@ -1,8 +0,0 @@
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: io.encodings kernel ;
IN: io.encodings.binary
SINGLETON: binary
M: binary <encoder> drop ;
M: binary <decoder> drop ;

View File

@ -1 +0,0 @@
Dummy encoding for binary I/O

View File

@ -1 +0,0 @@
text

View File

@ -888,9 +888,9 @@ $nl
"Here is an array containing the " { $link f } " class:" "Here is an array containing the " { $link f } " class:"
{ $example "{ POSTPONE: f } ." "{ POSTPONE: f }" } { $example "{ POSTPONE: f } ." "{ POSTPONE: f }" }
"The " { $link f } " object is an instance of the " { $link f } " class:" "The " { $link f } " object is an instance of the " { $link f } " class:"
{ $example "f class ." "POSTPONE: f" } { $example "USE: classes" "f class ." "POSTPONE: f" }
"The " { $link f } " class is an instance of " { $link word } ":" "The " { $link f } " class is an instance of " { $link word } ":"
{ $example "\\ f class ." "word" } { $example "USE: classes" "\\ f class ." "word" }
"On the other hand, " { $link t } " is just a word, and there is no class which it is a unique instance of." "On the other hand, " { $link t } " is just a word, and there is no class which it is a unique instance of."
{ $example "t \\ t eq? ." "t" } { $example "t \\ t eq? ." "t" }
"Many words which search collections confuse the case of no element being present with an element being found equal to " { $link f } ". If this distinction is imporant, there is usually an alternative word which can be used; for example, compare " { $link at } " with " { $link at* } "." ; "Many words which search collections confuse the case of no element being present with an element being found equal to " { $link f } ". If this distinction is imporant, there is usually an alternative word which can be used; for example, compare " { $link at } " with " { $link at* } "." ;

View File

@ -1,6 +1,7 @@
! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel.private slots.private classes.tuple.private ; USING: kernel.private slots.private math.private
classes.tuple.private ;
IN: kernel IN: kernel
DEFER: dip DEFER: dip
@ -154,7 +155,6 @@ TUPLE: identity-tuple ;
M: identity-tuple equal? 2drop f ; M: identity-tuple equal? 2drop f ;
USE: math.private
: = ( obj1 obj2 -- ? ) : = ( obj1 obj2 -- ? )
2dup eq? [ 2drop t ] [ 2dup eq? [ 2drop t ] [
2dup both-fixnums? [ 2drop f ] [ equal? ] if 2dup both-fixnums? [ 2drop f ] [ equal? ] if

View File

@ -4,10 +4,10 @@ IN: math.integers
ARTICLE: "integers" "Integers" ARTICLE: "integers" "Integers"
{ $subsection integer } { $subsection integer }
"Integers come in two varieties -- fixnums and bignums. Fixnums fit in a machine word and are faster to manipulate; if the result of a fixnum operation is too large to fit in a fixnum, the result is upgraded to a bignum. Here is an example where two fixnums are multiplied yielding a bignum:" "Integers come in two varieties -- fixnums and bignums. Fixnums fit in a machine word and are faster to manipulate; if the result of a fixnum operation is too large to fit in a fixnum, the result is upgraded to a bignum. Here is an example where two fixnums are multiplied yielding a bignum:"
{ $example "134217728 class ." "fixnum" } { $example "USE: classes" "134217728 class ." "fixnum" }
{ $example "128 class ." "fixnum" } { $example "USE: classes" "128 class ." "fixnum" }
{ $example "134217728 128 * ." "17179869184" } { $example "134217728 128 * ." "17179869184" }
{ $example "134217728 128 * class ." "bignum" } { $example "USE: classes" "1 128 shift class ." "bignum" }
"Integers can be entered using a different base; see " { $link "syntax-numbers" } "." "Integers can be entered using a different base; see " { $link "syntax-numbers" } "."
$nl $nl
"Integers can be tested for, and real numbers can be converted to integers:" "Integers can be tested for, and real numbers can be converted to integers:"

View File

@ -321,8 +321,8 @@ ARTICLE: "number-protocol" "Number protocol"
"Math operations obey certain numerical upgrade rules. If one of the inputs is a bignum and the other is a fixnum, the latter is first coerced to a bignum; if one of the inputs is a float, the other is coerced to a float." "Math operations obey certain numerical upgrade rules. If one of the inputs is a bignum and the other is a fixnum, the latter is first coerced to a bignum; if one of the inputs is a float, the other is coerced to a float."
$nl $nl
"Two examples where you should note the types of the inputs and outputs:" "Two examples where you should note the types of the inputs and outputs:"
{ $example "3 >fixnum 6 >bignum * class ." "bignum" } { $example "USE: classes" "3 >fixnum 6 >bignum * class ." "bignum" }
{ $example "1/2 2.0 + ." "4.5" } { $example "1/2 2.0 + ." "2.5" }
"The following usual operations are supported by all numbers." "The following usual operations are supported by all numbers."
{ $subsection + } { $subsection + }
{ $subsection - } { $subsection - }

View File

@ -57,7 +57,7 @@ SYMBOL: auto-use?
dup vocabulary>> dup vocabulary>>
[ (use+) ] [ (use+) ]
[ amended-use get dup [ push ] [ 2drop ] if ] [ amended-use get dup [ push ] [ 2drop ] if ]
[ "Added “" "” vocabulary to search path" surround note. ] [ "Added \"" "\" vocabulary to search path" surround note. ]
tri tri
] [ create-in ] if ; ] [ create-in ] if ;
@ -160,6 +160,7 @@ SYMBOL: interactive-vocabs
"definitions" "definitions"
"editors" "editors"
"help" "help"
"help.lint"
"inspector" "inspector"
"io" "io"
"io.files" "io.files"
@ -200,7 +201,7 @@ SYMBOL: interactive-vocabs
SYMBOL: print-use-hook SYMBOL: print-use-hook
print-use-hook global [ [ ] or ] change-at print-use-hook global [ [ ] or ] change-at
!
: parse-fresh ( lines -- quot ) : parse-fresh ( lines -- quot )
[ [
V{ } clone amended-use set V{ } clone amended-use set

View File

@ -352,6 +352,18 @@ HELP: SYMBOLS:
{ $description "Creates a new symbol for every token until the " { $snippet ";" } "." } { $description "Creates a new symbol for every token until the " { $snippet ";" } "." }
{ $examples { $example "USING: prettyprint ;" "IN: scratchpad" "SYMBOLS: foo bar baz ;\nfoo . bar . baz ." "foo\nbar\nbaz" } } ; { $examples { $example "USING: prettyprint ;" "IN: scratchpad" "SYMBOLS: foo bar baz ;\nfoo . bar . baz ." "foo\nbar\nbaz" } } ;
HELP: SINGLETON:
{ $syntax "SINGLETON: class" }
{ $values
{ "class" "a new singleton to define" }
}
{ $description
"Defines a new singleton class. The class word itself is the sole instance of the singleton class."
}
{ $examples
{ $example "USING: classes.singleton kernel io ;" "IN: singleton-demo" "USE: prettyprint SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
} ;
HELP: SINGLETONS: HELP: SINGLETONS:
{ $syntax "SINGLETONS: words... ;" } { $syntax "SINGLETONS: words... ;" }
{ $values { "words" "a sequence of new words to define" } } { $values { "words" "a sequence of new words to define" } }

View File

@ -11,7 +11,7 @@ name words
main help main help
source-loaded? docs-loaded? ; source-loaded? docs-loaded? ;
! sources-loaded? slot is one of these two ! sources-loaded? slot is one of these three
SYMBOL: +parsing+ SYMBOL: +parsing+
SYMBOL: +running+ SYMBOL: +running+
SYMBOL: +done+ SYMBOL: +done+

View File

@ -1,18 +1,21 @@
! Copyright (C) 2009 Jose Antonio Ortega Ruiz. ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors io io.encodings.utf8 io.servers.connection kernel USING: accessors debugger io io.encodings.utf8 io.servers.connection
listener math ; kernel listener math namespaces ;
IN: fuel.remote IN: fuel.remote
<PRIVATE <PRIVATE
: start-listener ( -- )
[ [ print-error-and-restarts ] error-hook set listener ] with-scope ;
: server ( port -- server ) : server ( port -- server )
<threaded-server> <threaded-server>
"tty-server" >>name "tty-server" >>name
utf8 >>encoding utf8 >>encoding
swap local-server >>insecure swap local-server >>insecure
[ listener ] >>handler [ start-listener ] >>handler
f >>timeout ; f >>timeout ;
: print-banner ( -- ) : print-banner ( -- )