diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index 80f0b4f515..b5b2be5095 100755 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -23,3 +23,30 @@ IN: compiler.constants : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; : compiled-header-size ( -- n ) 4 bootstrap-cells ; + +! Relocation classes +: rc-absolute-cell 0 ; +: rc-absolute 1 ; +: rc-relative 2 ; +: rc-absolute-ppc-2/2 3 ; +: rc-relative-ppc-2 4 ; +: rc-relative-ppc-3 5 ; +: rc-relative-arm-3 6 ; +: rc-indirect-arm 7 ; +: rc-indirect-arm-pc 8 ; + +! Relocation types +: rt-primitive 0 ; +: rt-dlsym 1 ; +: rt-literal 2 ; +: rt-dispatch 3 ; +: rt-xt 4 ; +: rt-here 5 ; +: rt-label 6 ; +: rt-immediate 7 ; + +: rc-absolute? ( n -- ? ) + [ rc-absolute-ppc-2/2 = ] + [ rc-absolute-cell = ] + [ rc-absolute = ] + tri or or ; diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index 24344acbf7..7397694ba5 100755 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -113,12 +113,6 @@ ERROR: no-sql-type ; (lookup-type) second ] if ; -: paren ( string -- new-string ) - "(" swap ")" 3append ; - -: join-space ( string1 string2 -- new-string ) - " " swap 3append ; - : modifiers ( spec -- string ) modifiers>> [ lookup-modifier ] map " " join [ "" ] [ " " prepend ] if-empty ; diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index 9d57e758c1..4e136d81c2 100755 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -108,6 +108,7 @@ USE: io.buffers ARTICLE: "collections" "Collections" { $heading "Sequences" } { $subsection "sequences" } +{ $subsection "virtual-sequences" } { $subsection "namespaces-make" } "Fixed-length sequences:" { $subsection "arrays" } diff --git a/basis/io/unix/linux/monitors/monitors-tests.factor b/basis/io/unix/linux/monitors/monitors-tests.factor index c71b053919..42c5009ccb 100644 --- a/basis/io/unix/linux/monitors/monitors-tests.factor +++ b/basis/io/unix/linux/monitors/monitors-tests.factor @@ -10,6 +10,7 @@ threads calendar prettyprint destructors io.timeouts ; ! Non-recursive [ ] [ "monitor-test-self" temp-file f "m" set ] unit-test + [ ] [ 3 seconds "m" get set-timeout ] unit-test [ ] [ "monitor-test-self" temp-file touch-file ] unit-test @@ -22,6 +23,7 @@ threads calendar prettyprint destructors io.timeouts ; ! Recursive [ ] [ "monitor-test-self" temp-file t "m" set ] unit-test + [ ] [ 3 seconds "m" get set-timeout ] unit-test [ ] [ "monitor-test-self" temp-file touch-file ] unit-test diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 12f9a55795..d80adeaed9 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -115,6 +115,7 @@ ERROR: no-vocab vocab ; { "seq3" sequence } { "seq4" sequence } { "seq1'" sequence } { "seq2'" sequence } { "newseq" sequence } + { "seq'" sequence } { "assoc" assoc } { "assoc1" assoc } { "assoc2" assoc } { "assoc3" assoc } { "newassoc" assoc } { "alist" "an array of key/value pairs" } @@ -157,7 +158,7 @@ ERROR: no-vocab vocab ; "{ $description \"\" } ;" print ; : help-header. ( word -- ) - "HELP: " write name>> print ; + "HELP: " write . ; : (help.) ( word -- ) [ help-header. ] [ $values. ] [ $description. ] tri ; diff --git a/build-support/factor.sh b/build-support/factor.sh index 16ab260df5..8be61f322a 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -175,6 +175,7 @@ find_os() { *FreeBSD*) OS=freebsd;; *OpenBSD*) OS=openbsd;; *DragonFly*) OS=dragonflybsd;; + SunOS) OS=solaris;; esac } @@ -186,6 +187,7 @@ find_architecture() { case $uname_m in i386) ARCH=x86;; i686) ARCH=x86;; + i86pc) ARCH=x86;; amd64) ARCH=x86;; ppc64) ARCH=ppc;; *86) ARCH=x86;; @@ -261,6 +263,8 @@ check_os_arch_word() { $ECHO "ARCH: $ARCH" $ECHO "WORD: $WORD" $ECHO "OS, ARCH, or WORD is empty. Please report this." + + echo $MAKE_TARGET exit 5 fi } @@ -486,6 +490,8 @@ usage() { echo " $0 update macosx-x86-32" } +MAKE_TARGET=unknown + # -n is nonzero length, -z is zero length if [[ -n "$2" ]] ; then parse_build_info $2 diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 3949c4b566..f5ebc2a338 100755 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -77,6 +77,9 @@ $nl "Another two words resume continuations:" { $subsection continue } { $subsection continue-with } +"Continuations as control-flow:" +{ $subsection attempt-all } +{ $subsection with-return } "Reflecting the datastack:" { $subsection with-datastack } "Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "." @@ -211,3 +214,42 @@ HELP: with-datastack { $examples { $example "USING: continuations math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" } } ; + +HELP: +{ $description "Constructs a new continuation." } +{ $notes "User code should call " { $link continuation } " instead." } ; + +HELP: attempt-all +{ $values + { "seq" sequence } { "quot" quotation } + { "obj" object } } +{ $description "Applies the quotation to elements in a sequence and returns the value from the first quotation that does not throw an error. If all quotations throw an error, returns the last error thrown." } +{ $examples "The first two numbers throw, the last one doesn't:" + { $example + "USING: prettyprint continuations kernel math ;" + "{ 1 3 6 } [ dup odd? [ \"Odd\" throw ] when ] attempt-all ." + "6" } + "All quotations throw, the last exception is rethrown:" + { $example + "USING: prettyprint continuations kernel math ;" + "[ { 1 3 5 } [ dup odd? [ throw ] when ] attempt-all ] [ ] recover ." + "5" + } +} ; + +HELP: return +{ $description "Returns early from a quotation by reifying the continuation captured by " { $link with-return } " ; execution is resumed starting immediately after " { $link with-return } "." } ; + +HELP: with-return +{ $values + { "quot" quotation } } +{ $description "Captures a continuation that can be reified by calling the " { $link return } " word. If so, it will resume execution immediatly after the " { $link with-return } " word. If " { $link return } " is not called, then execution proceeds as if this word were simply " { $link call } "." } +{ $examples + "Only \"Hi\" will print:" + { $example + "USING: prettyprint continuations io ;" + "[ \"Hi\" print return \"Bye\" print ] with-return" + "Hi" +} } ; + +{ return with-return } related-words diff --git a/core/destructors/destructors-docs.factor b/core/destructors/destructors-docs.factor index b611b8ec19..c82f92dc10 100755 --- a/core/destructors/destructors-docs.factor +++ b/core/destructors/destructors-docs.factor @@ -1,4 +1,5 @@ -USING: help.markup help.syntax libc kernel continuations io ; +USING: help.markup help.syntax libc kernel continuations io +sequences ; IN: destructors HELP: dispose @@ -45,6 +46,11 @@ HELP: |dispose { $values { "disposable" "a disposable object" } } { $description "Marks the object for disposal in the event of an error at the end of the current " { $link with-destructors } " scope." } ; +HELP: dispose-each +{ $values + { "seq" sequence } } +{ $description "Attempts to dispose of each element of a sequence and collects all of the errors into a sequence. If any errors are thrown during disposal, the last error is rethrown after all objects have been disposed." } ; + ARTICLE: "destructors-anti-patterns" "Resource disposal anti-patterns" "Words which create objects corresponding to external resources should always be used with " { $link with-disposal } ". The following code is wrong:" { $code diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor index 07517afdf7..7cc8333c12 100755 --- a/core/hashtables/hashtables-docs.factor +++ b/core/hashtables/hashtables-docs.factor @@ -111,6 +111,12 @@ HELP: associate { $values { "value" "a value" } { "key" "a key" } { "hash" "a new " { $link hashtable } } } { $description "Create a new hashtable holding one key/value pair." } ; +HELP: ?set-at +{ $values + { "value" object } { "key" object } { "assoc/f" "an assoc or " { $link f } } + { "assoc" assoc } } +{ $description "If the third input is an assoc, stores the key/value pair into that assoc, or else creates a new hashtable with the key/value pair as its only entry." } ; + HELP: >hashtable { $values { "assoc" "an assoc" } { "hashtable" "a hashtable" } } { $description "Constructs a hashtable from any assoc." } ; diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor index b639696f57..43f66657a7 100755 --- a/core/io/io-docs.factor +++ b/core/io/io-docs.factor @@ -1,128 +1,7 @@ USING: help.markup help.syntax quotations hashtables kernel -classes strings continuations destructors ; +classes strings continuations destructors math ; IN: io -ARTICLE: "stream-protocol" "Stream protocol" -"The stream protocol consists of a large number of generic words, many of which are optional." -$nl -"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "." -$nl -"All streams must implement the " { $link dispose } " word in addition to the stream protocol." -$nl -"Three words are required for input streams:" -{ $subsection stream-read1 } -{ $subsection stream-read } -{ $subsection stream-read-until } -{ $subsection stream-readln } -"Seven words are required for output streams:" -{ $subsection stream-flush } -{ $subsection stream-write1 } -{ $subsection stream-write } -{ $subsection stream-format } -{ $subsection stream-nl } -{ $subsection make-span-stream } -{ $subsection make-block-stream } -{ $subsection make-cell-stream } -{ $subsection stream-write-table } -{ $see-also "io.timeouts" } ; - -ARTICLE: "stdio" "Default input and output streams" -"Most I/O code only operates on one stream at a time. The " { $link input-stream } " and " { $link output-stream } " variables are implicit parameters used by many I/O words. Using this idiom improves code in three ways:" -{ $list - { "Code becomes simpler because there is no need to keep a stream around on the stack." } - { "Code becomes more robust because " { $link with-input-stream } " and " { $link with-output-stream } " automatically close the streams if there is an error." } - { "Code becomes more reusable because it can be written to not worry about which stream is being used, and instead the caller can use " { $link with-input-stream } " or " { $link with-output-stream } " to specify the source or destination for I/O operations." } -} -"For example, here is a program which reads the first line of a file, converts it to an integer, then reads that many characters, and splits them into groups of 16:" -{ $code - "USING: continuations kernel io io.files math.parser splitting ;" - "\"data.txt\" utf8 " - "dup stream-readln number>string over stream-read 16 group" - "swap dispose" -} -"This code has two problems: it has some unnecessary stack shuffling, and if either " { $link stream-readln } " or " { $link stream-read } " throws an I/O error, the stream is not closed because " { $link dispose } " is never reached. So we can add a call to " { $link with-disposal } " to ensure the stream is always closed:" -{ $code - "USING: continuations kernel io io.files math.parser splitting ;" - "\"data.txt\" utf8 [" - " dup stream-readln number>string over stream-read" - " 16 group" - "] with-disposal" -} -"This code is robust however it is more complex than it needs to be since. This is where the default stream words come in; using them, the above can be rewritten as follows:" -{ $code - "USING: continuations kernel io io.files math.parser splitting ;" - "\"data.txt\" utf8 [" - " readln number>string read 16 group" - "] with-input-stream" -} -"An even better implementation that takes advantage of a utility word:" -{ $code - "USING: continuations kernel io io.files math.parser splitting ;" - "\"data.txt\" utf8 [" - " readln number>string read 16 group" - "] with-file-reader" -} -"The default input stream is stored in a dynamically-scoped variable:" -{ $subsection input-stream } -"Unless rebound in a child namespace, this variable will be set to a console stream for reading input from the user." -$nl -"Words reading from the default input stream:" -{ $subsection read1 } -{ $subsection read } -{ $subsection read-until } -{ $subsection readln } -"A pair of combinators for rebinding the " { $link input-stream } " variable:" -{ $subsection with-input-stream } -{ $subsection with-input-stream* } -"The default output stream is stored in a dynamically-scoped variable:" -{ $subsection output-stream } -"Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user." -$nl -"Words writing to the default input stream:" -{ $subsection flush } -{ $subsection write1 } -{ $subsection write } -{ $subsection print } -{ $subsection nl } -{ $subsection bl } -"Formatted output:" -{ $subsection format } -{ $subsection with-style } -{ $subsection with-nesting } -"Tabular output:" -{ $subsection tabular-output } -{ $subsection with-row } -{ $subsection with-cell } -{ $subsection write-cell } -"A pair of combinators for rebinding the " { $link output-stream } " variable:" -{ $subsection with-output-stream } -{ $subsection with-output-stream* } -"A pair of combinators for rebinding both default streams at once:" -{ $subsection with-streams } -{ $subsection with-streams* } ; - -ARTICLE: "stream-utils" "Stream utilities" -"There are a few useful stream-related words which are not generic, but merely built up from the stream protocol." -$nl -"First, a simple composition of " { $link stream-write } " and " { $link stream-nl } ":" -{ $subsection stream-print } -"Sluring an entire stream into memory all at once:" -{ $subsection lines } -{ $subsection contents } -"Copying the contents of one stream to another:" -{ $subsection stream-copy } ; - -ARTICLE: "streams" "Streams" -"Input and output centers on the concept of a " { $emphasis "stream" } ", which is a source or sink of characters. Streams also support formatted output, which may be used to present styled text in a manner independent of output medium." -$nl -"A stream can either be passed around on the stack or bound to a dynamic variable and used as an implicit " { $emphasis "default stream" } "." -{ $subsection "stream-protocol" } -{ $subsection "stdio" } -{ $subsection "stream-utils" } -{ $see-also "io.streams.string" "io.streams.plain" "io.streams.duplex" } ; - -ABOUT: "streams" - HELP: stream-readln { $values { "stream" "an input stream" } { "str/f" "a string or " { $link f } } } { $contract "Reads a line of input from the stream. Outputs " { $link f } " on stream exhaustion." } @@ -147,6 +26,12 @@ HELP: stream-read-until { $notes "Most code only works on one stream at a time and should instead use " { $link read-until } "; see " { $link "stdio" } "." } $io-error ; +HELP: stream-read-partial +{ $values + { "n" integer } { "stream" "an input stream" } + { "str/f" "a string or " { $link f } } } +{ $description "Reads at most " { $snippet "n" } " characters from a stream and returns up to that many characters without blocking. If no characters are available, blocks until some are and returns them." } ; + HELP: stream-write1 { $values { "ch" "a character" } { "stream" "an output stream" } } { $contract "Writes a character of output to the stream. If the stream does buffering, output may not be performed immediately; use " { $link stream-flush } " to force output." } @@ -249,6 +134,12 @@ HELP: read-until { $contract "Reads characters from " { $link input-stream } ". until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." } $io-error ; +HELP: read-partial +{ $values + { "n" null } + { "str/f" null } } +{ $description "Reads at most " { $snippet "n" } " characters from " { $link input-stream } " and returns up to that many characters without blocking. If no characters are available, blocks until some are and returns them." } ; + HELP: write1 { $values { "ch" "a character" } } { $contract "Writes a character of output to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." } @@ -363,3 +254,126 @@ HELP: contents { $values { "stream" "an input stream" } { "str" string } } { $description "Reads the entire contents of a stream into a string." } $io-error ; + +ARTICLE: "stream-protocol" "Stream protocol" +"The stream protocol consists of a large number of generic words, many of which are optional." +$nl +"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "." +$nl +"All streams must implement the " { $link dispose } " word in addition to the stream protocol." +$nl +"These words are required for input streams:" +{ $subsection stream-read1 } +{ $subsection stream-read } +{ $subsection stream-read-until } +{ $subsection stream-readln } +{ $subsection stream-read-partial } +"These words are required for output streams:" +{ $subsection stream-flush } +{ $subsection stream-write1 } +{ $subsection stream-write } +{ $subsection stream-format } +{ $subsection stream-nl } +{ $subsection make-span-stream } +{ $subsection make-block-stream } +{ $subsection make-cell-stream } +{ $subsection stream-write-table } +{ $see-also "io.timeouts" } ; + +ARTICLE: "stdio" "Default input and output streams" +"Most I/O code only operates on one stream at a time. The " { $link input-stream } " and " { $link output-stream } " variables are implicit parameters used by many I/O words. Using this idiom improves code in three ways:" +{ $list + { "Code becomes simpler because there is no need to keep a stream around on the stack." } + { "Code becomes more robust because " { $link with-input-stream } " and " { $link with-output-stream } " automatically close the streams if there is an error." } + { "Code becomes more reusable because it can be written to not worry about which stream is being used, and instead the caller can use " { $link with-input-stream } " or " { $link with-output-stream } " to specify the source or destination for I/O operations." } +} +"For example, here is a program which reads the first line of a file, converts it to an integer, then reads that many characters, and splits them into groups of 16:" +{ $code + "USING: continuations kernel io io.files math.parser splitting ;" + "\"data.txt\" utf8 " + "dup stream-readln number>string over stream-read 16 group" + "swap dispose" +} +"This code has two problems: it has some unnecessary stack shuffling, and if either " { $link stream-readln } " or " { $link stream-read } " throws an I/O error, the stream is not closed because " { $link dispose } " is never reached. So we can add a call to " { $link with-disposal } " to ensure the stream is always closed:" +{ $code + "USING: continuations kernel io io.files math.parser splitting ;" + "\"data.txt\" utf8 [" + " dup stream-readln number>string over stream-read" + " 16 group" + "] with-disposal" +} +"This code is robust however it is more complex than it needs to be since. This is where the default stream words come in; using them, the above can be rewritten as follows:" +{ $code + "USING: continuations kernel io io.files math.parser splitting ;" + "\"data.txt\" utf8 [" + " readln number>string read 16 group" + "] with-input-stream" +} +"An even better implementation that takes advantage of a utility word:" +{ $code + "USING: continuations kernel io io.files math.parser splitting ;" + "\"data.txt\" utf8 [" + " readln number>string read 16 group" + "] with-file-reader" +} +"The default input stream is stored in a dynamically-scoped variable:" +{ $subsection input-stream } +"Unless rebound in a child namespace, this variable will be set to a console stream for reading input from the user." +$nl +"Words reading from the default input stream:" +{ $subsection read1 } +{ $subsection read } +{ $subsection read-until } +{ $subsection readln } +{ $subsection read-partial } +"A pair of combinators for rebinding the " { $link input-stream } " variable:" +{ $subsection with-input-stream } +{ $subsection with-input-stream* } +"The default output stream is stored in a dynamically-scoped variable:" +{ $subsection output-stream } +"Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user." +$nl +"Words writing to the default input stream:" +{ $subsection flush } +{ $subsection write1 } +{ $subsection write } +{ $subsection print } +{ $subsection nl } +{ $subsection bl } +"Formatted output:" +{ $subsection format } +{ $subsection with-style } +{ $subsection with-nesting } +"Tabular output:" +{ $subsection tabular-output } +{ $subsection with-row } +{ $subsection with-cell } +{ $subsection write-cell } +"A pair of combinators for rebinding the " { $link output-stream } " variable:" +{ $subsection with-output-stream } +{ $subsection with-output-stream* } +"A pair of combinators for rebinding both default streams at once:" +{ $subsection with-streams } +{ $subsection with-streams* } ; + +ARTICLE: "stream-utils" "Stream utilities" +"There are a few useful stream-related words which are not generic, but merely built up from the stream protocol." +$nl +"First, a simple composition of " { $link stream-write } " and " { $link stream-nl } ":" +{ $subsection stream-print } +"Sluring an entire stream into memory all at once:" +{ $subsection lines } +{ $subsection contents } +"Copying the contents of one stream to another:" +{ $subsection stream-copy } ; + +ARTICLE: "streams" "Streams" +"Input and output centers on the concept of a " { $emphasis "stream" } ", which is a source or sink of characters. Streams also support formatted output, which may be used to present styled text in a manner independent of output medium." +$nl +"A stream can either be passed around on the stack or bound to a dynamic variable and used as an implicit " { $emphasis "default stream" } "." +{ $subsection "stream-protocol" } +{ $subsection "stdio" } +{ $subsection "stream-utils" } +{ $see-also "io.streams.string" "io.streams.plain" "io.streams.duplex" } ; + +ABOUT: "streams" diff --git a/core/io/io.factor b/core/io/io.factor index 0d5a857490..c50fc6f46c 100755 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -8,7 +8,7 @@ GENERIC: stream-readln ( stream -- str/f ) GENERIC: stream-read1 ( stream -- ch/f ) GENERIC: stream-read ( n stream -- str/f ) GENERIC: stream-read-until ( seps stream -- str/f sep/f ) -GENERIC: stream-read-partial ( max stream -- str/f ) +GENERIC: stream-read-partial ( n stream -- str/f ) GENERIC: stream-write1 ( ch stream -- ) GENERIC: stream-write ( str stream -- ) GENERIC: stream-flush ( stream -- ) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index c833325c41..786919bb68 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -4,289 +4,6 @@ kernel.private vectors combinators quotations strings words assocs arrays math.order ; IN: kernel -ARTICLE: "shuffle-words" "Shuffle words" -"Shuffle words rearrange items at the top of the data stack. They control the flow of data between words that perform actions." -$nl -"The " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." -$nl -"Removing stack elements:" -{ $subsection drop } -{ $subsection 2drop } -{ $subsection 3drop } -{ $subsection nip } -{ $subsection 2nip } -"Duplicating stack elements:" -{ $subsection dup } -{ $subsection 2dup } -{ $subsection 3dup } -{ $subsection dupd } -{ $subsection over } -{ $subsection 2over } -{ $subsection pick } -{ $subsection tuck } -"Permuting stack elements:" -{ $subsection swap } -{ $subsection swapd } -{ $subsection rot } -{ $subsection -rot } -{ $subsection spin } -{ $subsection roll } -{ $subsection -roll } -"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using the following two words:" -{ $subsection >r } -{ $subsection r> } -"The top of the data stack is ``hidden'' between " { $link >r } " and " { $link r> } ":" -{ $example "1 2 3 >r .s r>" "1\n2" } -"Usages of " { $link >r } " and " { $link r> } " must be balanced within a single quotation; quotations are not permitted to pop retain stack elements they did not push, or leave elements on the retain stack after returning." -$nl -"The " { $link "inference" } " tool checks retain stack usage. The " { $link "slip-keep-combinators" } " combinators abstract out common retain stack usage patterns." ; - -ARTICLE: "cleave-shuffle-equivalence" "Expressing shuffle words with cleave combinators" -"Cleave combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to cleave combinators are discussed in the documentation for " { $link bi } ", " { $link 2bi } ", " { $link 3bi } ", " { $link tri } ", " { $link 2tri } " and " { $link 3tri } "." -$nl -"Certain shuffle words can also be expressed in terms of the cleave combinators. Internalizing such identities can help with understanding and writing code using cleave combinators:" -{ $code - ": keep [ ] bi ;" - ": 2keep [ ] 2bi ;" - ": 3keep [ ] 3bi ;" - "" - ": dup [ ] [ ] bi ;" - ": 2dup [ ] [ ] 2bi ;" - ": 3dup [ ] [ ] 3bi ;" - "" - ": tuck [ nip ] [ ] 2bi ;" - ": swap [ nip ] [ drop ] 2bi ;" - "" - ": over [ ] [ drop ] 2bi ;" - ": pick [ ] [ 2drop ] 3bi ;" - ": 2over [ ] [ drop ] 3bi ;" -} ; - -ARTICLE: "cleave-combinators" "Cleave combinators" -"The cleave combinators apply multiple quotations to a single value." -$nl -"Two quotations:" -{ $subsection bi } -{ $subsection 2bi } -{ $subsection 3bi } -"Three quotations:" -{ $subsection tri } -{ $subsection 2tri } -{ $subsection 3tri } -"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:" -{ $code - "! First alternative; uses keep" - "[ 1 + ] keep" - "[ 1 - ] keep" - "2 *" - "! Second alternative: uses tri" - "[ 1 + ]" - "[ 1 - ]" - "[ 2 * ] tri" -} -"The latter is more aesthetically pleasing than the former." -$nl -"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." -{ $subsection "cleave-shuffle-equivalence" } ; - -ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators" -"Spread combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to spread combinators are discussed in the documentation for " { $link bi* } ", " { $link 2bi* } ", and " { $link tri* } "." -$nl -"Certain shuffle words can also be expressed in terms of the spread combinators. Internalizing such identities can help with understanding and writing code using spread combinators:" -{ $code - ": dip [ ] bi* ;" - ": 2dip [ ] [ ] tri* ;" - "" - ": slip [ call ] [ ] bi* ;" - ": 2slip [ call ] [ ] [ ] tri* ;" - "" - ": nip [ drop ] [ ] bi* ;" - ": 2nip [ drop ] [ drop ] [ ] tri* ;" - "" - ": rot" - " [ [ drop ] [ ] [ drop ] tri* ]" - " [ [ drop ] [ drop ] [ ] tri* ]" - " [ [ ] [ drop ] [ drop ] tri* ]" - " 3tri ;" - "" - ": -rot" - " [ [ drop ] [ drop ] [ ] tri* ]" - " [ [ ] [ drop ] [ drop ] tri* ]" - " [ [ drop ] [ ] [ drop ] tri* ]" - " 3tri ;" - "" - ": spin" - " [ [ drop ] [ drop ] [ ] tri* ]" - " [ [ drop ] [ ] [ drop ] tri* ]" - " [ [ ] [ drop ] [ drop ] tri* ]" - " 3tri ;" -} ; - -ARTICLE: "spread-combinators" "Spread combinators" -"The spread combinators apply multiple quotations to multiple values. The " { $snippet "*" } " suffix signifies spreading." -$nl -"Two quotations:" -{ $subsection bi* } -{ $subsection 2bi* } -"Three quotations:" -{ $subsection tri* } -"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:" -{ $code - "! First alternative; uses retain stack explicitly" - ">r >r 1 +" - "r> 1 -" - "r> 2 *" - "! Second alternative: uses tri*" - "[ 1 + ]" - "[ 1 - ]" - "[ 2 * ] tri*" -} - -$nl -"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." -{ $subsection "spread-shuffle-equivalence" } ; - -ARTICLE: "apply-combinators" "Apply combinators" -"The apply combinators apply a single quotation to multiple values. The " { $snippet "@" } " suffix signifies application." -$nl -"Two quotations:" -{ $subsection bi@ } -{ $subsection 2bi@ } -"Three quotations:" -{ $subsection tri@ } -"A pair of utility words built from " { $link bi@ } ":" -{ $subsection both? } -{ $subsection either? } ; - -ARTICLE: "slip-keep-combinators" "The dip, slip and keep combinators" -"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:" -{ $subsection dip } -{ $subsection 2dip } -"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:" -{ $subsection slip } -{ $subsection 2slip } -{ $subsection 3slip } -"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:" -{ $subsection keep } -{ $subsection 2keep } -{ $subsection 3keep } ; - -ARTICLE: "compositional-combinators" "Compositional combinators" -"Quotations can be composed using efficient quotation-specific operations:" -{ $subsection curry } -{ $subsection 2curry } -{ $subsection 3curry } -{ $subsection with } -{ $subsection compose } -{ $subsection 3compose } -{ $subsection prepose } -"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ; - -ARTICLE: "implementing-combinators" "Implementing combinators" -"The following pair of words invoke words and quotations reflectively:" -{ $subsection call } -{ $subsection execute } -"These words are used to implement combinators. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:" -{ $code - ": keep ( x quot -- x )" - " over >r call r> ; inline" -} -"Word inlining is documented in " { $link "declarations" } "." ; - -ARTICLE: "booleans" "Booleans" -"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value." -{ $subsection f } -{ $subsection t } -"The " { $link f } " object is the unique instance of the " { $link f } " class; the two are distinct objects. The latter is also a parsing word which adds the " { $link f } " object to the parse tree at parse time. To refer to the class itself you must use " { $link POSTPONE: POSTPONE: } " or " { $link POSTPONE: \ } " to prevent the parsing word from executing." -$nl -"Here is the " { $link f } " object:" -{ $example "f ." "f" } -"Here is the " { $link f } " class:" -{ $example "\\ f ." "POSTPONE: f" } -"They are not equal:" -{ $example "f \\ f = ." "f" } -"Here is an array containing the " { $link f } " object:" -{ $example "{ f } ." "{ f }" } -"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" } -"The " { $link f } " class is an instance of " { $link word } ":" -{ $example "\\ 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* } "." ; - -ARTICLE: "conditionals-boolean-equivalence" "Expressing conditionals with boolean logic" -"Certain simple conditional forms can be expressed in a simpler manner using boolean logic." -$nl -"The following two lines are equivalent:" -{ $code "[ drop f ] unless" "swap and" } -"The following two lines are equivalent:" -{ $code "[ ] [ ] ?if" "swap or" } -"The following two lines are equivalent, where " { $snippet "L" } " is a literal:" -{ $code "[ L ] unless*" "L or" } ; - -ARTICLE: "conditionals" "Conditionals and logic" -"The basic conditionals:" -{ $subsection if } -{ $subsection when } -{ $subsection unless } -"Forms abstracting a common stack shuffle pattern:" -{ $subsection if* } -{ $subsection when* } -{ $subsection unless* } -"Another form abstracting a common stack shuffle pattern:" -{ $subsection ?if } -"Sometimes instead of branching, you just need to pick one of two values:" -{ $subsection ? } -"There are some logical operations on booleans:" -{ $subsection >boolean } -{ $subsection not } -{ $subsection and } -{ $subsection or } -{ $subsection xor } -{ $subsection "conditionals-boolean-equivalence" } -"See " { $link "combinators" } " for forms which abstract away common patterns involving multiple nested branches." -{ $see-also "booleans" "bitwise-arithmetic" both? either? } ; - -ARTICLE: "equality" "Equality" -"There are two distinct notions of ``sameness'' when it comes to objects." -$nl -"You can test if two references point to the same object (" { $emphasis "identity comparison" } "). This is rarely used; it is mostly useful with large, mutable objects where the object identity matters but the value is transient:" -{ $subsection eq? } -"You can test if two objects are equal in a domain-specific sense, usually by being instances of the same class, and having equal slot values (" { $emphasis "value comparison" } "):" -{ $subsection = } -"A third form of equality is provided by " { $link number= } ". It compares numeric value while disregarding types." -$nl -"Custom value comparison methods for use with " { $link = } " can be defined on a generic word:" -{ $subsection equal? } -"Utility class:" -{ $subsection identity-tuple } -"An object can be cloned; the clone has distinct identity but equal value:" -{ $subsection clone } ; - -ARTICLE: "dataflow" "Data and control flow" -{ $subsection "evaluator" } -{ $subsection "words" } -{ $subsection "effects" } -{ $subsection "booleans" } -{ $subsection "shuffle-words" } -"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input." -{ $subsection "cleave-combinators" } -{ $subsection "spread-combinators" } -{ $subsection "apply-combinators" } -{ $subsection "slip-keep-combinators" } -{ $subsection "conditionals" } -{ $subsection "compositional-combinators" } -{ $subsection "combinators" } -"Advanced topics:" -{ $subsection "implementing-combinators" } -{ $subsection "errors" } -{ $subsection "continuations" } ; - -ABOUT: "dataflow" - HELP: eq? ( obj1 obj2 -- ? ) { $values { "obj1" object } { "obj2" object } { "?" "a boolean" } } { $description "Tests if two references point at the same object." } ; @@ -916,6 +633,20 @@ $nl } "However, depending on the stack effects of " { $snippet "pred" } " and " { $snippet "quot" } ", the " { $snippet "tail" } " quotation might need to be non-empty in order to balance out the stack effect of branches for stack effect inference." } ; +HELP: loop +{ $values + { "pred" quotation } } +{ $description "Calls the quotation repeatedly until the output is true." } +{ $examples "Loop until we hit a zero:" + { $unchecked-example "USING: kernel random math io ; " + " [ \"hi\" write bl 10 random zero? not ] loop" + "hi hi hi" } + "A fun loop:" + { $example "USING: kernel prettyprint math ; " + "3 [ dup . 7 + 11 mod dup 3 = not ] loop" + "3\n10\n6\n2\n9\n5\n1\n8\n4\n0\n7" } +} ; + HELP: assert { $values { "got" "the obtained value" } { "expect" "the expected value" } } { $description "Throws an " { $link assert } " error." } @@ -924,3 +655,288 @@ HELP: assert HELP: assert= { $values { "a" object } { "b" object } } { $description "Throws an " { $link assert } " error if " { $snippet "a" } " does not equal " { $snippet "b" } "." } ; + + +ARTICLE: "shuffle-words" "Shuffle words" +"Shuffle words rearrange items at the top of the data stack. They control the flow of data between words that perform actions." +$nl +"The " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "." +$nl +"Removing stack elements:" +{ $subsection drop } +{ $subsection 2drop } +{ $subsection 3drop } +{ $subsection nip } +{ $subsection 2nip } +"Duplicating stack elements:" +{ $subsection dup } +{ $subsection 2dup } +{ $subsection 3dup } +{ $subsection dupd } +{ $subsection over } +{ $subsection 2over } +{ $subsection pick } +{ $subsection tuck } +"Permuting stack elements:" +{ $subsection swap } +{ $subsection swapd } +{ $subsection rot } +{ $subsection -rot } +{ $subsection spin } +{ $subsection roll } +{ $subsection -roll } +"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using the following two words:" +{ $subsection >r } +{ $subsection r> } +"The top of the data stack is ``hidden'' between " { $link >r } " and " { $link r> } ":" +{ $example "1 2 3 >r .s r>" "1\n2" } +"Usages of " { $link >r } " and " { $link r> } " must be balanced within a single quotation; quotations are not permitted to pop retain stack elements they did not push, or leave elements on the retain stack after returning." +$nl +"The " { $link "inference" } " tool checks retain stack usage. The " { $link "slip-keep-combinators" } " combinators abstract out common retain stack usage patterns." ; + +ARTICLE: "cleave-shuffle-equivalence" "Expressing shuffle words with cleave combinators" +"Cleave combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to cleave combinators are discussed in the documentation for " { $link bi } ", " { $link 2bi } ", " { $link 3bi } ", " { $link tri } ", " { $link 2tri } " and " { $link 3tri } "." +$nl +"Certain shuffle words can also be expressed in terms of the cleave combinators. Internalizing such identities can help with understanding and writing code using cleave combinators:" +{ $code + ": keep [ ] bi ;" + ": 2keep [ ] 2bi ;" + ": 3keep [ ] 3bi ;" + "" + ": dup [ ] [ ] bi ;" + ": 2dup [ ] [ ] 2bi ;" + ": 3dup [ ] [ ] 3bi ;" + "" + ": tuck [ nip ] [ ] 2bi ;" + ": swap [ nip ] [ drop ] 2bi ;" + "" + ": over [ ] [ drop ] 2bi ;" + ": pick [ ] [ 2drop ] 3bi ;" + ": 2over [ ] [ drop ] 3bi ;" +} ; + +ARTICLE: "cleave-combinators" "Cleave combinators" +"The cleave combinators apply multiple quotations to a single value." +$nl +"Two quotations:" +{ $subsection bi } +{ $subsection 2bi } +{ $subsection 3bi } +"Three quotations:" +{ $subsection tri } +{ $subsection 2tri } +{ $subsection 3tri } +"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:" +{ $code + "! First alternative; uses keep" + "[ 1 + ] keep" + "[ 1 - ] keep" + "2 *" + "! Second alternative: uses tri" + "[ 1 + ]" + "[ 1 - ]" + "[ 2 * ] tri" +} +"The latter is more aesthetically pleasing than the former." +$nl +"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." +{ $subsection "cleave-shuffle-equivalence" } ; + +ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators" +"Spread combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to spread combinators are discussed in the documentation for " { $link bi* } ", " { $link 2bi* } ", and " { $link tri* } "." +$nl +"Certain shuffle words can also be expressed in terms of the spread combinators. Internalizing such identities can help with understanding and writing code using spread combinators:" +{ $code + ": dip [ ] bi* ;" + ": 2dip [ ] [ ] tri* ;" + "" + ": slip [ call ] [ ] bi* ;" + ": 2slip [ call ] [ ] [ ] tri* ;" + "" + ": nip [ drop ] [ ] bi* ;" + ": 2nip [ drop ] [ drop ] [ ] tri* ;" + "" + ": rot" + " [ [ drop ] [ ] [ drop ] tri* ]" + " [ [ drop ] [ drop ] [ ] tri* ]" + " [ [ ] [ drop ] [ drop ] tri* ]" + " 3tri ;" + "" + ": -rot" + " [ [ drop ] [ drop ] [ ] tri* ]" + " [ [ ] [ drop ] [ drop ] tri* ]" + " [ [ drop ] [ ] [ drop ] tri* ]" + " 3tri ;" + "" + ": spin" + " [ [ drop ] [ drop ] [ ] tri* ]" + " [ [ drop ] [ ] [ drop ] tri* ]" + " [ [ ] [ drop ] [ drop ] tri* ]" + " 3tri ;" +} ; + +ARTICLE: "spread-combinators" "Spread combinators" +"The spread combinators apply multiple quotations to multiple values. The " { $snippet "*" } " suffix signifies spreading." +$nl +"Two quotations:" +{ $subsection bi* } +{ $subsection 2bi* } +"Three quotations:" +{ $subsection tri* } +"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:" +{ $code + "! First alternative; uses retain stack explicitly" + ">r >r 1 +" + "r> 1 -" + "r> 2 *" + "! Second alternative: uses tri*" + "[ 1 + ]" + "[ 1 - ]" + "[ 2 * ] tri*" +} + +$nl +"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "." +{ $subsection "spread-shuffle-equivalence" } ; + +ARTICLE: "apply-combinators" "Apply combinators" +"The apply combinators apply a single quotation to multiple values. The " { $snippet "@" } " suffix signifies application." +$nl +"Two quotations:" +{ $subsection bi@ } +{ $subsection 2bi@ } +"Three quotations:" +{ $subsection tri@ } +"A pair of utility words built from " { $link bi@ } ":" +{ $subsection both? } +{ $subsection either? } ; + +ARTICLE: "slip-keep-combinators" "The dip, slip and keep combinators" +"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:" +{ $subsection dip } +{ $subsection 2dip } +"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:" +{ $subsection slip } +{ $subsection 2slip } +{ $subsection 3slip } +"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:" +{ $subsection keep } +{ $subsection 2keep } +{ $subsection 3keep } ; + +ARTICLE: "compositional-combinators" "Compositional combinators" +"Quotations can be composed using efficient quotation-specific operations:" +{ $subsection curry } +{ $subsection 2curry } +{ $subsection 3curry } +{ $subsection with } +{ $subsection compose } +{ $subsection 3compose } +{ $subsection prepose } +"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ; + +ARTICLE: "implementing-combinators" "Implementing combinators" +"The following pair of words invoke words and quotations reflectively:" +{ $subsection call } +{ $subsection execute } +"These words are used to implement combinators. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:" +{ $code + ": keep ( x quot -- x )" + " over >r call r> ; inline" +} +"Word inlining is documented in " { $link "declarations" } "." ; + +ARTICLE: "booleans" "Booleans" +"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value." +{ $subsection f } +{ $subsection t } +"The " { $link f } " object is the unique instance of the " { $link f } " class; the two are distinct objects. The latter is also a parsing word which adds the " { $link f } " object to the parse tree at parse time. To refer to the class itself you must use " { $link POSTPONE: POSTPONE: } " or " { $link POSTPONE: \ } " to prevent the parsing word from executing." +$nl +"Here is the " { $link f } " object:" +{ $example "f ." "f" } +"Here is the " { $link f } " class:" +{ $example "\\ f ." "POSTPONE: f" } +"They are not equal:" +{ $example "f \\ f = ." "f" } +"Here is an array containing the " { $link f } " object:" +{ $example "{ f } ." "{ f }" } +"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" } +"The " { $link f } " class is an instance of " { $link word } ":" +{ $example "\\ 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* } "." ; + +ARTICLE: "conditionals-boolean-equivalence" "Expressing conditionals with boolean logic" +"Certain simple conditional forms can be expressed in a simpler manner using boolean logic." +$nl +"The following two lines are equivalent:" +{ $code "[ drop f ] unless" "swap and" } +"The following two lines are equivalent:" +{ $code "[ ] [ ] ?if" "swap or" } +"The following two lines are equivalent, where " { $snippet "L" } " is a literal:" +{ $code "[ L ] unless*" "L or" } ; + +ARTICLE: "conditionals" "Conditionals and logic" +"The basic conditionals:" +{ $subsection if } +{ $subsection when } +{ $subsection unless } +"Forms abstracting a common stack shuffle pattern:" +{ $subsection if* } +{ $subsection when* } +{ $subsection unless* } +"Another form abstracting a common stack shuffle pattern:" +{ $subsection ?if } +"Sometimes instead of branching, you just need to pick one of two values:" +{ $subsection ? } +"There are some logical operations on booleans:" +{ $subsection >boolean } +{ $subsection not } +{ $subsection and } +{ $subsection or } +{ $subsection xor } +{ $subsection "conditionals-boolean-equivalence" } +"See " { $link "combinators" } " for forms which abstract away common patterns involving multiple nested branches." +{ $see-also "booleans" "bitwise-arithmetic" both? either? } ; + +ARTICLE: "equality" "Equality" +"There are two distinct notions of ``sameness'' when it comes to objects." +$nl +"You can test if two references point to the same object (" { $emphasis "identity comparison" } "). This is rarely used; it is mostly useful with large, mutable objects where the object identity matters but the value is transient:" +{ $subsection eq? } +"You can test if two objects are equal in a domain-specific sense, usually by being instances of the same class, and having equal slot values (" { $emphasis "value comparison" } "):" +{ $subsection = } +"A third form of equality is provided by " { $link number= } ". It compares numeric value while disregarding types." +$nl +"Custom value comparison methods for use with " { $link = } " can be defined on a generic word:" +{ $subsection equal? } +"Utility class:" +{ $subsection identity-tuple } +"An object can be cloned; the clone has distinct identity but equal value:" +{ $subsection clone } ; + +ARTICLE: "dataflow" "Data and control flow" +{ $subsection "evaluator" } +{ $subsection "words" } +{ $subsection "effects" } +{ $subsection "booleans" } +{ $subsection "shuffle-words" } +"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input." +{ $subsection "cleave-combinators" } +{ $subsection "spread-combinators" } +{ $subsection "apply-combinators" } +{ $subsection "slip-keep-combinators" } +{ $subsection "conditionals" } +{ $subsection "compositional-combinators" } +{ $subsection "combinators" } +"Advanced topics:" +{ $subsection "implementing-combinators" } +{ $subsection "errors" } +{ $subsection "continuations" } ; + +ABOUT: "dataflow" + diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index b38baa5cc9..a863715d33 100755 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -2,64 +2,6 @@ USING: help.markup help.syntax kernel sequences quotations math.private ; IN: math -ARTICLE: "division-by-zero" "Division by zero" -"Floating point division never raises an error if the denominator is zero. This means that if at least one of the two inputs to " { $link / } ", " { $link /f } " or " { $link mod } " is a float, the result will be a floating point infinity or not a number value." -$nl -"The behavior of integer division is hardware specific. On x86 processors, " { $link /i } " and " { $link mod } " raise an error if both inputs are integers and the denominator is zero. On PowerPC, integer division by zero yields a result of zero." -$nl -"On the other hand, the " { $link / } " word, when given integer arguments, implements a much more expensive division algorithm which always yields an exact rational answer, and this word always tests for division by zero explicitly." ; - -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" } -"The following usual operations are supported by all numbers." -{ $subsection + } -{ $subsection - } -{ $subsection * } -{ $subsection / } -"Non-commutative operations take operands from the stack in the natural order; " { $snippet "6 2 /" } " divides 6 by 2." -{ $subsection "division-by-zero" } -"Real numbers (but not complex numbers) can be ordered:" -{ $subsection < } -{ $subsection <= } -{ $subsection > } -{ $subsection >= } -"Numbers can be compared for equality using " { $link = } ", or a less precise test which disregards types:" -{ $subsection number= } ; - -ARTICLE: "modular-arithmetic" "Modular arithmetic" -{ $subsection mod } -{ $subsection rem } -{ $subsection /mod } -{ $subsection /i } -{ $see-also "integer-functions" } ; - -ARTICLE: "bitwise-arithmetic" "Bitwise arithmetic" -"There are two ways of looking at an integer -- as an abstract mathematical entity, or as a string of bits. The latter representation motivates " { $emphasis "bitwise operations" } "." -{ $subsection bitand } -{ $subsection bitor } -{ $subsection bitxor } -{ $subsection bitnot } -{ $subsection shift } -{ $subsection 2/ } -{ $subsection 2^ } -{ $subsection bit? } -{ $see-also "conditionals" } ; - -ARTICLE: "arithmetic" "Arithmetic" -"Factor attempts to preserve natural mathematical semantics for numbers. Multiplying two large integers never results in overflow, and dividing two integers yields an exact ratio. Floating point numbers are also supported, along with complex numbers." -$nl -"Math words are in the " { $vocab-link "math" } " vocabulary. Implementation details are in the " { $vocab-link "math.private" } " vocabulary." -{ $subsection "number-protocol" } -{ $subsection "modular-arithmetic" } -{ $subsection "bitwise-arithmetic" } -{ $see-also "integers" "rationals" "floats" "complex-numbers" } ; - -ABOUT: "arithmetic" - HELP: number= { $values { "x" number } { "y" number } { "?" "a boolean" } } { $description "Tests if two numbers have the same numeric value." } @@ -235,6 +177,9 @@ HELP: 1- { $code "1-" "1 -" } } ; +HELP: ?1+ +{ $description "If the input is not " { $link f } ", adds one. Otherwise, outputs a " { $snippet "0" } "." } ; + HELP: sq { $values { "x" number } { "y" number } } { $description "Multiplies a number by itself." } ; @@ -357,3 +302,62 @@ HELP: find-last-integer { $values { "n" integer } { "quot" "a quotation with stack effect " { $snippet "( i -- ? )" } } { "i" "an integer or " { $link f } } } { $description "Applies the quotation to each integer from " { $snippet "n" } " down to 0, inclusive. Iteration stops when the quotation outputs a true value or 0 is reached. If the quotation yields a true value for some integer, the word outputs that integer. Otherwise, the word outputs " { $link f } "." } { $notes "This word is used to implement " { $link find-last } "." } ; + +ARTICLE: "division-by-zero" "Division by zero" +"Floating point division never raises an error if the denominator is zero. This means that if at least one of the two inputs to " { $link / } ", " { $link /f } " or " { $link mod } " is a float, the result will be a floating point infinity or not a number value." +$nl +"The behavior of integer division is hardware specific. On x86 processors, " { $link /i } " and " { $link mod } " raise an error if both inputs are integers and the denominator is zero. On PowerPC, integer division by zero yields a result of zero." +$nl +"On the other hand, the " { $link / } " word, when given integer arguments, implements a much more expensive division algorithm which always yields an exact rational answer, and this word always tests for division by zero explicitly." ; + +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" } +"The following usual operations are supported by all numbers." +{ $subsection + } +{ $subsection - } +{ $subsection * } +{ $subsection / } +"Non-commutative operations take operands from the stack in the natural order; " { $snippet "6 2 /" } " divides 6 by 2." +{ $subsection "division-by-zero" } +"Real numbers (but not complex numbers) can be ordered:" +{ $subsection < } +{ $subsection <= } +{ $subsection > } +{ $subsection >= } +"Numbers can be compared for equality using " { $link = } ", or a less precise test which disregards types:" +{ $subsection number= } ; + +ARTICLE: "modular-arithmetic" "Modular arithmetic" +{ $subsection mod } +{ $subsection rem } +{ $subsection /mod } +{ $subsection /i } +{ $see-also "integer-functions" } ; + +ARTICLE: "bitwise-arithmetic" "Bitwise arithmetic" +"There are two ways of looking at an integer -- as an abstract mathematical entity, or as a string of bits. The latter representation motivates " { $emphasis "bitwise operations" } "." +{ $subsection bitand } +{ $subsection bitor } +{ $subsection bitxor } +{ $subsection bitnot } +{ $subsection shift } +{ $subsection 2/ } +{ $subsection 2^ } +{ $subsection bit? } +{ $see-also "conditionals" } ; + +ARTICLE: "arithmetic" "Arithmetic" +"Factor attempts to preserve natural mathematical semantics for numbers. Multiplying two large integers never results in overflow, and dividing two integers yields an exact ratio. Floating point numbers are also supported, along with complex numbers." +$nl +"Math words are in the " { $vocab-link "math" } " vocabulary. Implementation details are in the " { $vocab-link "math.private" } " vocabulary." +{ $subsection "number-protocol" } +{ $subsection "modular-arithmetic" } +{ $subsection "bitwise-arithmetic" } +{ $see-also "integers" "rationals" "floats" "complex-numbers" } ; + +ABOUT: "arithmetic" + diff --git a/core/memory/memory-docs.factor b/core/memory/memory-docs.factor index 506ae43671..fb1d4a336f 100755 --- a/core/memory/memory-docs.factor +++ b/core/memory/memory-docs.factor @@ -1,19 +1,7 @@ -USING: help.markup help.syntax debugger sequences kernel ; +USING: help.markup help.syntax debugger sequences kernel +quotations math ; IN: memory -ARTICLE: "images" "Images" -"The current image can be saved; the image contains a complete dump of all data and code in the current Factor instance:" -{ $subsection save } -{ $subsection save-image } -{ $subsection save-image-and-exit } -"To start Factor with a custom image, use the " { $snippet "-i=" { $emphasis "image" } } " command line switch; see " { $link "runtime-cli-args" } "." -$nl -"New images can be created from scratch:" -{ $subsection "bootstrap.image" } -{ $see-also "tools.memory" "tools.deploy" } ; - -ABOUT: "images" - HELP: begin-scan ( -- ) { $description "Moves all objects to tenured space, disables the garbage collector, and resets the heap scan pointer to point at the first object in the heap. The " { $link next-object } " word can then be called to advance the heap scan pointer and return successive objects." $nl @@ -67,3 +55,27 @@ HELP: save-image-and-exit ( path -- ) HELP: save { $description "Saves a snapshot of the heap to the current image file." } ; + +HELP: count-instances +{ $values + { "quot" quotation } + { "n" integer } } +{ $description "Applies the predicate quotation to each object in the heap and returns the number of objects that match. Since this word uses " { $link each-object } " with the garbage collector switched off, avoid allocating too much memory in the quotation." } +{ $examples { $unchecked-example + "USING: memory words prettyprint ;" + "[ word? ] count-instances ." + "24210" +} } ; + +ARTICLE: "images" "Images" +"The current image can be saved; the image contains a complete dump of all data and code in the current Factor instance:" +{ $subsection save } +{ $subsection save-image } +{ $subsection save-image-and-exit } +"To start Factor with a custom image, use the " { $snippet "-i=" { $emphasis "image" } } " command line switch; see " { $link "runtime-cli-args" } "." +$nl +"New images can be created from scratch:" +{ $subsection "bootstrap.image" } +{ $see-also "tools.memory" "tools.deploy" } ; + +ABOUT: "images" diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index a0691f0d82..f9c539f16a 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -3,271 +3,6 @@ sequences.private vectors strings kernel math.order layouts quotations ; IN: sequences -ARTICLE: "sequences-unsafe" "Unsafe sequence operations" -"The " { $link nth-unsafe } " and " { $link set-nth-unsafe } " sequence protocol bypasses bounds checks for increased performance." -$nl -"These words assume the sequence index given is within bounds; if it is not, memory corruption can occur. Great care must be exercised when using these words. First, make sure the code in question is actually a bottleneck; next, try improving the algorithm first. If all else fails, then the unsafe sequence words can be used." -$nl -"There is a very important invariant these word must preserve: if at some point in time, the length of a sequence was " { $snippet "n" } ", then any future lookups of elements with indices below " { $snippet "n" } " must not crash the VM, even if the sequence length is now less than " { $snippet "n" } ". For example, vectors preserve this invariant by never shrinking the underlying storage, only growing it as necessary." -$nl -"The justification for this is that the VM should not crash if a resizable sequence is resized during the execution of an iteration combinator." -$nl -"Indeed, iteration combinators are the primary use-case for these words; if the iteration index is already guarded by a loop test which ensures it is within bounds, then additional bounds checks are redundant. For example, see the implementation of " { $link each } "." ; - -ARTICLE: "sequence-protocol" "Sequence protocol" -"All sequences must be instances of a mixin class:" -{ $subsection sequence } -{ $subsection sequence? } -"All sequences must know their length:" -{ $subsection length } -"At least one of the following two generic words must have a method for accessing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:" -{ $subsection nth } -{ $subsection nth-unsafe } -"At least one of the following two generic words must have a method for storing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:" -{ $subsection set-nth } -{ $subsection set-nth-unsafe } -"Note that even if the sequence is immutable, at least one of the generic words must be specialized, otherwise calling them will result in an infinite recursion. There is a standard word which throws an error indicating a sequence is immutable:" -{ $subsection immutable } -"The following two generic words are optional, as not all sequences are resizable:" -{ $subsection set-length } -{ $subsection lengthen } -"An optional generic word for creating sequences of the same class as a given sequence:" -{ $subsection like } -"Optional generic words for optimization purposes:" -{ $subsection new-sequence } -{ $subsection new-resizable } -{ $see-also "sequences-unsafe" } ; - -ARTICLE: "sequences-integers" "Integer sequences and counted loops" -"Integers support the sequence protocol in a trivial fashion; a non-negative integer presents its non-negative predecessors as elements. For example, the integer 3, when viewed as a sequence, contains the elements 0, 1, and 2. This is very useful for performing counted loops." -$nl -"For example, the " { $link each } " combinator, given an integer, simply calls a quotation that number of times, pushing a counter on each iteration that ranges from 0 up to that integer:" -{ $example "3 [ . ] each" "0\n1\n2" } -"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link each-index } ", " { $link map-index } " and " { $link reduce-index } "." -$nl -"Combinators that produce new sequences, such as " { $link map } ", will output an array if the input is an integer." ; - -ARTICLE: "sequences-access" "Accessing sequence elements" -{ $subsection ?nth } -"Concise way of extracting one of the first four elements:" -{ $subsection first } -{ $subsection second } -{ $subsection third } -{ $subsection fourth } -"Unpacking sequences:" -{ $subsection first2 } -{ $subsection first3 } -{ $subsection first4 } -{ $see-also nth peek } ; - -ARTICLE: "sequences-add-remove" "Adding and removing sequence elements" -"Adding elements:" -{ $subsection prefix } -{ $subsection suffix } -"Removing elements:" -{ $subsection remove } -{ $subsection remove-nth } ; - -ARTICLE: "sequences-reshape" "Reshaping sequences" -"A " { $emphasis "repetition" } " is a virtual sequence consisting of a single element repeated multiple times:" -{ $subsection repetition } -{ $subsection } -"Reversing a sequence:" -{ $subsection reverse } -"A " { $emphasis "reversal" } " presents a reversed view of an underlying sequence:" -{ $subsection reversed } -{ $subsection } -"Transposing a matrix:" -{ $subsection flip } ; - -ARTICLE: "sequences-appending" "Appending sequences" -{ $subsection append } -{ $subsection prepend } -{ $subsection 3append } -{ $subsection concat } -{ $subsection join } -"A pair of words useful for aligning strings:" -{ $subsection pad-left } -{ $subsection pad-right } ; - -ARTICLE: "sequences-slices" "Subsequences and slices" -"Extracting a subsequence:" -{ $subsection subseq } -{ $subsection head } -{ $subsection tail } -{ $subsection head* } -{ $subsection tail* } -"Removing the first or last element:" -{ $subsection rest } -{ $subsection but-last } -"Taking a sequence apart into a head and a tail:" -{ $subsection unclip } -{ $subsection unclip-last } -{ $subsection cut } -{ $subsection cut* } -"A " { $emphasis "slice" } " is a virtual sequence which presents as view of a subsequence of an underlying sequence:" -{ $subsection slice } -{ $subsection slice? } -"Creating slices:" -{ $subsection } -{ $subsection head-slice } -{ $subsection tail-slice } -{ $subsection but-last-slice } -{ $subsection rest-slice } -{ $subsection head-slice* } -{ $subsection tail-slice* } -"Taking a sequence apart into a head and a tail:" -{ $subsection unclip-slice } -{ $subsection cut-slice } -"A utility for words which use slices as iterators:" -{ $subsection } ; - -ARTICLE: "sequences-combinators" "Sequence combinators" -"Iteration:" -{ $subsection each } -{ $subsection each-index } -{ $subsection reduce } -{ $subsection interleave } -{ $subsection replicate } -{ $subsection replicate-as } -"Mapping:" -{ $subsection map } -{ $subsection map-as } -{ $subsection map-index } -{ $subsection accumulate } -{ $subsection produce } -"Filtering:" -{ $subsection push-if } -{ $subsection filter } -"Testing if a sequence contains elements satisfying a predicate:" -{ $subsection contains? } -{ $subsection all? } -"Testing how elements are related:" -{ $subsection monotonic? } -{ $subsection "sequence-2combinators" } ; - -ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators" -"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined." -{ $subsection 2each } -{ $subsection 2reduce } -{ $subsection 2map } -{ $subsection 2map-as } -{ $subsection 2all? } ; - -ARTICLE: "sequences-tests" "Testing sequences" -"Testing for an empty sequence:" -{ $subsection empty? } -"Testing indices:" -{ $subsection bounds-check? } -"Testing if a sequence contains an object:" -{ $subsection member? } -{ $subsection memq? } -"Testing if a sequence contains a subsequence:" -{ $subsection head? } -{ $subsection tail? } -{ $subsection subseq? } -"Testing how elements are related:" -{ $subsection all-eq? } -{ $subsection all-equal? } ; - -ARTICLE: "sequences-search" "Searching sequences" -"Finding the index of an element:" -{ $subsection index } -{ $subsection index-from } -{ $subsection last-index } -{ $subsection last-index-from } -"Finding the start of a subsequence:" -{ $subsection start } -{ $subsection start* } -"Finding the index of an element satisfying a predicate:" -{ $subsection find } -{ $subsection find-from } -{ $subsection find-last } -{ $subsection find-last-from } ; - -ARTICLE: "sequences-trimming" "Trimming sequences" -"Trimming words:" -{ $subsection trim } -{ $subsection trim-left } -{ $subsection trim-right } -"Potentially more efficient trim:" -{ $subsection trim-slice } -{ $subsection trim-left-slice } -{ $subsection trim-right-slice } ; - -ARTICLE: "sequences-destructive" "Destructive operations" -"These words modify their input, instead of creating a new sequence." -$nl -"In-place variant of " { $link reverse } ":" -{ $subsection reverse-here } -"In-place variant of " { $link append } ":" -{ $subsection push-all } -"In-place variant of " { $link remove } ":" -{ $subsection delete } -"In-place variant of " { $link map } ":" -{ $subsection change-each } -"Changing elements:" -{ $subsection change-nth } -{ $subsection cache-nth } -"Deleting elements:" -{ $subsection delete-nth } -{ $subsection delete-slice } -{ $subsection delete-all } -"Other destructive words:" -{ $subsection move } -{ $subsection exchange } -{ $subsection copy } -{ $subsection replace-slice } -{ $see-also set-nth push pop "sequences-stacks" } ; - -ARTICLE: "sequences-stacks" "Treating sequences as stacks" -"The classical stack operations, modifying a sequence in place:" -{ $subsection peek } -{ $subsection push } -{ $subsection pop } -{ $subsection pop* } -{ $see-also empty? } ; - -ARTICLE: "sequences-comparing" "Comparing sequences" -"Element equality testing:" -{ $subsection sequence= } -{ $subsection mismatch } -{ $subsection drop-prefix } -"The " { $link <=> } " generic word performs lexicographic comparison when applied to sequences." ; - -ARTICLE: "sequences-f" "The f object as a sequence" -"The " { $link f } " object supports the sequence protocol in a trivial way. It responds with a length of zero and throws an out of bounds error when an attempt is made to access elements." ; - -ARTICLE: "sequences" "Sequence operations" -"A " { $emphasis "sequence" } " is a finite, linearly-ordered collection of elements. Words for working with sequences are in the " { $vocab-link "sequences" } " vocabulary." -$nl -"Sequences implement a protocol:" -{ $subsection "sequence-protocol" } -{ $subsection "sequences-f" } -{ $subsection "sequences-integers" } -"Sequence utility words can operate on any object whose class implements the sequence protocol. Most implementations are backed by storage. Some implementations obtain their elements from an underlying sequence, or compute them on the fly. These are known as " { $emphasis "virtual sequences" } "." -{ $subsection "sequences-access" } -{ $subsection "sequences-combinators" } -{ $subsection "sequences-add-remove" } -{ $subsection "sequences-appending" } -{ $subsection "sequences-slices" } -{ $subsection "sequences-reshape" } -{ $subsection "sequences-tests" } -{ $subsection "sequences-search" } -{ $subsection "sequences-comparing" } -{ $subsection "sequences-split" } -{ $subsection "grouping" } -{ $subsection "sequences-destructive" } -{ $subsection "sequences-stacks" } -{ $subsection "sequences-sorting" } -{ $subsection "binary-search" } -{ $subsection "sets" } -{ $subsection "sequences-trimming" } -"For inner loops:" -{ $subsection "sequences-unsafe" } ; - -ABOUT: "sequences" - HELP: sequence { $class-description "A mixin class whose instances are sequences. Custom implementations of the sequence protocol should be declared as instances of this mixin for all sequence functionality to work correctly:" { $code "INSTANCE: my-sequence sequence" } @@ -305,6 +40,18 @@ $nl "Throws an error if the sequence cannot hold elements of the given type." } { $side-effects "seq" } ; +HELP: nths +{ $values + { "indices" null } { "seq" sequence } + { "seq'" sequence } } +{ $description "Ouptuts a sequence of elements from the input sequence indexed by the indices." } +{ $examples + { $example "USING: prettyprint sequences ;" + "{ 0 2 } { \"a\" \"b\" \"c\" } nths ." + "{ \"a\" \"c\" }" + } +} ; + HELP: immutable { $values { "seq" sequence } } { $description "Throws an " { $link immutable } " error." } @@ -514,6 +261,15 @@ HELP: reduce { $example "USING: math prettyprint sequences ;" "{ 1 5 3 } 0 [ + ] reduce ." "9" } } ; +HELP: reduce-index +{ $values + { "seq" sequence } { "identity" object } { "quot" quotation } } +{ $description "Combines successive elements of the sequence and their indices using a binary operation, and outputs the final result. On the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", the first element of the sequence, and its index, 0. On successive iterations, the first input is the result of the previous iteration, the second input is the corresponding element of the sequence, and the third is its index." } +{ $examples { $example "USING: sequences prettyprint math ;" + "{ 10 50 90 } 0 [ + + ] reduce-index ." + "153" +} } ; + HELP: accumulate { $values { "identity" object } { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( prev elt -- next )" } } { "final" "the final result" } { "newseq" "a new sequence" } } { $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of intermediate results together with the final result. On the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the sequence." @@ -1309,3 +1065,291 @@ HELP: partition "{ 2 4 }\n{ 1 3 5 }" } } ; + +HELP: virtual-seq +{ $values + { "seq" sequence } + { "seq'" sequence } } +{ $description "Part of the virtual sequence protocol, this word is used to return an underlying array from which to look up a value at an index given by " { $link virtual@ } "." } ; + +HELP: virtual@ +{ $values + { "n" integer } { "seq" sequence } + { "n'" integer } { "seq'" sequence } } +{ $description "Part of the sequence protocol, this word translates the input index " { $snippet "n" } " into an index into the underlying storage returned by " { $link virtual-seq } "." } ; + +ARTICLE: "sequences-unsafe" "Unsafe sequence operations" +"The " { $link nth-unsafe } " and " { $link set-nth-unsafe } " sequence protocol bypasses bounds checks for increased performance." +$nl +"These words assume the sequence index given is within bounds; if it is not, memory corruption can occur. Great care must be exercised when using these words. First, make sure the code in question is actually a bottleneck; next, try improving the algorithm first. If all else fails, then the unsafe sequence words can be used." +$nl +"There is a very important invariant these word must preserve: if at some point in time, the length of a sequence was " { $snippet "n" } ", then any future lookups of elements with indices below " { $snippet "n" } " must not crash the VM, even if the sequence length is now less than " { $snippet "n" } ". For example, vectors preserve this invariant by never shrinking the underlying storage, only growing it as necessary." +$nl +"The justification for this is that the VM should not crash if a resizable sequence is resized during the execution of an iteration combinator." +$nl +"Indeed, iteration combinators are the primary use-case for these words; if the iteration index is already guarded by a loop test which ensures it is within bounds, then additional bounds checks are redundant. For example, see the implementation of " { $link each } "." ; + +ARTICLE: "sequence-protocol" "Sequence protocol" +"All sequences must be instances of a mixin class:" +{ $subsection sequence } +{ $subsection sequence? } +"All sequences must know their length:" +{ $subsection length } +"At least one of the following two generic words must have a method for accessing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:" +{ $subsection nth } +{ $subsection nth-unsafe } +"At least one of the following two generic words must have a method for storing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:" +{ $subsection set-nth } +{ $subsection set-nth-unsafe } +"Note that even if the sequence is immutable, at least one of the generic words must be specialized, otherwise calling them will result in an infinite recursion. There is a standard word which throws an error indicating a sequence is immutable:" +{ $subsection immutable } +"The following two generic words are optional, as not all sequences are resizable:" +{ $subsection set-length } +{ $subsection lengthen } +"An optional generic word for creating sequences of the same class as a given sequence:" +{ $subsection like } +"Optional generic words for optimization purposes:" +{ $subsection new-sequence } +{ $subsection new-resizable } +{ $see-also "sequences-unsafe" } ; + +ARTICLE: "sequences-virtual-protocol" "Virtual sequence protocol" +"Virtual sequences must know their length:" +{ $subsection length } +"The underlying sequence to look up a value in:" +{ $subsection virtual-seq } +"The index of the value in the underlying sequence:" +{ $subsection virtual@ } ; + +ARTICLE: "virtual-sequences" "Virtual sequences" +"Virtual sequences allow different ways of accessing a sequence without having to create a new sequence or a new data structure altogether. To do this, they translate the virtual index into a normal index into an underlying sequence using the " { $link "sequences-virtual-protocol" } "." ; + +ARTICLE: "sequences-integers" "Integer sequences and counted loops" +"Integers support the sequence protocol in a trivial fashion; a non-negative integer presents its non-negative predecessors as elements. For example, the integer 3, when viewed as a sequence, contains the elements 0, 1, and 2. This is very useful for performing counted loops." +$nl +"For example, the " { $link each } " combinator, given an integer, simply calls a quotation that number of times, pushing a counter on each iteration that ranges from 0 up to that integer:" +{ $example "3 [ . ] each" "0\n1\n2" } +"A common idiom is to iterate over a sequence, while also maintaining a loop counter. This can be done using " { $link each-index } ", " { $link map-index } " and " { $link reduce-index } "." +$nl +"Combinators that produce new sequences, such as " { $link map } ", will output an array if the input is an integer." ; + +ARTICLE: "sequences-access" "Accessing sequence elements" +{ $subsection ?nth } +"Concise way of extracting one of the first four elements:" +{ $subsection first } +{ $subsection second } +{ $subsection third } +{ $subsection fourth } +"Unpacking sequences:" +{ $subsection first2 } +{ $subsection first3 } +{ $subsection first4 } +{ $see-also nth peek } ; + +ARTICLE: "sequences-add-remove" "Adding and removing sequence elements" +"Adding elements:" +{ $subsection prefix } +{ $subsection suffix } +"Removing elements:" +{ $subsection remove } +{ $subsection remove-nth } ; + +ARTICLE: "sequences-reshape" "Reshaping sequences" +"A " { $emphasis "repetition" } " is a virtual sequence consisting of a single element repeated multiple times:" +{ $subsection repetition } +{ $subsection } +"Reversing a sequence:" +{ $subsection reverse } +"A " { $emphasis "reversal" } " presents a reversed view of an underlying sequence:" +{ $subsection reversed } +{ $subsection } +"Transposing a matrix:" +{ $subsection flip } ; + +ARTICLE: "sequences-appending" "Appending sequences" +{ $subsection append } +{ $subsection prepend } +{ $subsection 3append } +{ $subsection concat } +{ $subsection join } +"A pair of words useful for aligning strings:" +{ $subsection pad-left } +{ $subsection pad-right } ; + +ARTICLE: "sequences-slices" "Subsequences and slices" +"Extracting a subsequence:" +{ $subsection subseq } +{ $subsection head } +{ $subsection tail } +{ $subsection head* } +{ $subsection tail* } +"Removing the first or last element:" +{ $subsection rest } +{ $subsection but-last } +"Taking a sequence apart into a head and a tail:" +{ $subsection unclip } +{ $subsection unclip-last } +{ $subsection cut } +{ $subsection cut* } +"A " { $emphasis "slice" } " is a virtual sequence which presents as view of a subsequence of an underlying sequence:" +{ $subsection slice } +{ $subsection slice? } +"Creating slices:" +{ $subsection } +{ $subsection head-slice } +{ $subsection tail-slice } +{ $subsection but-last-slice } +{ $subsection rest-slice } +{ $subsection head-slice* } +{ $subsection tail-slice* } +"Taking a sequence apart into a head and a tail:" +{ $subsection unclip-slice } +{ $subsection cut-slice } +"A utility for words which use slices as iterators:" +{ $subsection } ; + +ARTICLE: "sequences-combinators" "Sequence combinators" +"Iteration:" +{ $subsection each } +{ $subsection each-index } +{ $subsection reduce } +{ $subsection interleave } +{ $subsection replicate } +{ $subsection replicate-as } +"Mapping:" +{ $subsection map } +{ $subsection map-as } +{ $subsection map-index } +{ $subsection accumulate } +{ $subsection produce } +"Filtering:" +{ $subsection push-if } +{ $subsection filter } +"Testing if a sequence contains elements satisfying a predicate:" +{ $subsection contains? } +{ $subsection all? } +"Testing how elements are related:" +{ $subsection monotonic? } +{ $subsection "sequence-2combinators" } ; + +ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators" +"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined." +{ $subsection 2each } +{ $subsection 2reduce } +{ $subsection 2map } +{ $subsection 2map-as } +{ $subsection 2all? } ; + +ARTICLE: "sequences-tests" "Testing sequences" +"Testing for an empty sequence:" +{ $subsection empty? } +"Testing indices:" +{ $subsection bounds-check? } +"Testing if a sequence contains an object:" +{ $subsection member? } +{ $subsection memq? } +"Testing if a sequence contains a subsequence:" +{ $subsection head? } +{ $subsection tail? } +{ $subsection subseq? } +"Testing how elements are related:" +{ $subsection all-eq? } +{ $subsection all-equal? } ; + +ARTICLE: "sequences-search" "Searching sequences" +"Finding the index of an element:" +{ $subsection index } +{ $subsection index-from } +{ $subsection last-index } +{ $subsection last-index-from } +"Finding the start of a subsequence:" +{ $subsection start } +{ $subsection start* } +"Finding the index of an element satisfying a predicate:" +{ $subsection find } +{ $subsection find-from } +{ $subsection find-last } +{ $subsection find-last-from } ; + +ARTICLE: "sequences-trimming" "Trimming sequences" +"Trimming words:" +{ $subsection trim } +{ $subsection trim-left } +{ $subsection trim-right } +"Potentially more efficient trim:" +{ $subsection trim-slice } +{ $subsection trim-left-slice } +{ $subsection trim-right-slice } ; + +ARTICLE: "sequences-destructive" "Destructive operations" +"These words modify their input, instead of creating a new sequence." +$nl +"In-place variant of " { $link reverse } ":" +{ $subsection reverse-here } +"In-place variant of " { $link append } ":" +{ $subsection push-all } +"In-place variant of " { $link remove } ":" +{ $subsection delete } +"In-place variant of " { $link map } ":" +{ $subsection change-each } +"Changing elements:" +{ $subsection change-nth } +{ $subsection cache-nth } +"Deleting elements:" +{ $subsection delete-nth } +{ $subsection delete-slice } +{ $subsection delete-all } +"Other destructive words:" +{ $subsection move } +{ $subsection exchange } +{ $subsection copy } +{ $subsection replace-slice } +{ $see-also set-nth push pop "sequences-stacks" } ; + +ARTICLE: "sequences-stacks" "Treating sequences as stacks" +"The classical stack operations, modifying a sequence in place:" +{ $subsection peek } +{ $subsection push } +{ $subsection pop } +{ $subsection pop* } +{ $see-also empty? } ; + +ARTICLE: "sequences-comparing" "Comparing sequences" +"Element equality testing:" +{ $subsection sequence= } +{ $subsection mismatch } +{ $subsection drop-prefix } +"The " { $link <=> } " generic word performs lexicographic comparison when applied to sequences." ; + +ARTICLE: "sequences-f" "The f object as a sequence" +"The " { $link f } " object supports the sequence protocol in a trivial way. It responds with a length of zero and throws an out of bounds error when an attempt is made to access elements." ; + +ARTICLE: "sequences" "Sequence operations" +"A " { $emphasis "sequence" } " is a finite, linearly-ordered collection of elements. Words for working with sequences are in the " { $vocab-link "sequences" } " vocabulary." +$nl +"Sequences implement a protocol:" +{ $subsection "sequence-protocol" } +{ $subsection "sequences-f" } +{ $subsection "sequences-integers" } +"Sequence utility words can operate on any object whose class implements the sequence protocol. Most implementations are backed by storage. Some implementations obtain their elements from an underlying sequence, or compute them on the fly. These are known as " { $link "virtual-sequences" } "." +{ $subsection "sequences-access" } +{ $subsection "sequences-combinators" } +{ $subsection "sequences-add-remove" } +{ $subsection "sequences-appending" } +{ $subsection "sequences-slices" } +{ $subsection "sequences-reshape" } +{ $subsection "sequences-tests" } +{ $subsection "sequences-search" } +{ $subsection "sequences-comparing" } +{ $subsection "sequences-split" } +{ $subsection "grouping" } +{ $subsection "sequences-destructive" } +{ $subsection "sequences-stacks" } +{ $subsection "sequences-sorting" } +{ $subsection "binary-search" } +{ $subsection "sets" } +{ $subsection "sequences-trimming" } +"For inner loops:" +{ $subsection "sequences-unsafe" } ; + +ABOUT: "sequences" diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index b3fa649dd1..5f7f4acf7a 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -1,4 +1,4 @@ -USING: kernel help.markup help.syntax sequences ; +USING: kernel help.markup help.syntax sequences quotations ; IN: sets ARTICLE: "sets" "Set-theoretic operations on sequences" @@ -111,3 +111,9 @@ HELP: subset? HELP: set= { $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } } { $description "Tests if both sequences contain the same elements, disregrading order and duplicates." } ; + +HELP: gather +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Maps a quotation onto a sequence, concatenates the results of the mapping, and removes duplicates." } ; diff --git a/extra/mason/authors.txt b/extra/mason/authors.txt new file mode 100644 index 0000000000..db8d84451d --- /dev/null +++ b/extra/mason/authors.txt @@ -0,0 +1,2 @@ +Eduardo Cavazos +Slava Pestov diff --git a/extra/mason/build/build-tests.factor b/extra/mason/build/build-tests.factor new file mode 100644 index 0000000000..1e3705629f --- /dev/null +++ b/extra/mason/build/build-tests.factor @@ -0,0 +1,5 @@ +USING: mason.build tools.test sequences ; +IN: mason.build.tests + +{ create-build-dir enter-build-dir clone-builds-factor record-id } +[ must-infer ] each diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor new file mode 100644 index 0000000000..8b8befce34 --- /dev/null +++ b/extra/mason/build/build.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.files io.launcher io.encodings.utf8 prettyprint arrays +calendar namespaces mason.common mason.child +mason.release mason.report mason.email mason.cleanup ; +IN: mason.build + +: create-build-dir ( -- ) + now datestamp stamp set + build-dir make-directory ; + +: enter-build-dir ( -- ) build-dir set-current-directory ; + +: clone-builds-factor ( -- ) + "git" "clone" builds/factor 3array try-process ; + +: record-id ( -- ) + "factor" [ git-id ] with-directory "git-id" to-file ; + +: build ( -- ) + create-build-dir + enter-build-dir + clone-builds-factor + record-id + build-child + release + email-report + cleanup ; + +MAIN: build \ No newline at end of file diff --git a/extra/mason/child/child-tests.factor b/extra/mason/child/child-tests.factor new file mode 100644 index 0000000000..7913d05b26 --- /dev/null +++ b/extra/mason/child/child-tests.factor @@ -0,0 +1,34 @@ +IN: mason.child.tests +USING: mason.child mason.config tools.test namespaces ; + +[ { "make" "clean" "winnt-x86-32" } ] [ + [ + "winnt" target-os set + "x86.32" target-cpu set + make-cmd + ] with-scope +] unit-test + +[ { "make" "clean" "macosx-x86-32" } ] [ + [ + "macosx" target-os set + "x86.32" target-cpu set + make-cmd + ] with-scope +] unit-test + +[ { "gmake" "clean" "netbsd-ppc" } ] [ + [ + "netbsd" target-os set + "ppc" target-cpu set + make-cmd + ] with-scope +] unit-test + +[ { "./factor" "-i=boot.macosx-ppc.image" "-no-user-init" } ] [ + [ + "macosx" target-os set + "ppc" target-cpu set + boot-cmd + ] with-scope +] unit-test diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor new file mode 100644 index 0000000000..02085a89b3 --- /dev/null +++ b/extra/mason/child/child.factor @@ -0,0 +1,80 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces make debugger sequences io.files +io.launcher arrays accessors calendar continuations +combinators.short-circuit mason.common mason.report mason.platform ; +IN: mason.child + +: make-cmd ( -- args ) + [ gnu-make , "clean" , platform , ] { } make ; + +: make-vm ( -- ) + "factor" [ + + make-cmd >>command + "../compile-log" >>stdout + +stdout+ >>stderr + try-process + ] with-directory ; + +: builds-factor-image ( -- img ) + builds/factor boot-image-name append-path ; + +: copy-image ( -- ) + builds-factor-image "." copy-file-into + builds-factor-image "factor" copy-file-into ; + +: boot-cmd ( -- cmd ) + "./factor" + "-i=" boot-image-name append + "-no-user-init" + 3array ; + +: boot ( -- ) + "factor" [ + + boot-cmd >>command + +closed+ >>stdin + "../boot-log" >>stdout + +stdout+ >>stderr + 1 hours >>timeout + try-process + ] with-directory ; + +: test-cmd ( -- cmd ) { "./factor" "-run=mason.test" } ; + +: test ( -- ) + "factor" [ + + test-cmd >>command + +closed+ >>stdin + "../test-log" >>stdout + +stdout+ >>stderr + 4 hours >>timeout + try-process + ] with-directory ; + +: return-with ( obj -- ) return-continuation get continue-with ; + +: build-clean? ( -- ? ) + { + [ load-everything-vocabs-file eval-file empty? ] + [ test-all-vocabs-file eval-file empty? ] + [ help-lint-vocabs-file eval-file empty? ] + } 0&& ; + +: build-child ( -- ) + [ + return-continuation set + + copy-image + + [ make-vm ] [ compile-failed-report status-error return-with ] recover + [ boot ] [ boot-failed-report status-error return-with ] recover + [ test ] [ test-failed-report status-error return-with ] recover + + successful-report + + build-clean? status-clean status-dirty ? return-with + ] callcc1 + status set ; \ No newline at end of file diff --git a/extra/mason/cleanup/cleanup-tests.factor b/extra/mason/cleanup/cleanup-tests.factor new file mode 100644 index 0000000000..9158536ffb --- /dev/null +++ b/extra/mason/cleanup/cleanup-tests.factor @@ -0,0 +1,4 @@ +USING: tools.test mason.cleanup ; +IN: mason.cleanup.tests + +\ cleanup must-infer diff --git a/extra/mason/cleanup/cleanup.factor b/extra/mason/cleanup/cleanup.factor new file mode 100644 index 0000000000..ae24f533d6 --- /dev/null +++ b/extra/mason/cleanup/cleanup.factor @@ -0,0 +1,22 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces arrays continuations io.files io.launcher +mason.common mason.platform mason.config ; +IN: mason.cleanup + +: compress-image ( -- ) + "bzip2" boot-image-name 2array try-process ; + +: compress-test-log ( -- ) + "test-log" exists? [ + { "bzip2" "test-log" } try-process + ] when ; + +: cleanup ( -- ) + builder-debug get [ + build-dir [ + compress-image + compress-test-log + "factor" delete-tree + ] with-directory + ] unless ; diff --git a/extra/mason/common/common-tests.factor b/extra/mason/common/common-tests.factor new file mode 100644 index 0000000000..ed6ffecdd1 --- /dev/null +++ b/extra/mason/common/common-tests.factor @@ -0,0 +1,34 @@ +IN: mason.common.tests +USING: prettyprint mason.common mason.config +namespaces calendar tools.test io.files io.encodings.utf8 ; + +[ "00:01:01" ] [ 61000 milli-seconds>time ] unit-test + +[ "/home/bobby/builds/factor" ] [ + [ + "/home/bobby/builds" builds-dir set + builds/factor + ] with-scope +] unit-test + +[ "/home/bobby/builds/2008-09-11-12-23" ] [ + [ + "/home/bobby/builds" builds-dir set + T{ timestamp + { year 2008 } + { month 9 } + { day 11 } + { hour 12 } + { minute 23 } + } datestamp stamp set + build-dir + ] with-scope +] unit-test + +[ ] [ "empty-test" temp-file utf8 [ ] with-file-writer ] unit-test + +[ "empty-test" temp-file eval-file ] must-fail + +[ ] [ "eval-file-test" temp-file utf8 [ { 1 2 3 } . ] with-file-writer ] unit-test + +[ { 1 2 3 } ] [ "eval-file-test" temp-file eval-file ] unit-test diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor new file mode 100644 index 0000000000..d5996f300c --- /dev/null +++ b/extra/mason/common/common.factor @@ -0,0 +1,81 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces sequences splitting system accessors +math.functions make io io.files io.launcher io.encodings.utf8 +prettyprint combinators.short-circuit parser combinators +calendar calendar.format arrays mason.config ; +IN: mason.common + +: short-running-process ( command -- ) + #! Give network operations at most 15 minutes to complete. + + swap >>command + 15 minutes >>timeout + try-process ; + +: eval-file ( file -- obj ) + dup utf8 file-lines parse-fresh + [ "Empty file: " swap append throw ] [ nip first ] if-empty ; + +: cat ( file -- ) utf8 file-contents print ; + +: cat-n ( file n -- ) [ utf8 file-lines ] dip short tail* [ print ] each ; + +: to-file ( object file -- ) utf8 [ . ] with-file-writer ; + +: datestamp ( timestamp -- string ) + [ + { + [ year>> , ] + [ month>> , ] + [ day>> , ] + [ hour>> , ] + [ minute>> , ] + } cleave + ] { } make [ pad-00 ] map "-" join ; + +: milli-seconds>time ( n -- string ) + millis>timestamp + [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array + [ pad-00 ] map ":" join ; + +SYMBOL: stamp + +: builds/factor ( -- path ) builds-dir get "factor" append-path ; +: build-dir ( -- path ) builds-dir get stamp get append-path ; + +: prepare-build-machine ( -- ) + builds-dir get make-directories + builds-dir get + [ { "git" "clone" "git://factorcode.org/git/factor.git" } try-process ] + with-directory ; + +: git-id ( -- id ) + { "git" "show" } utf8 [ readln ] with-input-stream + " " split second ; + +: ?prepare-build-machine ( -- ) + builds/factor exists? [ prepare-build-machine ] unless ; + +: load-everything-vocabs-file "load-everything-vocabs" ; +: load-everything-errors-file "load-everything-errors" ; + +: test-all-vocabs-file "test-all-vocabs" ; +: test-all-errors-file "test-all-errors" ; + +: help-lint-vocabs-file "help-lint-vocabs" ; +: help-lint-errors-file "help-lint-errors" ; + +: boot-time-file "boot-time" ; +: load-time-file "load-time" ; +: test-time-file "test-time" ; +: help-lint-time-file "help-lint-time" ; +: benchmark-time-file "benchmark-time" ; + +: benchmarks-file "benchmarks" ; + +SYMBOL: status + +SYMBOL: status-error ! didn't bootstrap, or crashed +SYMBOL: status-dirty ! bootstrapped but not all tests passed +SYMBOL: status-clean ! everything good diff --git a/extra/mason/config/config.factor b/extra/mason/config/config.factor new file mode 100644 index 0000000000..0ce059c995 --- /dev/null +++ b/extra/mason/config/config.factor @@ -0,0 +1,66 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: system io.files namespaces kernel accessors ; +IN: mason.config + +! (Optional) Location for build directories +SYMBOL: builds-dir + +builds-dir get-global [ + home "builds" append-path builds-dir set-global +] unless + +! Who sends build reports. +SYMBOL: builder-from + +! Who receives build reports. +SYMBOL: builder-recipients + +! (Optional) CPU architecture to build for. +SYMBOL: target-cpu + +target-cpu get-global [ + cpu name>> target-cpu set-global +] unless + +! (Optional) OS to build for. +SYMBOL: target-os + +target-os get-global [ + os name>> target-os set-global +] unless + +! Keep test-log around? +SYMBOL: builder-debug + +! Boolean. Do we release binaries and update the clean branch? +SYMBOL: upload-to-factorcode + +! The below are only needed if upload-to-factorcode is true. + +! Host with clean git repo. +SYMBOL: branch-host + +! Username to log in. +SYMBOL: branch-username + +! Directory with git repo. +SYMBOL: branch-directory + +! Host to upload clean image to. +SYMBOL: image-host + +! Username to log in. +SYMBOL: image-username + +! Directory with clean images. +SYMBOL: image-directory + +! Host to upload binary package to. +SYMBOL: upload-host + +! Username to log in. +SYMBOL: upload-username + +! Directory with binary packages. +SYMBOL: upload-directory diff --git a/extra/mason/email/email-tests.factor b/extra/mason/email/email-tests.factor new file mode 100644 index 0000000000..5bde9a9cfe --- /dev/null +++ b/extra/mason/email/email-tests.factor @@ -0,0 +1,11 @@ +IN: mason.email.tests +USING: mason.email mason.common mason.config namespaces tools.test ; + +[ "mason on linux-x86-64: error" ] [ + [ + "linux" target-os set + "x86.64" target-cpu set + status-error status set + subject prefix-subject + ] with-scope +] unit-test diff --git a/extra/mason/email/email.factor b/extra/mason/email/email.factor new file mode 100644 index 0000000000..f25f7e5cfa --- /dev/null +++ b/extra/mason/email/email.factor @@ -0,0 +1,35 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces accessors combinators make smtp +debugger prettyprint io io.streams.string io.encodings.utf8 +io.files io.sockets +mason.common mason.platform mason.config ; +IN: mason.email + +: prefix-subject ( str -- str' ) + [ "mason on " % platform % ": " % % ] "" make ; + +: email-status ( body subject -- ) + + builder-from get >>from + builder-recipients get >>to + swap prefix-subject >>subject + swap >>body + send-email ; + +: subject ( -- str ) + status get { + { status-clean [ "clean" ] } + { status-dirty [ "dirty" ] } + { status-error [ "error" ] } + } case ; + +: email-report ( -- ) + "report" utf8 file-contents subject email-status ; + +: email-error ( error callstack -- ) + [ + "Fatal error on " write host-name print nl + [ error. ] [ callstack. ] bi* + ] with-string-writer "fatal error" + email-status ; diff --git a/extra/mason/mason.factor b/extra/mason/mason.factor new file mode 100644 index 0000000000..4f9c8f65d3 --- /dev/null +++ b/extra/mason/mason.factor @@ -0,0 +1,30 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel debugger io io.files threads debugger continuations +namespaces accessors calendar mason.common mason.updates +mason.build mason.email ; +IN: mason + +: build-loop-error ( error -- ) + error-continuation get call>> email-error ; + +: build-loop-fatal ( error -- ) + "FATAL BUILDER ERROR:" print + error. flush ; + +: build-loop ( -- ) + ?prepare-build-machine + [ + [ + builds/factor set-current-directory + new-code-available? [ build ] when + ] [ + build-loop-error + ] recover + ] [ + build-loop-fatal + ] recover + 5 minutes sleep + build-loop ; + +MAIN: build-loop \ No newline at end of file diff --git a/extra/mason/platform/platform.factor b/extra/mason/platform/platform.factor new file mode 100644 index 0000000000..e4bba51491 --- /dev/null +++ b/extra/mason/platform/platform.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel system accessors namespaces splitting sequences make +mason.config ; +IN: mason.platform + +: platform ( -- string ) + target-os get "-" target-cpu get "." split "-" join 3append ; + +: gnu-make ( -- string ) + target-os get { "freebsd" "openbsd" "netbsd" } member? "gmake" "make" ? ; + +: boot-image-name ( -- string ) + [ + "boot." % + target-cpu get "ppc" = [ target-os get % "-" % ] when + target-cpu get % + ".image" % + ] "" make ; diff --git a/extra/mason/release/archive/archive.factor b/extra/mason/release/archive/archive.factor new file mode 100644 index 0000000000..e76979d885 --- /dev/null +++ b/extra/mason/release/archive/archive.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel combinators sequences make namespaces io.files +io.launcher prettyprint arrays +mason.common mason.platform mason.config ; +IN: mason.release.archive + +: base-name ( -- string ) + [ "factor-" % platform % "-" % stamp get % ] "" make ; + +: extension ( -- extension ) + target-os get { + { "winnt" [ ".zip" ] } + { "macosx" [ ".dmg" ] } + [ drop ".tar.gz" ] + } case ; + +: archive-name ( -- string ) base-name extension append ; + +: make-windows-archive ( -- ) + [ "zip" , "-r" , archive-name , "factor" , ] { } make try-process ; + +: make-macosx-archive ( -- ) + { "mkdir" "dmg-root" } try-process + { "cp" "-R" "factor" "dmg-root" } try-process + { "hdiutil" "create" + "-srcfolder" "dmg-root" + "-fs" "HFS+" + "-volname" "factor" } + archive-name suffix try-process + "dmg-root" delete-tree ; + +: make-unix-archive ( -- ) + [ "tar" , "-cvzf" , archive-name , "factor" , ] { } make try-process ; + +: make-archive ( -- ) + target-os get { + { "winnt" [ make-windows-archive ] } + { "macosx" [ make-macosx-archive ] } + [ drop make-unix-archive ] + } case ; + +: releases ( -- path ) + builds-dir get "releases" append-path dup make-directories ; + +: save-archive ( -- ) + archive-name releases move-file-into ; \ No newline at end of file diff --git a/extra/mason/release/branch/branch-tests.factor b/extra/mason/release/branch/branch-tests.factor new file mode 100644 index 0000000000..68046f79cf --- /dev/null +++ b/extra/mason/release/branch/branch-tests.factor @@ -0,0 +1,24 @@ +IN: mason.release.branch.tests +USING: mason.release.branch mason.config tools.test namespaces ; + +[ { "git" "push" "joe@blah.com:/my/git" "master:clean-linux-x86-32" } ] [ + [ + "joe" branch-username set + "blah.com" branch-host set + "/my/git" branch-directory set + "linux" target-os set + "x86.32" target-cpu set + push-to-clean-branch-cmd + ] with-scope +] unit-test + +[ { "scp" "boot.x86.64.image" "joe@blah.com:/stuff/clean/netbsd-x86-64" } ] [ + [ + "joe" image-username set + "blah.com" image-host set + "/stuff/clean" image-directory set + "netbsd" target-os set + "x86.64" target-cpu set + upload-clean-image-cmd + ] with-scope +] unit-test diff --git a/extra/mason/release/branch/branch.factor b/extra/mason/release/branch/branch.factor new file mode 100644 index 0000000000..8872cda5b5 --- /dev/null +++ b/extra/mason/release/branch/branch.factor @@ -0,0 +1,48 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces sequences prettyprint io.files +io.launcher make +mason.common mason.platform mason.config ; +IN: mason.release.branch + +: branch-name ( -- string ) "clean-" platform append ; + +: refspec ( -- string ) "master:" branch-name append ; + +: push-to-clean-branch-cmd ( -- args ) + [ + "git" , "push" , + [ + branch-username get % "@" % + branch-host get % ":" % + branch-directory get % + ] "" make , + refspec , + ] { } make ; + +: push-to-clean-branch ( -- ) + push-to-clean-branch-cmd short-running-process ; + +: upload-clean-image-cmd ( -- args ) + [ + "scp" , + boot-image-name , + [ + image-username get % "@" % + image-host get % ":" % + image-directory get % "/" % + platform % + ] "" make , + ] { } make ; + +: upload-clean-image ( -- ) + upload-clean-image-cmd short-running-process ; + +: (update-clean-branch) ( -- ) + "factor" [ + push-to-clean-branch + upload-clean-image + ] with-directory ; + +: update-clean-branch ( -- ) + upload-to-factorcode get [ (update-clean-branch) ] when ; diff --git a/extra/mason/release/release.factor b/extra/mason/release/release.factor new file mode 100644 index 0000000000..bbb47ba0d3 --- /dev/null +++ b/extra/mason/release/release.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2008 Eduardo Cavazos. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel debugger namespaces sequences splitting +combinators io io.files io.launcher prettyprint bootstrap.image +mason.common mason.release.branch mason.release.tidy +mason.release.archive mason.release.upload ; +IN: mason.release + +: (release) ( -- ) + update-clean-branch + tidy + make-archive + upload + save-archive ; + +: release ( -- ) status get status-clean eq? [ (release) ] when ; \ No newline at end of file diff --git a/extra/mason/release/tidy/tidy-tests.factor b/extra/mason/release/tidy/tidy-tests.factor new file mode 100644 index 0000000000..e140926c7a --- /dev/null +++ b/extra/mason/release/tidy/tidy-tests.factor @@ -0,0 +1,2 @@ +IN: mason.release.tidy.tests +USING: mason.release.tidy tools.test ; diff --git a/extra/mason/release/tidy/tidy.factor b/extra/mason/release/tidy/tidy.factor new file mode 100644 index 0000000000..a456e6ff23 --- /dev/null +++ b/extra/mason/release/tidy/tidy.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces continuations debugger sequences fry +io.files io.launcher mason.common mason.platform +mason.config ; +IN: mason.release.tidy + +: common-files ( -- seq ) + { + "boot.x86.32.image" + "boot.x86.64.image" + "boot.macosx-ppc.image" + "boot.linux-ppc.image" + "vm" + "temp" + "logs" + ".git" + ".gitignore" + "Makefile" + "unmaintained" + "unfinished" + "build-support" + } ; + +: remove-common-files ( -- ) + common-files [ delete-tree ] each ; + +: remove-factor-app ( -- ) + target-os get "macosx" = + [ "Factor.app" delete-tree ] unless ; + +: tidy ( -- ) + "factor" [ remove-factor-app remove-common-files ] with-directory ; diff --git a/extra/mason/release/upload/upload-tests.factor b/extra/mason/release/upload/upload-tests.factor new file mode 100644 index 0000000000..9f5300b129 --- /dev/null +++ b/extra/mason/release/upload/upload-tests.factor @@ -0,0 +1,38 @@ +IN: mason.release.upload.tests +USING: mason.release.upload mason.common mason.config +mason.common namespaces calendar tools.test ; + +[ + { + "scp" + "factor-linux-ppc-2008-09-11-23-12.tar.gz" + "slava@www.apple.com:/uploads/linux-ppc/factor-linux-ppc-2008-09-11-23-12.tar.gz.incomplete" + } + { + "ssh" + "www.apple.com" + "-l" "slava" + "mv" + "/uploads/linux-ppc/factor-linux-ppc-2008-09-11-23-12.tar.gz.incomplete" + "/uploads/linux-ppc/factor-linux-ppc-2008-09-11-23-12.tar.gz" + } +] [ + [ + "slava" upload-username set + "www.apple.com" upload-host set + "/uploads" upload-directory set + "linux" target-os set + "ppc" target-cpu set + T{ timestamp + { year 2008 } + { month 09 } + { day 11 } + { hour 23 } + { minute 12 } + } datestamp stamp set + upload-command + rename-command + ] with-scope +] unit-test + +\ upload must-infer diff --git a/extra/mason/release/upload/upload.factor b/extra/mason/release/upload/upload.factor new file mode 100644 index 0000000000..2bf18f1126 --- /dev/null +++ b/extra/mason/release/upload/upload.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces make sequences arrays io io.files +io.launcher mason.common mason.platform +mason.release.archive mason.config ; +IN: mason.release.upload + +: remote-location ( -- dest ) + upload-directory get "/" platform 3append ; + +: remote-archive-name ( -- dest ) + remote-location "/" archive-name 3append ; + +: temp-archive-name ( -- dest ) + remote-archive-name ".incomplete" append ; + +: upload-command ( -- args ) + "scp" + archive-name + [ + upload-username get % "@" % + upload-host get % ":" % + temp-archive-name % + ] "" make + 3array ; + +: rename-command ( -- args ) + [ + "ssh" , + upload-host get , + "-l" , + upload-username get , + "mv" , + temp-archive-name , + remote-archive-name , + ] { } make ; + +: upload-temp-file ( -- ) + upload-command short-running-process ; + +: rename-temp-file ( -- ) + rename-command short-running-process ; + +: upload ( -- ) + upload-to-factorcode get + [ upload-temp-file rename-temp-file ] + when ; diff --git a/extra/mason/report/report-tests.factor b/extra/mason/report/report-tests.factor new file mode 100644 index 0000000000..7f5c4f1d30 --- /dev/null +++ b/extra/mason/report/report-tests.factor @@ -0,0 +1,2 @@ +IN: mason.report.tests +USING: mason.report tools.test ; diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor new file mode 100644 index 0000000000..145686d621 --- /dev/null +++ b/extra/mason/report/report.factor @@ -0,0 +1,66 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces debugger fry io io.files io.sockets +io.encodings.utf8 prettyprint benchmark mason.common +mason.platform mason.config ; +IN: mason.report + +: time. ( file -- ) + [ write ": " write ] [ eval-file milli-seconds>time print ] bi ; + +: common-report ( -- ) + "Build machine: " write host-name print + "CPU: " write target-cpu get print + "OS: " write target-os get print + "Build directory: " write build-dir print + "git id: " write "git-id" eval-file print nl ; + +: with-report ( quot -- ) + [ "report" utf8 ] dip '[ common-report @ ] with-file-writer ; + +: compile-failed-report ( error -- ) + [ + "VM compile failed:" print nl + "compile-log" cat nl + error. + ] with-report ; + +: boot-failed-report ( error -- ) + [ + "Bootstrap failed:" print nl + "boot-log" 100 cat-n nl + error. + ] with-report ; + +: test-failed-report ( error -- ) + [ + "Tests failed:" print nl + "test-log" 100 cat-n nl + error. + ] with-report ; + +: successful-report ( -- ) + [ + boot-time-file time. + load-time-file time. + test-time-file time. + help-lint-time-file time. + benchmark-time-file time. + + nl + + "Did not pass load-everything:" print + load-everything-vocabs-file cat + load-everything-errors-file cat + + "Did not pass test-all:" print + test-all-vocabs-file cat + test-all-errors-file cat + + "Did not pass help-lint:" print + help-lint-vocabs-file cat + help-lint-errors-file cat + + "Benchmarks:" print + benchmarks-file eval-file benchmarks. + ] with-report ; \ No newline at end of file diff --git a/extra/mason/summary.txt b/extra/mason/summary.txt new file mode 100644 index 0000000000..798064e958 --- /dev/null +++ b/extra/mason/summary.txt @@ -0,0 +1 @@ +Continuous build system for Factor diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor new file mode 100644 index 0000000000..58884175a3 --- /dev/null +++ b/extra/mason/test/test.factor @@ -0,0 +1,38 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel namespaces assocs io.files io.encodings.utf8 +prettyprint help.lint benchmark tools.time bootstrap.stage2 +tools.test tools.vocabs mason.common ; +IN: mason.test + +: do-load ( -- ) + try-everything + [ keys load-everything-vocabs-file to-file ] + [ load-everything-errors-file utf8 [ load-failures. ] with-file-writer ] + bi ; + +: do-tests ( -- ) + run-all-tests + [ keys test-all-vocabs-file to-file ] + [ test-all-errors-file utf8 [ test-failures. ] with-file-writer ] + bi ; + +: do-help-lint ( -- ) + "" run-help-lint + [ keys help-lint-vocabs-file to-file ] + [ help-lint-errors-file utf8 [ typos. ] with-file-writer ] + bi ; + +: do-benchmarks ( -- ) + run-benchmarks benchmarks-file to-file ; + +: do-all ( -- ) + ".." [ + bootstrap-time get boot-time-file to-file + [ do-load ] benchmark load-time-file to-file + [ do-tests ] benchmark test-time-file to-file + [ do-help-lint ] benchmark help-lint-time-file to-file + [ do-benchmarks ] benchmark benchmark-time-file to-file + ] with-directory ; + +MAIN: do-all \ No newline at end of file diff --git a/extra/mason/updates/updates.factor b/extra/mason/updates/updates.factor new file mode 100644 index 0000000000..9c42ba2850 --- /dev/null +++ b/extra/mason/updates/updates.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel io.launcher bootstrap.image.download +mason.common mason.platform ; +IN: mason.updates + +: git-pull-cmd ( -- cmd ) + { + "git" + "pull" + "--no-summary" + "git://factorcode.org/git/factor.git" + "master" + } ; + +: updates-available? ( -- ? ) + git-id + git-pull-cmd short-running-process + git-id + = not ; + +: new-image-available? ( -- ? ) + boot-image-name need-new-image? [ download-my-image t ] [ f ] if ; + +: new-code-available? ( -- ? ) + updates-available? + new-image-available? + or ; \ No newline at end of file diff --git a/unfinished/compiler/backend/backend.factor b/unfinished/compiler/backend/backend.factor index c1944eb9a7..ffe8f73ba9 100644 --- a/unfinished/compiler/backend/backend.factor +++ b/unfinished/compiler/backend/backend.factor @@ -1,10 +1,223 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: system ; +USING: accessors assocs arrays generic kernel kernel.private +math memory namespaces make sequences layouts system hashtables +classes alien byte-arrays combinators words sets classes.algebra +compiler.cfg.registers compiler.cfg.instructions ; IN: compiler.backend -! Is this structure small enough to be returned in registers? -HOOK: struct-small-enough? cpu ( size -- ? ) +! Labels +TUPLE: label offset ; + +: