Merge git://factorcode.org/git/factor

db4
Daniel Ehrenberg 2007-12-15 16:22:06 -05:00
commit 87b4633318
69 changed files with 411 additions and 244 deletions

View File

@ -74,6 +74,10 @@ following command line:
./factor -i=boot.<cpu>.image
Or this command for Mac OS X systems:
./Factor.app/Contents/MacOS/factor -i=boot.<cpu>.image
Bootstrap can take a while, depending on your system. When the process
completes, a 'factor.image' file will be generated. Note that this image
is both CPU and OS-specific, so in general cannot be shared between

View File

@ -14,7 +14,7 @@ $nl
ABOUT: "bootstrap.image"
HELP: make-image
{ $values { "architecture" "a string" } }
{ $values { "arch" "a string" } }
{ $description "Creates a bootstrap image from sources, where " { $snippet "architecture" } " is one of the following:"
{ $code "x86.32" "x86.64" "ppc" "arm" }
"The new image file is written to the " { $link resource-path } " and is named " { $snippet "boot." { $emphasis "architecture" } ".image" } "." } ;

View File

@ -203,17 +203,3 @@ HELP: define-class
{ $values { "word" word } { "members" "a sequence of class words" } { "superclass" class } { "metaclass" class } }
{ $description "Sets a property indicating this word is a class word, thus making it an instance of " { $link class } ", and registers it with " { $link typemap } " and " { $link class<map } "." }
$low-level-note ;
: $predicate ( element -- )
{ { "object" object } { "?" "a boolean" } } $values
[
"Tests if the object is an instance of the " ,
first "predicating" word-prop \ $link swap 2array ,
" class." ,
] { } make $description ;
M: predicate word-help* drop \ $predicate ;
HELP: $predicate
{ $values { "element" "a markup element of the form " { $snippet "{ word }" } } }
{ $description "Prints the boilerplate description of a class membership predicate word such as " { $link array? } " or " { $link integer? } "." } ;

View File

@ -85,7 +85,7 @@ HELP: continuation
{ $description "Reifies the current continuation from the point immediately after which the caller returns." } ;
HELP: >continuation<
{ $values { "continuation" continuation } { "data" vector } { "retain" vector } { "call" vector } { "name" vector } { "catch" vector } { "c" array } }
{ $values { "continuation" continuation } { "data" vector } { "retain" vector } { "call" vector } { "name" vector } { "catch" vector } }
{ $description "Takes a continuation apart into its constituents." } ;
HELP: ifcc

View File

@ -48,11 +48,10 @@ HELP: literal-table
{ $var-description "Holds a vector of literal objects referenced from the currently compiling word. If " { $link compiled-stack-traces? } " is on, " { $link init-generator } " ensures that the first entry is the word being compiled." } ;
HELP: init-generator
{ $values { "word" word } }
{ $description "Prepares to generate machine code for a word." } ;
HELP: generate-1
{ $values { "label" word } { "node" "a dataflow node" } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } }
{ $values { "word" word } { "label" word } { "node" "a dataflow node" } { "quot" "a quotation with stack effect " { $snippet "( node -- )" } } }
{ $description "Generates machine code for " { $snippet "label" } " by applying the quotation to the dataflow node." } ;
HELP: generate-node

View File

@ -4,7 +4,7 @@ generic.math ;
HELP: math-upgrade
{ $values { "class1" "a class word" } { "class2" "a class word" } { "quot" "a quotation with stack effect " { $snippet "( n n -- n n )" } } }
{ $description "Outputs a quotation for upgrading numberical types. It takes two numbers on the stack, an instance of " { $snippet "class1" } ", and an instance of " { $snippet "class2" } ", and converts the one with the lower priority to the higher priority type." }
{ $examples { $example "USE: generic.math" "fixnum bignum math-upgrade ." "[ >r >bignum r> ]" } } ;
{ $examples { $example "USE: generic.math" "fixnum bignum math-upgrade ." "[ [ >bignum ] dip ]" } } ;
HELP: no-math-method
{ $values { "left" "an object" } { "right" "an object" } { "generic" "a generic word" } }
@ -14,7 +14,7 @@ HELP: no-math-method
HELP: math-method
{ $values { "word" "a generic word" } { "class1" "a class word" } { "class2" "a class word" } { "quot" "a quotation" } }
{ $description "Generates a definition for " { $snippet "word" } " when the two inputs are instances of " { $snippet "class1" } " and " { $snippet "class2" } ", respectively." }
{ $examples { $example "USE: generic.math" "\\ + fixnum float math-method ." "[ >r >float r> float+ ]" } } ;
{ $examples { $example "USE: generic.math" "\\ + fixnum float math-method ." "[ [ >float ] dip float+ ]" } } ;
HELP: math-class
{ $class-description "The class of subtypes of " { $link number } " which are not " { $link null } "." } ;

View File

@ -96,7 +96,7 @@ HELP: hash-deleted+
{ $side-effects "hash" } ;
HELP: (set-hash)
{ $values { "value" "a value" } { "key" "a key to add" } { "hash" hashtable } }
{ $values { "value" "a value" } { "key" "a key to add" } { "hash" hashtable } { "new?" "a boolean" } }
{ $description "Stores the key/value pair into the hashtable. This word does not grow the hashtable if it exceeds capacity, therefore a hang can result. User code should use " { $link set-at } " instead, which grows the hashtable if necessary." }
{ $side-effects "hash" } ;

View File

@ -104,7 +104,7 @@ HELP: file-modified
HELP: parent-directory
{ $values { "path" "a pathname string" } { "parent" "a pathname string" } }
{ $description "Strips the last component off a pathname." }
{ $examples { $example "USE: io.files" "\"/etc/passwd\" parent-directory print" "/etc" } } ;
{ $examples { $example "USE: io.files" "\"/etc/passwd\" parent-directory print" "/etc/" } } ;
HELP: file-name
{ $values { "path" "a pathname string" } { "string" string } }

View File

@ -134,12 +134,13 @@ $nl
$io-error ;
HELP: make-block-stream
{ $values { "quot" "a quotation" } { "style" "a hashtable" } { "stream" "an output stream" } }
{ $contract "Calls the quotation in a new dynamic scope with the " { $link stdio } " stream rebound to a nested paragraph stream, with formatting information applied."
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
$nl
"Unlike " { $link make-span-stream } ", this creates a new paragraph block in the output."
$nl
"The " { $snippet "style" } " hashtable holds paragraph style information. See " { $link "paragraph-styles" } "." }
{ $notes "Instead of calling this word directly, use " { $link with-nesting } "." }
$io-error ;
HELP: stream-write-table
@ -151,16 +152,17 @@ $nl
$io-error ;
HELP: make-cell-stream
{ $values { "quot" quotation } { "style" hashtable } { "stream" "an output stream" } { "table-cell" object } }
{ $contract "Creates a table cell by calling the quotation in a new scope with a rebound " { $link stdio } " stream. Callers should not make any assumptions about the type of this word's output value; it should be treated like an opaque handle passed to " { $link stream-write-table } "." }
{ $values { "style" hashtable } { "stream" "an output stream" } { "stream'" object } }
{ $contract "Creates an output stream which writes to a table cell object." }
{ $notes "Instead of calling this word directly, use " { $link tabular-output } "." }
$io-error ;
HELP: make-span-stream
{ $values { "style" "a hashtable" } { "quot" "a quotation" } { "stream" "an output stream" } }
{ $contract "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "."
{ $values { "style" "a hashtable" } { "stream" "an output stream" } { "stream'" "an output stream" } }
{ $contract "Creates an output stream which wraps " { $snippet "stream" } " and adds " { $snippet "style" } " on calls to " { $link stream-write } " and " { $link stream-format } "."
$nl
"Unlike " { $link make-block-stream } ", the quotation's output is inline, and not nested in a paragraph block." }
"Unlike " { $link make-block-stream } ", the stream output is inline, and not nested in a paragraph block." }
{ $notes "Instead of calling this word directly, use " { $link with-style } "." }
$io-error ;
HELP: stream-print

