Merge branch 'master' of git://factorcode.org/git/factor into unicode

core/alien/alien-tests.factor

@@ -1,7 +1,7 @@
 IN: alien.tests
 USING: alien alien.accessors byte-arrays arrays kernel
 kernel.private namespaces tools.test sequences libc math system
-prettyprint ;
+prettyprint layouts ;
 
 [ t ] [ -1 <alien> alien-address 0 > ] unit-test
 

core/alien/c-types/c-types-docs.factor

@@ -84,11 +84,11 @@ HELP: alien>u16-string ( c-ptr -- string )
 { $values { "c-ptr" c-ptr } { "string" string } }
 { $description "Reads a null-terminated UCS-2 string from the specified address." } ;
 
-HELP: memory>byte-array ( base len -- string )
+HELP: memory>byte-array
-{ $values { "base" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
+{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
 { $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
 
-HELP: byte-array>memory ( string base -- )
+HELP: byte-array>memory
 { $values { "byte-array" byte-array } { "base" c-ptr } }
 { $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
 { $warning "This word is unsafe. Improper use can corrupt memory." } ;

core/alien/c-types/c-types.factor

@@ -4,7 +4,7 @@ USING: bit-arrays byte-arrays float-arrays arrays
 generator.registers assocs kernel kernel.private libc math
 namespaces parser sequences strings words assocs splitting
 math.parser cpu.architecture alien alien.accessors quotations
-system compiler.units io.files io.encodings.binary ;
+layouts system compiler.units io.files io.encodings.binary ;
 IN: alien.c-types
 
 DEFER: <int>

core/alien/compiler/compiler.factor

@@ -6,7 +6,7 @@ inference.state inference.backend inference.dataflow system
 math.parser classes alien.arrays alien.c-types alien.structs
 alien.syntax cpu.architecture alien inspector quotations assocs
 kernel.private threads continuations.private libc combinators
-compiler.errors continuations ;
+compiler.errors continuations layouts ;
 IN: alien.compiler
 
 ! Common protocol for alien-invoke/alien-callback/alien-indirect

core/assocs/assocs-docs.factor

@@ -162,6 +162,7 @@ HELP: assoc-each
 { $description "Applies a quotation to each entry in the assoc." }
 { $examples
     { $example
+        "USING: assocs kernel math prettyprint ;"
         "H{ { \"bananas\" 5 } { \"apples\" 42 } { \"pears\" 17 } }"
         "0 swap [ nip + ] assoc-each ."
         "64"

core/bootstrap/image/image.factor

@@ -191,7 +191,9 @@ M: bignum '
 M: fixnum '
     #! When generating a 32-bit image on a 64-bit system,
     #! some fixnums should be bignums.
-    dup most-negative-fixnum most-positive-fixnum between?
+    dup
+    bootstrap-most-negative-fixnum
+    bootstrap-most-positive-fixnum between?
     [ tag-fixnum ] [ >bignum ' ] if ;
 
 ! Floats

core/boxes/boxes-docs.factor

@@ -19,7 +19,7 @@ HELP: box>
 { $errors "Throws an error if the box is empty." } ;
 
 HELP: ?box
-{ $values { "box" box } { "value" "the value of the box or " { $link f } } { "?" "a boolean" } }
+{ $values { "box" box } { "value/f" "the value of the box or " { $link f } } { "?" "a boolean" } }
 { $description "If the box is full, removes the value from the box and pushes " { $link t } ". If the box is empty pushes " { $snippet "f f" } "." } ;
 
 ARTICLE: "boxes" "Boxes"

core/byte-vectors/byte-vectors.factor

@@ -6,7 +6,7 @@ IN: byte-vectors
 
 <PRIVATE
 
-: byte-array>vector ( byte-array capacity -- byte-vector )
+: byte-array>vector ( byte-array length -- byte-vector )
     byte-vector construct-boa ; inline
 
 PRIVATE>

core/classes/classes-docs.factor

@@ -1,4 +1,4 @@
-USING: generic help.markup help.syntax kernel kernel.private
+USING: help.markup help.syntax kernel kernel.private
 namespaces sequences words arrays layouts help effects math
 layouts classes.private classes.union classes.mixin
 classes.predicate ;
@@ -7,11 +7,6 @@ IN: classes
 ARTICLE: "builtin-classes" "Built-in classes"
 "Every object is an instance of exactly one canonical " { $emphasis "built-in class" } " which defines its layout in memory and basic behavior."
 $nl
-"Corresponding to every built-in class is a built-in type number. An object can be asked for its built-in type number:"
-{ $subsection type }
-"Built-in type numbers can be converted to classes, and vice versa:"
-{ $subsection type>class }
-{ $subsection type-number }
 "The set of built-in classes is a class:"
 { $subsection builtin-class }
 { $subsection builtin-class? }
@@ -79,7 +74,7 @@ HELP: class
 { $values { "object" object } { "class" class } }
 { $description "Outputs an object's canonical class. While an object may be an instance of more than one class, the canonical class is either its built-in class, or if the object is a tuple, its tuple class." }
 { $class-description "The class of all class words. Subclasses include " { $link builtin-class } ", " { $link union-class } ", " { $link mixin-class } ", " { $link predicate-class } " and " { $link tuple-class } "." }
-{ $examples { $example "USE: classes" "1.0 class ." "float" } { $example "USE: classes" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
+{ $examples { $example "USING: classes prettyprint ;" "1.0 class ." "float" } { $example "USING: classes prettyprint ;" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
 
 HELP: classes
 { $values { "seq" "a sequence of class words" } }
@@ -89,14 +84,14 @@ HELP: builtin-class
 { $class-description "The class of built-in classes." }
 { $examples
     "The class of arrays is a built-in class:"
-    { $example "USE: classes" "array builtin-class? ." "t" }
+    { $example "USING: arrays classes prettyprint ;" "array builtin-class? ." "t" }
-    "However, a literal array is not a built-in class; it is not even a class:"
+    "However, an instance of the array class is not a built-in class; it is not even a class:"
-    { $example "USE: classes" "{ 1 2 3 } builtin-class? ." "f" }
+    { $example "USING: classes prettyprint ;" "{ 1 2 3 } builtin-class? ." "f" }
 } ;
 
 HELP: tuple-class
 { $class-description "The class of tuple class words." }
-{ $examples { $example "USE: classes\nTUPLE: name title first last ;\nname tuple-class? ." "t" } } ;
+{ $examples { $example "USING: classes prettyprint ;" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ;
 
 HELP: typemap
 { $var-description "Hashtable mapping unions to class words, used to implement " { $link class-and } " and " { $link class-or } "." } ;
@@ -167,7 +162,7 @@ HELP: types
 HELP: class-empty?
 { $values { "class" "a class" } { "?" "a boolean" } }
 { $description "Tests if a class is a union class with no members." }
-{ $examples { $example "USE: classes" "null class-empty? ." "t" } } ;
+{ $examples { $example "USING: classes kernel prettyprint ;" "null class-empty? ." "t" } } ;
 
 HELP: (class<)
 { $values { "class1" "a class" } { "class2" "a class" } { "?" "a boolean" } }
@@ -182,8 +177,6 @@ HELP: sort-classes
 { $values { "seq" "a sequence of class" } { "newseq" "a new seqence of classes" } }
 { $description "Outputs a topological sort of a sequence of classes. Larger classes come before their subclasses." } ;
 
-{ sort-classes methods order } related-words
-
 HELP: lookup-union
 { $values { "classes" "a hashtable mapping class words to themselves" } { "class" class } }
 { $description "Given a set of classes represented as a hashtable with equal keys and values, looks up a previously-defined union class having those members. If no union is defined, outputs " { $link object } "." } ;

core/combinators/combinators-docs.factor

@@ -82,7 +82,7 @@ HELP: with-datastack
 { $values { "stack" sequence } { "quot" quotation } { "newstack" sequence } }
 { $description "Executes the quotation with the given data stack contents, and outputs the new data stack after the word returns. The input sequence is not modified. Does not affect the data stack in surrounding code, other than consuming the two inputs and pushing the output." }
 { $examples
-    { $example "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
+    { $example "USING: combinators math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
 } ;
 
 HELP: recursive-hashcode

core/compiler/errors/errors-docs.factor

@@ -9,7 +9,7 @@ ARTICLE: "compiler-errors" "Compiler warnings and errors"
 { $subsection :errors }
 { $subsection :warnings }
 { $subsection :linkage }
-"Words such as " { $link require } " and " { $link refresh-all } " use a combinator which counts errors and prints a report at the end:"
+"Words such as " { $link require } " use a combinator which counts errors and prints a report at the end:"
 { $link with-compiler-errors } ;
 
 HELP: compiler-errors
@@ -24,8 +24,8 @@ HELP: compiler-error.
 { $description "Prints a compiler error to the " { $link stdio } " stream." } ;
 
 HELP: compiler-errors.
-{ $values { "errors" "an assoc mapping words to errors" } }
+{ $values { "type" symbol } }
-{ $description "Prints a set of compiler errors to the " { $link stdio } " stream." } ;
+{ $description "Prints compiler errors to the " { $link stdio } " stream. The type parameter is one of " { $link +error+ } ", " { $link +warning+ } ", or " { $link +linkage+ } "." } ;
 HELP: :errors
 { $description "Prints all serious compiler errors from the most recent compile to the " { $link stdio } " stream." } ;
 

core/compiler/units/units-docs.factor

@@ -63,7 +63,7 @@ HELP: modify-code-heap ( alist -- )
 { $notes "This word is called at the end of " { $link with-compilation-unit } "." } ;
 
 HELP: compile
-{ $values { "seq" "a sequence of words" } }
+{ $values { "words" "a sequence of words" } }
 { $description "Compiles a set of words." } ;
 
 HELP: compile-call

core/continuations/continuations-docs.factor

@@ -150,7 +150,7 @@ HELP: recover
 { $description "Calls the " { $snippet "try" } " quotation. If an exception is thrown in the dynamic extent of the " { $snippet "try" } " quotation, restores the data stack and calls the " { $snippet "recovery" } " quotation to handle the error." } ;
 
 HELP: ignore-errors
-{ $values { "try" quotation } }
+{ $values { "quot" quotation } }
 { $description "Calls the quotation. If an exception is thrown in the dynamic extent of the quotation, restores the data stack and returns." } ;
 
 HELP: rethrow

core/cpu/x86/32/32.factor

@@ -3,7 +3,7 @@
 USING: alien.c-types arrays cpu.x86.assembler
 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot
 cpu.architecture kernel kernel.private math namespaces sequences
-generator.registers generator.fixup generator system
+generator.registers generator.fixup generator system layouts
 alien.compiler combinators command-line
 compiler compiler.units io vocabs.loader ;
 IN: cpu.x86.32

core/cpu/x86/64/64.factor

@@ -4,7 +4,7 @@ USING: alien.c-types arrays cpu.x86.assembler
 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2
 cpu.x86.allot cpu.architecture kernel kernel.private math
 namespaces sequences generator.registers generator.fixup system
-alien alien.accessors alien.compiler alien.structs slots
+layouts alien alien.accessors alien.compiler alien.structs slots
 splitting assocs ;
 IN: cpu.x86.64
 

core/cpu/x86/assembler/assembler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generator.fixup io.binary kernel
 combinators kernel.private math namespaces parser sequences
-words system ;
+words system layouts ;
 IN: cpu.x86.assembler
 
 ! A postfix assembler for x86 and AMD64.

core/effects/effects-docs.factor

@@ -58,7 +58,7 @@ HELP: effect>string
 { $values { "effect" effect } { "string" string } }
 { $description "Turns a stack effect object into a string mnemonic." }
 { $examples
-    { $example "USE: effects" "1 2 <effect> effect>string print" "( object -- object object )" }
+    { $example "USING: effects io ;" "1 2 <effect> effect>string print" "( object -- object object )" }
 } ;
 
 HELP: stack-effect

core/generator/fixup/fixup.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs hashtables
 kernel kernel.private math namespaces sequences words
-quotations strings alien system combinators math.bitfields
+quotations strings alien layouts system combinators
-words.private cpu.architecture ;
+math.bitfields words.private cpu.architecture ;
 IN: generator.fixup
 
 : no-stack-frame -1 ; inline

core/generator/generator-docs.factor

@@ -57,7 +57,7 @@ HELP: generate
 { $description "Generates machine code for " { $snippet "label" } " from " { $snippet "node" } ". The value of " { $snippet "word" } " is retained for debugging purposes; it is the word which will appear in a call stack trace if this compiled code block throws an error when run." } ;
 
 HELP: word-dataflow
-{ $values { "word" word } { "effect" effect } { "dependencies" sequence } { "dataflow" "a dataflow graph" } }
+{ $values { "word" word } { "effect" effect } { "dataflow" "a dataflow graph" } }
 { $description "Outputs the dataflow graph of a word, taking specializers into account (see " { $link "specializers" } ")." } ;
 
 HELP: define-intrinsics

core/generic/generic-docs.factor

@@ -1,6 +1,6 @@
-USING: help.markup help.syntax generic.math generic.standard
+USING: help.markup help.syntax words classes definitions kernel
-words classes definitions kernel alien combinators sequences 
+alien sequences math quotations generic.standard generic.math
-math quotations ;
+combinators ;
 IN: generic
 
 ARTICLE: "method-order" "Method precedence"
@@ -33,8 +33,6 @@ $nl
 "New generic words can be defined:"
 { $subsection define-generic }
 { $subsection define-simple-generic }
-"Methods are tuples:"
-{ $subsection <method> }
 "Methods can be added to existing generic words:"
 { $subsection define-method }
 "Method definitions can be looked up:"
@@ -42,8 +40,10 @@ $nl
 { $subsection methods }
 "A generic word contains methods; the list of methods specializing on a class can also be obtained:"
 { $subsection implementors }
-"Low-level words which rebuilds the generic word after methods are added or removed, or the method combination is changed:"
+"Low-level word which rebuilds the generic word after methods are added or removed, or the method combination is changed:"
 { $subsection make-generic }
+"Low-level method constructor:"
+{ $subsection <method> }
 "A " { $emphasis "method specifier" } " refers to a method and implements the " { $link "definition-protocol" } ":"
 { $subsection method-spec } ;
 
@@ -126,7 +126,7 @@ HELP: method
 { method define-method POSTPONE: M: } related-words
 
 HELP: <method>
-{ $values { "def" "a quotation" } { "method" "a new method definition" } }
+{ $values { "quot" quotation } { "class" class } { "generic" generic } { "method" "a new method definition" } }
 { $description "Creates a new method." } ;
 
 HELP: methods
@@ -148,7 +148,7 @@ HELP: with-methods
 $low-level-note ;
 
 HELP: define-method
-{ $values { "method" quotation } { "class" class } { "generic" generic } }
+{ $values { "quot" quotation } { "class" class } { "generic" generic } }
 { $description "Defines a method. This is the runtime equivalent of " { $link POSTPONE: M: } "." } ;
 
 HELP: implementors
@@ -158,3 +158,5 @@ HELP: implementors
 HELP: forget-methods
 { $values { "class" class } }
 { $description "Remove all method definitions which specialize on the class." } ;
+
+{ sort-classes methods order } related-words

core/generic/generic.factor

@@ -74,7 +74,7 @@ M: method-body stack-effect
         "method-def" set
     ] H{ } make-assoc ;
 
-: <method> ( quot class generic -- word )
+: <method> ( quot class generic -- method )
     check-method
     [ make-method-def ] 3keep
     [ method-word-props ] 2keep

core/generic/math/math-docs.factor

@@ -1,26 +1,27 @@
 USING: kernel generic help.markup help.syntax math classes
-generic.math ;
+sequences quotations ;
+IN: generic.math
 
 HELP: math-upgrade
-{ $values { "class1" "a class word" } { "class2" "a class word" } { "quot" "a quotation with stack effect " { $snippet "( n n -- n n )" } } }
+{ $values { "class1" class } { "class2" class } { "quot" "a quotation with stack effect " { $snippet "( n n -- n n )" } } }
 { $description "Outputs a quotation for upgrading numberical types. It takes two numbers on the stack, an instance of " { $snippet "class1" } ", and an instance of " { $snippet "class2" } ", and converts the one with the lower priority to the higher priority type." }
-{ $examples { $example "USE: generic.math" "fixnum bignum math-upgrade ." "[ [ >bignum ] dip ]" } } ;
+{ $examples { $example "USING: generic.math math kernel prettyprint ;" "fixnum bignum math-upgrade ." "[ [ >bignum ] dip ]" } } ;
 
 HELP: no-math-method
-{ $values { "left" "an object" } { "right" "an object" } { "generic" "a generic word" } }
+{ $values { "left" "an object" } { "right" "an object" } { "generic" generic } }
 { $description "Throws a " { $link no-math-method } " error." }
 { $error-description "Thrown by generic words using the " { $link math-combination } " method combination if there is no suitable method defined for the two inputs." } ;
 
 HELP: math-method
-{ $values { "word" "a generic word" } { "class1" "a class word" } { "class2" "a class word" } { "quot" "a quotation" } }
+{ $values { "word" generic } { "class1" class } { "class2" class } { "quot" quotation } }
 { $description "Generates a definition for " { $snippet "word" } " when the two inputs are instances of " { $snippet "class1" } " and " { $snippet "class2" } ", respectively." }
-{ $examples { $example "USE: generic.math" "\\ + fixnum float math-method ." "[ [ >float ] dip float+ ]" } } ;
+{ $examples { $example "USING: generic.math math prettyprint ;" "\\ + fixnum float math-method ." "[ [ >float ] dip float+ ]" } } ;
 
 HELP: math-class
 { $class-description "The class of subtypes of " { $link number } " which are not " { $link null } "." } ;
 
 HELP: math-combination
-{ $values { "word" "a generic word" } { "quot" "a quotation" } }
+{ $values { "word" generic } { "quot" quotation } }
 { $description "Generates a double-dispatching word definition. Only methods defined on numerical classes and " { $link object } " take effect in the math combination. Methods defined on numerical classes are guaranteed to have their two inputs upgraded to the highest priority type of the two."
 $nl
 "The math method combination is used for binary operators such as " { $link + } " and " { $link * } "."
@@ -40,5 +41,5 @@ HELP: math-generic
 { $class-description "The class of generic words using " { $link math-combination } "." } ;
 
 HELP: last/first
-{ $values { "seq" "a sequence" } { "pair" "a two-element array" } }
+{ $values { "seq" sequence } { "pair" "a two-element array" } }
 { $description "Creates an array holding the first and last element of the sequence." } ;

core/generic/standard/standard-docs.factor

@@ -1,5 +1,5 @@
-USING: generic help.markup help.syntax sequences
+USING: generic help.markup help.syntax sequences ;
-generic.standard ;
+IN: generic.standard
 
 HELP: no-method
 { $values { "object" "an object" } { "generic" "a generic word" } }

core/growable/growable-docs.factor

@@ -18,19 +18,19 @@ $nl
 ABOUT: "growable"
 
 HELP: set-fill
-{ $values { "n" "a new fill pointer" } { "seq" "a resizable sequence" } }
+{ $values { "n" "a new fill pointer" } { "seq" growable } }
 { $contract "Sets the fill pointer (number of occupied elements in the underlying storage) of a resizable sequence." }
 { $side-effects "seq" }
-{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
+{ $warning "This word is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
 
 HELP: underlying
-{ $values { "seq" "a resizable sequence" } { "underlying" "the underlying sequence" } }
+{ $values { "seq" growable } { "underlying" "the underlying sequence" } }
 { $contract "Outputs the underlying storage of a resizable sequence." } ;
 
 HELP: set-underlying
-{ $values { "underlying" "a sequence" } { "seq" "a resizable sequence" } }
+{ $values { "underlying" sequence } { "seq" growable } }
 { $contract "Modifies the underlying storage of a resizable sequence." }
-{ $warning "This word is in the " { $vocab-link "growable.private" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
+{ $warning "This word is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
 
 HELP: capacity
 { $values { "seq" "a vector or string buffer" } { "n" "the capacity of the sequence" } }
@@ -41,7 +41,7 @@ HELP: new-size
 { $description "Computes the new size of a resizable sequence." } ;
 
 HELP: ensure
-{ $values { "n" "a positive integer" } { "seq" "a resizable sequence" } }
+{ $values { "n" "a positive integer" } { "seq" growable } }
 { $description "If " { $snippet "n" } " is less than the length of the sequence, does nothing. Otherwise, if " { $snippet "n" } " also exceeds the capacity of the underlying storage, the underlying storage is grown, and the fill pointer is reset. Finally, if " { $snippet "n" } " is greater than or equal to the length but less than the capacity of the underlying storage, the fill pointer is moved and nothing else is done."
 $nl
 "This word is used in the implementation of the " { $link set-nth } " generic for sequences supporting the resizable sequence protocol (see " { $link "growable" } ")."

core/hashtables/hashtables-docs.factor

@@ -128,14 +128,14 @@ HELP: prune
 { $values { "seq" "a sequence" } { "newseq" "a sequence" } }
 { $description "Outputs a new sequence with each distinct element of " { $snippet "seq" } " appearing only once. Elements are compared for equality using " { $link = } " and elements are ordered according to their position in " { $snippet "seq" } "." }
 { $examples
-    { $example "USE: hashtables" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" }
+    { $example "USING: hashtables prettyprint ;" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" }
 } ;
 
 HELP: all-unique?
 { $values { "seq" sequence } { "?" "a boolean" } }
 { $description "Tests whether a sequence contains any repeated elements." }
 { $example
-    "USE: combinators.lib"
+    "USING: hashtables prettyprint ;"
     "{ 0 1 1 2 3 5 } all-unique? ."
     "f"
 } ;

core/heaps/heaps-docs.factor

@@ -77,6 +77,7 @@ HELP: heap-size
 { $description "Returns the number of key/value pairs in the heap." } ;
 
 HELP: heap-delete
-{ $values { "heap" "a heap" } { "key" object } { "value" object } }
+{ $values { "entry" entry } { "heap" "a heap" } }
-{ $description "Output and remove the first element in the heap." }
+{ $description "Remove the specified entry from the heap." }
+{ $errors "Throws an error if the entry is from another heap or if it has already been deleted." }
 { $side-effects "heap" } ;

core/inference/class/class-tests.factor

@@ -4,7 +4,7 @@ inference.dataflow optimizer tools.test kernel.private generic
 sequences words inference.class quotations alien
 alien.c-types strings sbufs sequences.private
 slots.private combinators definitions compiler.units
-system ;
+system layouts ;
 
 ! Make sure these compile even though this is invalid code
 [ ] [ [ 10 mod 3.0 /i ] dataflow optimize drop ] unit-test

core/io/crc32/crc32-docs.factor

@@ -6,7 +6,7 @@ HELP: crc32
 { $description "Computes the CRC32 checksum of a sequence of bytes." } ;
 
 HELP: lines-crc32
-{ $values { "lines" "a sequence of strings" } { "n" integer } }
+{ $values { "seq" "a sequence of strings" } { "n" integer } }
 { $description "Computes the CRC32 checksum of a sequence of lines of bytes." } ;
 
 ARTICLE: "io.crc32" "CRC32 checksum calculation"

core/io/files/files-docs.factor

@@ -43,11 +43,19 @@ ARTICLE: "directories" "Directories"
 { $subsection make-directory }
 { $subsection make-directories } ;
 
+! ARTICLE: "file-types" "File Types"
+
+!   { $table { +directory+ "" } }
+
+! ;
+
 ARTICLE: "fs-meta" "File meta-data"
+
+{ $subsection file-info }
+{ $subsection link-info }
 { $subsection exists? }
 { $subsection directory? }
-{ $subsection file-length }
+! { $subsection file-modified }
-{ $subsection file-modified }
 { $subsection stat } ;
 
 ARTICLE: "delete-move-copy" "Deleting, moving, copying files"
@@ -104,18 +112,54 @@ HELP: path-separator?
 HELP: parent-directory
 { $values { "path" "a pathname string" } { "parent" "a pathname string" } }
 { $description "Strips the last component off a pathname." }
-{ $examples { $example "USE: io.files" "\"/etc/passwd\" parent-directory print" "/etc/" } } ;
+{ $examples { $example "USING: io io.files ;" "\"/etc/passwd\" parent-directory print" "/etc/" } } ;
 
 HELP: file-name
 { $values { "path" "a pathname string" } { "string" string } }
 { $description "Outputs the last component of a pathname string." }
 { $examples
-    { "\"/usr/bin/gcc\" file-name ." "\"gcc\"" }
+    { $example "USING: io.files prettyprint ;" "\"/usr/bin/gcc\" file-name ." "\"gcc\"" }
-    { "\"/usr/libexec/awk/\" file-name ." "\"awk\"" }
+    { $example "USING: io.files prettyprint ;" "\"/usr/libexec/awk/\" file-name ." "\"awk\"" }
 } ;
 
+! need a $class-description file-info
+
+HELP: file-info
+
+  { $values { "path" "a pathname string" }
+            { "info" file-info } }
+  { $description "Queries the file system for meta data. "
+                 "If path refers to a symbolic link, it is followed."
+                 "If the file does not exist, an exception is thrown." }
+
+  { $class-description "File meta data" }
+
+  { $table 
+           { "type" { "One of the following:"
+                      { $list { $link +regular-file+ }
+                              { $link +directory+ }
+                              { $link +symbolic-link+ } } } }
+
+           { "size"     "Size of the file in bytes" }
+           { "modified" "Last modification timestamp." } }
+
+  ;
+
+! need a see also to link-info
+
+HELP: link-info
+  { $values { "path" "a pathname string" }
+            { "info" "a file-info tuple" } }
+  { $description "Queries the file system for meta data. "
+                 "If path refers to a symbolic link, information about "
+                 "the symbolic link itself is returned."
+                 "If the file does not exist, an exception is thrown." } ;
+! need a see also to file-info
+
+{ file-info link-info } related-words
+
 HELP: <file-reader>
-{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptors" }
+{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" { "stream" "an input stream" } }
     { "stream" "an input stream" } }
 { $description "Outputs an input stream for reading from the specified pathname using the given encoding." }
 { $errors "Throws an error if the file is unreadable." } ;
@@ -178,7 +222,7 @@ HELP: stat ( path -- directory? permissions length modified )
     "Queries the file system for file meta data. If the file does not exist, outputs " { $link f } " for all four values."
 } ;
 
-{ stat exists? directory? file-length file-modified } related-words
+{ stat exists? directory? } related-words
 
 HELP: path+
 { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
@@ -206,13 +250,9 @@ HELP: directory*
 { $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
 { $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
 
-HELP: file-length
+! HELP: file-modified
-{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
+! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
-{ $description "Outputs the length of the file in bytes, or " { $link f } " if it does not exist." } ;
+! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
-
-HELP: file-modified
-{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
-{ $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
 
 HELP: resource-path
 { $values { "path" "a pathname string" } { "newpath" "a pathname string" } }

core/io/files/files.factor

@@ -219,6 +219,9 @@ M: pathname <=> [ pathname-string ] compare ;
 : with-file-reader ( path encoding quot -- )
     >r <file-reader> r> with-stream ; inline
 
+! : file-contents ( path encoding -- str )
+!     dupd [ file-info file-info-size read ] with-file-reader ;
+
 : file-contents ( path encoding -- str )
     dupd [ file-length read ] with-file-reader ;
 

core/io/streams/byte-array/byte-array-docs.factor

@@ -13,21 +13,22 @@ ARTICLE: "io.streams.byte-array" "Byte-array streams"
 
 HELP: <byte-reader>
 { $values { "byte-array" byte-array }
-    { "encoding" "an encoding descriptor" } }
+    { "encoding" "an encoding descriptor" }
-{ $description "Provides an input stream reading off the given byte array using the given encoding." } ;
+    { "stream" "a new byte reader" } }
+{ $description "Creates an input stream reading from a byte array using an encoding." } ;
 
 HELP: <byte-writer>
 { $values { "encoding" "an encoding descriptor" }
-    { "stream" "an output stream" } }
+    { "stream" "a new byte writer" } }
-{ $description "Provides an output stream, putting things in the given encoding, storing everything written to it in a byte-array." } ;
+{ $description "Creates an output stream writing data to a byte array using an encoding." } ;
 
 HELP: with-byte-reader
 { $values { "encoding" "an encoding descriptor" }
     { "quot" quotation } { "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading the byte array in the given encoding from beginning to end." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream for reading from a byte array using an encoding." } ;
 
 HELP: with-byte-writer
 { $values  { "encoding" "an encoding descriptor" }
     { "quot" quotation }
     { "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to a new byte array writer, putting things in the given encoding. The accumulated byte array is output when the quotation returns." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an output stream writing data to a byte array using an encoding." } ;

core/kernel/kernel-docs.factor

@@ -127,12 +127,22 @@ ARTICLE: "conditionals" "Conditionals and logic"
 { $see-also "booleans" "bitwise-arithmetic" both? either? } ;
 
 ARTICLE: "equality" "Equality and comparison testing"
-"There are two distinct notions of ``sameness'' when it comes to objects. You can test if two references point to the same object, or you can test if two objects are equal in some sense, usually by being instances of the same class, and having equal slot values. Both notions of equality are equality relations in the mathematical sense."
+"There are two distinct notions of ``sameness'' when it comes to objects. You can test if two references point to the same object (" { $emphasis "identity comparison" } "), or 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" } "). Both notions of equality are equality relations in the mathematical sense."
+$nl
+"Identity comparison:"
 { $subsection eq? }
+"Value comparison:"
 { $subsection = }
+"Generic words for custom value comparison methods:"
+{ $subsection equal? }
 "Some types of objects also have an intrinsic order allowing sorting using " { $link natural-sort } ":"
 { $subsection <=> }
 { $subsection compare }
+"Utilities for comparing objects:"
+{ $subsection after? }
+{ $subsection before? }
+{ $subsection after=? }
+{ $subsection before=? }
 "An object can be cloned; the clone has distinct identity but equal value:"
 { $subsection clone } ;
 
@@ -225,21 +235,18 @@ HELP: equal?
 { $contract
     "Tests if two objects are equal."
     $nl
-    "Method definitions should ensure that this is an equality relation:"
+    "User code should call " { $link = } " instead; that word first tests the case where the objects are " { $link eq? } ", and so by extension, methods defined on " { $link equal? } " assume they are never called on " { $link eq? } " objects."
+    $nl
+    "Method definitions should ensure that this is an equality relation, modulo the assumption that the two objects are not " { $link eq? } ". That is, for any three non-" { $link eq? } " objects " { $snippet "a" } ", " { $snippet "b" } " and " { $snippet "c" } ", we must have:"
     { $list
-        { $snippet "a = a" }
         { { $snippet "a = b" } " implies " { $snippet "b = a" } }
         { { $snippet "a = b" } " and " { $snippet "b = c" } " implies " { $snippet "a = c" } }
     }
-    "While user code can define methods for this generic word, it should not call it directly, since it does not handle the case where the two references point to the same object."
 }
 { $examples
-    "The most common reason for defining a method for this generic word to ensure that instances of a specific tuple class are only ever equal to themselves, overriding the default implementation which checks slot values for equality."
+    "To define a tuple class such that two instances are only equal if they are both the same instance, we can add a method to " { $link equal? } " which always returns " { $link f } ". Since " { $link = } " handles the case where the two objects are " { $link eq? } ", this method will never be called with two " { $link eq? } " objects, so such a definition is valid:"
     { $code "TUPLE: foo ;" "M: foo equal? 2drop f ;" }
-    "Note that with the above definition, calling " { $link equal? } " directly will give unexpected results:"
+    "By calling " { $link = } " on instances of " { $snippet "foo" } " we get the results we expect:"
-    { $unchecked-example "T{ foo } dup equal? ." "f" }
-    { $unchecked-example "T{ foo } dup clone equal? ." "f" }
-    "As documented above, " { $link = } " should be called instead:"
     { $unchecked-example "T{ foo } dup = ." "t" }
     { $unchecked-example "T{ foo } dup clone = ." "f" }
 } ;
@@ -264,7 +271,7 @@ HELP: compare
 { $values { "obj1" object } { "obj2" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "n" integer } }
 { $description "Compares the results of applying the quotation to both objects via " { $link <=> } "." }
 { $examples
-    { $example "\"hello\" \"hi\" [ length ] compare ." "3" }
+    { $example "USING: kernel prettyprint sequences ;" "\"hello\" \"hi\" [ length ] compare ." "3" }
 } ;
 
 HELP: clone
@@ -296,9 +303,9 @@ HELP: and
 { $notes "This word implements boolean and, so applying it to integers will not yield useful results (all integers have a true value). Bitwise and is the " { $link bitand } " word." }
 { $examples
     "Usually only the boolean value of the result is used, however you can also explicitly rely on the behavior that if both inputs are true, the second is output:"
-    { $example "t f and ." "f" }
+    { $example "USING: kernel prettyprint ;" "t f and ." "f" }
-    { $example "t 7 and ." "7" }
+    { $example "USING: kernel prettyprint ;" "t 7 and ." "7" }
-    { $example "\"hi\" 12.0 and ." "12.0" }
+    { $example "USING: kernel prettyprint ;" "\"hi\" 12.0 and ." "12.0" }
 } ;
 
 HELP: or
@@ -307,8 +314,8 @@ HELP: or
 { $notes "This word implements boolean inclusive or, so applying it to integers will not yield useful results (all integers have a true value). Bitwise inclusive or is the " { $link bitor } " word." }
 { $examples
     "Usually only the boolean value of the result is used, however you can also explicitly rely on the behavior that the result will be the first true input:"
-    { $example "t f or ." "t" }
+    { $example "USING: kernel prettyprint ;" "t f or ." "t" }
-    { $example "\"hi\" 12.0 or ." "\"hi\"" }
+    { $example "USING: kernel prettyprint ;" "\"hi\" 12.0 or ." "\"hi\"" }
 } ;
 
 HELP: xor
@@ -320,23 +327,21 @@ HELP: both?
 { $values { "quot" "a quotation with stack effect " { $snippet "( obj -- ? )" } } { "x" object } { "y" object } { "?" "a boolean" } }
 { $description "Tests if the quotation yields a true value when applied to both " { $snippet "x" } " and " { $snippet "y" } "." }
 { $examples
-    { $example "3 5 [ odd? ] both? ." "t" }
+    { $example "USING: kernel math prettyprint ;" "3 5 [ odd? ] both? ." "t" }
-    { $example "12 7 [ even? ] both? ." "f" }
+    { $example "USING: kernel math prettyprint ;" "12 7 [ even? ] both? ." "f" }
 } ;
 
 HELP: either?
 { $values { "quot" "a quotation with stack effect " { $snippet "( obj -- ? )" } } { "x" object } { "y" object } { "?" "a boolean" } }
 { $description "Tests if the quotation yields a true value when applied to either " { $snippet "x" } " or " { $snippet "y" } "." }
 { $examples
-    { $example "3 6 [ odd? ] either? ." "t" }
+    { $example "USING: kernel math prettyprint ;" "3 6 [ odd? ] either? ." "t" }
-    { $example "5 7 [ even? ] either? ." "f" }
+    { $example "USING: kernel math prettyprint ;" "5 7 [ even? ] either? ." "f" }
 } ;
 
-HELP: call ( callable -- )
+HELP: call
-{ $values { "quot" callable } }
+{ $values { "callable" callable } }
-{ $description "Calls a quotation."
+{ $description "Calls a quotation." }
-$nl
-"Under the covers, pushes the current call frame on the call stack, and set the call frame to the given quotation." }
 { $examples
     "The following two lines are equivalent:"
     { $code "2 [ 2 + 3 * ] call" "2 2 + 3 *" }
@@ -489,9 +494,9 @@ HELP: curry ( obj quot -- curry )
 $nl
 "This operation is efficient and does not copy the quotation." }
 { $examples
-    { $example "5 [ . ] curry ." "[ 5 . ]" }
+    { $example "USING: kernel prettyprint ;" "5 [ . ] curry ." "[ 5 . ]" }
-    { $example "\\ = [ see ] curry ." "[ \\ = see ]" }
+    { $example "USING: kernel prettyprint ;" "\\ = [ see ] curry ." "[ \\ = see ]" }
-    { $example "{ 1 2 3 } 2 [ - ] curry map ." "{ -1 0 1 }" }
+    { $example "USING: kernel math prettyprint sequences ;" "{ 1 2 3 } 2 [ - ] curry map ." "{ -1 0 1 }" }
 } ;
 
 HELP: 2curry
@@ -499,7 +504,7 @@ HELP: 2curry
 { $description "Outputs a " { $link callable } " which pushes " { $snippet "obj1" } " and " { $snippet "obj2" } " and then calls " { $snippet "quot" } "." }
 { $notes "This operation is efficient and does not copy the quotation." }
 { $examples
-    { $example "5 4 [ + ] 2curry ." "[ 5 4 + ]" }
+    { $example "USING: kernel math prettyprint ;" "5 4 [ + ] 2curry ." "[ 5 4 + ]" }
 } ;
 
 HELP: 3curry
@@ -516,7 +521,7 @@ HELP: with
 }
 { $notes "This operation is efficient and does not copy the quotation." }
 { $examples
-    { $example "2 { 1 2 3 } [ - ] with map ." "{ 1 0 -1 }" }
+    { $example "USING: kernel math prettyprint sequences ;" "2 { 1 2 3 } [ - ] with map ." "{ 1 0 -1 }" }
 } ;
 
 HELP: compose

core/layouts/layouts-docs.factor

@@ -1,5 +1,7 @@
-USING: layouts generic help.markup help.syntax kernel math
+USING: generic help.markup help.syntax kernel math
-memory namespaces sequences kernel.private classes ;
+memory namespaces sequences kernel.private classes
+sequences.private ;
+IN: layouts
 
 HELP: tag-bits
 { $var-description "Number of least significant bits reserved for a type tag in a tagged pointer." }
@@ -35,3 +37,88 @@ HELP: most-positive-fixnum
 
 HELP: most-negative-fixnum
 { $values { "n" "smallest negative integer representable by a fixnum" } } ;
+
+HELP: bootstrap-first-bignum
+{ $values { "n" "smallest positive integer not representable by a fixnum" } }
+{ $description "Outputs the value for the target architecture when bootstrapping." } ;
+
+HELP: bootstrap-most-positive-fixnum
+{ $values { "n" "largest positive integer representable by a fixnum" } } 
+{ $description "Outputs the value for the target architecture when bootstrapping." } ;
+
+HELP: bootstrap-most-negative-fixnum
+{ $values { "n" "smallest negative integer representable by a fixnum" } } 
+{ $description "Outputs the value for the target architecture when bootstrapping." } ;
+
+HELP: cell
+{ $values { "n" "a positive integer" } }
+{ $description "Outputs the pointer size in bytes of the current CPU architecture." } ;
+
+HELP: cells
+{ $values { "m" integer } { "n" integer } }
+{ $description "Computes the number of bytes used by " { $snippet "m" } " CPU operand-sized cells." } ;
+
+HELP: cell-bits
+{ $values { "n" integer } }
+{ $description "Outputs the number of bits in one CPU operand-sized cell." } ;
+
+HELP: bootstrap-cell
+{ $values { "n" "a positive integer" } }
+{ $description "Outputs the pointer size in bytes for the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
+
+HELP: bootstrap-cells
+{ $values { "m" integer } { "n" integer } }
+{ $description "Computes the number of bytes used by " { $snippet "m" } " cells in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
+
+HELP: bootstrap-cell-bits
+{ $values { "n" integer } }
+{ $description "Outputs the number of bits in one cell in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
+
+ARTICLE: "layouts-types" "Type numbers"
+"Corresponding to every built-in class is a built-in type number. An object can be asked for its built-in type number:"
+{ $subsection type }
+"Built-in type numbers can be converted to classes, and vice versa:"
+{ $subsection type>class }
+{ $subsection type-number }
+{ $subsection num-types }
+{ $see-also "builtin-classes" } ;
+
+ARTICLE: "layouts-tags" "Tagged pointers"
+"Every pointer stored on the stack or in the heap has a " { $emphasis "tag" } ", which is a small integer identifying the type of the pointer. If the tag is not equal to one of the two special tags, the remaining bits contain the memory address of a heap-allocated object. The two special tags are the " { $link fixnum } " tag and the " { $link f } " tag."
+$nl
+"Getting the tag of an object:"
+{ $link tag }
+"Words for working with tagged pointers:"
+{ $subsection tag-bits }
+{ $subsection num-tags }
+{ $subsection tag-mask }
+{ $subsection tag-number }
+"The Factor VM does not actually expose any words for working with tagged pointers directly. The above words operate on integers; they are used in the bootstrap image generator and the optimizing compiler." ;
+
+ARTICLE: "layouts-limits" "Sizes and limits"
+"Processor cell size:"
+{ $subsection cell }
+{ $subsection cells }
+{ $subsection cell-bits }
+"Range of integers representable by " { $link fixnum } "s:"
+{ $subsection most-negative-fixnum }
+{ $subsection most-positive-fixnum }
+"Maximum array size:"
+{ $subsection max-array-capacity } ;
+
+ARTICLE: "layouts-bootstrap" "Bootstrap support"
+"Bootstrap support:"
+{ $subsection bootstrap-cell }
+{ $subsection bootstrap-cells }
+{ $subsection bootstrap-cell-bits }
+{ $subsection bootstrap-most-negative-fixnum }
+{ $subsection bootstrap-most-positive-fixnum } ;
+
+ARTICLE: "layouts" "VM memory layouts"
+"The words documented in this section do not ever need to be called by user code. They are documented for the benefit of those wishing to explore the internals of Factor's implementation."
+{ $subsection "layouts-types" }
+{ $subsection "layouts-tags" }
+{ $subsection "layouts-limits" }
+{ $subsection "layouts-bootstrap" } ;
+
+ABOUT: "layouts"

core/layouts/layouts-tests.factor

@@ -0,0 +1,5 @@
+IN: system.tests
+USING: layouts math tools.test ;
+
+[ t ] [ cell integer? ] unit-test
+[ t ] [ bootstrap-cell integer? ] unit-test

core/layouts/layouts.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces math words kernel assocs system classes ;
+USING: namespaces math words kernel assocs classes
+kernel.private ;
 IN: layouts
 
 SYMBOL: tag-mask
@@ -24,8 +25,23 @@ SYMBOL: type-numbers
 : tag-fixnum ( n -- tagged )
     tag-bits get shift ;
 
+: cell ( -- n ) 7 getenv ; foldable
+
+: cells ( m -- n ) cell * ; inline
+
+: cell-bits ( -- n ) 8 cells ; inline
+
+: bootstrap-cell \ cell get cell or ; inline
+
+: bootstrap-cells bootstrap-cell * ; inline
+
+: bootstrap-cell-bits 8 bootstrap-cells ; inline
+
+: (first-bignum) ( m -- n )
+    tag-bits get - 1 - 2^ ;
+
 : first-bignum ( -- n )
-    bootstrap-cell-bits tag-bits get - 1 - 2^ ;
+    cell-bits (first-bignum) ;
 
 : most-positive-fixnum ( -- n )
     first-bignum 1- ;
@@ -33,6 +49,15 @@ SYMBOL: type-numbers
 : most-negative-fixnum ( -- n )
     first-bignum neg ;
 
+: bootstrap-first-bignum ( -- n )
+    bootstrap-cell-bits (first-bignum) ;
+
+: bootstrap-most-positive-fixnum ( -- n )
+    bootstrap-first-bignum 1- ;
+
+: bootstrap-most-negative-fixnum ( -- n )
+    bootstrap-first-bignum neg ;
+
 M: bignum >integer
     dup most-negative-fixnum most-positive-fixnum between?
     [ >fixnum ] when ;

core/listener/listener-docs.factor

@@ -31,8 +31,8 @@ HELP: listener-hook
 { $var-description "Variable holding a quotation called by the listener before reading an input expression. The UI sets this variable to a quotation which updates the stack display in a listener gadget." } ;
 
 HELP: read-quot
-{ $values { "stream" "an input stream" } { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } }
+{ $values { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } }
-{ $description "Reads a Factor expression from the stream, possibly spanning more than line. Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
+{ $description "Reads a Factor expression which possibly spans more than one line from " { $link stdio } " stream. Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
 
 HELP: listen
 { $description "Prompts for an expression on the " { $link stdio } " stream and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }

core/listener/listener.factor

@@ -38,7 +38,7 @@ M: object stream-read-quot
 M: duplex-stream stream-read-quot
     duplex-stream-in stream-read-quot ;
 
-: read-quot ( -- quot ) stdio get stream-read-quot ;
+: read-quot ( -- quot/f ) stdio get stream-read-quot ;
 
 : bye ( -- ) quit-flag on ;
 

core/math/intervals/intervals-docs.factor

@@ -213,41 +213,41 @@ HELP: incomparable
 { $description "Output value from " { $link interval<= } ", " { $link interval< } ", " { $link interval>= } " and " { $link interval> } " in the case where the result of the comparison is ambiguous." } ;
 
 HELP: interval<=
-{ $values { "int" interval } { "n" real } { "?" "a boolean or " { $link incomparable } } }
+{ $values { "i1" interval } { "i2" interval } { "?" "a boolean or " { $link incomparable } } }
-{ $description "Compares " { $snippet "int" } " with " { $snippet "n" } ", and outputs one of the following:"
+{ $description "Compares " { $snippet "i1" } " with " { $snippet "i2" } ", and outputs one of the following:"
     { $list
-        { { $link t } " if every point in " { $snippet "int" } " is less than or equal to " { $snippet "n" } }
+        { { $link t } " if every point in " { $snippet "i1" } " is less than or equal to every point in " { $snippet "i2" } }
-        { { $link f } " if every point in " { $snippet "int" } " is greater than " { $snippet "n" } }
+        { { $link f } " if every point in " { $snippet "i1" } " is greater than every point in " { $snippet "i2" } }
         { { $link incomparable } " if neither of the above conditions hold" }
     }
 } ;
 
 HELP: interval<
-{ $values { "int" interval } { "n" real } { "?" "a boolean or " { $link incomparable } } }
+{ $values { "i1" interval } { "i2" interval } { "?" "a boolean or " { $link incomparable } } }
-{ $description "Compares " { $snippet "int" } " with " { $snippet "n" } ", and outputs one of the following:"
+{ $description "Compares " { $snippet "i1" } " with " { $snippet "i2" } ", and outputs one of the following:"
     { $list
-        { { $link t } " if every point in " { $snippet "int" } " is less than " { $snippet "n" } }
+        { { $link t } " if every point in " { $snippet "i1" } " is less than every point in " { $snippet "i2" } }
-        { { $link f } " if every point in " { $snippet "int" } " is greater than or equal to " { $snippet "n" } }
+        { { $link f } " if every point in " { $snippet "i1" } " is greater than or equal to every point in " { $snippet "i2" } }
         { { $link incomparable } " if neither of the above conditions hold" }
     }
 } ;
 
 HELP: interval>=
-{ $values { "int" interval } { "n" real } { "?" "a boolean or " { $link incomparable } } }
+{ $values { "i1" interval } { "i2" interval } { "?" "a boolean or " { $link incomparable } } }
-{ $description "Compares " { $snippet "int" } " with " { $snippet "n" } ", and outputs one of the following:"
+{ $description "Compares " { $snippet "i1" } " with " { $snippet "i2" } ", and outputs one of the following:"
     { $list
-        { { $link t } " if every point in " { $snippet "int" } " is greater than or equal to " { $snippet "n" } }
+        { { $link t } " if every point in " { $snippet "i1" } " is greater than or equal to every point in " { $snippet "i2" } }
-        { { $link f } " if every point in " { $snippet "int" } " is less than " { $snippet "n" } }
+        { { $link f } " if every point in " { $snippet "i1" } " is less than every point in " { $snippet "i2" } }
         { { $link incomparable } " if neither of the above conditions hold" }
     }
 } ;
 
 HELP: interval>
-{ $values { "int" interval } { "n" real } { "?" "a boolean or " { $link incomparable } } }
+{ $values { "i1" interval } { "i2" interval } { "?" "a boolean or " { $link incomparable } } }
-{ $description "Compares " { $snippet "int" } " with " { $snippet "n" } ", and outputs one of the following:"
+{ $description "Compares " { $snippet "i1" } " with " { $snippet "i2" } ", and outputs one of the following:"
     { $list
-        { { $link t } " if every point in " { $snippet "int" } " is greater than " { $snippet "n" } }
+        { { $link t } " if every point in " { $snippet "i1" } " is greater than every point in " { $snippet "i2" } }
-        { { $link f } " if every point in " { $snippet "int" } " is less than or equal to " { $snippet "n" } }
+        { { $link f } " if every point in " { $snippet "i1" } " is less than or equal to every point in " { $snippet "i2" } }
         { { $link incomparable } " if neither of the above conditions hold" }
     }
 } ;

core/math/math-docs.factor

@@ -184,8 +184,8 @@ HELP: bitand
 { $values { "x" integer } { "y" integer } { "z" integer } }
 { $description "Outputs a new integer where each bit is set if and only if the corresponding bit is set in both inputs." }
 { $examples
-    { $example "BIN: 101 BIN: 10 bitand .b" "0" }
+    { $example "USING: math prettyprint ;" "BIN: 101 BIN: 10 bitand .b" "0" }
-    { $example "BIN: 110 BIN: 10 bitand .b" "10" }
+    { $example "USING: math prettyprint ;" "BIN: 110 BIN: 10 bitand .b" "10" }
 }
 { $notes "This word implements bitwise and, so applying it to booleans will throw an error. Boolean and is the " { $link and } " word." } ;
 
@@ -193,8 +193,8 @@ HELP: bitor
 { $values { "x" integer } { "y" integer } { "z" integer } }
 { $description "Outputs a new integer where each bit is set if and only if the corresponding bit is set in at least one of the inputs." }
 { $examples
-    { $example "BIN: 101 BIN: 10 bitor .b" "111" }
+    { $example "USING: math prettyprint ;" "BIN: 101 BIN: 10 bitor .b" "111" }
-    { $example "BIN: 110 BIN: 10 bitor .b" "110" }
+    { $example "USING: math prettyprint ;" "BIN: 110 BIN: 10 bitor .b" "110" }
 }
 { $notes "This word implements bitwise inclusive or, so applying it to booleans will throw an error. Boolean inclusive or is the " { $link and } " word." } ;
 
@@ -202,15 +202,15 @@ HELP: bitxor
 { $values { "x" integer } { "y" integer } { "z" integer } }
 { $description "Outputs a new integer where each bit is set if and only if the corresponding bit is set in exactly one of the inputs." }
 { $examples
-    { $example "BIN: 101 BIN: 10 bitxor .b" "111" }
+    { $example "USING: math prettyprint ;" "BIN: 101 BIN: 10 bitxor .b" "111" }
-    { $example "BIN: 110 BIN: 10 bitxor .b" "100" }
+    { $example "USING: math prettyprint ;" "BIN: 110 BIN: 10 bitxor .b" "100" }
 }
 { $notes "This word implements bitwise exclusive or, so applying it to booleans will throw an error. Boolean exclusive or is the " { $link xor } " word." } ;
 
 HELP: shift
 { $values { "x" integer } { "n" integer } { "y" integer } }
 { $description "Shifts " { $snippet "x" } " to the left by " { $snippet "n" } " bits if " { $snippet "n" } " is positive, or " { $snippet "-n" } " bits to the right if " { $snippet "n" } " is negative. A left shift of a fixnum may overflow, yielding a bignum. A right shift may result in bits ``falling off'' the right hand side and being discarded." }
-{ $examples { $example "BIN: 101 5 shift .b" "10100000" } { $example "BIN: 11111 -2 shift .b" "111" } } ;
+{ $examples { $example "USING: math prettyprint ;" "BIN: 101 5 shift .b" "10100000" } { $example "USING: math prettyprint ;" "BIN: 11111 -2 shift .b" "111" } } ;
 
 HELP: bitnot
 { $values { "x" integer } { "y" integer } }
@@ -222,7 +222,7 @@ $nl
 HELP: bit?
 { $values { "x" integer } { "n" integer } { "?" "a boolean" } }
 { $description "Tests if the " { $snippet "n" } "th bit of " { $snippet "x" } " is set." }
-{ $examples { $example "BIN: 101 2 bit? ." "t" } } ;
+{ $examples { $example "USING: math prettyprint ;" "BIN: 101 2 bit? ." "t" } } ;
 
 HELP: log2
 { $values { "x" "a positive integer" } { "n" integer } }
@@ -295,9 +295,9 @@ HELP: 2/
 { $values { "x" integer } { "y" integer } }
 { $description "Shifts " { $snippet "x" } " to the right by one bit." }
 { $examples
-    { $example "14 2/ ." "7" }
+    { $example "USING: math prettyprint ;" "14 2/ ." "7" }
-    { $example "17 2/ ." "8" }
+    { $example "USING: math prettyprint ;" "17 2/ ." "8" }
-    { $example "-17 2/ ." "-9" }
+    { $example "USING: math prettyprint ;" "-17 2/ ." "-9" }
 }
 { $notes "This word is not equivalent to " { $snippet "2 /" } " or " { $snippet "2 /i" } "; the name is historic and originates from the Forth programming language." } ;
 

core/mirrors/mirrors-docs.factor

@@ -29,7 +29,7 @@ HELP: <mirror>
 { $description "Creates a " { $link mirror } " reflecting an object." }
 { $examples
     { $example
-        "USING: assocs mirrors ;"
+        "USING: assocs mirrors prettyprint ;"
         "TUPLE: circle center radius ;"
         "C: <circle> circle"
         "{ 100 50 } 15 <circle> <mirror> >alist ."

core/namespaces/namespaces-docs.factor

@@ -87,7 +87,7 @@ HELP: +@
 { $description "Adds " { $snippet "n" } " to the value of the variable. A variable value of " { $link f } " is interpreted as being zero." }
 { $side-effects "variable" }
 { $examples
-    { $example "SYMBOL: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
+    { $example "USING: namespaces prettyprint ;" "SYMBOL: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
 } ;
 
 HELP: inc
@@ -168,7 +168,7 @@ HELP: building
 HELP: make
 { $values { "quot" quotation } { "exemplar" "a sequence" } { "seq" "a new sequence" } }
 { $description "Calls the quotation in a new " { $emphasis "dynamic scope" } ". The quotation and any words it calls can execute the " { $link , } " and " { $link % } " words to accumulate elements. When the quotation returns, all accumulated elements are collected into a sequence with the same type as " { $snippet "exemplar" } "." }
-{ $examples { $example "[ 1 , 2 , 3 , ] { } make ." "{ 1 2 3 }" } } ;
+{ $examples { $example "USING: namespaces prettyprint ;" "[ 1 , 2 , 3 , ] { } make ." "{ 1 2 3 }" } } ;
 
 HELP: ,
 { $values { "elt" object } }

core/parser/parser-docs.factor

@@ -221,8 +221,8 @@ HELP: <parse-error>
 { $description "Creates a new " { $link parse-error } ", filling in the location information from the current " { $link lexer } "." } ;
 
 HELP: skip
-{ $values { "i" "a starting index" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "n" integer } }
+{ $values { "i" "a starting index" } { "seq" sequence } { "?" "a boolean" } { "n" integer } }
-{ $description "Variant of " { $link find* } " that outputs the length of the sequence instead of " { $link f } " if no elements satisfy the predicate." } ;
+{ $description "Skips to the first space character (if " { $snippet "boolean" } " is " { $link f } ") or the first non-space character (otherwise)." } ;
 
 HELP: change-column
 { $values { "lexer" lexer } { "quot" "a quotation with stack effect " { $snippet "( col line -- newcol )" } } }
@@ -264,7 +264,7 @@ HELP: bad-number
 HELP: escape
 { $values { "escape" "a single-character escape" } { "ch" "a character" } }
 { $description "Converts from a single-character escape code and the corresponding character." }
-{ $examples { $example "CHAR: n escape CHAR: \\n = ." "t" } } ;
+{ $examples { $example "USING: kernel parser prettyprint ;" "CHAR: n escape CHAR: \\n = ." "t" } } ;
 
 HELP: parse-string
 { $values { "str" "a new " { $link string } } }
@@ -340,8 +340,8 @@ HELP: no-word
 { $notes "Apart from a missing " { $link POSTPONE: USE: } ", this error can also indicate an ordering issue. In Factor, words must be defined before they can be called. Mutual recursion can be implemented via " { $link POSTPONE: DEFER: } "." } ;
 
 HELP: search
-{ $values { "str" string } { "word" word } }
+{ $values { "str" string } { "word/f" "a word or " { $link f } } }
-{ $description "Searches for a word by name in the current vocabulary search path. If no such word could be found, throws a " { $link no-word } " error. If the search path does not contain a word with this name but other vocabularies do, the error will have restarts offering to add vocabularies to the search path." }
+{ $description "Searches for a word by name in the current vocabulary search path. If no such word could be found, outputs " { $link f } "." }
 $parsing-note ;
 
 HELP: scan-word
@@ -459,7 +459,7 @@ HELP: forget-smudged
 { $description "Forgets removed definitions and prints a warning message if any of them are still referenced from other source files." } ;
 
 HELP: finish-parsing
-{ $values { "quot" "the quotation just parsed" } }
+{ $values { "lines" "the lines of text just parsed" } { "quot" "the quotation just parsed" } }
 { $description "Records information to the current " { $link file } " and prints warnings about any removed definitions which are still in use." }
 { $notes "This is one of the factors of " { $link parse-stream } "." } ;
 

core/parser/parser-tests.factor

@@ -430,3 +430,20 @@ IN: parser.tests
 [ "resource:core/parser/test/assert-depth.factor" run-file ]
 [ relative-overflow-stack { 1 2 3 } sequence= ]
 must-fail-with
+
+2 [
+    [ ] [
+        "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
+        <string-reader> "d-f-s-test" parse-stream drop
+    ] unit-test
+
+    [ ] [
+        "IN: parser.tests DEFER: d-f-s d-f-s FORGET: d-f-s SYMBOL: d-f-s d-f-s"
+        <string-reader> "d-f-s-test" parse-stream drop
+    ] unit-test
+
+    [ ] [
+        "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
+        <string-reader> "d-f-s-test" parse-stream drop
+    ] unit-test
+] times

core/parser/parser.factor

@@ -240,13 +240,13 @@ PREDICATE: unexpected unexpected-eof
 
 : CREATE ( -- word ) scan create-in ;
 
-: create-class ( word vocab -- word )
+: create-class-in ( word -- word )
-    create
+    in get create
     dup save-class-location
     dup predicate-word dup set-word save-location ;
 
 : CREATE-CLASS ( -- word )
-    scan in get create-class ;
+    scan create-class-in ;
 
 : word-restarts ( possibilities -- restarts )
     natural-sort [
@@ -416,6 +416,7 @@ SYMBOL: interactive-vocabs
     "tools.test"
     "tools.threads"
     "tools.time"
+    "tools.vocabs"
     "vocabs"
     "vocabs.loader"
     "words"
@@ -483,7 +484,6 @@ SYMBOL: interactive-vocabs
 : finish-parsing ( lines quot -- )
     file get
     [ record-form ] keep
-    [ record-modified ] keep
     [ record-definitions ] keep
     record-checksum ;
 

core/prettyprint/prettyprint-docs.factor

@@ -242,8 +242,8 @@ HELP: definer
 { $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } }
 { $contract "Outputs the parsing words which delimit the definition." }
 { $examples
-    { $example ": foo ; \\ foo definer . ." ";\nPOSTPONE: :" }
+    { $example "USING: definitions prettyprint ;" ": foo ; \\ foo definer . ." ";\nPOSTPONE: :" }
-    { $example "SYMBOL: foo \\ foo definer . ." "f\nPOSTPONE: SYMBOL:" }
+    { $example "USING: definitions prettyprint ;" "SYMBOL: foo \\ foo definer . ." "f\nPOSTPONE: SYMBOL:" }
 }
 { $notes "This word is used in the implementation of " { $link see } "." } ;
 
@@ -251,6 +251,6 @@ HELP: definition
 { $values { "defspec" "a definition specifier" } { "seq" "a sequence" } }
 { $contract "Outputs the body of a definition." }
 { $examples
-    { $example "USE: math" "\\ sq definition ." "[ dup * ]" }
+    { $example "USING: definitions math prettyprint ;" "\\ sq definition ." "[ dup * ]" }
 }
 { $notes "This word is used in the implementation of " { $link see } "." } ;

core/quotations/quotations-docs.factor

@@ -51,8 +51,8 @@ HELP: literalize
 { $values { "obj" object } { "wrapped" object } }
 { $description "Outputs an object which evaluates to " { $snippet "obj" } " when placed in a quotation. If " { $snippet "obj" } " is not self-evaluating (for example, it is a word), then it will be wrapped." }
 { $examples
-    { $example "USE: quotations" "5 literalize ." "5" }
+    { $example "USING: prettyprint quotations ;" "5 literalize ." "5" }
-    { $example "USE: quotations" "[ + ] [ literalize ] map ." "[ \\ + ]" }
+    { $example "USING: math prettyprint quotations sequences ;" "[ + ] [ literalize ] map ." "[ \\ + ]" }
 } ;
 
 { literalize curry <wrapper> POSTPONE: \ POSTPONE: W{ } related-words

core/sequences/sequences-docs.factor

@@ -288,8 +288,8 @@ HELP: new-resizable
 { $values { "len" "a non-negative integer" } { "seq" sequence } { "newseq" "a resizable mutable sequence" } }
 { $contract "Outputs a resizable mutable sequence with an initial capacity of " { $snippet "n" } " elements and zero length, which can hold the elements of " { $snippet "seq" } "." }
 { $examples
-    { $example "300 V{ } new-resizable ." "V{ }" }
+    { $example "USING: prettyprint sequences ;" "300 V{ } new-resizable ." "V{ }" }
-    { $example "300 SBUF\" \" new-resizable ." "SBUF\" \"" }
+    { $example "USING: prettyprint sequences ;" "300 SBUF\" \" new-resizable ." "SBUF\" \"" }
 } ;
 
 HELP: like
@@ -435,14 +435,16 @@ HELP: reduce
 { $values { "seq" sequence } { "identity" object } { "quot" "a quotation with stack effect " { $snippet "( prev elt -- next )" } } { "result" "the final result" } }
 { $description "Combines successive elements of the sequence using a binary operation, and outputs 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." }
 { $examples
-    { $example "{ 1 5 3 } 0 [ + ] reduce ." "9" }
+    { $example "USING: math prettyprint sequences ;" "{ 1 5 3 } 0 [ + ] reduce ." "9" }
 } ;
 
 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. Given the empty sequence, outputs a one-element sequence consisting of " { $snippet "identity" } "." }
+{ $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."
+$nl
+"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." }
 { $examples
-    { $example "{ 2 2 2 2 2 } 0 [ + ] accumulate . ." "{ 0 2 4 6 8 }\n10" }
+    { $example "USING: math prettyprint sequences ;" "{ 2 2 2 2 2 } 0 [ + ] accumulate . ." "{ 0 2 4 6 8 }\n10" }
 } ;
 
 HELP: map
@@ -546,9 +548,9 @@ HELP: monotonic?
 { $description "Applies the relation to successive pairs of elements in the sequence, testing for a truth value. The relation should be a transitive relation, such as a total order or an equality relation." }
 { $examples
     "Testing if a sequence is non-decreasing:"
-    { $example "{ 1 1 2 } [ <= ] monotonic? ." "t" }
+    { $example "USING: math prettyprint sequences ;" "{ 1 1 2 } [ <= ] monotonic? ." "t" }
     "Testing if a sequence is decreasing:"
-    { $example "{ 9 8 6 7 } [ < ] monotonic? ." "f" }
+    { $example "USING: math prettyprint sequences ;" "{ 9 8 6 7 } [ < ] monotonic? ." "f" }
 } ;
 
 { monotonic? all-eq? all-equal? } related-words
@@ -556,7 +558,7 @@ HELP: monotonic?
 HELP: interleave
 { $values { "seq" sequence } { "between" "a quotation" } { "quot" "a quotation with stack effect " { $snippet "( elt -- )" } } }
 { $description "Applies " { $snippet "quot" } " to each element in turn, also invoking " { $snippet "between" } " in-between each pair of elements." }
-{ $example "{ \"a\" \"b\" \"c\" } [ \"X\" write ] [ write ] interleave" "aXbXc" } ;
+{ $example "USING: io sequences ;" "{ \"a\" \"b\" \"c\" } [ \"X\" write ] [ write ] interleave" "aXbXc" } ;
 
 HELP: cache-nth
 { $values { "i" "a non-negative integer" } { "seq" "a mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( i -- elt )" } } { "elt" object } }
@@ -590,7 +592,7 @@ HELP: memq?
 { $description "Tests if the sequence contains the object." }
 { $examples
     "This word uses identity comparison, so the following will most likely print " { $link f } ":"
-    { $example "\"hello\" { \"hello\" } memq? ." "f" }
+    { $example "USING: prettyprint sequences ;" "\"hello\" { \"hello\" } memq? ." "f" }
 } ;
 
 HELP: remove
@@ -629,6 +631,7 @@ HELP: push-new
 { $description "Removes all elements equal to " { $snippet "elt" } ", and adds " { $snippet "elt" } " at the end of the sequence." }
 { $examples
     { $example
+        "USING: namespaces prettyprint sequences ;"
         "V{ \"beans\" \"salsa\" \"cheese\" } \"v\" set"
         "\"nachos\" \"v\" get push-new"
         "\"salsa\" \"v\" get push-new"
@@ -645,7 +648,7 @@ HELP: add
 { $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the end of " { $snippet "seq" } "." }
 { $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." }
 { $examples
-    { $example "{ 1 2 3 } 4 add ." "{ 1 2 3 4 }" }
+    { $example "USING: prettyprint sequences ;" "{ 1 2 3 } 4 add ." "{ 1 2 3 4 }" }
 } ;
 
 HELP: add*
@@ -653,7 +656,7 @@ HELP: add*
 { $description "Outputs a new sequence obtained by adding " { $snippet "elt" } " at the beginning of " { $snippet "seq" } "." }
 { $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq1" } "." } 
 { $examples
-    { $example "{ 1 2 3 } 0 add* ." "{ 0 1 2 3 }" }
+{ $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 add* ." "{ 0 1 2 3 }" }
 } ;
 
 HELP: seq-diff
@@ -710,7 +713,7 @@ HELP: mismatch
 HELP: flip
 { $values { "matrix" "a sequence of equal-length sequences" } { "newmatrix" "a sequence of equal-length sequences" } }
 { $description "Transposes the matrix; that is, rows become columns and columns become rows." }
-{ $examples { $example "{ { 1 2 3 } { 4 5 6 } } flip ." "{ { 1 4 } { 2 5 } { 3 6 } }" } } ;
+{ $examples { $example "USING: prettyprint sequences ;" "{ { 1 2 3 } { 4 5 6 } } flip ." "{ { 1 4 } { 2 5 } { 3 6 } }" } } ;
 
 HELP: exchange
 { $values { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "seq" "a mutable sequence" } }
@@ -728,12 +731,12 @@ HELP: padding
 HELP: pad-left
 { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } }
 { $description "Outputs a new sequence consisting of " { $snippet "seq" } " padded on the left with enough repetitions of " { $snippet "elt" } " to have the result be of length " { $snippet "n" } "." }
-{ $examples { $example "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-left print ] each" "---ab\n-quux" } } ;
+{ $examples { $example "USING: io sequences ;" "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-left print ] each" "---ab\n-quux" } } ;
 
 HELP: pad-right
 { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } }
 { $description "Outputs a new sequence consisting of " { $snippet "seq" } " padded on the right with enough repetitions of " { $snippet "elt" } " to have the result be of length " { $snippet "n" } "." }
-{ $examples { $example "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-right print ] each" "ab---\nquux-" } } ;
+{ $examples { $example "USING: io sequences ;" "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-right print ] each" "ab---\nquux-" } } ;
 
 HELP: sequence=
 { $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } }
@@ -798,6 +801,7 @@ HELP: <column> ( seq n -- column )
 { $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of" { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." }
 { $examples
     { $example
+        "USING: arrays prettyprint sequences ;"
         "{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } 0 <column> >array ."
         "{ 1 4 7 }"
     }
@@ -813,8 +817,8 @@ HELP: <repetition> ( len elt -- repetition )
 { $values { "len" "a non-negative integer" } { "elt" object } { "repetition" repetition } }
 { $description "Creates a new " { $link repetition } "." }
 { $examples
-    { $example "10 \"X\" <repetition> >array ." "{ \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" }" }
+    { $example "USING: arrays prettyprint sequences ;" "10 \"X\" <repetition> >array ." "{ \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" \"X\" }" }
-    { $example "10 \"X\" <repetition> >array concat ." "\"XXXXXXXXXX\"" }
+    { $example "USING: prettyprint sequences ;" "10 \"X\" <repetition> concat ." "\"XXXXXXXXXX\"" }
 } ;
 HELP: copy
 { $values { "src" sequence } { "i" "an index in " { $snippet "dest" } } { "dst" "a mutable sequence" } }
@@ -936,7 +940,7 @@ HELP: unclip
 { $values { "seq" sequence } { "rest" sequence } { "first" object } }
 { $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first." }
 { $examples
-    { $example "{ 1 2 3 } unclip add ." "{ 2 3 1 }" }
+    { $example "USING: prettyprint sequences ;" "{ 1 2 3 } unclip add ." "{ 2 3 1 }" }
 } ;
 
 HELP: unclip-slice
@@ -966,7 +970,7 @@ HELP: unfold
 { $description "Calls " { $snippet "pred" } " repeatedly. If the predicate yields " { $link f } ", stops, otherwise, calls " { $snippet "quot" } " to yield a value. Values are accumulated and returned in a sequence at the end." }
 { $examples
     "The following example divides a number by two until we reach zero, and accumulates intermediate results:"
-    { $example "1337 [ dup 0 > ] [ 2/ dup ] [ ] unfold nip ." "{ 668 334 167 83 41 20 10 5 2 1 0 }" }
+    { $example "USING: kernel math prettyprint sequences ;" "1337 [ dup 0 > ] [ 2/ dup ] [ ] unfold nip ." "{ 668 334 167 83 41 20 10 5 2 1 0 }" }
     "The " { $snippet "tail" } " quotation is used when the predicate produces more than one output value. In this case, we have to drop this value even if the predicate fails in order for stack inference to calculate a stack effect for the " { $link unfold } " call:"
-    { $unchecked-example "[ 10 random dup 1 > ] [ ] [ drop ] unfold ." "{ 8 2 2 9 }" }
+    { $unchecked-example "USING: kernel prettyprint random sequences ;" "[ 10 random dup 1 > ] [ ] [ drop ] unfold ." "{ 8 2 2 9 }" }
 } ;

core/sequences/sequences.factor

@@ -441,6 +441,9 @@ PRIVATE>
 : memq? ( obj seq -- ? )
     [ eq? ] with contains? ;
 
+: seq-intersect ( seq1 seq2 -- seq1/\seq2 )
+    swap [ member? ] curry subset ;
+
 : remove ( obj seq -- newseq )
     [ = not ] with subset ;
 

core/slots/slots-docs.factor

@@ -68,7 +68,7 @@ HELP: reader-quot
 HELP: slot-reader
 { $class-description "The class of slot reader words." }
 { $examples
-    { $example "USING: classes slots ;" "TUPLE: circle center radius ;" "\\ circle-center slot-reader? ." "t" }
+    { $example "USING: classes prettyprint slots ;" "TUPLE: circle center radius ;" "\\ circle-center slot-reader? ." "t" }
 } ;
 
 HELP: define-reader
@@ -83,7 +83,7 @@ HELP: writer-effect
 HELP: slot-writer
 { $class-description "The class of slot writer words." }
 { $examples
-    { $example "USING: classes slots ;" "TUPLE: circle center radius ;" "\\ set-circle-center slot-writer? ." "t" }
+    { $example "USING: classes prettyprint slots ;" "TUPLE: circle center radius ;" "\\ set-circle-center slot-writer? ." "t" }
 } ;
 
 HELP: define-writer

core/source-files/source-files-docs.factor

@@ -3,16 +3,13 @@ definitions quotations compiler.units ;
 IN: source-files
 
 ARTICLE: "source-files" "Source files"
-"Words in the " { $vocab-link "source-files" } " vocabulary are used to keep track of loaded source files. This is used to implement features such as " { $link refresh-all } "."
+"Words in the " { $vocab-link "source-files" } " vocabulary are used to keep track of loaded source files. This is used to implement " { $link "tools.vocabs" } "."
 $nl
 "The source file database:"
 { $subsection source-files }
 "The class of source files:"
 { $subsection source-file }
-"Testing if a source file has been changed on disk:"
-{ $subsection source-modified? }
 "Words intended for the parser:"
-{ $subsection record-modified }
 { $subsection record-checksum }
 { $subsection record-form }
 { $subsection xref-source }
@@ -34,24 +31,14 @@ HELP: source-file
 { $class-description "Instances retain information about loaded source files, and have the following slots:"
     { $list
         { { $link source-file-path } " - a pathname string." }
-        { { $link source-file-modified } " - the result of " { $link file-modified } " at the time the source file was most recently loaded." }
         { { $link source-file-checksum } " - the CRC32 checksum of the source file's contents at the time it was most recently loaded." }
         { { $link source-file-uses } " - an assoc whose keys are words referenced from this source file's top level form." }
         { { $link source-file-definitions } " - a pair of assocs, containing definitions and classes defined in this source file, respectively" }
     }
 } ;
 
-HELP: source-modified?
-{ $values { "path" "a pathname string" } { "?" "a boolean" } }
-{ $description "Tests if the source file has been modified since it was last loaded. This compares the file's modification time and CRC32 checksum of the file's contents against previously-recorded values." } ;
-
-HELP: record-modified
-{ $values { "source-file" source-file } }
-{ $description "Records the modification time of the source file." } 
-$low-level-note ;
-
 HELP: record-checksum
-{ $values { "source-file" source-file } { "contents" string } }
+{ $values { "source-file" source-file } { "lines" "a sequence of strings" } }
 { $description "Records the CRC32 checksm of the source file's contents." } 
 $low-level-note ;
 
@@ -75,7 +62,7 @@ HELP: record-form
 $low-level-note ;
 
 HELP: reset-checksums
-{ $description "Resets recorded modification times and CRC32 checksums for all loaded source files, creating a checkpoint for " { $link refresh } "." } ;
+{ $description "Resets recorded modification times and CRC32 checksums for all loaded source files, creating a checkpoint for " { $link "tools.vocabs" } "." } ;
 
 HELP: forget-source
 { $values { "path" "a pathname string" } }

core/source-files/source-files.factor

@@ -1,44 +1,25 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays definitions generic assocs kernel math
+USING: arrays definitions generic assocs kernel math namespaces
-namespaces prettyprint sequences strings vectors words
+prettyprint sequences strings vectors words quotations inspector
-quotations inspector io.styles io combinators sorting
+io.styles io combinators sorting splitting math.parser effects
-splitting math.parser effects continuations debugger
+continuations debugger io.files io.crc32 vocabs hashtables
-io.files io.crc32 io.streams.string vocabs
+graphs compiler.units io.encodings.utf8 ;
-hashtables graphs compiler.units io.encodings.utf8 ;
 IN: source-files
 
 SYMBOL: source-files
 
 TUPLE: source-file
 path
-modified checksum
+checksum
 uses definitions ;
 
-: (source-modified?) ( path modified checksum -- ? )
-    pick file-modified rot [ 0 or ] 2apply >
-    [ swap utf8 file-lines lines-crc32 = not ] [ 2drop f ] if ;
-
-: source-modified? ( path -- ? )
-    dup source-files get at [
-        dup source-file-path ?resource-path
-        over source-file-modified
-        rot source-file-checksum
-        (source-modified?)
-    ] [
-        resource-exists?
-    ] ?if ;
-
-: record-modified ( source-file -- )
-    dup source-file-path ?resource-path file-modified
-    swap set-source-file-modified ;
-
 : record-checksum ( lines source-file -- )
-    swap lines-crc32 swap set-source-file-checksum ;
+    >r lines-crc32 r> set-source-file-checksum ;
 
 : (xref-source) ( source-file -- pathname uses )
-    dup source-file-path <pathname> swap source-file-uses
+    dup source-file-path <pathname>
-    [ crossref? ] subset ;
+    swap source-file-uses [ crossref? ] subset ;
 
 : xref-source ( source-file -- )
     (xref-source) crossref get add-vertex ;
@@ -67,9 +48,7 @@ uses definitions ;
 
 : reset-checksums ( -- )
     source-files get [
-        swap ?resource-path dup exists?
+        swap ?resource-path dup exists? [
-        [
-            over record-modified
             utf8 file-lines swap record-checksum
         ] [ 2drop ] if
     ] assoc-each ;
@@ -85,7 +64,7 @@ M: pathname where pathname-string 1 2array ;
 M: pathname forget*
     pathname-string forget-source ;
 
-: rollback-source-file ( source-file -- )
+: rollback-source-file ( file -- )
     dup source-file-definitions new-definitions get [ union ] 2map
     swap set-source-file-definitions ;
 

core/splitting/splitting-docs.factor

@@ -33,7 +33,7 @@ HELP: last-split1
 HELP: split
 { $values { "seq" "a sequence" } { "separators" "a sequence" } { "pieces" "a new array" } }
 { $description "Splits " { $snippet "seq" } " at each occurrence of an element of " { $snippet "separators" } ", and outputs an array of pieces. The pieces do not include the elements along which the sequence was split." }
-{ $examples { $example "USE: splitting" "\"hello world-how are you?\" \" -\" split ." "{ \"hello\" \"world\" \"how\" \"are\" \"you?\" }" } } ;
+{ $examples { $example "USING: prettyprint splitting ;" "\"hello world-how are you?\" \" -\" split ." "{ \"hello\" \"world\" \"how\" \"are\" \"you?\" }" } } ;
 
 HELP: groups
 { $class-description "Instances are virtual sequences whose elements are fixed-length subsequences or slices of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
@@ -51,7 +51,7 @@ HELP: <groups>
 { $description "Outputs a virtual sequence whose elements are subsequences consisting of groups of " { $snippet "n" } " elements from the underlying sequence." }
 { $examples
     { $example
-        "USE: splitting"
+        "USING: arrays kernel prettyprint sequences splitting ;"
         "9 >array 3 <groups> dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }"
     }
 } ;
@@ -61,7 +61,7 @@ HELP: <sliced-groups>
 { $description "Outputs a virtual sequence whose elements are slices consisting of groups of " { $snippet "n" } " elements from the underlying sequence." }
 { $examples
     { $example
-        "USE: splitting"
+        "USING: arrays kernel prettyprint sequences splitting ;"
         "9 >array 3 <sliced-groups>"
         "dup [ reverse-here ] each concat >array ."
         "{ 2 1 0 5 4 3 8 7 6 }"
@@ -90,5 +90,5 @@ HELP: string-lines
 { $values { "str" string } { "seq" "a sequence of strings" } }
 { $description "Splits a string along line breaks." }
 { $examples
-    { $example "USE: splitting" "\"Hello\\r\\nworld\\n\" string-lines ." "{ \"Hello\" \"world\" \"\" }" }
+    { $example "USING: prettyprint splitting ;" "\"Hello\\r\\nworld\\n\" string-lines ." "{ \"Hello\" \"world\" \"\" }" }
 } ;

core/splitting/splitting.factor

@@ -69,12 +69,12 @@ INSTANCE: groups sequence
 : split ( seq separators -- pieces ) [ split, ] { } make ;
 
 : string-lines ( str -- seq )
-    dup [ "\r\n" member? ] contains? [
+    dup "\r\n" seq-intersect empty? [
+        1array
+    ] [
         "\n" split [
             1 head-slice* [
                 "\r" ?tail drop "\r" split
             ] map
         ] keep peek "\r" split add concat
-    ] [
-        1array
     ] if ;

core/syntax/syntax-docs.factor

@@ -204,7 +204,7 @@ HELP: delimiter
 HELP: parsing
 { $syntax ": foo ... ; parsing" }
 { $description "Declares the most recently defined word as a parsing word." }
-{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example ": hello \"Hello parser!\" print ; parsing\n: world hello ;" "Hello parser!" } } ;
+{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "<< : hello \"Hello parser!\" print ; parsing >>\n: world hello ;" "Hello parser!" } } ;
 
 HELP: inline
 { $syntax ": foo ... ; inline" }
@@ -367,7 +367,7 @@ HELP: SYMBOL:
 { $syntax "SYMBOL: word" }
 { $values { "word" "a new word to define" } }
 { $description "Defines a new symbol word in the current vocabulary. Symbols push themselves on the stack when executed, and are used to identify variables (see " { $link "namespaces" } ") as well as for storing crufties in word properties (see " { $link "word-props" } ")." }
-{ $examples { $example "SYMBOL: foo\nfoo ." "foo" } } ;
+{ $examples { $example "USE: prettyprint" "SYMBOL: foo\nfoo ." "foo" } } ;
 
 { define-symbol POSTPONE: SYMBOL: } related-words
 
@@ -424,19 +424,19 @@ HELP: "
 { $syntax "\"string...\"" }
 { $values { "string" "literal and escaped characters" } }
 { $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", and appends the resulting string to the parse tree. String literals cannot span multiple lines. Strings containing the " { $link POSTPONE: " } " character and various other special characters can be read by inserting escape sequences." }
-{ $examples { $example "\"Hello\\nworld\" print" "Hello\nworld" } } ;
+{ $examples { $example "USE: io" "\"Hello\\nworld\" print" "Hello\nworld" } } ;
 
 HELP: SBUF"
 { $syntax "SBUF\" string... \"" }
 { $values { "string" "literal and escaped characters" } }
 { $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", converts the string to a string buffer, and appends it to the parse tree." }
-{ $examples { $example "SBUF\" Hello world\" >string print" "Hello world" } } ;
+{ $examples { $example "USING: io strings ;" "SBUF\" Hello world\" >string print" "Hello world" } } ;
 
 HELP: P"
 { $syntax "P\" pathname\"" }
 { $values { "pathname" "a pathname string" } }
 { $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", creates a new " { $link pathname } ", and appends it to the parse tree." }
-{ $examples { $example "USE: io.files" "P\" foo.txt\" pathname-string print" "foo.txt" } } ;
+{ $examples { $example "USING: io io.files ;" "P\" foo.txt\" pathname-string print" "foo.txt" } } ;
 
 HELP: (
 { $syntax "( inputs -- outputs )" }
@@ -460,19 +460,19 @@ HELP: HEX:
 { $syntax "HEX: integer" }
 { $values { "integer" "hexadecimal digits (0-9, a-f, A-F)" } }
 { $description "Adds an integer read from a hexadecimal literal to the parse tree." }
-{ $examples { $example "HEX: ff ." "255" } } ;
+{ $examples { $example "USE: prettyprint" "HEX: ff ." "255" } } ;
 
 HELP: OCT:
 { $syntax "OCT: integer" }
 { $values { "integer" "octal digits (0-7)" } }
 { $description "Adds an integer read from an octal literal to the parse tree." }
-{ $examples { $example "OCT: 31337 ." "13023" } } ;
+{ $examples { $example "USE: prettyprint" "OCT: 31337 ." "13023" } } ;
 
 HELP: BIN:
 { $syntax "BIN: integer" }
 { $values { "integer" "binary digits (0 and 1)" } }
 { $description "Adds an integer read from an binary literal to the parse tree." }
-{ $examples { $example "BIN: 100 ." "4" } } ;
+{ $examples { $example "USE: prettyprint" "BIN: 100 ." "4" } } ;
 
 HELP: GENERIC:
 { $syntax "GENERIC: word" }
@@ -500,6 +500,7 @@ HELP: HOOK:
 { $description "Defines a new hook word in the current vocabulary. Hook words are generic words which dispatch on the value of a variable, so methods are defined with " { $link POSTPONE: M: } ". Hook words differ from other generic words in that the dispatch value is removed from the stack before the chosen method is called." }
 { $examples
     { $example
+        "USING: io namespaces ;"
         "SYMBOL: transport"
         "TUPLE: land-transport ;"
         "TUPLE: air-transport ;"

core/system/system-docs.factor

@@ -15,10 +15,6 @@ ARTICLE: "os" "System interface"
 { $subsection wince? }
 "Processor detection:"
 { $subsection cpu }
-"Processor cell size:"
-{ $subsection cell }
-{ $subsection cells }
-{ $subsection cell-bits }
 "Reading environment variables:"
 { $subsection os-env }
 { $subsection os-envs }
@@ -114,7 +110,15 @@ HELP: os-envs
 }
 { $errors "Windows CE has no concept of environment variables, so this word throws an error there." } ;
 
-{ os-env os-envs } related-words
+HELP: set-os-envs
+{ $values { "assoc" "an association mapping strings to strings" } }
+{ $description "Replaces the current set of environment variables." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+}
+{ $errors "Windows CE has no concept of environment variables, so this word throws an error there." } ;
+
+{ os-env os-envs set-os-envs } related-words
 
 HELP: win32?
 { $values { "?" "a boolean" } }
@@ -135,27 +139,3 @@ HELP: vm
 HELP: unix?
 { $values { "?" "a boolean" } }
 { $description "Tests if Factor is running on a Unix-like system. While this is a rather vague notion, one can use it to make certain assumptions about system calls and file structure which are not valid on Windows." } ;
-
-HELP: cell
-{ $values { "n" "a positive integer" } }
-{ $description "Outputs the pointer size in bytes of the current CPU architecture." } ;
-
-HELP: cells
-{ $values { "m" integer } { "n" integer } }
-{ $description "Computes the number of bytes used by " { $snippet "m" } " CPU operand-sized cells." } ;
-
-HELP: cell-bits
-{ $values { "n" integer } }
-{ $description "Outputs the number of bits in one CPU operand-sized cell." } ;
-
-HELP: bootstrap-cell
-{ $values { "n" "a positive integer" } }
-{ $description "Outputs the pointer size in bytes for the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
-
-HELP: bootstrap-cells
-{ $values { "m" integer } { "n" integer } }
-{ $description "Computes the number of bytes used by " { $snippet "m" } " cells in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;
-
-HELP: bootstrap-cell-bits
-{ $values { "n" integer } }
-{ $description "Outputs the number of bits in one cell in the target image (if bootstrapping) or the current CPU architecture (otherwise)." } ;

core/system/system-tests.factor

@@ -1,9 +1,6 @@
 USING: math tools.test system prettyprint namespaces kernel ;
 IN: system.tests
 
-[ t ] [ cell integer? ] unit-test
-[ t ] [ bootstrap-cell integer? ] unit-test
-
 wince? [
     [ ] [ os-envs . ] unit-test
 ] unless

core/system/system.factor

@@ -2,13 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: system
 USING: kernel kernel.private sequences math namespaces
-splitting assocs system.private ;
+splitting assocs system.private layouts ;
-
-: cell ( -- n ) 7 getenv ; foldable
-
-: cells ( m -- n ) cell * ; inline
-
-: cell-bits ( -- n ) 8 cells ; inline
 
 : cpu ( -- cpu ) 8 getenv ; foldable
 
@@ -51,12 +45,6 @@ splitting assocs system.private ;
 : solaris? ( -- ? )
     os "solaris" = ;
 
-: bootstrap-cell \ cell get cell or ; inline
-
-: bootstrap-cells bootstrap-cell * ; inline
-
-: bootstrap-cell-bits 8 bootstrap-cells ; inline
-
 : os-envs ( -- assoc )
     (os-envs) [ "=" split1 ] H{ } map>assoc ;
 

core/threads/threads-docs.factor

@@ -73,8 +73,10 @@ HELP: self
 { $description "Pushes the currently-running thread." } ;
 
 HELP: <thread>
-{ $values { "quot" quotation } { "name" string } { "error-handler" quotation } }
+{ $values { "quot" quotation } { "name" string } { "thread" thread } }
-{ $description "Low-level thread constructor. The thread runs the quotation when spawned; the name is simply used to identify the thread for debugging purposes. The error handler is called if the thread's quotation throws an unhandled error; it should either print the error or notify another thread." }
+{ $description "Low-level thread constructor. The thread runs the quotation when spawned."
+$nl
+"The name is used to identify the thread for debugging purposes; see " { $link "tools.threads" } "." }
 { $notes "In most cases, user code should call " { $link spawn } " instead, however for control over the error handler quotation, threads can be created with " { $link <thread> } " then passed to " { $link (spawn) } "." } ;
 
 HELP: run-queue
@@ -96,7 +98,7 @@ HELP: sleep-queue
 { $var-description "A " { $link min-heap } " storing the queue of sleeping threads." } ;
 
 HELP: sleep-time
-{ $values { "ms" "a non-negative integer or " { $link f } } }
+{ $values { "ms/f" "a non-negative integer or " { $link f } } }
 { $description "Outputs the time until the next sleeping thread is scheduled to wake up, which could be zero if there are threads in the run queue, or threads which need to wake up right now. If there are no runnable or sleeping threads, outputs " { $link f } "." } ;
 
 HELP: stop
@@ -122,11 +124,15 @@ HELP: interrupt
 { $description "Interrupts a sleeping thread." } ;
 
 HELP: suspend
-{ $values { "quot" "a quotation with stack effect " { $snippet "( thread -- )" } } { "obj" object } }
+{ $values { "quot" "a quotation with stack effect " { $snippet "( thread -- )" } } { "state" string } { "obj" object } }
-{ $description "Suspends the current thread and passes it to the quotation. After the quotation returns, control yields to the next runnable thread and the current thread does not execute again until it is resumed, and so the quotation must arrange for another thread to later resume the suspended thread with a call to " { $link resume } " or " { $link resume-with } "." } ;
+{ $description "Suspends the current thread and passes it to the quotation."
+$nl
+"After the quotation returns, control yields to the next runnable thread and the current thread does not execute again until it is resumed, and so the quotation must arrange for another thread to later resume the suspended thread with a call to " { $link resume } " or " { $link resume-with } "."
+$nl
+"The status string is for debugging purposes; see " { $link "tools.threads" } "." } ;
 
 HELP: spawn
-{ $values { "quot" quotation } { "name" string } }
+{ $values { "quot" quotation } { "name" string } { "thread" thread } }
 { $description "Spawns a new thread. The thread begins executing the given quotation; the name is for debugging purposes. The new thread begins running immediately and the current thread is added to the end of the run queue."
 $nl
 "The new thread begins with an empty data stack, an empty retain stack, and an empty catch stack. The name stack is inherited from the parent thread but may be cleared with " { $link init-namespaces } "." }
@@ -138,7 +144,7 @@ $nl
 } ;
 
 HELP: spawn-server
-{ $values { "quot" "a quotation with stack effect " { $snippet "( -- ? )" } } { "name" string } }
+{ $values { "quot" "a quotation with stack effect " { $snippet "( -- ? )" } } { "name" string } { "thread" thread } }
 { $description "Convenience wrapper around " { $link spawn } " which repeatedly calls the quotation in a new thread until it outputs " { $link f } "." }
 { $examples
     "A thread that runs forever:"

core/tuples/tuples-docs.factor

@@ -180,6 +180,7 @@ HELP: construct-empty
 { $description "Creates a new instance of " { $snippet "class" } " with all slots initially set to " { $link f } "." }
 { $examples
     { $example
+        "USING: kernel prettyprint ;"
         "TUPLE: employee number name department ;"
         "employee construct-empty ."
         "T{ employee f f f f }"

core/vectors/vectors.factor

@@ -5,7 +5,7 @@ IN: vectors
 
 <PRIVATE
 
-: array>vector ( byte-array capacity -- byte-vector )
+: array>vector ( array length -- vector )
     vector construct-boa ; inline
 
 PRIVATE>

core/vocabs/loader/loader-docs.factor

@@ -23,9 +23,6 @@ $nl
 "Application vocabularies can define a main entry point, giving the user a convenient way to run the application:"
 { $subsection POSTPONE: MAIN: }
 { $subsection run }
-"Reloading source files changed on disk:"
-{ $subsection refresh }
-{ $subsection refresh-all }
 { $see-also "vocabularies" "parser-files" "source-files" } ;
 
 ABOUT: "vocabs.loader"
@@ -42,20 +39,12 @@ HELP: vocab-main
 HELP: vocab-roots
 { $var-description "A sequence of pathname strings to search for vocabularies." } ;
 
-HELP: vocab-tests
-{ $values { "vocab" "a vocabulary specifier" } { "tests" "a sequence of pathname strings" } }
-{ $description "Outputs a sequence of pathnames where the unit tests for " { $snippet "vocab" } " are located." } ;
-
 HELP: find-vocab-root
 { $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string" } }
 { $description "Searches for a vocabulary in the vocabulary roots." } ;
 
 { vocab-root find-vocab-root } related-words
 
-HELP: vocab-files
-{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
-{ $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
-
 HELP: no-vocab
 { $values { "name" "a vocabulary name" } } 
 { $description "Throws a " { $link no-vocab } "." }
@@ -65,12 +54,12 @@ HELP: load-help?
 { $var-description "If set to a true value, documentation will be automatically loaded when vocabularies are loaded. This variable is usually on, except when Factor has been bootstrapped without the help system." } ;
 
 HELP: load-source
-{ $values { "root" "a pathname string" } { "name" "a vocabulary name" } }
+{ $values { "vocab" "a vocabulary specifier" } }
-{ $description "Loads a vocabulary's source code from the specified vocabulary root." } ;
+{ $description "Loads a vocabulary's source code." } ;
 
 HELP: load-docs
-{ $values { "root" "a pathname string" } { "name" "a vocabulary name" } }
+{ $values { "vocab" "a vocabulary specifier" } }
-{ $description "If " { $link load-help? } " is on, loads a vocabulary's documentation from the specified vocabulary root." } ;
+{ $description "If " { $link load-help? } " is on, loads a vocabulary's documentation." } ;
 
 HELP: reload
 { $values { "name" "a vocabulary name" } }
@@ -80,7 +69,7 @@ HELP: reload
 HELP: require
 { $values { "vocab" "a vocabulary specifier" } }
 { $description "Loads a vocabulary if it has not already been loaded." }
-{ $notes "To unconditionally reload a vocabulary, use " { $link reload } ". To reload changed source files, use " { $link refresh } " or " { $link refresh-all } "." } ;
+{ $notes "To unconditionally reload a vocabulary, use " { $link reload } ". To reload changed source files only, use the words in " { $link "tools.vocabs" } "." } ;
 
 HELP: run
 { $values { "vocab" "a vocabulary specifier" } }
@@ -93,12 +82,3 @@ HELP: vocab-source-path
 HELP: vocab-docs-path
 { $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string or " { $link f } } }
 { $description "Outputs a pathname where the documentation for " { $snippet "vocab" } " might be found. Outputs " { $link f } " if the vocabulary does not have a directory on disk." } ;
-
-HELP: refresh
-{ $values { "prefix" string } }
-{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
-
-HELP: refresh-all
-{ $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
-
-{ refresh refresh-all } related-words

core/vocabs/loader/loader-tests.factor

@@ -3,7 +3,7 @@ IN: vocabs.loader.tests
 USING: vocabs.loader tools.test continuations vocabs math
 kernel arrays sequences namespaces io.streams.string
 parser source-files words assocs tuples definitions
-debugger compiler.units ;
+debugger compiler.units tools.vocabs ;
 
 ! This vocab should not exist, but just in case...
 [ ] [

core/vocabs/loader/loader.factor

@@ -48,34 +48,13 @@ M: string vocab-root
 M: vocab-link vocab-root
     vocab-link-root ;
 
-: vocab-tests ( vocab -- tests )
-    dup vocab-root [
-        [
-            f >vocab-link dup
-
-            dup "-tests.factor" vocab-dir+ vocab-path+
-            dup resource-exists? [ , ] [ drop ] if
-
-            dup vocab-dir "tests" path+ vocab-path+ dup
-            ?resource-path directory keys [ ".factor" tail? ] subset
-            [ path+ , ] with each
-        ] { } make
-    ] [ drop f ] if ;
-
-: vocab-files ( vocab -- seq )
-    f >vocab-link [
-        dup vocab-source-path [ , ] when*
-        dup vocab-docs-path [ , ] when*
-        vocab-tests %
-    ] { } make ;
-
 SYMBOL: load-help?
 
 : source-was-loaded t swap set-vocab-source-loaded? ;
 
 : source-wasn't-loaded f swap set-vocab-source-loaded? ;
 
-: load-source ( vocab-link -- )
+: load-source ( vocab -- )
     [ source-wasn't-loaded ] keep
     [ vocab-source-path bootstrap-file ] keep
     source-was-loaded ;
@@ -84,7 +63,7 @@ SYMBOL: load-help?
 
 : docs-weren't-loaded f swap set-vocab-docs-loaded? ;
 
-: load-docs ( vocab-link -- )
+: load-docs ( vocab -- )
     load-help? get [
         [ docs-weren't-loaded ] keep
         [ vocab-docs-path ?run-file ] keep
@@ -119,68 +98,7 @@ SYMBOL: load-help?
         "To define one, refer to \\ MAIN: help" print
     ] ?if ;
 
-: modified ( seq quot -- seq )
-    [ dup ] swap compose { } map>assoc
-    [ nip ] assoc-subset
-    [ nip source-modified? ] assoc-subset keys ; inline
-
-: modified-sources ( vocabs -- seq )
-    [ vocab-source-path ] modified ;
-
-: modified-docs ( vocabs -- seq )
-    [ vocab-docs-path ] modified ;
-
-: update-roots ( vocabs -- )
-    [ dup find-vocab-root swap vocab set-vocab-root ] each ;
-
-: to-refresh ( prefix -- modified-sources modified-docs )
-    child-vocabs
-    dup update-roots
-    dup modified-sources swap modified-docs ;
-
-: vocab-heading. ( vocab -- )
-    nl
-    "==== " write
-    dup vocab-name swap vocab write-object ":" print
-    nl ;
-
-: load-error. ( triple -- )
-    dup first vocab-heading.
-    dup second print-error
-    drop ;
-
-: load-failures. ( failures -- )
-    [ load-error. nl ] each ;
-
 SYMBOL: blacklist
-SYMBOL: failures
-
-: require-all ( vocabs -- failures )
-    [
-        V{ } clone blacklist set
-        V{ } clone failures set
-        [
-            [ require ]
-            [ swap vocab-name failures get set-at ]
-            recover
-        ] each
-        failures get
-    ] with-compiler-errors ;
-
-: do-refresh ( modified-sources modified-docs -- )
-    2dup
-    [ f swap set-vocab-docs-loaded? ] each
-    [ f swap set-vocab-source-loaded? ] each
-    append prune require-all load-failures. ;
-
-: refresh ( prefix -- ) to-refresh do-refresh ;
-
-SYMBOL: sources-changed?
-
-[ t sources-changed? set-global ] "vocabs.loader" add-init-hook
-
-: refresh-all ( -- )
-    "" refresh f sources-changed? set-global ;
 
 GENERIC: (load-vocab) ( name -- vocab )
 

core/words/words-docs.factor

@@ -197,7 +197,7 @@ HELP: execute ( word -- )
 { $values { "word" word } }
 { $description "Executes a word." }
 { $examples
-    { $example ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
+    { $example "USING: kernel io words ;" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
 } ;
 
 HELP: word-props ( word -- props )
@@ -322,7 +322,7 @@ HELP: create
 HELP: constructor-word
 { $values { "name" string } { "vocab" string } { "word" word } }
 { $description "Creates a new word, surrounding " { $snippet "name" } " in angle brackets." }
-{ $examples { $example "\"salmon\" \"scratchpad\" constructor-word ." "<salmon>" } } ;
+{ $examples { $example "USING: prettyprint words ;" "\"salmon\" \"scratchpad\" constructor-word ." "<salmon>" } } ;
 
 HELP: forget-word
 { $values { "word" word } }

extra/alarms/alarms-docs.factor

@@ -9,7 +9,7 @@ HELP: add-alarm
 { $description "Creates and registers an alarm. If " { $snippet "frequency" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency. The quotation will be called from the alarm thread." } ;
 
 HELP: later
-{ $values { "quot" quotation } { "time" duration } { "alarm" alarm } }
+{ $values { "quot" quotation } { "dt" duration } { "alarm" alarm } }
 { $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } { $link from-now } "." } ;
 
 HELP: cancel-alarm

extra/alarms/alarms-tests.factor

@@ -1,6 +1,6 @@
 IN: alarms.tests
-USING: alarms kernel calendar sequences tools.test threads
+USING: alarms alarms.private kernel calendar sequences
-concurrency.count-downs ;
+tools.test threads concurrency.count-downs ;
 
 [ ] [
     1 <count-down>
@@ -15,3 +15,5 @@ concurrency.count-downs ;
         [ resume ] curry instant later drop
     ] "test" suspend drop
 ] unit-test
+
+\ alarm-thread-loop must-infer

extra/alarms/alarms.factor

@@ -38,7 +38,7 @@ SYMBOL: alarm-thread
 
 : call-alarm ( alarm -- )
     dup alarm-entry box> drop
-    dup alarm-quot try
+    dup alarm-quot "Alarm execution" spawn drop
     dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
 
 : (trigger-alarms) ( alarms now -- )
@@ -62,8 +62,7 @@ SYMBOL: alarm-thread
 : alarm-thread-loop ( -- )
     alarms get-global
     dup next-alarm sleep-until
-    dup trigger-alarms
+    trigger-alarms ;
-    alarm-thread-loop ;
 
 : cancel-alarms ( alarms -- )
     [
@@ -72,7 +71,7 @@ SYMBOL: alarm-thread
 
 : init-alarms ( -- )
     alarms global [ cancel-alarms <min-heap> ] change-at
-    [ alarm-thread-loop ] "Alarms" spawn
+    [ alarm-thread-loop t ] "Alarms" spawn-server
     alarm-thread set-global ;
 
 [ init-alarms ] "alarms" add-init-hook

extra/benchmark/benchmark.factor

@@ -1,28 +1,28 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel vocabs vocabs.loader tools.time tools.browser
+USING: kernel vocabs vocabs.loader tools.time tools.vocabs
 arrays assocs io.styles io help.markup prettyprint sequences
-continuations debugger ;
+continuations debugger combinators.cleave ;
 IN: benchmark
 
 : run-benchmark ( vocab -- result )
-  [ dup require [ run ] benchmark ] [ error. drop f f ] recover 2array ;
+  [ [ require ] [ [ run ] benchmark nip ] bi ] curry
+  [ error. f ] recover ;
 
 : run-benchmarks ( -- assoc )
-  "benchmark" all-child-vocabs values concat [ vocab-name ] map
+  "benchmark" all-child-vocabs-seq
   [ dup run-benchmark ] { } map>assoc ;
 
 : benchmarks. ( assoc -- )
     standard-table-style [
         [
             [ "Benchmark" write ] with-cell
-            [ "Run time (ms)" write ] with-cell
+            [ "Time (ms)" write ] with-cell
-            [ "GC time (ms)" write ] with-cell
         ] with-row
         [
             [
-                swap [ dup ($vocab-link) ] with-cell
+                [ [ 1array $vocab-link ] with-cell ]
-                first2 pprint-cell pprint-cell
+                [ pprint-cell ] bi*
             ] with-row
         ] assoc-each
     ] tabular-output ;

extra/benchmark/crc32/crc32.factor

@@ -1,10 +1,10 @@
-USING: io.crc32 io.files kernel math ;
+USING: io.crc32 io.encodings.ascii io.files kernel math ;
 IN: benchmark.crc32
 
 : crc32-primes-list ( -- )
     10 [
         "extra/math/primes/list/list.factor" resource-path
-        file-contents crc32 drop
+        ascii file-contents crc32 drop
     ] times ;
 
 MAIN: crc32-primes-list

extra/benchmark/fasta/fasta.factor

@@ -51,7 +51,7 @@ HINTS: random fixnum ;
     dup keys >byte-array
     swap values >float-array unclip [ + ] accumulate swap add ;
 
-:: select-random ( seed chars floats -- elt )
+:: select-random ( seed chars floats -- seed elt )
     floats seed random -rot
     [ >= ] curry find drop
     chars nth-unsafe ; inline
@@ -71,7 +71,7 @@ HINTS: random fixnum ;
     write-description
     [ make-random-fasta ] 2curry split-lines ; inline
 
-:: make-repeat-fasta ( k len alu -- )
+:: make-repeat-fasta ( k len alu -- k' )
     [let | kn [ alu length ] |
         len [ k + kn mod alu nth-unsafe ] B{ } map-as print
         k len +

extra/benchmark/mandel/mandel.factor

@@ -1,7 +1,7 @@
 IN: benchmark.mandel
-USING: arrays io kernel math namespaces sequences strings sbufs
+USING: arrays io kernel math namespaces sequences
-math.functions math.parser io.files colors.hsv
+byte-arrays byte-vectors math.functions math.parser io.files
-io.encodings.ascii ;
+colors.hsv io.encodings.binary ;
 
 : max-color 360 ; inline
 : zoom-fact 0.8 ; inline
@@ -54,18 +54,18 @@ SYMBOL: cols
 : ppm-header ( w h -- )
     "P6\n" % swap # " " % # "\n255\n" % ;
 
-: sbuf-size width height * 3 * 100 + ;
+: buf-size width height * 3 * 100 + ;
 
-: mandel ( -- string )
+: mandel ( -- data )
     [
-        sbuf-size <sbuf> building set
+        buf-size <byte-vector> building set
         width height ppm-header
         nb-iter max-color min <color-map> cols set
         render
-        building get >string
+        building get >byte-array
     ] with-scope ;
 
 : mandel-main ( -- )
-    mandel "mandel.ppm" temp-file ascii set-file-contents ;
+    mandel "mandel.ppm" temp-file binary set-file-contents ;
 
 MAIN: mandel-main

extra/benchmark/random/random.factor

@@ -1,10 +1,10 @@
-USING: io.files random math.parser io math ;
+USING: io.files io.encodings.ascii random math.parser io math ;
 IN: benchmark.random
 
 : random-numbers-path "random-numbers.txt" temp-file ;
 
 : write-random-numbers ( n -- )
-    random-numbers-path [
+    random-numbers-path ascii [
         [ 200 random 100 - number>string print ] times
     ] with-file-writer ;
 

extra/benchmark/raytracer/raytracer.factor

@@ -3,7 +3,7 @@
 
 USING: float-arrays compiler generic io io.files kernel math
 math.functions math.vectors math.parser namespaces sequences
-sequences.private words io.encodings.ascii ;
+sequences.private words io.encodings.binary ;
 IN: benchmark.raytracer
 
 ! parameters
@@ -167,9 +167,9 @@ DEFER: create ( level c r -- scene )
     levels { 0.0 -1.0 0.0 } 1.0 create ray-trace [
         size size pgm-header
         [ [ oversampling sq / pgm-pixel ] each ] each
-    ] "" make ;
+    ] B{ } make ;
 
 : raytracer-main
-    run "raytracer.pnm" temp-file ascii set-file-contents ;
+    run "raytracer.pnm" temp-file binary set-file-contents ;
 
 MAIN: raytracer-main

extra/benchmark/sort/sort.factor

@@ -1,8 +1,10 @@
 USING: kernel sequences sorting benchmark.random math.parser
-io.files ;
+io.files io.encodings.ascii ;
 IN: benchmark.sort
 
 : sort-benchmark
-    random-numbers-path file-lines [ string>number ] map natural-sort drop ;
+    random-numbers-path
+    ascii file-lines [ string>number ] map
+    natural-sort drop ;
 
 MAIN: sort-benchmark

extra/bootstrap/tools/tools.factor

@@ -11,5 +11,7 @@ USING: vocabs.loader sequences ;
     "tools.test"
     "tools.time"
     "tools.threads"
+    "tools.vocabs"
+    "tools.vocabs.browser"
     "editors"
 } [ require ] each

extra/builder/builder.factor

@@ -164,7 +164,7 @@ SYMBOL: builder-recipients
     builder-recipients get  >>to
     subject                 >>subject
     "./report" file>string >>body
-  send ;
+  send-email ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/builder/test/test.factor

@@ -4,7 +4,7 @@ USING: kernel namespaces sequences assocs builder continuations
        io
        io.files
        prettyprint
-       tools.browser
+       tools.vocabs
        tools.test
        io.encodings.utf8
        combinators.cleave

extra/bunny/deploy.factor

@@ -1,12 +1,14 @@
 USING: tools.deploy.config ;
-V{
+H{
+    { deploy-math? t }
+    { deploy-reflection 1 }
+    { deploy-name "Bunny" }
+    { deploy-threads? t }
+    { deploy-word-props? f }
+    { "stop-after-last-window?" t }
     { deploy-ui? t }
     { deploy-io 3 }
-    { deploy-reflection 1 }
     { deploy-compiler? t }
-    { deploy-math? t }
+    { deploy-word-defs? f }
-    { deploy-word-props? f }
     { deploy-c-types? f }
-    { "stop-after-last-window?" t }
-    { deploy-name "Bunny" }
 }

extra/bunny/outlined/outlined.factor

@@ -1,7 +1,7 @@
 USING: arrays bunny.model bunny.cel-shaded
 combinators.lib continuations kernel math multiline
 opengl opengl.shaders opengl.framebuffers opengl.gl
-opengl.capabilities sequences ui.gadgets ;
+opengl.capabilities sequences ui.gadgets combinators.cleave ;
 IN: bunny.outlined
 
 STRING: outlined-pass1-fragment-shader-main-source
@@ -177,7 +177,7 @@ TUPLE: bunny-outlined
             [ bunny-outlined-normal-texture [ delete-texture ] when* ]
             [ bunny-outlined-depth-texture  [ delete-texture ] when* ]
             [ f swap set-bunny-outlined-framebuffer-dim ]
-        } call-with
+        } cleave
     ] [ drop ] if ;
 
 : remake-framebuffer-if-needed ( draw -- )
@@ -237,4 +237,4 @@ M: bunny-outlined dispose
         [ bunny-outlined-pass1-program [ delete-gl-program ] when* ]
         [ bunny-outlined-pass2-program [ delete-gl-program ] when* ]
         [ dispose-framebuffer ]
-    } call-with ;
+    } cleave ;

extra/combinators/cleave/cleave-docs.factor

@@ -0,0 +1,82 @@
+
+USING: kernel quotations help.syntax help.markup ;
+
+IN: combinators.cleave
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ARTICLE: "cleave-combinators" "Cleave Combinators"
+
+{ $subsection bi  }
+{ $subsection tri }
+
+{ $notes
+  "From the Merriam-Webster Dictionary: "
+  $nl
+  { $strong "cleave" }
+  { $list
+    { $emphasis "To divide by or as if by a cutting blow" }
+    { $emphasis "To separate into distinct parts and especially into "
+                "groups having divergent views" } }
+  $nl
+  "The Joy programming language has a " { $emphasis "cleave" } " combinator." }
+
+;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: bi
+
+  { $values { "x" object }
+            { "p" quotation }
+            { "q" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(x)" "q applied to x" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: tri
+
+  { $values { "x" object }
+            { "p" quotation }
+            { "q" quotation }
+            { "r" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(x)" "q applied to x" }
+            { "r(x)" "r applied to x" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ARTICLE: "spread-combinators" "Spread Combinators"
+
+{ $subsection bi* }
+{ $subsection tri* } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: bi*
+
+  { $values { "x" object }
+            { "y" object }
+            { "p" quotation }
+            { "q" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(y)" "q applied to y" } } ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+HELP: tri*
+
+  { $values { "x" object }
+            { "y" object }
+            { "z" object }
+            { "p" quotation }
+            { "q" quotation }
+            { "r" quotation }
+          
+            { "p(x)" "p applied to x" }
+            { "q(y)" "q applied to y" }
+            { "r(z)" "r applied to z" } } ;

extra/combinators/cleave/cleave.factor

@@ -7,10 +7,8 @@ IN: combinators.cleave
 ! The cleaver family
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: bi ( obj quot quot -- val val ) >r keep r> call ; inline
+: bi  ( x p q   -- p(x) q(x)      ) >r keep r> call          ; inline
-
+: tri ( x p q r -- p(x) q(x) r(x) ) >r pick >r bi r> r> call ; inline
-: tri ( obj quot quot quot -- val val val )
-  >r pick >r bi r> r> call ; inline
 
 : tetra ( obj quot quot quot quot -- val val val val )
   >r >r pick >r bi r> r> r> bi ; inline
@@ -19,6 +17,9 @@ IN: combinators.cleave
 
 : 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline
 
+: 2tri ( obj obj quot quot quot -- val val val )
+  >r >r 2keep r> 2keep r> call ; inline
+
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 ! General cleave
@@ -39,9 +40,9 @@ MACRO: cleave ( seq -- )
 ! The spread family
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: bi* ( obj obj quot quot -- val val ) >r swap slip r> call ; inline
+: bi* ( x y p q -- p(x) q(y) ) >r swap slip r> call ; inline
 
-: tri* ( obj obj obj quot quot quot -- val val val )
+: tri* ( x y z p q r -- p(x) q(y) r(z) )
   >r rot >r bi* r> r> call ; inline
 
 : tetra* ( obj obj obj obj quot quot quot quot -- val val val val )

extra/combinators/lib/lib-docs.factor

@@ -7,7 +7,7 @@ HELP: generate
 { $description "Loop until the generator quotation generates an object that satisfies predicate quotation." }
 { $unchecked-example
     "! Generate a random 20-bit prime number congruent to 3 (mod 4)"
-    "USE: math.miller-rabin"
+    "USING: combinators.lib math math.miller-rabin prettyprint ;"
     "[ 20 random-prime ] [ 4 mod 3 = ] generate ."
     "526367"
 } ;
@@ -20,8 +20,8 @@ HELP: ndip
 "stack. The quotation can consume and produce any number of items."
 } 
 { $examples
-  { $example "USE: combinators.lib" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" }
+  { $example "USING: combinators.lib kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" }
-  { $example "USE: combinators.lib" "1 2 3 [ drop ] 2 ndip .s" "2\n3" }
+  { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" }
 }
 { $see-also dip dipd } ;
 
@@ -32,7 +32,7 @@ HELP: nslip
 "removed from the stack, the quotation called, and the items restored."
 } 
 { $examples
-  { $example "USE: combinators.lib" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" }
+  { $example "USING: combinators.lib prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" }
 }
 { $see-also slip nkeep } ;
 
@@ -43,7 +43,7 @@ HELP: nkeep
 "saved, the quotation called, and the items restored."
 } 
 { $examples
-  { $example "USE: combinators.lib" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" }
+  { $example "USING: combinators.lib kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" }
 }
 { $see-also keep nslip } ;
 

extra/combinators/lib/lib.factor

@@ -133,9 +133,6 @@ MACRO: parallel-call ( quots -- )
 : (make-call-with) ( quots -- quot ) 
     [ [ keep ] curry ] map concat [ drop ] append ;
 
-MACRO: call-with ( quots -- )
-    (make-call-with) ;
-
 MACRO: map-call-with ( quots -- )
     [ (make-call-with) ] keep length [ narray ] curry compose ;
 
@@ -143,9 +140,6 @@ MACRO: map-call-with ( quots -- )
     [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
     [ 2drop ] append ;
 
-MACRO: call-with2 ( quots -- )
-    (make-call-with2) ;
-
 MACRO: map-call-with2 ( quots -- )
     [ (make-call-with2) ] keep length [ narray ] curry append ;
 

extra/concurrency/distributed/distributed-docs.factor

@@ -2,9 +2,7 @@ USING: help.markup help.syntax concurrency.messaging threads ;
 IN: concurrency.distributed
 
 HELP: local-node
-{ $values { "addrspec" "an address specifier" } 
+{ $var-description "A variable containing the node the current thread is running on." } ;
-}
-{ $description "Return the node the current thread is running on." } ;
 
 HELP: start-node
 { $values { "port" "a port number between 0 and 65535" } }

extra/concurrency/distributed/distributed-tests.factor

@@ -0,0 +1,31 @@
+IN: concurrency.distributed.tests
+USING: tools.test concurrency.distributed kernel io.files
+arrays io.sockets system combinators threads math sequences
+concurrency.messaging ;
+
+: test-node
+    {
+        { [ unix? ] [ "distributed-concurrency-test" temp-file <local> ] }
+        { [ windows? ] [ "127.0.0.1" 1238 <inet4> ] }
+    } cond ;
+
+[ ] [ test-node dup 1array swap (start-node) ] unit-test
+
+[ ] [ yield ] unit-test
+
+[ ] [
+    [
+        receive first2 >r 3 + r> send
+        "thread-a" unregister-process
+    ] "Thread A" spawn
+    "thread-a" swap register-process
+] unit-test
+
+[ 8 ] [
+    5 self 2array
+    "thread-a" test-node <remote-process> send
+
+    receive
+] unit-test
+
+[ ] [ test-node stop-node ] unit-test

extra/concurrency/distributed/distributed.factor

@@ -2,35 +2,46 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: serialize sequences concurrency.messaging
 threads io io.server qualified arrays
-namespaces kernel io.encodings.binary ;
+namespaces kernel io.encodings.binary combinators.cleave
+new-slots accessors ;
 QUALIFIED: io.sockets
 IN: concurrency.distributed
 
-SYMBOL: local-node ( -- addrspec )
+SYMBOL: local-node
 
 : handle-node-client ( -- )
-    deserialize first2 get-process send ;
+    deserialize
+    [ first2 get-process send ]
+    [ stop-server ] if* ;
 
 : (start-node) ( addrspecs addrspec -- )
-    [
     local-node set-global
+    [
         "concurrency.distributed"
-        binary [ handle-node-client ] with-server
+        binary
-    ] 2curry f spawn drop ;
+        [ handle-node-client ] with-server
+    ] curry "Distributed concurrency server" spawn drop ;
 
 : start-node ( port -- )
-    dup internet-server io.sockets:host-name
+    [ internet-server ]
-    rot io.sockets:<inet> (start-node) ;
+    [ io.sockets:host-name swap io.sockets:<inet> ] bi
+    (start-node) ;
 
 TUPLE: remote-process id node ;
 
 C: <remote-process> remote-process
 
+: send-remote-message ( message node -- )
+    binary io.sockets:<client>
+    [ serialize ] with-stream ;
+
 M: remote-process send ( message thread -- )
-    { remote-process-id remote-process-node } get-slots
+    [ id>> 2array ] [ node>> ] bi
-    binary io.sockets:<client> [ 2array serialize ] with-stream ;
+    send-remote-message ;
 
 M: thread (serialize) ( obj -- )
-    thread-id local-node get-global
+    thread-id local-node get-global <remote-process>
-    <remote-process>
     (serialize) ;
+
+: stop-node ( node -- )
+    f swap send-remote-message ;

extra/concurrency/locks/locks-docs.factor

@@ -1,4 +1,5 @@
-USING: help.markup help.syntax sequences kernel quotations ;
+USING: help.markup help.syntax sequences kernel quotations
+calendar ;
 IN: concurrency.locks
 
 HELP: lock
@@ -12,11 +13,15 @@ HELP: <reentrant-lock>
 { $values { "lock" lock } }
 { $description "Creates a reentrant lock." } ;
 
-HELP: with-lock
+HELP: with-lock-timeout
-{ $values { "lock" lock } { "timeout" "a timeout in milliseconds or " { $link f } } { "quot" quotation } }
+{ $values { "lock" lock } { "timeout" "a " { $link duration } " or " { $link f } } { "quot" quotation } }
 { $description "Calls the quotation, ensuring that only one thread executes with the lock held at a time. If another thread is holding the lock, blocks until the thread releases the lock." }
 { $errors "Throws an error if the lock could not be acquired before the timeout expires. A timeout value of " { $link f } " means the thread is willing to wait indefinitely." } ;
 
+HELP: with-lock
+{ $values { "lock" lock } { "quot" quotation } }
+{ $description "Calls the quotation, ensuring that only one thread executes with the lock held at a time. If another thread is holding the lock, blocks until the thread releases the lock." } ;
+
 ARTICLE: "concurrency.locks.mutex" "Mutual-exclusion locks"
 "A mutual-exclusion lock ensures that only one thread executes with the lock held at a time. They are used to protect critical sections so that certain operations appear to be atomic to other threads."
 $nl
@@ -24,21 +29,30 @@ $nl
 { $subsection lock }
 { $subsection <lock> }
 { $subsection <reentrant-lock> }
-{ $subsection with-lock } ;
+{ $subsection with-lock }
+{ $subsection with-lock-timeout } ;
 
 HELP: rw-lock
 { $class-description "The class of reader/writer locks." } ;
 
-HELP: with-read-lock
+HELP: with-read-lock-timeout
-{ $values { "lock" lock } { "timeout" "a timeout in milliseconds or " { $link f } } { "quot" quotation } }
+{ $values { "lock" lock } { "timeout" "a " { $link duration } " or " { $link f } } { "quot" quotation } }
 { $description "Calls the quotation, ensuring that no other thread is holding a write lock at the same time. If another thread is holding a write lock, blocks until the thread releases the lock." }
 { $errors "Throws an error if the lock could not be acquired before the timeout expires. A timeout value of " { $link f } " means the thread is willing to wait indefinitely." } ;
 
-HELP: with-write-lock
+HELP: with-read-lock
-{ $values { "lock" lock } { "timeout" "a timeout in milliseconds or " { $link f } } { "quot" quotation } }
+{ $values { "lock" lock } { "quot" quotation } }
+{ $description "Calls the quotation, ensuring that no other thread is holding a write lock at the same time. If another thread is holding a write lock, blocks until the thread releases the lock." } ;
+
+HELP: with-write-lock-timeout
+{ $values { "lock" lock } { "timeout" "a " { $link duration } " or " { $link f } } { "quot" quotation } }
 { $description "Calls the quotation, ensuring that no other thread is holding a read or write lock at the same time. If another thread is holding a read or write lock, blocks until the thread releases the lock." }
 { $errors "Throws an error if the lock could not be acquired before the timeout expires. A timeout value of " { $link f } " means the thread is willing to wait indefinitely." } ;
 
+HELP: with-write-lock
+{ $values { "lock" lock } { "quot" quotation } }
+{ $description "Calls the quotation, ensuring that no other thread is holding a read or write lock at the same time. If another thread is holding a read or write lock, blocks until the thread releases the lock." } ;
+
 ARTICLE: "concurrency.locks.rw" "Read-write locks"
 "A read-write lock encapsulates a common pattern in the implementation of concurrent data structures, where one wishes to ensure that a thread is able to see a consistent view of the structure for a period of time, during which no other thread modifies the structure."
 $nl
@@ -50,7 +64,10 @@ $nl
 { $subsection rw-lock }
 { $subsection <rw-lock> }
 { $subsection with-read-lock }
-{ $subsection with-write-lock } ;
+{ $subsection with-write-lock }
+"Versions of the above that take a timeout duration:"
+{ $subsection with-read-lock-timeout }
+{ $subsection with-write-lock-timeout } ;
 
 ARTICLE: "concurrency.locks" "Locks"
 "A " { $emphasis "lock" } " is an object protecting a critical region of code, enforcing a particular mutual-exclusion policy. The " { $vocab-link "concurrency.locks" } " vocabulary implements two types of locks:"

extra/concurrency/messaging/messaging-docs.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.syntax help.markup concurrency.messaging.private
-threads kernel arrays quotations ;
+threads kernel arrays quotations threads strings ;
 IN: concurrency.messaging
 
 HELP: send
 { $values { "message" object } 
-          { "thread" "a thread object" } 
+          { "thread" thread } 
 }
 { $description "Send the message to the thread by placing it in the threades mailbox. This is an asynchronous operation and will return immediately. The receving thread will act on the message the next time it retrieves that item from its mailbox (usually using the " { $link receive } " word. The message can be any Factor object. For destinations that are instances of remote-thread the message must be a serializable Factor type." } 
 { $see-also receive receive-if } ;
@@ -26,7 +26,8 @@ HELP: receive-if
 
 HELP: spawn-linked
 { $values { "quot" quotation }
-          { "thread" "a thread object" } 
+          { "name" string }
+          { "thread" thread } 
 }
 { $description "Start a thread which runs the given quotation. If that quotation throws an error which is not caught then the error will get propagated to the thread that spawned it. This can be used to set up 'supervisor' threades that restart child threades that crash due to uncaught errors.\n" } 
 { $see-also spawn } ;

extra/concurrency/messaging/messaging.factor

@@ -7,7 +7,7 @@ USING: kernel threads concurrency.mailboxes continuations
 namespaces assocs random ;
 IN: concurrency.messaging
 
-GENERIC: send ( message process -- )
+GENERIC: send ( message thread -- )
 
 : mailbox-of ( thread -- mailbox )
     dup thread-mailbox [ ] [

extra/concurrency/promises/promises-docs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: concurrency.messaging kernel arrays
-continuations help.markup help.syntax quotations ;
+continuations help.markup help.syntax quotations calendar ;
 IN: concurrency.promises
 
 HELP: promise
@@ -12,12 +12,12 @@ HELP: promise-fulfilled?
 { $description "Tests if " { $link fulfill } " has previously been called on the promise, in which case " { $link ?promise } " will return immediately without blocking." } ;
 
 HELP: ?promise-timeout
-{ $values { "promise" promise } { "timeout" "a timeout in milliseconds or " { $link f } } { "value" object } }
+{ $values { "promise" promise } { "timeout" "a " { $link duration } " or " { $link f } } { "result" object } }
 { $description "Waits for another thread to fulfill a promise, returning immediately if the promise has already been fulfilled. A timeout of " { $link f } " indicates that the thread may block indefinitely, otherwise it will wait up to " { $snippet "timeout" } " milliseconds." }
 { $errors "Throws an error if the timeout expires before the promise has been fulfilled." } ;
 
 HELP: ?promise
-{ $values { "promise" promise } { "value" object } }
+{ $values { "promise" promise } { "result" object } }
 { $description "Waits for another thread to fulfill a promise, returning immediately if the promise has already been fulfilled." } ;
 
 HELP: fulfill

extra/concurrency/semaphores/semaphores-docs.factor

@@ -9,12 +9,12 @@ HELP: <semaphore>
 { $description "Creates a counting semaphore with the specified initial count." } ;
 
 HELP: acquire-timeout
-{ $values { "semaphore" semaphore } { "timeout" "a " { $link duration } " or " { $link f } } { "value" object } }
+{ $values { "semaphore" semaphore } { "timeout" "a " { $link duration } " or " { $link f } } }
 { $description "If the semaphore has a non-zero count, decrements it and returns immediately. Otherwise, if the timeout is " { $link f } ", waits indefinitely for the semaphore to be released. If the timeout is not " { $link f } ", waits a certain period of time, and if the semaphore still has not been released, throws an error." }
 { $errors "Throws an error if the timeout expires before the semaphore is released." } ;
 
 HELP: acquire
-{ $values { "semaphore" semaphore } { "value" object } }
+{ $values { "semaphore" semaphore } }
 { $description "If the semaphore has a non-zero count, decrements it and returns immediately. Otherwise, waits for it to be released." } ;
 
 HELP: release

extra/crypto/common/common-docs.factor

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

extra/crypto/rc4/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

extra/crypto/rc4/rc4.factor

@@ -1,39 +0,0 @@
-USING: kernel math sequences namespaces ;
-IN: crypto.rc4
-
-! http://en.wikipedia.org/wiki/RC4_%28cipher%29
-
-<PRIVATE
-
-SYMBOL: i
-SYMBOL: j
-SYMBOL: s
-SYMBOL: key
-SYMBOL: l
-
-! key scheduling algorithm, initialize s
-: ksa ( -- )
-    256 [ ] map s set
-    0 j set
-    256 [
-        dup s get nth j get + over l get mod key get nth + 255 bitand j set
-        dup j get s get exchange drop
-    ] each ;
-
-: generate ( -- n )
-    i get 1+ 255 bitand i set
-    j get i get s get nth + 255 bitand j set
-    i get j get s get exchange
-    i get s get nth j get s get nth + 255 bitand s get nth ;
-
-PRIVATE>
-
-: rc4 ( key -- )
-    [
-        [ key set ] keep
-        length l set
-        ksa
-        0 i set
-        0 j set
-    ] with-scope ;
-

extra/db/db.factor

@@ -20,8 +20,7 @@ GENERIC: db-open ( db -- )
 HOOK: db-close db ( handle -- )
 : make-db ( seq class -- db ) construct-empty make-db* ;
 
-: dispose-statements ( seq -- )
+: dispose-statements ( seq -- ) [ dispose drop ] assoc-each ;
-    [ dispose drop ] assoc-each ;
 
 : dispose-db ( db -- ) 
     dup db [
@@ -46,8 +45,8 @@ GENERIC: bind-tuple ( tuple statement -- )
 GENERIC: query-results ( query -- result-set )
 GENERIC: #rows ( result-set -- n )
 GENERIC: #columns ( result-set -- n )
-GENERIC# row-column 1 ( result-set n -- obj )
+GENERIC# row-column 1 ( result-set column -- obj )
-GENERIC# row-column-typed 1 ( result-set n -- sql )
+GENERIC# row-column-typed 1 ( result-set column -- sql )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 

extra/db/postgresql/ffi/ffi.factor

@@ -6,7 +6,7 @@ IN: db.postgresql.ffi
 
 << "postgresql" {
     { [ win32? ]  [ "libpq.dll" ] }
-    { [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
+    { [ macosx? ] [ "/opt/local/lib/postgresql82/libpq.dylib" ] }
     { [ unix?  ]  [ "libpq.so" ] }
 } cond "cdecl" add-library >>
 
@@ -270,7 +270,8 @@ FUNCTION: char* PQcmdStatus ( PGresult* res ) ;
 FUNCTION: char* PQoidStatus ( PGresult* res ) ;
 FUNCTION: Oid   PQoidValue ( PGresult* res ) ;
 FUNCTION: char* PQcmdTuples ( PGresult* res ) ;
-FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
+! FUNCTION: char* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
+FUNCTION: void* PQgetvalue ( PGresult* res, int tup_num, int field_num ) ;
 FUNCTION: int   PQgetlength ( PGresult* res, int tup_num, int field_num ) ;
 FUNCTION: int   PQgetisnull ( PGresult* res, int tup_num, int field_num ) ;
 
@@ -297,8 +298,8 @@ FUNCTION: size_t PQescapeStringConn ( PGconn* conn,
 FUNCTION: uchar* PQescapeByteaConn ( PGconn* conn,
                                     char* from, size_t length,
                                     size_t* to_length ) ;
-FUNCTION: uchar* PQunescapeBytea ( uchar* strtext,
+FUNCTION: void* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ;
-                size_t* retbuflen ) ;
+! FUNCTION: uchar* PQunescapeBytea ( uchar* strtext, size_t* retbuflen ) ;
 ! These forms are deprecated!
 FUNCTION: size_t PQescapeString ( void* to, char* from, size_t length ) ;
 FUNCTION: uchar* PQescapeBytea ( uchar* bintext, size_t binlen,
@@ -346,3 +347,23 @@ FUNCTION: int    PQdsplen ( uchar* s, int encoding ) ;
 
 ! Get encoding id from environment variable PGCLIENTENCODING
 FUNCTION: int    PQenv2encoding ( ) ;
+
+! From git, include/catalog/pg_type.h
+: BOOL-OID 16 ; inline
+: BYTEA-OID 17 ; inline
+: CHAR-OID 18 ; inline
+: NAME-OID 19 ; inline
+: INT8-OID 20 ; inline
+: INT2-OID 21 ; inline
+: INT4-OID 23 ; inline
+: TEXT-OID 23 ; inline
+: OID-OID 26 ; inline
+: FLOAT4-OID 700 ; inline
+: FLOAT8-OID 701 ; inline
+: VARCHAR-OID 1043 ; inline
+: DATE-OID 1082 ; inline
+: TIME-OID 1083 ; inline
+: TIMESTAMP-OID 1114 ; inline
+: TIMESTAMPTZ-OID 1184 ; inline
+: INTERVAL-OID 1186 ; inline
+: NUMERIC-OID 1700 ; inline

extra/db/postgresql/lib/lib.factor

@@ -2,7 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays continuations db io kernel math namespaces
 quotations sequences db.postgresql.ffi alien alien.c-types
-db.types tools.walker ascii splitting ;
+db.types tools.walker ascii splitting math.parser
+combinators combinators.cleave libc shuffle calendar.format
+byte-arrays destructors prettyprint new-slots accessors
+strings serialize io.encodings.binary io.streams.byte-array ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -38,13 +41,130 @@ IN: db.postgresql.lib
         dup postgresql-result-error-message swap PQclear throw
     ] unless ;
 
+: type>oid ( symbol -- n )
+    dup array? [ first ] when
+    {
+        { BLOB [ BYTEA-OID ] }
+        { FACTOR-BLOB [ BYTEA-OID ] }
+        [ drop 0 ]
+    } case ;
+
+: type>param-format ( symbol -- n )
+    dup array? [ first ] when
+    {
+        { BLOB [ 1 ] }
+        { FACTOR-BLOB [ 1 ] }
+        [ drop 0 ]
+    } case ;
+
+: param-types ( statement -- seq )
+    statement-in-params
+    [ sql-spec-type type>oid ] map
+    >c-uint-array ;
+
+: malloc-byte-array/length
+    [ malloc-byte-array dup free-always ] [ length ] bi ;
+    
+
+: param-values ( statement -- seq seq2 )
+    [ statement-bind-params ]
+    [ statement-in-params ] bi
+    [
+        sql-spec-type {
+            { FACTOR-BLOB [
+                dup [
+                    binary [ serialize ] with-byte-writer
+                    malloc-byte-array/length ] [ 0 ] if ] }
+            { BLOB [
+                dup [ malloc-byte-array/length ] [ 0 ] if ] }
+            [
+                drop number>string* dup [
+                    malloc-char-string dup free-always
+                ] when 0
+            ]
+        } case 2array
+    ] 2map flip dup empty? [
+        drop f f
+    ] [
+        first2 [ >c-void*-array ] [ >c-uint-array ] bi*
+    ] if ;
+
+: param-formats ( statement -- seq )
+    statement-in-params
+    [ sql-spec-type type>param-format ] map
+    >c-uint-array ;
+
 : do-postgresql-bound-statement ( statement -- res )
+    [
         >r db get db-handle r>
-    [ statement-sql ] keep
+        {
-    [ statement-bind-params length f ] keep
+            [ statement-sql ]
-    statement-bind-params
+            [ statement-bind-params length ]
-    [ number>string* malloc-char-string ] map >c-void*-array
+            [ param-types ]
-    f f 0 PQexecParams
+            [ param-values ]
-    dup postgresql-result-ok? [
+            [ param-formats ]
+        } cleave
+        0 PQexecParams dup postgresql-result-ok? [
             dup postgresql-result-error-message swap PQclear throw
-    ] unless ;
+        ] unless
+    ] with-destructors ;
+
+: pq-get-is-null ( handle row column -- ? )
+    PQgetisnull 1 = ;
+
+: pq-get-string ( handle row column -- obj )
+    3dup PQgetvalue alien>char-string
+    dup "" = [ >r pq-get-is-null f r> ? ] [ 3nip ] if ;
+
+: pq-get-number ( handle row column -- obj )
+    pq-get-string dup [ string>number ] when ;
+
+TUPLE: postgresql-malloc-destructor alien ;
+C: <postgresql-malloc-destructor> postgresql-malloc-destructor
+
+M: postgresql-malloc-destructor dispose ( obj -- )
+    alien>> PQfreemem ;
+
+: postgresql-free-always ( alien -- )
+    <postgresql-malloc-destructor> add-always-destructor ;
+
+: pq-get-blob ( handle row column -- obj/f )
+    [ PQgetvalue ] 3keep 3dup PQgetlength
+    dup 0 > [
+        3nip
+        [
+            memory>byte-array >string
+            0 <uint>
+            [
+                PQunescapeBytea dup zero? [
+                    postgresql-result-error-message throw
+                ] [
+                    dup postgresql-free-always
+                ] if
+            ] keep
+            *uint memory>byte-array
+        ] with-destructors 
+    ] [
+        drop pq-get-is-null nip [ f ] [ B{ } clone ] if
+    ] if ;
+
+: postgresql-column-typed ( handle row column type -- obj )
+    dup array? [ first ] when
+    {
+        { +native-id+ [ pq-get-number ] }
+        { INTEGER [ pq-get-number ] }
+        { BIG-INTEGER [ pq-get-number ] }
+        { DOUBLE [ pq-get-number ] }
+        { TEXT [ pq-get-string ] }
+        { VARCHAR [ pq-get-string ] }
+        { DATE [ pq-get-string dup [ ymd>timestamp ] when ] }
+        { TIME [ pq-get-string dup [ hms>timestamp ] when ] }
+        { TIMESTAMP [ pq-get-string dup [ ymdhms>timestamp ] when ] }
+        { DATETIME [ pq-get-string dup [ ymdhms>timestamp ] when ] }
+        { BLOB [ pq-get-blob ] }
+        { FACTOR-BLOB [
+            pq-get-blob
+            dup [ binary [ deserialize ] with-byte-reader ] when ] }
+        [ no-sql-type ]
+    } case ;
+    ! PQgetlength PQgetisnull

extra/db/postgresql/postgresql-tests.factor

@@ -7,7 +7,7 @@ db.tuples db.types unicode.case ;
 IN: db.postgresql.tests
 
 : test-db ( -- postgresql-db )
-    { "localhost" "postgres" "" "factor-test" } postgresql-db ;
+    { "localhost" "postgres" "foob" "factor-test" } postgresql-db ;
 
 [ ] [ test-db [ ] with-db ] unit-test
 

extra/db/postgresql/postgresql.factor

@@ -4,7 +4,8 @@ USING: arrays assocs alien alien.syntax continuations io
 kernel math math.parser namespaces prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
-combinators sequences.lib classes locals words tools.walker ;
+combinators sequences.lib classes locals words tools.walker
+combinators.cleave namespaces.lib ;
 IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
@@ -53,11 +54,12 @@ M: postgresql-result-set #rows ( result-set -- n )
 M: postgresql-result-set #columns ( result-set -- n )
     result-set-handle PQnfields ;
 
-M: postgresql-result-set row-column ( result-set n -- obj )
+M: postgresql-result-set row-column ( result-set column -- obj )
-    >r dup result-set-handle swap result-set-n r> PQgetvalue ;
+    >r dup result-set-handle swap result-set-n r> pq-get-string ;
 
-M: postgresql-result-set row-column-typed ( result-set n type -- obj )
+M: postgresql-result-set row-column-typed ( result-set column -- obj )
-    >r row-column r> sql-type>factor-type ;
+    dup pick result-set-out-params nth sql-spec-type
+    >r >r [ result-set-handle ] [ result-set-n ] bi r> r> postgresql-column-typed ;
 
 M: postgresql-statement query-results ( query -- result-set )
     dup statement-bind-params [
@@ -236,10 +238,13 @@ M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
 
         " from " 0% 0%
         [ sql-spec-slot-name swap get-slot-named ] with subset
+        dup empty? [
+            drop
+        ] [
             " where " 0%
-        [ ", " 0% ]
+            [ " and " 0% ]
             [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
-        ";" 0%
+        ] if ";" 0%
     ] postgresql-make ;
 
 M: postgresql-db type-table ( -- hash )
@@ -249,7 +254,12 @@ M: postgresql-db type-table ( -- hash )
         { VARCHAR "varchar" }
         { INTEGER "integer" }
         { DOUBLE "real" }
+        { DATE "date" }
+        { TIME "time" }
+        { DATETIME "timestamp" }
         { TIMESTAMP "timestamp" }
+        { BLOB "bytea" }
+        { FACTOR-BLOB "bytea" }
     } ;
 
 M: postgresql-db create-type-table ( -- hash )

extra/db/sql/sql-tests.factor

@@ -1,4 +1,4 @@
-USING: kernel db.sql ;
+USING: kernel namespaces db.sql sequences math ;
 IN: db.sql.tests
 
 TUPLE: person name age ;