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

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." } ;
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 } ;

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.
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 ;

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.
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

View File

@ -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:"

View File

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

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:"
{ $example
"USE: locals"
"IN: scratchpad"
"TUPLE: person first-name last-name ;"
":: 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:"
{ $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"

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."
$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 }

View File

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

View File

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

View File

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

View File

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

View File

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

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:"
{ $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* } "." ;

View File

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

View File

@ -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:"

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."
$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 - }

View File

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

View File

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

View File

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

View File

@ -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 ( -- )