View File

@ -542,7 +542,7 @@ HELP: 3compose
} ;
HELP: while
{ $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "quot" "a quotation" } { "tail" "a quotation" } }
{ $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
{ $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "quot" } " is called. After iteration stops, " { $snippet "tail" } " is called." }
{ $notes "In most cases, tail recursion should be used, because it is simpler both in terms of implementation and conceptually. However in some cases this combinator expresses intent better and should be used."
$nl

View File

@ -3,7 +3,7 @@
USING: kernel.private ;
IN: kernel
: version ( -- str ) "0.91" ; foldable
: version ( -- str ) "0.92" ; foldable
! Stack stuff
: roll ( x y z t -- y z t x ) >r rot r> swap ; inline

View File

@ -25,7 +25,7 @@ HELP: memcpy
{ $warning "As per the BSD C library documentation, the behavior is undefined if the source and destination overlap." } ;
HELP: check-ptr
{ $values { "c-ptr" "an alien address, byte array, or " { $link f } } { "checked" "an alien address or byte array with non-zero address" } }
{ $values { "c-ptr" "an alien address, byte array, or " { $link f } } }
{ $description "Throws an error if the input is " { $link f } ". Otherwise the object remains on the data stack." } ;
HELP: free

View File

@ -222,12 +222,12 @@ $nl
HELP: bit?
{ $values { "x" integer } { "n" integer } { "?" "a boolean" } }
{ $description "Tests if the " { $snippet "n" } "th bit of " { $snippet "x" } " is set." }
{ $examples { $example "BIN: 101 3 bit? ." "t" } } ;
{ $examples { $example "BIN: 101 2 bit? ." "t" } } ;
HELP: log2
{ $values { "n" "a positive integer" } { "b" integer } }
{ $description "Outputs the largest integer " { $snippet "b" } " such that " { $snippet "2^b" } " is less than " { $snippet "n" } "." }
{ $errors "Throws an error if " { $snippet "n" } " is zero or negative." } ;
{ $values { "x" "a positive integer" } { "n" integer } }
{ $description "Outputs the largest integer " { $snippet "n" } " such that " { $snippet "2^n" } " is less than " { $snippet "x" } "." }
{ $errors "Throws an error if " { $snippet "x" } " is zero or negative." } ;
HELP: 1+
{ $values { "x" number } { "y" number } }
@ -344,7 +344,7 @@ HELP: each-integer
{ $notes "This word is used to implement " { $link each } "." } ;
HELP: all-integers?
{ $values { "n" integer } { "quot" "a quotation with stack effect " { $snippet "( i -- ? )" } } { "i" "an integer or " { $link f } } }
{ $values { "n" integer } { "quot" "a quotation with stack effect " { $snippet "( i -- ? )" } } { "?" "a boolean" } }
{ $description "Applies the quotation to each integer from 0 up to " { $snippet "n" } ", excluding " { $snippet "n" } ". Iterationi stops when the quotation outputs " { $link f } " or the end is reached. If the quotation yields a false value for some integer, this word outputs " { $link f } ". Otherwise, this word outputs " { $link t } "." }
{ $notes "This word is used to implement " { $link all? } "." } ;

View File

@ -31,7 +31,7 @@ HELP: do-string-limit
{ $description "If " { $link string-limit } " is on, trims the string such that it does not exceed the margin, appending \"...\" if trimming took place." } ;
HELP: pprint-string
{ $values { "obj" object } { "str" string } { "prefix" "a prefix string" } }
{ $values { "obj" object } { "str" string } { "prefix" string } { "suffix" string } }
{ $description "Outputs a text section consisting of the prefix, the string, and a final quote (\")." }
$prettyprinting-note ;

1
extra/bake/authors.txt Normal file
View File

@ -0,0 +1 @@
Eduardo Cavazos

1
extra/bake/summary.txt Normal file
View File

@ -0,0 +1 @@
Bake is similar to make but with additional features

1
extra/cabal/authors.txt Normal file
View File

@ -0,0 +1 @@
Eduardo Cavazos

1
extra/cabal/summary.txt Normal file
View File

@ -0,0 +1 @@
Minimalist chat server

View File

@ -0,0 +1,2 @@
Matthew Willis
Eduardo Cavazos

View File

@ -0,0 +1 @@
Connects to a cabal server

1
extra/cfdg/summary.txt Normal file
View File

@ -0,0 +1 @@
Implementation of: http://contextfreeart.org

View File

@ -13,7 +13,7 @@ HELP: <remote-channel>
"returned by " { $link publish }
}
{ $examples
{ $example "\"localhost\" 9000 <node> \"ID123456\" <remote-channel> \"foo\" over to" }
{ $code "\"localhost\" 9000 <node> \"ID123456\" <remote-channel> \"foo\" over to" }
}
{ $see-also publish unpublish } ;
@ -24,7 +24,7 @@ HELP: unpublish
"accessible by remote nodes."
}
{ $examples
{ $example "<channel> publish unpublish" }
{ $code "<channel> publish unpublish" }
}
{ $see-also <remote-channel> publish } ;
@ -37,7 +37,7 @@ HELP: publish
{ $link to } " and " { $link from } " to access the channel."
}
{ $examples
{ $example "<channel> publish" }
{ $code "<channel> publish" }
}
{ $see-also <remote-channel> unpublish } ;

View File

@ -1,8 +1,9 @@
USING: help.syntax help.markup kernel prettyprint sequences ;
USING: help.syntax help.markup kernel prettyprint sequences
quotations math ;
IN: combinators.lib
HELP: generate
{ $values { "generator" "a quotation" } { "predicate" "a quotation" } { "obj" "an object" } }
{ $values { "generator" quotation } { "predicate" quotation } { "obj" object } }
{ $description "Loop until the generator quotation generates an object that satisfies predicate quotation." }
{ $unchecked-example
"! Generate a random 20-bit prime number congruent to 3 (mod 4)"
@ -12,7 +13,7 @@ HELP: generate
} ;
HELP: ndip
{ $values { "quot" "a quotation" } { "n" "a number" } }
{ $values { "quot" quotation } { "n" number } }
{ $description "A generalisation of " { $link dip } " that can work "
"for any stack depth. The quotation will be called with a stack that "
"has 'n' items removed first. The 'n' items are then put back on the "
@ -25,7 +26,7 @@ HELP: ndip
{ $see-also dip dipd } ;
HELP: nslip
{ $values { "n" "a number" } }
{ $values { "n" number } }
{ $description "A generalisation of " { $link slip } " that can work "
"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
"removed from the stack, the quotation called, and the items restored."
@ -36,7 +37,7 @@ HELP: nslip
{ $see-also slip nkeep } ;
HELP: nkeep
{ $values { "quot" "a quotation" } { "n" "a number" } }
{ $values { "quot" quotation } { "n" number } }
{ $description "A generalisation of " { $link keep } " that can work "
"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
"saved, the quotation called, and the items restored."
@ -47,7 +48,7 @@ HELP: nkeep
{ $see-also keep nslip } ;
HELP: map-withn
{ $values { "seq" "a sequence" } { "quot" "a quotation" } { "n" "a number" } { "newseq" "a sequence" } }
{ $values { "seq" sequence } { "quot" quotation } { "n" number } { "newseq" sequence } }
{ $description "A generalisation of " { $link map } ". The first " { $snippet "n" } " items after the quotation will be "
"passed to the quotation given to map-withn for each element in the sequence."
}
@ -57,43 +58,44 @@ HELP: map-withn
{ $see-also each-withn } ;
HELP: each-withn
{ $values { "seq" "a sequence" } { "quot" "a quotation" } { "n" "a number" } }
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
{ $description "A generalisation of " { $link each } ". The first " { $snippet "n" } " items after the quotation will be "
"passed to the quotation given to each-withn for each element in the sequence."
}
{ $see-also map-withn } ;
HELP: sigma
{ $values { "seq" "a sequence" } { "quot" "a quotation" } }
{ $values { "seq" sequence } { "quot" quotation } { "n" number } }
{ $description "Like map sum, but without creating an intermediate sequence." }
{ $example
"! Find the sum of the squares [0,99]"
"USE: math.ranges"
"100 [1,b] [ sq ] sigma"
"USING: math.ranges combinators.lib ;"
"100 [1,b] [ sq ] sigma ."
"338350"
} ;
HELP: count
{ $values { "seq" "a sequence" } { "quot" "a quotation" } }
{ $values { "seq" sequence } { "quot" quotation } { "n" integer } }
{ $description "Efficiently returns the number of elements that the predicate quotation matches." }
{ $example
"USE: math.ranges"
"USING: math.ranges combinators.lib ;"
"100 [1,b] [ even? ] count ."
"50"
} ;
HELP: all-unique?
{ $values { "seq" "a sequence" } { "?" "a boolean" } }
{ $values { "seq" sequence } { "?" "a boolean" } }
{ $description "Tests whether a sequence contains any repeated elements." }
{ $example
"USE: combinators.lib"
"{ 0 1 1 2 3 5 } all-unique? ."
"f"
} ;
HELP: &&
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } }
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
{ $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ;
HELP: ||
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } }
{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } }
{ $description "Calls each quotation in turn; outputs " { $link t } " if one of the quotations output " { $link t } ", otherwise outputs " { $link f } ". As soon as a quotation outputs " { $link t } ", evaluation stops and subsequent quotations are not called." } ;

