Merge branch 'master' of git://factorcode.org/git/factor
commit
cd6b494e78
|
@ -53,7 +53,8 @@ ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous sends"
|
|||
{ $subsection reply-synchronous }
|
||||
"An example:"
|
||||
{ $example
|
||||
"USING: concurrency.messaging kernel threads ;"
|
||||
"USING: concurrency.messaging kernel prettyprint threads ;"
|
||||
"IN: scratchpad"
|
||||
": pong-server ( -- )"
|
||||
" receive [ \"pong\" ] dip reply-synchronous ;"
|
||||
"[ 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." } ;
|
||||
|
||||
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>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.
|
||||
USING: splitting parser compiler.units kernel namespaces
|
||||
debugger io.streams.string ;
|
||||
debugger io.streams.string fry ;
|
||||
IN: eval
|
||||
|
||||
: parse-string ( str -- )
|
||||
[ string-lines parse-lines ] with-compilation-unit ;
|
||||
|
||||
: (eval) ( str -- )
|
||||
parse-string call ;
|
||||
|
||||
: 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 )
|
||||
[
|
||||
parser-notes off
|
||||
[ [ eval ] keep ] try drop
|
||||
] with-string-writer ;
|
||||
[ (eval>string) ] with-file-vocabs ;
|
|
@ -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.
|
||||
USING: fry accessors sequences parser kernel help help.markup
|
||||
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
|
||||
hashtables sorting effects vocabs vocabs.loader assocs editors
|
||||
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
|
||||
|
||||
: check-example ( element -- )
|
||||
rest [
|
||||
but-last "\n" join 1vector
|
||||
[
|
||||
use [ clone ] change
|
||||
[ eval>string ] with-datastack
|
||||
] with-scope peek "\n" ?tail drop
|
||||
] keep
|
||||
peek assert= ;
|
||||
SYMBOL: vocabs-quot
|
||||
|
||||
: check-examples ( word element -- )
|
||||
nip \ $example swap elements [ check-example ] each ;
|
||||
: check-example ( element -- )
|
||||
[
|
||||
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 )
|
||||
\ $values swap elements dup empty? [
|
||||
|
@ -64,8 +67,13 @@ IN: help.lint
|
|||
]
|
||||
} 2|| [ "$values don't match stack effect" throw ] unless ;
|
||||
|
||||
: check-see-also ( word element -- )
|
||||
nip \ $see-also swap elements [
|
||||
: check-nulls ( element -- )
|
||||
\ $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=
|
||||
] each ;
|
||||
|
||||
|
@ -79,43 +87,78 @@ IN: help.lint
|
|||
] each ;
|
||||
|
||||
: 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 )
|
||||
[ word-help ] filter ;
|
||||
|
||||
TUPLE: help-error topic error ;
|
||||
TUPLE: help-error error topic ;
|
||||
|
||||
C: <help-error> help-error
|
||||
|
||||
M: help-error error.
|
||||
"In " write dup topic>> pprint nl
|
||||
error>> error. ;
|
||||
[ "In " write topic>> pprint nl ]
|
||||
[ error>> error. ]
|
||||
bi ;
|
||||
|
||||
: check-something ( obj quot -- )
|
||||
flush [ <help-error> , ] recover ; inline
|
||||
flush '[ _ assert-depth ] swap '[ _ <help-error> , ] recover ; inline
|
||||
|
||||
: check-word ( word -- )
|
||||
[ with-file-vocabs ] vocabs-quot set
|
||||
dup word-help [
|
||||
[
|
||||
dup word-help '[
|
||||
_ _ {
|
||||
[ check-examples ]
|
||||
[ check-values ]
|
||||
[ check-see-also ]
|
||||
[ [ check-rendering ] [ check-modules ] bi* ]
|
||||
} 2cleave
|
||||
] assert-depth
|
||||
dup '[
|
||||
_ dup word-help
|
||||
[ check-values ]
|
||||
[ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2bi
|
||||
] check-something
|
||||
] [ drop ] if ;
|
||||
|
||||
: 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 -- )
|
||||
[
|
||||
dup article-content
|
||||
'[ _ check-rendering _ check-modules ]
|
||||
assert-depth
|
||||
[ with-interactive-vocabs ] vocabs-quot set
|
||||
dup '[
|
||||
_
|
||||
[ check-article-title ]
|
||||
[ article-content check-markup ] bi
|
||||
] check-something ;
|
||||
|
||||
: files>vocabs ( -- assoc )
|
||||
|
@ -135,7 +178,7 @@ M: help-error error.
|
|||
] keep ;
|
||||
|
||||
: check-about ( vocab -- )
|
||||
[ vocab-help [ article drop ] when* ] check-something ;
|
||||
dup '[ _ vocab-help [ article drop ] when* ] check-something ;
|
||||
|
||||
: check-vocab ( vocab -- seq )
|
||||
"Checking " write dup write "..." print
|
||||
|
|
|
@ -94,7 +94,7 @@ $nl
|
|||
"For example, we'd like it to identify the following as a palindrome:"
|
||||
{ $code "\"A man, a plan, a canal: Panama.\"" }
|
||||
"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" } ":"
|
||||
{ $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:"
|
||||
|
@ -106,12 +106,12 @@ $nl
|
|||
"Start by pushing a character on the stack; notice that characters are really just integers:"
|
||||
{ $code "CHAR: a" }
|
||||
"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."
|
||||
$nl
|
||||
"Now try with a non-alphabetical character:"
|
||||
{ $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:"
|
||||
{ $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:"
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types arrays destructors io io.backend io.buffers
|
||||
io.files io.ports io.binary io.timeouts io.encodings.8-bit
|
||||
USING: alien alien.c-types arrays destructors io io.backend
|
||||
io.buffers io.files io.ports io.binary io.timeouts
|
||||
windows.errors strings kernel math namespaces sequences windows
|
||||
windows.kernel32 windows.shell32 windows.types windows.winsock
|
||||
splitting continuations math.bitwise system accessors ;
|
||||
|
@ -51,6 +51,4 @@ HOOK: add-completion io-backend ( port -- )
|
|||
: default-security-attributes ( -- obj )
|
||||
"SECURITY_ATTRIBUTES" <c-object>
|
||||
"SECURITY_ATTRIBUTES" heap-size
|
||||
over set-SECURITY_ATTRIBUTES-nLength ;
|
||||
|
||||
M: windows console-encoding windows-1252 ;
|
||||
over set-SECURITY_ATTRIBUTES-nLength ;
|
|
@ -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:"
|
||||
{ $example
|
||||
"USE: locals"
|
||||
"IN: scratchpad"
|
||||
"TUPLE: person first-name last-name ;"
|
||||
":: 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:"
|
||||
{ $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:"
|
||||
{ $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." ;
|
||||
|
||||
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."
|
||||
$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:"
|
||||
{ $example "2 acos ." "C{ 0.0 1.316957896924817 }" }
|
||||
{ $example "2 facos ." "0.0/0.0" }
|
||||
{ $example "USE: math.functions" "2 acos ." "C{ 0.0 1.316957896924817 }" }
|
||||
{ $example "USE: math.libm" "2 facos ." "0.0/0.0" }
|
||||
"Trigonometric functions:"
|
||||
{ $subsection fcos }
|
||||
{ $subsection fsin }
|
||||
|
|
|
@ -21,7 +21,7 @@ $nl
|
|||
|
||||
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."
|
||||
{ $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:"
|
||||
{ $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:"
|
||||
|
@ -35,7 +35,15 @@ $nl
|
|||
"Here is an example where the stack effect cannot be inferred:"
|
||||
{ $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 } ":"
|
||||
{ $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"
|
||||
"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
|
||||
"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
|
||||
"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example,"
|
||||
{ $see loop }
|
||||
"An inline recursive word cannot pass a quotation through the recursive call. For example, the following will not infer:"
|
||||
{ $code ": foo ( a b c -- d e f ) [ f foo drop ] when 2dup call ; inline" "[ 1 [ 1+ ] foo ] infer." }
|
||||
"Furthermore, the input parameters which are quotations must be annotated in the stack effect. For example, the following will not infer:"
|
||||
{ $example ": bad ( quot -- ) [ call ] keep foo ; inline recursive" "[ [ ] bad ] infer." "Literal value expected\n\nType :help for debugging help." }
|
||||
"The following is correct:"
|
||||
{ $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:"
|
||||
{ $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:"
|
||||
{ $code
|
||||
": foo ( quot ? -- ) [ f foo ] [ call ] if ; inline"
|
||||
|
|
|
@ -21,7 +21,7 @@ ARTICLE: "enums" "Enumerations"
|
|||
{ $subsection enum }
|
||||
{ $subsection <enum> }
|
||||
"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
|
||||
{ $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
|
||||
{ "key" object } { "alist" "an array of key/value pairs" }
|
||||
{ "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 } "." }
|
||||
{ $examples { $example "USING: prettyprint assocs kernel ;"
|
||||
{ $description "Iterates over " { $snippet "alist" } " and stops when the key is matched or the end of the " { $snippet "alist" } " has been reached. If there is no match, both outputs are " { $link f } "." }
|
||||
{ $notes "This word is used to implement " { $link at* } " and " { $link set-at } " on sequences, and should not be called direclty." }
|
||||
{ $examples { $example "USING: prettyprint assocs.private kernel ;"
|
||||
"3 { { 1 2 } { 3 4 } } search-alist [ . ] bi@"
|
||||
"{ 3 4 }\n1"
|
||||
} { $example "USING: prettyprint assocs kernel ;"
|
||||
} { $example "USING: prettyprint assocs.private kernel ;"
|
||||
"6 { { 1 2 } { 3 4 } } search-alist [ . ] bi@"
|
||||
"f\nf"
|
||||
}
|
||||
|
|
|
@ -38,6 +38,9 @@ M: assoc assoc-like drop ;
|
|||
: substituter ( assoc -- quot )
|
||||
[ dupd at* [ nip ] [ drop ] if ] curry ; inline
|
||||
|
||||
: with-assoc ( assoc quot: ( value key -- assoc ) -- quot: ( key value -- ) )
|
||||
curry [ swap ] prepose ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: assoc-find ( assoc quot -- key value ? )
|
||||
|
@ -81,7 +84,7 @@ PRIVATE>
|
|||
|
||||
M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
|
||||
[ dup assoc-size ] dip new-assoc
|
||||
[ [ swapd set-at ] curry assoc-each ] keep ;
|
||||
[ [ set-at ] with-assoc assoc-each ] keep ;
|
||||
|
||||
: keys ( assoc -- keys )
|
||||
[ drop ] { } assoc>map ;
|
||||
|
@ -93,7 +96,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
|
|||
[ at* ] 2keep delete-at ;
|
||||
|
||||
: 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-size 0 = ;
|
||||
|
@ -102,7 +105,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
|
|||
[ length 1- ] keep (assoc-stack) ; flushable
|
||||
|
||||
: assoc-subset? ( assoc1 assoc2 -- ? )
|
||||
[ swapd at* [ = ] [ 2drop f ] if ] curry assoc-all? ;
|
||||
[ at* [ = ] [ 2drop f ] if ] with-assoc assoc-all? ;
|
||||
|
||||
: assoc= ( assoc1 assoc2 -- ? )
|
||||
[ 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 ;
|
||||
|
||||
: update ( assoc1 assoc2 -- )
|
||||
swap [ swapd set-at ] curry assoc-each ;
|
||||
swap [ set-at ] with-assoc assoc-each ;
|
||||
|
||||
: assoc-union ( assoc1 assoc2 -- union )
|
||||
[ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep
|
||||
|
|
|
@ -10,18 +10,6 @@ ARTICLE: "singletons" "Singleton classes"
|
|||
{ $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
|
||||
{ $values { "word" "a new word" } }
|
||||
{ $description
|
||||
|
|
|
@ -14,15 +14,11 @@ HOOK: init-io io-backend ( -- )
|
|||
|
||||
HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )
|
||||
|
||||
HOOK: console-encoding os ( -- encoding )
|
||||
|
||||
M: object console-encoding utf8 ;
|
||||
|
||||
: init-stdio ( -- )
|
||||
(init-stdio)
|
||||
[ console-encoding <decoder> input-stream set-global ]
|
||||
[ console-encoding <encoder> output-stream set-global ]
|
||||
[ console-encoding <encoder> error-stream set-global ] tri* ;
|
||||
[ utf8 <decoder> input-stream set-global ]
|
||||
[ utf8 <encoder> output-stream set-global ]
|
||||
[ utf8 <encoder> error-stream set-global ] tri* ;
|
||||
|
||||
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:"
|
||||
{ $example "{ POSTPONE: f } ." "{ POSTPONE: f }" }
|
||||
"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 } ":"
|
||||
{ $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."
|
||||
{ $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* } "." ;
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! 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
|
||||
|
||||
DEFER: dip
|
||||
|
@ -154,7 +155,6 @@ TUPLE: identity-tuple ;
|
|||
|
||||
M: identity-tuple equal? 2drop f ;
|
||||
|
||||
USE: math.private
|
||||
: = ( obj1 obj2 -- ? )
|
||||
2dup eq? [ 2drop t ] [
|
||||
2dup both-fixnums? [ 2drop f ] [ equal? ] if
|
||||
|
|
|
@ -4,10 +4,10 @@ IN: math.integers
|
|||
ARTICLE: "integers" "Integers"
|
||||
{ $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:"
|
||||
{ $example "134217728 class ." "fixnum" }
|
||||
{ $example "128 class ." "fixnum" }
|
||||
{ $example "USE: classes" "134217728 class ." "fixnum" }
|
||||
{ $example "USE: classes" "128 class ." "fixnum" }
|
||||
{ $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" } "."
|
||||
$nl
|
||||
"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."
|
||||
$nl
|
||||
"Two examples where you should note the types of the inputs and outputs:"
|
||||
{ $example "3 >fixnum 6 >bignum * class ." "bignum" }
|
||||
{ $example "1/2 2.0 + ." "4.5" }
|
||||
{ $example "USE: classes" "3 >fixnum 6 >bignum * class ." "bignum" }
|
||||
{ $example "1/2 2.0 + ." "2.5" }
|
||||
"The following usual operations are supported by all numbers."
|
||||
{ $subsection + }
|
||||
{ $subsection - }
|
||||
|
|
|
@ -57,7 +57,7 @@ SYMBOL: auto-use?
|
|||
dup vocabulary>>
|
||||
[ (use+) ]
|
||||
[ amended-use get dup [ push ] [ 2drop ] if ]
|
||||
[ "Added “" "” vocabulary to search path" surround note. ]
|
||||
[ "Added \"" "\" vocabulary to search path" surround note. ]
|
||||
tri
|
||||
] [ create-in ] if ;
|
||||
|
||||
|
@ -160,6 +160,7 @@ SYMBOL: interactive-vocabs
|
|||
"definitions"
|
||||
"editors"
|
||||
"help"
|
||||
"help.lint"
|
||||
"inspector"
|
||||
"io"
|
||||
"io.files"
|
||||
|
@ -200,7 +201,7 @@ SYMBOL: interactive-vocabs
|
|||
SYMBOL: print-use-hook
|
||||
|
||||
print-use-hook global [ [ ] or ] change-at
|
||||
!
|
||||
|
||||
: parse-fresh ( lines -- quot )
|
||||
[
|
||||
V{ } clone amended-use set
|
||||
|
|
|
@ -352,6 +352,18 @@ HELP: SYMBOLS:
|
|||
{ $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" } } ;
|
||||
|
||||
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:
|
||||
{ $syntax "SINGLETONS: words... ;" }
|
||||
{ $values { "words" "a sequence of new words to define" } }
|
||||
|
|
|
@ -11,7 +11,7 @@ name words
|
|||
main help
|
||||
source-loaded? docs-loaded? ;
|
||||
|
||||
! sources-loaded? slot is one of these two
|
||||
! sources-loaded? slot is one of these three
|
||||
SYMBOL: +parsing+
|
||||
SYMBOL: +running+
|
||||
SYMBOL: +done+
|
||||
|
|
|
@ -1,18 +1,21 @@
|
|||
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors io io.encodings.utf8 io.servers.connection kernel
|
||||
listener math ;
|
||||
USING: accessors debugger io io.encodings.utf8 io.servers.connection
|
||||
kernel listener math namespaces ;
|
||||
|
||||
IN: fuel.remote
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: start-listener ( -- )
|
||||
[ [ print-error-and-restarts ] error-hook set listener ] with-scope ;
|
||||
|
||||
: server ( port -- server )
|
||||
<threaded-server>
|
||||
"tty-server" >>name
|
||||
utf8 >>encoding
|
||||
swap local-server >>insecure
|
||||
[ listener ] >>handler
|
||||
[ start-listener ] >>handler
|
||||
f >>timeout ;
|
||||
|
||||
: print-banner ( -- )
|
||||
|
|
Loading…
Reference in New Issue