Merge branch 'master' of git://factorcode.org/git/factor
commit
cd6b494e78
|
@ -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"
|
||||||
|
|
|
@ -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 } ;
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,4 @@
|
||||||
|
IN: eval.tests
|
||||||
|
USING: eval tools.test ;
|
||||||
|
|
||||||
|
[ "4\n" ] [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-testv
|
|
@ -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 ;
|
|
|
@ -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
|
||||||
|
|
|
@ -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:"
|
||||||
|
|
|
@ -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 ;
|
|
|
@ -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 )"
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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 }
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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"
|
||||||
}
|
}
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 -- )
|
||||||
|
|
||||||
|
|
|
@ -1 +0,0 @@
|
||||||
Daniel Ehrenberg
|
|
|
@ -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"
|
|
|
@ -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 ;
|
|
|
@ -1 +0,0 @@
|
||||||
Dummy encoding for binary I/O
|
|
|
@ -1 +0,0 @@
|
||||||
text
|
|
|
@ -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* } "." ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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:"
|
||||||
|
|
|
@ -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 - }
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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" } }
|
||||||
|
|
|
@ -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+
|
||||||
|
|
|
@ -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 ( -- )
|
||||||
|
|
Loading…
Reference in New Issue