View File

@ -25,9 +25,8 @@ HELP: mailbox-put
HELP: (mailbox-block-unless-pred)
{ $values { "pred" "a quotation with stack effect " { $snippet "( X -- bool )" } }
{ "mailbox" "a mailbox object" }
{ "pred2" "same object as 'pred'" }
{ "mailbox2" "same object as 'mailbox'" }
{ "mailbox" "a mailbox object" }
{ "timeout" "a timeout in milliseconds" }
}
{ $description "Block the thread if there are no items in the mailbox that return true when the predicate is called with the item on the stack. The predicate must have stack effect " { $snippet "( X -- bool )" } "." }
{ $see-also make-mailbox mailbox-empty? mailbox-put mailbox-get mailbox-get-all while-mailbox-empty mailbox-get? } ;
@ -35,6 +34,7 @@ HELP: (mailbox-block-unless-pred)
HELP: (mailbox-block-if-empty)
{ $values { "mailbox" "a mailbox object" }
{ "mailbox2" "same object as 'mailbox'" }
{ "timeout" "a timeout in milliseconds" }
}
{ $description "Block the thread if the mailbox is empty." }
{ $see-also make-mailbox mailbox-empty? mailbox-put mailbox-get mailbox-get-all while-mailbox-empty mailbox-get? } ;

View File

@ -13,8 +13,8 @@ HELP: bitroll
{ $values { "x" "an integer (input)" } { "s" "an integer (shift)" } { "w" "an integer (wrap)" } { "y" "an integer" } }
{ $description "Roll n by s bits to the left, wrapping around after w bits." }
{ $examples
{ $example "1 -1 32 bitroll .b" "10000000000000000000000000000000" }
{ $example "HEX: ffff0000 8 32 bitroll .h" "ff0000ff" }
{ $example "USE: crypto.common" "1 -1 32 bitroll .b" "10000000000000000000000000000000" }
{ $example "USE: crypto.common" "HEX: ffff0000 8 32 bitroll .h" "ff0000ff" }
} ;
@ -22,7 +22,7 @@ HELP: hex-string
{ $values { "seq" "a sequence" } { "str" "a string" } }
{ $description "Converts a sequence of values from 0-255 to a string of hex numbers from 0-ff." }
{ $examples
{ $example "B{ 1 2 3 4 } hex-string print" "01020304" }
{ $example "USE: crypto.common" "B{ 1 2 3 4 } hex-string print" "01020304" }
}
{ $notes "Numbers are zero-padded on the left." } ;

View File

@ -195,11 +195,11 @@ TUPLE: one-word-elt ;
M: one-word-elt prev-elt
drop
[ [ f -rot >r 1- r> (prev-word) ] (word-elt) ] (prev-char) ;
[ f -rot >r 1- r> (prev-word) ] (word-elt) ;
M: one-word-elt next-elt
drop
[ [ f -rot (next-word) ] (word-elt) ] (next-char) ;
[ f -rot (next-word) ] (word-elt) ;
TUPLE: word-elt ;

View File

@ -1,5 +1,5 @@
USING: help.markup help.crossref help.topics help.syntax
definitions io prettyprint inspector ;
definitions io prettyprint inspector help.lint arrays math ;
IN: help
ARTICLE: "printing-elements" "Printing markup elements"
@ -81,7 +81,8 @@ $nl
}
{ $subsection "element-types" }
"Related words can be cross-referenced:"
{ $subsection related-words } ;
{ $subsection related-words }
{ $see-also "help.lint" } ;
ARTICLE: "help-impl" "Help system implementation"
"Help topic protocol:"
@ -108,6 +109,7 @@ ARTICLE: "help" "Help system"
"The help system maintains documentation written in a simple markup language, along with cross-referencing and search. Documentation can either exist as free-standing " { $emphasis "articles" } " or be associated with words."
{ $subsection "browsing-help" }
{ $subsection "writing-help" }
{ $subsection "help.lint" }
{ $subsection "help-impl" } ;
ABOUT: "help"
@ -143,7 +145,7 @@ HELP: $index
{ $description "Calls the quotation to generate a sequence of help topics, and outputs a " { $link $subsection } " for each one." } ;
HELP: ($index)
{ $values { "seq" "a sequence of help article names and words" } { "quot" "a quotation with stack effect " { $snippet "( topic -- )" } } }
{ $values { "articles" "a sequence of help articles" } }
{ $description "Writes a list of " { $link $subsection } " elements to the " { $link stdio } " stream." } ;
HELP: xref-help
@ -154,3 +156,7 @@ HELP: sort-articles
{ $description "Sorts a sequence of help topics." } ;
{ article-children article-parent xref-help } related-words
HELP: $predicate
{ $values { "element" "a markup element of the form " { $snippet "{ word }" } } }
{ $description "Prints the boilerplate description of a class membership predicate word such as " { $link array? } " or " { $link integer? } "." } ;

View File

@ -4,7 +4,7 @@ USING: arrays io kernel namespaces parser prettyprint sequences
words assocs definitions generic quotations effects
slots continuations tuples debugger combinators
vocabs help.stylesheet help.topics help.crossref help.markup
sorting ;
sorting classes ;
IN: help
GENERIC: word-help* ( word -- content )
@ -15,12 +15,22 @@ GENERIC: word-help* ( word -- content )
[ swap 2array 1array ] [ 2drop f ] if
] ?if ;
: $predicate ( element -- )
{ { "object" object } { "?" "a boolean" } } $values
[
"Tests if the object is an instance of the " ,
first "predicating" word-prop \ $link swap 2array ,
" class." ,
] { } make $description ;
M: word word-help* drop f ;
M: slot-reader word-help* drop \ $slot-reader ;
M: slot-writer word-help* drop \ $slot-writer ;
M: predicate word-help* drop \ $predicate ;
: all-articles ( -- seq )
articles get keys
all-words [ word-help ] subset append ;

View File

@ -1,8 +1,20 @@
USING: help.markup help.syntax ;
IN: help.lint
HELP: check-help
{ $description "Checks all word and article help." } ;
HELP: check-vocab-help
{ $values { "vocab" "a vocabulary specifier" } }
{ $description "Checks all word help in the given vocabulary." } ;
ARTICLE: "help.lint" "Help lint tool"
"A quick and dirty tool to check documentation in an automated fashion."
"The " { $vocab-link "help.lint" } " vocabulary implements a tool to check documentation in an automated fashion. You should use this tool to check any documentation that you write."
$nl
"To run help lint, use one of the following two words:"
{ $subsection check-help }
{ $subsection check-vocab-help }
"Help lint performs the following checks:"
{ $list
"ensures examples run and produce stated output"
{ "ensures " { $link $see-also } " elements don't contain duplicate entries" }

View File

@ -4,7 +4,8 @@ USING: sequences parser kernel help help.markup help.topics
words strings classes tools.browser namespaces io
io.streams.string prettyprint definitions arrays vectors
combinators splitting debugger hashtables sorting effects vocabs
vocabs.loader assocs editors continuations classes.predicate ;
vocabs.loader assocs editors continuations classes.predicate
macros combinators.lib ;
IN: help.lint
: check-example ( element -- )
@ -29,7 +30,7 @@ IN: help.lint
stack-effect dup effect-in swap effect-out
append [ string? ] subset prune natural-sort ;
: check-values ( word element -- )
: contains-funky-elements? ( element -- ? )
{
$shuffle
$values-x/y
@ -38,11 +39,20 @@ IN: help.lint
$predicate
$class-description
$error-description
}
over [ elements empty? ] curry all?
pick "declared-effect" word-prop and
[ extract-values >array >r effect-values >array r> assert= ]
[ 2drop ] if ;
} swap [ elements f like ] curry contains? ;
: check-values ( word element -- )
{
[ over "declared-effect" word-prop ]
[ dup contains-funky-elements? not ]
[ over macro? not ]
[
2dup extract-values >array
>r effect-values >array
r> assert=
t
]
} && 3drop ;
: check-see-also ( word element -- )
nip \ $see-also swap elements [
@ -61,55 +71,59 @@ IN: help.lint
: check-rendering ( word element -- )
[ help ] string-out drop ;
: all-word-help ( -- seq )
all-words [ word-help ] subset ;
: all-word-help ( words -- seq )
[ word-help ] subset ;
TUPLE: help-error topic ;
: <help-error> ( topic delegate -- error )
{ set-help-error-topic set-delegate } help-error construct ;
: fix-help ( error -- )
dup delegate error.
help-error-topic >link edit
"Press ENTER when done." print flush readln drop
refresh-all ;
M: help-error error.
"In " write dup help-error-topic ($link) nl
delegate error. ;
: check-something ( obj quot -- )
over . flush [ <help-error> , ] recover ; inline
: check-word ( word -- )
dup . flush
[
dup word-help [
2dup check-examples
2dup check-values
2dup check-see-also
2dup check-modules
2dup drop check-rendering
] assert-depth 2drop
] [
dupd <help-error> fix-help check-word
] recover ;
dup word-help [
[
dup word-help [
2dup check-examples
2dup check-values
2dup check-see-also
2dup check-modules
2dup drop check-rendering
] assert-depth 2drop
] check-something
] [ drop ] if ;
: check-words ( -- )
[
all-vocabs-seq [ vocab-name ] map
"all-vocabs" set
all-word-help [ check-word ] each
] with-scope ;
: check-words ( words -- ) [ check-word ] each ;
: check-article ( article -- )
dup . flush
[
[ dup check-rendering ] assert-depth drop
] [
dupd <help-error> fix-help check-article
] recover ;
] check-something ;
: check-articles ( -- )
articles get keys [ check-article ] each ;
: check-help ( -- ) check-words check-articles ;
: with-help-lint ( quot -- )
[
all-vocabs-seq [ vocab-name ] map "all-vocabs" set
call
] { } make [ nl error. ] each ; inline
: unlinked-words ( -- seq )
: check-help ( -- )
[ all-words check-words check-articles ] with-help-lint ;
: check-vocab-help ( vocab -- )
[
child-vocabs [ words check-words ] each
] with-help-lint ;
: unlinked-words ( words -- seq )
all-word-help [ article-parent not ] subset ;
: linked-undocumented-words ( -- seq )

View File

@ -181,7 +181,7 @@ HELP: lmerge
{ $values { "list1" "a list" } { "list2" "a list" } { "result" "lazy list merging list1 and list2" } }
{ $description "Return the result of merging the two lists in a lazy manner." }
{ $examples
{ $example "{ 1 2 3 } >list { 4 5 6 } >list lmerge list>array ." "{ 1 4 2 5 3 6 }" }
{ $example "USE: lazy-lists" "{ 1 2 3 } >list { 4 5 6 } >list lmerge list>array ." "{ 1 4 2 5 3 6 }" }
}
{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp } ;

View File

@ -4,7 +4,7 @@ IN: locals
<PRIVATE
: $with-locals-note
{
drop {
"This form must appear either in a word defined by " { $link POSTPONE: :: } " or " { $link POSTPONE: MACRO:: } ", or alternatively, " { $link with-locals } " must be called on the top-level form of the word to perform closure conversion."
} $notes ;
@ -28,10 +28,10 @@ HELP: [let
{ $description "Introduces a set of lexical bindings and evaluates the body. The values are evaluated in parallel, and may not refer to other bindings within the same " { $link POSTPONE: [let } " form; for Lisp programmers, this means that Factor's " { $link POSTPONE: [let } " is equivalent to the Lisp " { $snippet "let" } ", not " { $snippet "let*" } "." }
{ $examples
{ $example
"USE: locals"
"USING: locals math.functions ;"
":: frobnicate | n seq |"
" [let | n' [ n 6 * ] |"
" seq [ n' gcd ] map ] ;"
" seq [ n' gcd nip ] map ] ;"
"6 { 36 14 } frobnicate ."
"{ 36 2 }"
}

View File

@ -273,20 +273,20 @@ HELP: mod-inv
{ $description "Outputs an integer " { $snippet "y" } " such that " { $snippet "xy = 1 (mod n)" } "." }
{ $errors "Throws an error if " { $snippet "n" } " is not invertible modulo " { $snippet "n" } "." }
{ $examples
{ $example "173 1119 mod-inv ." "815" }
{ $example "173 815 * 1119 mod ." "1" }
{ $example "USE: math.functions" "173 1119 mod-inv ." "815" }
{ $example "USE: math.functions" "173 815 * 1119 mod ." "1" }
} ;
HELP: each-bit
{ $values { "n" integer } { "quot" "a quotation with stack effect " { $snippet "( ? -- )" } } }
{ $description "Applies the quotation to each bit of the integer, starting from the least significant bit, and stopping at the last bit from which point on all bits are either clear (if the integer is positive) or all bits are set (if the integer is negataive)." }
{ $examples
{ $example "[ BIN: 1101 [ , ] each-bit ] { } make ." "{ t f t t }" }
{ $example "[ -3 [ , ] each-bit ] { } make ." "{ f t }" }
{ $example "USE: math.functions" "[ BIN: 1101 [ , ] each-bit ] { } make ." "{ t f t t }" }
{ $example "USE: math.functions" "[ -3 [ , ] each-bit ] { } make ." "{ t f }" }
} ;
HELP: ~
{ $values { "x" real } { "y" real } { "epsilon" real } }
{ $values { "x" real } { "y" real } { "epsilon" real } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "x" } " and " { $snippet "y" } " are approximately equal to each other. There are three possible comparison tests, chosen based on the sign of " { $snippet "epsilon" } ":"
{ $list
{ { $snippet "epsilon" } " is zero: exact comparison." }

View File

@ -45,7 +45,7 @@ HELP: deactivate-model
{ $warning "Calls to " { $link activate-model } " and " { $link deactivate-model } " should be balanced to keep the reference counting consistent, otherwise " { $link model-changed } " might be called at the wrong time or not at all." } ;
HELP: model-changed
{ $values { "observer" object } }
{ $values { "model" model } { "observer" object } }
{ $contract "Called to notify observers of a model that the model value has changed as a result of a call to " { $link set-model } ". Observers can be registered with " { $link add-connection } "." } ;
{ add-connection remove-connection model-changed } related-words

View File

@ -10,7 +10,7 @@ HELP: tree-write
"Write the object to the standard output stream, unless "
"it is an array, in which case recurse through the array "
"writing each object to the stream." }
{ $example "[ { 65 \"bc\" { 68 \"ef\" } } tree-write ] string-out ." "\"AbcDef\"" } ;
{ $example "USE: parser-combinators" "{ 65 \"bc\" { 68 \"ef\" } } tree-write" "AbcDef" } ;
HELP: search
{ $values
@ -24,8 +24,8 @@ HELP: search
"parser."
}
{ $example "\"one 123 two 456\" 'integer' search ." "{ 123 456 }" }
{ $example "\"one 123 \\\"hello\\\" two 456\" 'integer' 'string' <|> search ." "{ 123 \"hello\" 456 }" }
{ $example "USE: parser-combinators" "\"one 123 two 456\" 'integer' search ." "{ 123 456 }" }
{ $example "USE: parser-combinators" "\"one 123 \\\"hello\\\" two 456\" 'integer' 'string' <|> search ." "{ 123 \"hello\" 456 }" }
{ $see-also search* replace replace* } ;
HELP: search*
@ -40,7 +40,7 @@ HELP: search*
"parsers in the 'parsers' sequence."
}
{ $example "\"one 123 \\\"hello\\\" two 456\" 'integer' 'string' 2array search* ." "{ 123 \"hello\" 456 }" }
{ $example "USE: parser-combinators" "\"one 123 \\\"hello\\\" two 456\" 'integer' 'string' 2array search* ." "{ 123 \"hello\" 456 }" }
{ $see-also search replace replace* } ;
HELP: replace
@ -54,9 +54,9 @@ HELP: replace
"successfully parse with the given parser replaced with "
"the result of that parser."
}
{ $example "\"one 123 two 456\" 'integer' [ 2 * number>string ] <@ replace ." "\"one 246 two 912\"" }
{ $example "\"hello *world* from *factor*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ replace ." "\"hello <strong>world</strong> from <strong>factor</strong>\"" }
{ $example "\"hello *world* from _factor_\"\n 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@\n 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ <|>\n replace ." "\"hello <strong>world</strong> from <emphasis>factor</emphasis>\"" }
{ $example "USING: parser-combinators math.parser ;" "\"one 123 two 456\" 'integer' [ 2 * number>string ] <@ replace ." "\"one 246 two 912\"" }
{ $example "USE: parser-combinators" "\"hello *world* from *factor*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ replace ." "\"hello <strong>world</strong> from <strong>factor</strong>\"" }
{ $example "USE: parser-combinators" "\"hello *world* from _factor_\"\n 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@\n 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ <|>\n replace ." "\"hello <strong>world</strong> from <emphasis>factor</emphasis>\"" }
{ $see-also search search* replace* } ;
HELP: replace*
@ -71,6 +71,6 @@ HELP: replace*
"the result of that parser. Each parser is done in sequence so that "
"the parse results of the first parser can be replaced by later parsers."
}
{ $example "\"*hello _world_*\"\n 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@\n 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ 2array\n replace* ." "\"<strong>hello <emphasis>world</emphasis></strong>\"" }
{ $example "USE: parser-combinators" "\"*hello _world_*\"\n 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@\n 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ 2array\n replace* ." "\"<strong>hello <emphasis>world</emphasis></strong>\"" }
{ $see-also search search* replace* } ;

View File

@ -60,6 +60,6 @@ HELP: comma-list
"'element' should be a parser that can parse the elements. The "
"result of the parser is a sequence of the parsed elements." }
{ $examples
{ $example "USING: lazy-lits parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse-1 ." "{ 1 2 3 4 }" } } ;
{ $example "USING: lazy-lists parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse-1 ." "{ 1 2 3 4 }" } } ;
{ $see-also 'digit' 'integer' 'string' 'bold' 'italic' comma-list } related-words

View File

@ -4,9 +4,9 @@ USING: help.markup help.syntax peg ;
HELP: parse
{ $values
{ "string" "a string" }
{ "parse" "a parser" }
{ "result" "a <parse-result> or f" }
{ "input" "a string" }
{ "parser" "a parser" }
{ "result" "a parse-result or f" }
}
{ $description
"Given the input string, parse it using the given parser. The result is a <parse-result> object if "
@ -37,7 +37,7 @@ HELP: range
}
{ $description
"Returns a parser that matches a single character that lies within the range of characters given, inclusive." }
{ $example ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } ;
{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ;
HELP: seq
{ $values
@ -60,8 +60,7 @@ HELP: choice
HELP: repeat0
{ $values
{ "p1" "a parser" }
{ "p2" "a parser" }
{ "parser" "a parser" }
}
{ $description
"Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "
@ -70,8 +69,7 @@ HELP: repeat0
HELP: repeat1
{ $values
{ "p1" "a parser" }
{ "p2" "a parser" }
{ "parser" "a parser" }
}
{ $description
"Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is "
@ -79,8 +77,7 @@ HELP: repeat1
HELP: optional
{ $values
{ "p1" "a parser" }
{ "p2" "a parser" }
{ "parser" "a parser" }
}
{ $description
"Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is "
@ -88,29 +85,27 @@ HELP: optional
HELP: ensure
{ $values
{ "p1" "a parser" }
{ "p2" "a parser" }
{ "parser" "a parser" }
}
{ $description
"Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "
"AST and does not move the location in the input string. This can be used for lookahead and "
"disambiguation, along with the " { $link ensure-not } " word." }
{ $example "\"0\" token ensure octal-parser" } ;
{ $examples { $code "\"0\" token ensure octal-parser" } } ;
HELP: ensure-not
{ $values
{ "p1" "a parser" }
{ "p2" "a parser" }
{ "parser" "a parser" }
}
{ $description
"Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "
"AST and does not move the location in the input string. This can be used for lookahead and "
"disambiguation, along with the " { $link ensure } " word." }
{ $example "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;
{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;
HELP: action
{ $values
{ "p1" "a parser" }
{ "parser" "a parser" }
{ "quot" "a quotation with stack effect ( ast -- ast )" }
}
{ $description
@ -118,11 +113,10 @@ HELP: action
"from that parse. The result of the quotation is then used as the final AST. This can be used "
"for manipulating the parse tree to produce a AST better suited for the task at hand rather than "
"the default AST." }
{ $example "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
HELP: sp
{ $values
{ "p1" "a parser" }
{ "parser" "a parser" }
}
{ $description
@ -131,17 +125,15 @@ HELP: sp
HELP: hide
{ $values
{ "p1" "a parser" }
{ "parser" "a parser" }
}
{ $description
"Returns a parser that succeeds if the original parser succeeds, but does not "
"put any result in the AST. Useful for ignoring 'syntax' in the AST." }
{ $example "\"[\" token hide number \"]\" token hide 3array seq" } ;
{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ;
HELP: delay
{ $values
{ "quot" "a quotation with stack effect ( -- parser )" }
{ "parser" "a parser" }
}
{ $description

View File

@ -28,6 +28,6 @@ HELP: LAZY:
{ $values { "word" "a new word to define" } { "definition" "a word definition" } }
{ $description "Creates a lazy word in the current vocabulary. When executed the word will return a " { $link promise } " that when forced, executes the word definition. Any values on the stack that are required by the word definition are captured along with the promise." }
{ $examples
{ $example "LAZY: my-add ( a b -- c ) + ;\n1 2 my-add force ." "3" }
{ $example "IN: promises LAZY: my-add ( a b -- c ) + ;\n1 2 my-add force ." "3" }
}
{ $see-also force promise-with promise-with2 } ;

View File

@ -6,33 +6,29 @@ IN: raptor
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run-script ( path -- ) 1array [ fork-exec-args-wait ] curry in-thread ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[
"/etc/cron.daily/apt" run-script
"/etc/cron.daily/aptitude" run-script
"/etc/cron.daily/bsdmainutils" run-script
"/etc/cron.daily/find.notslocate" run-script
"/etc/cron.daily/logrotate" run-script
"/etc/cron.daily/man-db" run-script
"/etc/cron.daily/ntp-server" run-script
"/etc/cron.daily/slocate" run-script
"/etc/cron.daily/standard" run-script
"/etc/cron.daily/sysklogd" run-script
"/etc/cron.daily/tetex-bin" run-script
"/etc/cron.daily/apt" fork-exec-arg
"/etc/cron.daily/aptitude" fork-exec-arg
"/etc/cron.daily/bsdmainutils" fork-exec-arg
"/etc/cron.daily/find.notslocate" fork-exec-arg
"/etc/cron.daily/logrotate" fork-exec-arg
"/etc/cron.daily/man-db" fork-exec-arg
"/etc/cron.daily/ntp-server" fork-exec-arg
"/etc/cron.daily/slocate" fork-exec-arg
"/etc/cron.daily/standard" fork-exec-arg
"/etc/cron.daily/sysklogd" fork-exec-arg
"/etc/cron.daily/tetex-bin" fork-exec-arg
] cron-jobs-daily set-global
[
"/etc/cron.weekly/cvs" run-script
"/etc/cron.weekly/man-db" run-script
"/etc/cron.weekly/ntp-server" run-script
"/etc/cron.weekly/popularity-contest" run-script
"/etc/cron.weekly/sysklogd" run-script
"/etc/cron.weekly/cvs" fork-exec-arg
"/etc/cron.weekly/man-db" fork-exec-arg
"/etc/cron.weekly/ntp-server" fork-exec-arg
"/etc/cron.weekly/popularity-contest" fork-exec-arg
"/etc/cron.weekly/sysklogd" fork-exec-arg
] cron-jobs-weekly set-global
[
"/etc/cron.monthly/scrollkeeper" run-script
"/etc/cron.monthly/standard" run-script
"/etc/cron.monthly/scrollkeeper" fork-exec-arg
"/etc/cron.monthly/standard" fork-exec-arg
] cron-jobs-monthly set-global

View File

@ -1,5 +1,5 @@
USING: kernel parser namespaces threads sequences unix unix.process
USING: kernel parser namespaces threads arrays sequences unix unix.process
combinators.cleave bake ;
IN: raptor
@ -24,6 +24,8 @@ SYMBOL: networking-hook
: fork-exec-args-wait ( args -- ) [ first ] [ ] bi fork-exec-wait ;
: fork-exec-arg ( arg -- ) 1array [ fork-exec-args-wait ] curry in-thread ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: forever ( quot -- ) [ call ] [ forever ] bi ;

View File

@ -32,6 +32,12 @@ another Linux distribution.
# cp -v /scratch/factor/factor.image /sbin/init.image
*** Filesystems ***
# emacs /etc/raptor/config.factor
Edit the root-device and swap-devices variables.
*** Static IP networking ***
If you use a static IP in your network then Factor can take care of
@ -71,6 +77,8 @@ The items in boot-hook correspond to the things in '/etc/rcS.d' and
example, I removed the printer services. I also removed other things
that I didn't feel were necessary on my system.
Look for the line with the call to 'set-hostname' and edit it appropriately.
*** Grub ***
Edit your '/boot/grub/menu.lst'. Basically, copy and paste your

View File

@ -8,7 +8,7 @@ HELP: (serialize)
}
{ $description "Serializes the object to the current output stream. Object references within the structure being serialized are maintained. It must be called from within the scope of a " { $link with-serialized } " call." }
{ $examples
{ $example "USE: serialize" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
}
{ $see-also deserialize (deserialize) serialize with-serialized } ;
@ -17,7 +17,7 @@ HELP: (deserialize)
}
{ $description "Deserializes an object by reading from the current input stream. Object references within the structure that was originally serialized are maintained. It must be called from within the scope of a " { $link with-serialized } " call." }
{ $examples
{ $example "USE: serialize" "[\n [ { 1 2 } dup serialize serialize ] with-serialized\n] string-out\n\n[\n [ deserialize deserialize ] with-serialized\n] string-in eq? ." "t" }
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
}
{ $see-also (serialize) deserialize serialize with-serialized } ;
@ -26,7 +26,7 @@ HELP: with-serialized
}
{ $description "Creates a scope for serialization and deserialization operations. The quotation is called within this scope. The scope is used for maintaining the structure and object references of serialized objects." }
{ $examples
{ $example "USE: serialize" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
{ $example "USING: serialize io.streams.string ;" "[\n [ { 1 2 } dup (serialize) (serialize) ] with-serialized\n] string-out\n\n[\n [ (deserialize) (deserialize) ] with-serialized\n] string-in eq? ." "t" }
}
{ $see-also (serialize) (deserialize) serialize deserialize } ;
@ -35,7 +35,7 @@ HELP: serialize
}
{ $description "Serializes the object to the current output stream. Object references within the structure being serialized are maintained." }
{ $examples
{ $example "USE: serialize" "[ { 1 2 } serialize ] ] string-out\n\n[ deserialize ] string-in ." "{ 1 2 }" }
{ $example "USING: serialize io.streams.string ;" "[ { 1 2 } serialize ] string-out\n\n[ deserialize ] string-in ." "{ 1 2 }" }
}
{ $see-also deserialize (deserialize) (serialize) with-serialized } ;
@ -44,6 +44,6 @@ HELP: deserialize
}
{ $description "Deserializes an object by reading from the current input stream. Object references within the structure that was originally serialized are maintained." }
{ $examples
{ $example "USE: serialize" "[ { 1 2 } serialize ] ] string-out\n\n[ deserialize ] string-in ." "{ 1 2 }" }
{ $example "USING: serialize io.streams.string ;" "[ { 1 2 } serialize ] string-out\n\n[ deserialize ] string-in ." "{ 1 2 }" }
}
{ $see-also (serialize) deserialize (deserialize) with-serialized } ;

View File

@ -0,0 +1 @@
Eduardo Cavazos

View File

@ -0,0 +1,13 @@
USING: tools.deploy.config ;
H{
{ deploy-compiler? t }
{ deploy-word-props? f }
{ deploy-ui? t }
{ deploy-reflection 1 }
{ deploy-name "springies.models.2x2snake" }
{ deploy-c-types? f }
{ deploy-word-defs? f }
{ "stop-after-last-window?" t }
{ deploy-math? t }
{ deploy-io 1 }
}

View File

@ -0,0 +1 @@
Mass and spring simulation (inspired by xspringies)

View File

@ -0,0 +1,3 @@
simulation
physics
demos

View File

@ -43,7 +43,7 @@ $nl
HELP: deploy-word-defs?
{ $description "Deploy flag. If set, the deploy tool retains word definition quotations for words compiled with the optimizing compiler. Otherwise, word definitions are stripped from words compiled with the optimizing compiler."
$nl
"Off by default. During normal execution, the word definition quotation of a word compiled with the optimizing compiler is not used, so disabling this flag can save space. However, some libraries introspect word definitions dynamically (for example, " { $link "inverse" } ") and so programs using these libraries must retain word definition quotations." } ;
"Off by default. During normal execution, the word definition quotation of a word compiled with the optimizing compiler is not used, so disabling this flag can save space. However, some libraries introspect word definitions dynamically (for example, " { $vocab-link "inverse" } ") and so programs using these libraries must retain word definition quotations." } ;
HELP: deploy-c-types?
{ $description "Deploy flag. If set, the deploy tool retains the " { $link c-types } " table, otherwise this table is stripped out, saving space."

View File

@ -1,7 +1,8 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io io.files kernel namespaces sequences system
tools.deploy tools.deploy.config assocs hashtables prettyprint ;
tools.deploy tools.deploy.config assocs hashtables prettyprint
windows.shell32 windows.user32 ;
IN: tools.deploy.windows
: copy-vm ( executable bundle-name -- vm )
@ -38,4 +39,5 @@ M: windows-deploy-implementation deploy
[ deploy-name get create-exe-dir ] keep
[ deploy-name get image-name ] keep
namespace
deploy-name get open-in-explorer
] bind deploy* ;

View File

@ -18,9 +18,7 @@ SYMBOL: this-test
: (unit-test) ( what quot -- )
swap dup . flush this-test set
[ time ] curry failures get [
[
this-test get <failure> failures get push
] recover
[ this-test get failure ] recover
] [
call
] if ;

View File

@ -5,6 +5,7 @@ HELP: >tuple<
{ $values { "class" "a tuple class" } }
{ $description "Explodes the tuple so that tuple slots are on the stack in the order listed in the tuple." }
{ $example
"USE: tuples.lib"
"TUPLE: foo a b c ;"
"1 2 3 \\ foo construct-boa \\ foo >tuple< .s"
"1\n2\n3"
@ -16,6 +17,7 @@ HELP: >tuple*<
{ $values { "class" "a tuple class" } }
{ $description "Explodes the tuple so that tuple slots ending with '*' are on the stack in the order listed in the tuple." }
{ $example
"USE: tuples.lib"
"TUPLE: foo a bb* ccc dddd* ;"
"1 2 3 4 \\ foo construct-boa \\ foo >tuple*< .s"
"2\n4"

View File

@ -30,6 +30,16 @@ tools.test.inference tools.test.ui models ;
] with-grafted-gadget
] unit-test
[ "bar" ] [
<editor> "editor" set
"editor" get [
"bar\nbaz quux" "editor" get set-editor-string
{ 0 3 } "editor" get editor-caret set-model
"editor" get select-word
"editor" get gadget-selection
] with-grafted-gadget
] unit-test
{ 0 1 } [ <editor> ] unit-test-effect
"hello" <model> <field> "field" set

View File

@ -34,14 +34,10 @@ focused? ;
: field-theme ( gadget -- )
gray <solid> swap set-gadget-boundary ;
: construct-editor ( class -- tuple )
>r <editor> { set-gadget-delegate } r> construct
: construct-editor ( object class -- tuple )
>r { set-gadget-delegate } r> construct
dup dup set-editor-self ; inline
TUPLE: source-editor ;
: <source-editor> source-editor construct-editor ;
: activate-editor-model ( editor model -- )
2dup add-connection
dup activate-model
@ -320,11 +316,6 @@ M: editor gadget-text* editor-string % ;
: end-of-document ( editor -- ) T{ doc-elt } editor-next ;
: selected-word ( editor -- string )
dup gadget-selection? [
dup T{ one-word-elt } select-elt
] unless gadget-selection ;
: position-caret ( editor -- )
mouse-elt dup T{ one-char-elt } =
[ drop dup extend-selection dup editor-mark click-loc ]
@ -345,9 +336,6 @@ M: editor gadget-text* editor-string % ;
: delete-to-end-of-line T{ one-line-elt } editor-backspace ;
editor "general" f {
{ T{ key-down f f "RET" } insert-newline }
{ T{ key-down f { S+ } "RET" } insert-newline }
{ T{ key-down f f "ENTER" } insert-newline }
{ T{ key-down f f "DELETE" } delete-next-character }
{ T{ key-down f { S+ } "DELETE" } delete-next-character }
{ T{ key-down f f "BACKSPACE" } delete-previous-character }
@ -408,6 +396,11 @@ editor "caret-motion" f {
: select-word T{ one-word-elt } select-elt ;
: selected-word ( editor -- string )
dup gadget-selection?
[ dup select-word ] unless
gadget-selection ;
: select-previous-character T{ char-elt } editor-select-prev ;
: select-next-character T{ char-elt } editor-select-next ;
@ -448,6 +441,23 @@ editor "selection" f {
{ T{ key-down f { S+ C+ } "END" } select-end-of-document }
} define-command-map
! Multi-line editors
TUPLE: multiline-editor ;
: <multiline-editor> ( -- editor )
<editor> multiline-editor construct-editor ;
multiline-editor "general" f {
{ T{ key-down f f "RET" } insert-newline }
{ T{ key-down f { S+ } "RET" } insert-newline }
{ T{ key-down f f "ENTER" } insert-newline }
} define-command-map
TUPLE: source-editor ;
: <source-editor> ( -- editor )
<multiline-editor> source-editor construct-editor ;
! Fields are like editors except they edit an external model
TUPLE: field model editor ;

View File

@ -1,5 +1,5 @@
USING: ui.gadgets help.markup help.syntax opengl kernel strings
tuples classes quotations ;
tuples classes quotations models ;
HELP: rect
{ $class-description "A rectangle with the following slots:"
@ -259,3 +259,52 @@ HELP: g
HELP: g->
{ $values { "x" object } { "gadget" gadget } }
{ $description "Duplicates the top of the stack and outputs the gadget being built. Can only be used inside a quotation passed to " { $link build-gadget } "." } ;
HELP: construct-control
{ $values { "model" model } { "gadget" gadget } { "class" class } { "control" gadget } }
{ $description "Creates a new control linked to the given model. The gadget parameter becomes the control's delegate. The quotation is called when the model value changes." }
{ $examples
"The following example creates a gadget whose fill color is determined by the value of a model:"
{ $code
"USING: ui.gadgets ui.gadgets.panes models ;"
": set-fill-color >r <solid> r> set-gadget-interior ;"
""
"TUPLE: color-gadget ;"
""
"M: color-gadget model-changed"
" >r model-value r> set-fill-color ;"
""
": <color-gadget> ( model -- gadget )"
" <gadget>"
" { 100 100 } over set-rect-dim"
" color-gadget"
" construct-control ;"
""
"{ 1.0 0.0 0.5 1.0 } <model> <color-gadget>"
"gadget."
}
"The " { $vocab-link "color-picker" } " module extends this example into a more elaborate color chooser."
} ;
{ construct-control control-value set-control-value gadget-model } related-words
HELP: control-value
{ $values { "control" gadget } { "value" object } }
{ $description "Outputs the value of the control's model." } ;
HELP: set-control-value
{ $values { "value" object } { "control" gadget } }
{ $description "Sets the value of the control's model." } ;
ARTICLE: "ui-control-impl" "Implementing controls"
"A " { $emphasis "control" } " is a gadget which is linked to an underlying " { $link model } " by having its " { $link gadget-model } " slot set to a model instance."
$nl
"To implement a new control, simply use this word in your constructor:"
{ $subsection construct-control }
"Some utility words useful in control implementations:"
{ $subsection gadget-model }
{ $subsection control-value }
{ $subsection set-control-value }
{ $see-also "models" } ;
ABOUT: "ui-control-impl"

View File

@ -55,6 +55,6 @@ HELP: find-world
{ $description "Finds the " { $link world } " containing the gadget, or outputs " { $link f } " if the gadget is not grafted." } ;
HELP: draw-world
{ $values { "rect" "a clipping rectangle" } { "world" world } }
{ $values { "world" world } }
{ $description "Redraws a world." }
{ $notes "This word should only be called by the UI backend. To force a gadget to redraw from user code, call " { $link relayout-1 } "." } ;

View File

@ -95,7 +95,7 @@ deploy-gadget "toolbar" f {
{ f com-help }
{ f com-revert }
{ f com-save }
{ T{ key-down f f "RETURN" } com-deploy }
{ T{ key-down f f "RET" } com-deploy }
} define-command-map
: buttons,

View File

@ -33,9 +33,8 @@ help ;
: <interactor> ( output -- gadget )
<source-editor>
{ set-interactor-output set-gadget-delegate }
interactor construct
dup dup set-editor-self
interactor construct-editor
tuck set-interactor-output
dup init-interactor-history
dup init-caret-help ;

View File

@ -33,7 +33,8 @@ M: live-search handle-gesture* ( gadget gesture delegate -- ? )
TUPLE: search-field ;
: <search-field> ( -- gadget ) search-field construct-editor ;
: <search-field> ( -- gadget )
<editor> search-field construct-editor ;
search-field H{
{ T{ key-down f f "UP" } [ find-search-list select-previous ] }

View File

@ -35,8 +35,9 @@ IN: webapps.file
SYMBOL: serve-file-hook
[
dupd
file-response
stdio get stream-copy
<file-reader> stdio get stream-copy
] serve-file-hook set-global
: serve-static ( filename mime-type -- )
@ -46,7 +47,6 @@ SYMBOL: serve-file-hook
"method" get "head" = [
file-response
] [
>r dup <file-reader> swap r>
serve-file-hook get call
] if
] if ;
@ -118,14 +118,6 @@ SYMBOL: page
] if ;
global [
! Serve up our own source code
"resources" [
[
"" resource-path "doc-root" set
file-responder
] with-scope
] add-simple-responder
! Serves files from a directory stored in the "doc-root"
! variable. You can set the variable in the global
! namespace, or inside the responder.

View File

@ -3,9 +3,9 @@
<h2>Annotation: <% "summary" get write %></h2>
<table>
<tr><th>Annotation by:</th><td><% "author" get write %></td></tr>
<tr><th>Channel:</th><td><% "channel" get write %></td></tr>
<tr><th>Created:</th><td><% "date" get timestamp>string write %></td></tr>
<tr><th align="right">Annotation by:</th><td><% "author" get write %></td></tr>
<tr><th align="right">File type:</th><td><% "mode" get write %></td></tr>
<tr><th align="right">Created:</th><td><% "date" get timestamp>string write %></td></tr>
</table>
<% "syntax" render-template %>

View File

@ -17,13 +17,15 @@
<% "pastes" get <reversed> [ "paste-summary" render-component ] each %>
</table>
</td>
<td valign="top" width="25%" class="infobox">
<p>This pastebin is written in <a href="http://factorcode.org/">Factor</a>. It is inspired by <a href="http://paste.lisp.org">lisppaste</a>.
</p>
<p>It can be used for collaborative development over IRC. You can post code for review, and annotate other people's code. Syntax highlighting for over a hundred file types is supported.
</p>
<p>
<% "webapps.pastebin" browse-webapp-source %></p>
<td valign="top" width="25%">
<div class="infobox">
<p>This pastebin is written in <a href="http://factorcode.org/">Factor</a>. It is inspired by <a href="http://paste.lisp.org">lisppaste</a>.
</p>
<p>It can be used for collaborative development over IRC. You can post code for review, and annotate other people's code. Syntax highlighting for over a hundred file types is supported.
</p>
<p>
<% "webapps.pastebin" browse-webapp-source %></p>
</div>
</td>
</tr>
</table>

View File

@ -58,7 +58,7 @@ C: <annotation> annotation
paste-n number>string [ show-paste ] curry quot-link ;
: paste-feed ( -- entries )
get-pastebin pastebin-pastes [
get-pastebin pastebin-pastes <reversed> [
{
paste-summary
paste-link
@ -100,7 +100,7 @@ C: <annotation> annotation
\ annotate-paste {
{ "n" v-required v-number }
{ "summary" "- no summary -" v-default }
{ "author" v-required }
{ "author" "- no author -" v-default }
{ "mode" "factor" v-default }
{ "contents" v-required }
} define-action

View File

@ -1,20 +1,33 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files namespaces webapps.file http.server.responders
xmode.code2html kernel html ;
xmode.code2html kernel html sequences ;
IN: webapps.source
! This responder is a potential security problem. Make sure you
! don't have sensitive files stored under vm/, core/, extra/
! or misc/.
: check-source-path ( path -- ? )
{ "vm/" "core/" "extra/" "misc/" }
[ head? ] curry* contains? ;
: source-responder ( path mime-type -- )
drop
serving-html
[ dup <file-reader> htmlize-stream ] with-html-stream ;
global [
! Serve up our own source code
"source" [
[
"" resource-path "doc-root" set
"argument" get check-source-path [
[
drop
serving-html
[ swap htmlize-stream ] with-html-stream
] serve-file-hook set
file-responder
] with-scope
"" resource-path "doc-root" set
[ source-responder ] serve-file-hook set
file-responder
] with-scope
] [
"403 forbidden" httpd-error
] if
] add-simple-responder
] bind

View File

@ -1,15 +1,21 @@
source misc/version.sh
TARGET=$1
if [ "$TARGET" = "x86" ]; then
if [ "$1" = "x86" ]; then
CPU="x86.32"
TARGET=macosx-x86-32
else
CPU="ppc"
CPU="macosx-ppc"
TARGET=macosx-ppc
fi
make macosx-$TARGET
Factor.app/Contents/MacOS/factor -i=boot.$CPU.image -no-user-init
BOOT_IMAGE=boot.$CPU.image
wget http://factorcode.org/images/$VERSION/$BOOT_IMAGE
make $TARGET
Factor.app/Contents/MacOS/factor -i=$BOOT_IMAGE -no-user-init
VERSION=0.91
DISK_IMAGE_DIR=Factor-$VERSION
DISK_IMAGE=Factor-$VERSION-$TARGET.dmg
@ -24,3 +30,6 @@ find core extra fonts misc unmaintained -type f \
-exec ./cp_dir {} $DISK_IMAGE_DIR/Factor/{} \;
hdiutil create -srcfolder "$DISK_IMAGE_DIR" -fs HFS+ \
-volname "$DISK_IMAGE_DIR" "$DISK_IMAGE"
ssh linode mkdir -p w/downloads/$VERSION/
scp $DISK_IMAGE linode:w/downloads/$VERSION/

7
misc/source-release.sh Normal file
View File

@ -0,0 +1,7 @@
source misc/version.sh
rm -rf .git
cd ..
tar cfz Factor-$VERSION.tar.gz factor/
ssh linode mkdir -p w/downloads/$VERSION/
scp Factor-$VERSION.tar.gz linode:w/downloads/$VERSION/

1
misc/version.sh Normal file
View File

@ -0,0 +1 @@
export VERSION=0.92

View File

@ -1,19 +1,31 @@
source misc/version.sh
CPU=$1
VERSION=0.91
if [ "$CPU" = "x86" ]; then
FLAGS="-no-sse2"
fi
make windows-nt-x86
wget http://factorcode.org/dlls/freetype6.dll
wget http://factorcode.org/dlls/zlib1.dll
wget http://factorcode.org/images/$VERSION/boot.x86.32.image
CMD="./factor-nt -i=boot.x86.32.image -no-user-init $FLAGS"
echo $CMD
$CMD
rm -rf .git/
rm -rf Factor.app/
rm -rf vm/
rm -f Makefile
rm -f cp_dir
rm -f boot.*.image
FILE=Factor-$VERSION-win32-$CPU.zip
cd ..
zip -r Factor-$VERSION-win32-$CPU.zip Factor/
zip -r $FILE Factor/
ssh linode mkdir -p w/downloads/$VERSION/
scp $FILE linode:w/downloads/$VERSION/

View File

@ -84,7 +84,8 @@ long exception_handler(PEXCEPTION_POINTERS pe)
void c_to_factor_toplevel(CELL quot)
{
AddVectoredExceptionHandler(0, (void*)exception_handler);
if(!AddVectoredExceptionHandler(0, (void*)exception_handler))
fatal_error("AddVectoredExceptionHandler failed", 0);
c_to_factor(quot);
RemoveVectoredExceptionHandler((void*)exception_handler);
}

View File

@ -72,7 +72,6 @@
#elif defined(FACTOR_ARM)
#include "os-linux-arm.h"
#elif defined(FACTOR_AMD64)
#include "os-unix-ucontext.h"
#include "os-linux-x86-64.h"
#else
#error "Unsupported Linux flavor"

View File

@ -191,12 +191,13 @@ XT quot_offset_to_pc(F_QUOTATION *quot, F_FIXNUM offset)
DEFINE_PRIMITIVE(curry)
{
F_CURRY *curry = allot_object(CURRY_TYPE,sizeof(F_CURRY));
F_CURRY *curry;
switch(type_of(dpeek()))
{
case QUOTATION_TYPE:
case CURRY_TYPE:
curry = allot_object(CURRY_TYPE,sizeof(F_CURRY));
curry->quot = dpop();
curry->obj = dpop();
dpush(tag_object(curry));