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

2008-09-30 18:22:41 -07:00 · 2008-09-30 18:22:41 -07:00 · 52a12c2387
parent 166f5777b5 21c621d464
commit 52a12c2387
546 changed files with 13192 additions and 3483 deletions
--- a/basis/alarms/summary.txt
+++ b/basis/alarms/summary.txt
@ -0,0 +1 @@
+One-time and recurring events
--- a/basis/alias/summary.txt
+++ b/basis/alias/summary.txt
@ -0,0 +1 @@
+Defining multiple words with the same name
--- a/basis/ascii/ascii-docs.factor
+++ b/basis/ascii/ascii-docs.factor
@ -46,6 +46,6 @@ ARTICLE: "ascii" "ASCII character classes"
 { $subsection printable? }
 { $subsection control? }
 { $subsection quotable? }
-"Modern applications should use Unicode 5.0 instead (" { $vocab-link "unicode" } ")." ;
+"Modern applications should use Unicode 5.0 instead (" { $vocab-link "unicode.categories" } ")." ;

 ABOUT: "ascii"
--- a/basis/binary-search/summary.txt
+++ b/basis/binary-search/summary.txt
@ -0,0 +1 @@
+Fast searching of sorted arrays
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@ -26,7 +26,6 @@ IN: bootstrap.image
        "x86.32"
        "x86.64"
        "linux-ppc" "macosx-ppc"
-        ! "arm"
    } ;

 <PRIVATE
@ -412,14 +411,14 @@ M: quotation '
    all-words [ emit-word ] each ;

 : emit-global ( -- )
-    [
-        {
-            dictionary source-files builtins
-            update-map implementors-map class<=-cache
-            class-not-cache classes-intersect-cache class-and-cache
-            class-or-cache
-        } [ dup get swap bootstrap-word set ] each
-    ] H{ } make-assoc
+    {
+        dictionary source-files builtins
+        update-map implementors-map
+    } [ [ bootstrap-word ] [ get ] bi ] H{ } map>assoc
+    {
+        class<=-cache class-not-cache classes-intersect-cache
+        class-and-cache class-or-cache
+    } [ H{ } clone ] H{ } map>assoc assoc-union
    bootstrap-global set
    bootstrap-global emit-userenv ;

--- a/basis/bootstrap/random/random.factor
+++ b/basis/bootstrap/random/random.factor
@ -13,4 +13,4 @@ IN: bootstrap.random
 [
    [ 32 random-bits ] with-system-random
    <mersenne-twister> random-generator set-global
-] "generator.random" add-init-hook
+] "bootstrap.random" add-init-hook
--- a/basis/boxes/summary.txt
+++ b/basis/boxes/summary.txt
@ -0,0 +1 @@
+An abstraction for enforcing a mutual-exclusion invariant
--- a/basis/calendar/calendar-docs.factor
+++ b/basis/calendar/calendar-docs.factor
@ -21,8 +21,8 @@ HELP: <date>
 { $description "Returns a timestamp object representing the start of the specified day in your current timezone." }
 { $examples
    { $example "USING: calendar prettyprint ;"
-               "2010 12 25 <date> ."
-               "T{ timestamp\n    { year 2010 }\n    { month 12 }\n    { day 25 }\n    { gmt-offset T{ duration { hour -5 } } }\n}"
+               "2010 12 25 <date> >gmt midnight ."
+               "T{ timestamp { year 2010 } { month 12 } { day 25 } }"
    }
 } ;

--- a/basis/calendar/format/format-tests.factor
+++ b/basis/calendar/format/format-tests.factor
@ -62,3 +62,15 @@ IN: calendar.format.tests
        T{ duration f 0 0 0 -5 0 0 }
    }
 ] [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
+
+[
+    T{ timestamp
+        { year 2008 }
+        { month 10 }
+        { day 2 }
+        { hour 23 }
+        { minute 59 }
+        { second 59 }
+        { gmt-offset T{ duration f 0 0 0 0 0 0 } }
+    }
+] [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
--- a/basis/calendar/format/format.factor
+++ b/basis/calendar/format/format.factor
@ -201,9 +201,13 @@ ERROR: invalid-timestamp-format ;
 : rfc822>timestamp ( str -- timestamp )
    [ (rfc822>timestamp) ] with-string-reader ;

+: check-day-name ( str -- )
+    [ day-abbreviations3 member? ] [ day-names member? ] bi or
+    check-timestamp drop ;
+
 : (cookie-string>timestamp-1) ( -- timestamp )
    timestamp new
-        "," read-token day-abbreviations3 member? check-timestamp drop
+        "," read-token check-day-name
        read1 CHAR: \s assert=
        "-" read-token checked-number >>day
        "-" read-token month-abbreviations index 1+ check-timestamp >>month
@ -218,7 +222,7 @@ ERROR: invalid-timestamp-format ;

 : (cookie-string>timestamp-2) ( -- timestamp )
    timestamp new
-        read-sp day-abbreviations3 member? check-timestamp drop
+        read-sp check-day-name
        read-sp month-abbreviations index 1+ check-timestamp >>month
        read-sp checked-number >>day
        ":" read-token checked-number >>hour
--- a/basis/channels/channels-docs.factor
+++ b/basis/channels/channels-docs.factor
@ -33,3 +33,14 @@ HELP: from
 " It will block the calling thread until there is data in the channel." 
 }
 { $see-also <channel> to } ;
+
+ARTICLE: "channels" "Channels"
+"The " { $vocab-link "channels" } " vocabulary provides a simple abstraction to send and receive objects." $nl
+"Opening a channel:"
+{ $subsection <channel> }
+"Sending a message:"
+{ $subsection to }
+"Receiving a message:"
+{ $subsection from } ;
+
+ABOUT: "channels"
--- a/basis/channels/remote/tags.txt
+++ b/basis/channels/remote/tags.txt
@ -1 +1 @@
-extensions
+concurrency
--- a/basis/channels/tags.txt
+++ b/basis/channels/tags.txt
@ -1 +1 @@
-extensions
+concurrency
--- a/basis/circular/circular-docs.factor
+++ b/basis/circular/circular-docs.factor
@ -0,0 +1,58 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string sequences
+math kernel ;
+IN: circular
+
+HELP: <circular-string>
+{ $values
+     { "n" integer }
+     { "circular" circular } }
+{ $description "Creates a new circular string object. A circular string is a string object that can be accessed out of bounds and the index will wrap around to the start of the string." } ;
+
+HELP: <circular>
+{ $values
+     { "seq" sequence }
+     { "circular" circular } }
+{ $description "Creates a new " { $link circular } " object that wraps an existing sequence. By default, the index is set to zero." } ;
+
+HELP: <growing-circular>
+{ $values
+     { "capacity" integer }
+     { "growing-circular" growing-circular } }
+{ $description "Creates a new growing-circular object." } ;
+
+HELP: change-circular-start
+{ $values
+     { "n" integer } { "circular" circular } }
+{ $description "Changes the start index of a circular object." } ;
+
+HELP: circular
+{ $description "A tuple class that stores a sequence and its start index." } ;
+
+HELP: growing-circular
+{ $description "A circular sequence that is growable." } ;
+
+HELP: push-circular
+{ $values
+     { "elt" object } { "circular" circular } }
+{ $description "Pushes an element to a " { $link circular } " object." } ;
+
+HELP: push-growing-circular
+{ $values
+     { "elt" object } { "circular" circular } }
+{ $description "Pushes an element onto a " { $link growing-circular } " object." } ;
+
+ARTICLE: "circular" "Circular sequences"
+"The " { $vocab-link "circular" } " vocabulary implements the " { $link "sequence-protocol" } " to allow an arbitrary start index and wrap-around indexing." $nl
+"Creating a new circular object:"
+{ $subsection <circular> }
+{ $subsection <circular-string> }
+{ $subsection <growing-circular> }
+"Changing the start index:"
+{ $subsection change-circular-start }
+"Pushing new elements:"
+{ $subsection push-circular }
+{ $subsection push-growing-circular } ;
+
+ABOUT: "circular"
--- a/basis/circular/circular.factor
+++ b/basis/circular/circular.factor
@ -11,9 +11,11 @@ TUPLE: circular seq start ;
 : <circular> ( seq -- circular )
    0 circular boa ;

+<PRIVATE
 : circular-wrap ( n circular -- n circular )
    [ start>> + ] keep
    [ seq>> length rem ] keep ; inline
+PRIVATE>

 M: circular length seq>> length ;

@ -37,11 +39,13 @@ TUPLE: growing-circular < circular length ;

 M: growing-circular length length>> ;

+<PRIVATE
 : full? ( circular -- ? )
    [ length ] [ seq>> length ] bi = ;

 : set-peek ( elt seq -- )
    [ length 1- ] keep set-nth ;
+PRIVATE>

 : push-growing-circular ( elt circular -- )
    dup full? [ push-circular ]
--- a/basis/cocoa/cocoa-docs.factor
+++ b/basis/cocoa/cocoa-docs.factor
@ -19,7 +19,7 @@ HELP: SUPER->
 ARTICLE: "objc-calling" "Calling Objective C code"
 "Before an Objective C class can be used, it must be imported; by default, a small set of common classes are imported automatically, but additional classes can be imported as needed."
 { $subsection import-objc-class }
-"Every imported Objective C class has as corresponding class word in the " { $vocab-link "objc-classes" } " vocabulary. Class words push the class object in the stack, allowing class methods to be invoked."
+"Every imported Objective C class has as corresponding class word in the " { $vocab-link "cocoa.classes" } " vocabulary. Class words push the class object in the stack, allowing class methods to be invoked."
 $nl
 "Messages can be sent to classes and instances using a pair of parsing words:"
 { $subsection POSTPONE: -> }
--- a/basis/colors/summary.txt
+++ b/basis/colors/summary.txt
@ -0,0 +1 @@
+Colors as a first-class data type
--- a/basis/columns/columns-docs.factor
+++ b/basis/columns/columns-docs.factor
@ -1,13 +1,6 @@
 USING: help.markup help.syntax sequences ;
 IN: columns

-ARTICLE: "columns" "Column sequences"
-"A " { $emphasis "column" } " presents a column of a matrix represented as a sequence of rows:"
-{ $subsection column }
-{ $subsection <column> }
-"A utility word:"
-{ $subsection <flipped> } ;
-
 HELP: column
 { $class-description "A virtual sequence which presents a fixed column of a matrix represented as a sequence of rows. New instances can be created by calling " { $link <column> } "." } ;

@ -30,4 +23,11 @@ HELP: <flipped>
 { $description "Outputs a new virtual sequence which presents the transpose of " { $snippet "seq" } "." }
 { $notes "This is the virtual sequence equivalent of " { $link flip } "." } ;

+ARTICLE: "columns" "Column sequences"
+"A " { $emphasis "column" } " presents a column of a matrix represented as a sequence of rows:"
+{ $subsection column }
+{ $subsection <column> }
+"A utility word:"
+{ $subsection <flipped> } ;
+
 ABOUT: "columns"
--- a/basis/combinators/short-circuit/short-circuit-docs.factor
+++ b/basis/combinators/short-circuit/short-circuit-docs.factor
@ -0,0 +1,84 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string quotations
+math ;
+IN: combinators.short-circuit
+
+HELP: 0&&
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if every quotation in the sequence of quotations returns true." } ;
+
+HELP: 0||
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if any quotation in the sequence returns true." } ;
+
+HELP: 1&&
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if every quotation in the sequence of quotations returns true. Each quotation gets the same element from the datastack and must output a boolean." } ;
+
+HELP: 1||
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same element from the datastack and must return a boolean." } ;
+
+HELP: 2&&
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if every quotation in the sequence of quotations returns true. Each quotation gets the same two elements from the datastack and must output a boolean." } ;
+
+HELP: 2||
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same two elements from the datastack and must return a boolean." } ;
+
+HELP: 3&&
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if every quotation in the sequence of quotations returns true. Each quotation gets the same three elements from the datastack and must output a boolean." } ;
+
+HELP: 3||
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ;
+
+HELP: n&&-rewrite
+{ $values
+     { "quots" "a sequence of quotations" } { "N" integer }
+     { "quot" quotation } }
+{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each AND quotation." } ;
+
+HELP: n||-rewrite
+{ $values
+     { "quots" "a sequence of quotations" } { "N" integer }
+     { "quot" quotation } }
+{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each OR quotation." } ;
+
+ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
+"The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl
+"AND combinators:"
+{ $subsection 0&& }
+{ $subsection 1&& }
+{ $subsection 2&& }
+{ $subsection 3&& }
+"OR combinators:"
+{ $subsection 0|| }
+{ $subsection 1|| }
+{ $subsection 2|| }
+{ $subsection 3|| }
+"Generalized combinators:"
+{ $subsection n&&-rewrite }
+{ $subsection n||-rewrite }
+;
+
+ABOUT: "combinators.short-circuit"
--- a/basis/combinators/short-circuit/smart/smart-docs.factor
+++ b/basis/combinators/short-circuit/smart/smart-docs.factor
@ -0,0 +1,38 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string quotations ;
+IN: combinators.short-circuit.smart
+
+HELP: &&
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Infers the number of arguments that each quotation takes from the stack. Eacn quotation must take the same number of arguments. Returns true if every quotation yields true, and stops early if one yields false." }
+{ $examples "Smart combinators will infer the two inputs:"
+    { $example "USING: prettyprint kernel math combinators.short-circuit.smart ;"
+    "2 3 { [ + 5 = ] [ - -1 = ] } && ."
+    "t"
+    }
+} ;
+
+HELP: ||
+{ $values
+     { "quots" "a sequence of quotations" }
+     { "quot" quotation } }
+{ $description "Infers the number of arguments that each quotation takes from the stack. Eacn quotation must take the same number of arguments. Returns true if any quotation yields true, and stops early when one yields true." }
+{ $examples "Smart combinators will infer the two inputs:"
+    { $example "USING: prettyprint kernel math combinators.short-circuit.smart ;"
+    "2 3 { [ - 1 = ] [ + 5 = ] } || ."
+    "t"
+    }
+} ;
+
+ARTICLE: "combinators.short-circuit.smart" "Smart short-circuit combinators"
+"The " { $vocab-link "combinators.short-circuit.smart" } " vocabulary is similar to " { $vocab-link "combinators.short-circuit" } " except the combinators here infer the number of inputs that the sequence of quotations takes."
+$nl
+"Generalized AND:"
+{ $subsection && }
+"Generalized OR:"
+{ $subsection || } ;
+
+ABOUT: "combinators.short-circuit.smart"
--- a/basis/command-line/command-line-docs.factor
+++ b/basis/command-line/command-line-docs.factor
@ -1,6 +1,43 @@
 USING: help.markup help.syntax parser vocabs.loader strings ;
 IN: command-line

+HELP: run-bootstrap-init
+{ $description "Runs the " { $snippet ".factor-boot-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ;
+
+HELP: run-user-init
+{ $description "Runs the " { $snippet ".factor-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ;
+
+HELP: cli-param
+{ $values { "param" string } }
+{ $description "Process a command-line switch."
+$nl
+"If the parameter contains " { $snippet "=" } ", the global variable named by the string before the equals sign is set to the string after the equals sign."
+$nl
+"If the parameter begins with " { $snippet "no-" } ", sets the global variable named by the parameter with the prefix removed to " { $link f } "."
+$nl
+"Otherwise, sets the global variable named by the parameter to " { $link t } "." } ;
+
+HELP: cli-args
+{ $values { "args" "a sequence of strings" } }
+{ $description "Outputs the command line parameters which were passed to the Factor VM on startup." } ;
+
+HELP: main-vocab-hook
+{ $var-description "Global variable holding a quotation which outputs a vocabulary name. UI backends set this so that the UI can automatically start if the prerequisites are met (for example, " { $snippet "$DISPLAY" } " being set on X11)." } ;
+
+HELP: main-vocab
+{ $values { "vocab" string } }
+{ $description "Outputs the name of the vocabulary which is to be run on startup using the " { $link run } " word. The " { $snippet "-run" } " command line switch overrides this setting." } ;
+
+HELP: default-cli-args
+{ $description "Sets global variables corresponding to default command line arguments." } ;
+
+HELP: ignore-cli-args?
+{ $values { "?" "a boolean" } }
+{ $description "On Mac OS X, source files to run are supplied by the Cocoa API, so to avoid running them twice the startup code has to call this word." } ;
+
+HELP: parse-command-line
+{ $description "Called on startup to process command line arguments. This sets global variables with " { $link cli-param } ", runs source files, and evaluates the string given by the " { $snippet "-e" } " switch, if there is one." } ;
+
 ARTICLE: "runtime-cli-args" "Command line switches for the VM"
 "A handful of command line switches are processed by the VM and not the library. They control low-level features."
 { $table
@ -77,40 +114,3 @@ $nl
 { $subsection main-vocab-hook } ;

 ABOUT: "cli"
-
-HELP: run-bootstrap-init
-{ $description "Runs the " { $snippet ".factor-boot-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ;
-
-HELP: run-user-init
-{ $description "Runs the " { $snippet ".factor-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ;
-
-HELP: cli-param
-{ $values { "param" string } }
-{ $description "Process a command-line switch."
-$nl
-"If the parameter contains " { $snippet "=" } ", the global variable named by the string before the equals sign is set to the string after the equals sign."
-$nl
-"If the parameter begins with " { $snippet "no-" } ", sets the global variable named by the parameter with the prefix removed to " { $link f } "."
-$nl
-"Otherwise, sets the global variable named by the parameter to " { $link t } "." } ;
-
-HELP: cli-args
-{ $values { "args" "a sequence of strings" } }
-{ $description "Outputs the command line parameters which were passed to the Factor VM on startup." } ;
-
-HELP: main-vocab-hook
-{ $var-description "Global variable holding a quotation which outputs a vocabulary name. UI backends set this so that the UI can automatically start if the prerequisites are met (for example, " { $snippet "$DISPLAY" } " being set on X11)." } ;
-
-HELP: main-vocab
-{ $values { "vocab" string } }
-{ $description "Outputs the name of the vocabulary which is to be run on startup using the " { $link run } " word. The " { $snippet "-run" } " command line switch overrides this setting." } ;
-
-HELP: default-cli-args
-{ $description "Sets global variables corresponding to default command line arguments." } ;
-
-HELP: ignore-cli-args?
-{ $values { "?" "a boolean" } }
-{ $description "On Mac OS X, source files to run are supplied by the Cocoa API, so to avoid running them twice the startup code has to call this word." } ;
-
-HELP: parse-command-line
-{ $description "Called on startup to process command line arguments. This sets global variables with " { $link cli-param } ", runs source files, and evaluates the string given by the " { $snippet "-e" } " switch, if there is one." } ;
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@ -23,3 +23,30 @@ IN: compiler.constants
 : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ;
 : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ;
 : compiled-header-size ( -- n ) 4 bootstrap-cells ;
+
+! Relocation classes
+: rc-absolute-cell    0 ;
+: rc-absolute         1 ;
+: rc-relative         2 ;
+: rc-absolute-ppc-2/2 3 ;
+: rc-relative-ppc-2   4 ;
+: rc-relative-ppc-3   5 ;
+: rc-relative-arm-3   6 ;
+: rc-indirect-arm     7 ;
+: rc-indirect-arm-pc  8 ;
+
+! Relocation types
+: rt-primitive 0 ;
+: rt-dlsym     1 ;
+: rt-literal   2 ;
+: rt-dispatch  3 ;
+: rt-xt        4 ;
+: rt-here      5 ;
+: rt-label     6 ;
+: rt-immediate 7 ;
+
+: rc-absolute? ( n -- ? )
+    [ rc-absolute-ppc-2/2 = ]
+    [ rc-absolute-cell = ]
+    [ rc-absolute = ]
+    tri or or ;
--- a/basis/compiler/generator/generator-docs.factor
+++ b/basis/compiler/generator/generator-docs.factor
@ -4,7 +4,7 @@ kernel vectors arrays effects sequences ;
 IN: compiler.generator

 ARTICLE: "generator" "Compiled code generator"
-"Most of the words in the " { $vocab-link "generator" } " vocabulary are internal to the compiler and user code has no reason to call them."
+"Most of the words in the " { $vocab-link "compiler.generator" } " vocabulary are internal to the compiler and user code has no reason to call them."
 $nl
 "Debugging information can be enabled or disabled; this hook is used by " { $link "tools.deploy" } ":"
 { $subsection compiled-stack-traces? }
--- a/basis/compiler/intrinsics/intrinsics.factor
+++ b/basis/compiler/intrinsics/intrinsics.factor
@ -4,20 +4,42 @@ USING: kernel classes.tuple classes.tuple.private math arrays
 byte-arrays words stack-checker.known-words ;
 IN: compiler.intrinsics

-: (tuple) ( layout -- tuple )
-    "BUG: missing (tuple) intrinsic" throw ;
+ERROR: missing-intrinsic ;
+
+: (tuple) ( n -- tuple ) missing-intrinsic ;

 \ (tuple) { tuple-layout } { tuple } define-primitive
 \ (tuple) make-flushable

-: (array) ( n -- array )
-    "BUG: missing (array) intrinsic" throw ;
+: (array) ( n -- array ) missing-intrinsic ;

 \ (array) { integer } { array } define-primitive
 \ (array) make-flushable

-: (byte-array) ( n -- byte-array )
-    "BUG: missing (byte-array) intrinsic" throw ;
+: (byte-array) ( n -- byte-array ) missing-intrinsic ;

 \ (byte-array) { integer } { byte-array } define-primitive
 \ (byte-array) make-flushable
+
+: (ratio) ( -- ratio ) missing-intrinsic ;
+
+\ (ratio) { } { ratio } define-primitive
+\ (ratio) make-flushable
+
+: (complex) ( -- complex ) missing-intrinsic ;
+
+\ (complex) { } { complex } define-primitive
+\ (complex) make-flushable
+
+: (wrapper) ( -- wrapper ) missing-intrinsic ;
+
+\ (wrapper) { } { wrapper } define-primitive
+\ (wrapper) make-flushable
+
+: (set-slot) ( val obj n -- ) missing-intrinsic ;
+
+\ (set-slot) { object object fixnum } { } define-primitive
+
+: (write-barrier) ( obj -- ) missing-intrinsic ;
+
+\ (write-barrier) { object } { } define-primitive
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@ -298,6 +298,12 @@ SYMBOL: value-infos
 : node-output-infos ( node -- seq )
    dup out-d>> [ node-value-info ] with map ;

+: first-literal ( #call -- obj )
+    dup in-d>> first node-value-info literal>> ;
+
+: last-literal ( #call -- obj )
+    dup out-d>> peek node-value-info literal>> ;
+
 : immutable-tuple-boa? ( #call -- ? )
    dup word>> \ <tuple-boa> eq? [
        dup in-d>> peek node-value-info
--- a/basis/concurrency/combinators/combinators.factor
+++ b/basis/concurrency/combinators/combinators.factor
@ -4,8 +4,10 @@ USING: concurrency.futures concurrency.count-downs sequences
 kernel ;
 IN: concurrency.combinators

+<PRIVATE
 : (parallel-each) ( n quot -- )
    >r <count-down> r> keep await ; inline
+PRIVATE>

 : parallel-each ( seq quot -- )
    over length [
@ -20,7 +22,9 @@ IN: concurrency.combinators
 : parallel-filter ( seq quot -- newseq )
    over >r pusher >r each r> r> like ; inline

+<PRIVATE
 : future-values dup [ ?future ] change-each ; inline
+PRIVATE>

 : parallel-map ( seq quot -- newseq )
    [ curry future ] curry map future-values ;
--- a/basis/concurrency/combinators/tags.txt
+++ b/basis/concurrency/combinators/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/conditions/tags.txt
+++ b/basis/concurrency/conditions/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/count-downs/count-downs.factor
+++ b/basis/concurrency/count-downs/count-downs.factor
@ -11,14 +11,18 @@ TUPLE: count-down n promise ;
 : count-down-check ( count-down -- )
    dup n>> zero? [ t swap promise>> fulfill ] [ drop ] if ;

+ERROR: invalid-count-down-count count ;
+
 : <count-down> ( n -- count-down )
-    dup 0 < [ "Invalid count for count down" throw ] when
+    dup 0 < [ invalid-count-down-count ] when
    <promise> \ count-down boa
    dup count-down-check ;

+ERROR: count-down-already-done ;
+
 : count-down ( count-down -- )
    dup n>> dup zero?
-    [ "Count down already done" throw ]
+    [ count-down-already-done ]
    [ 1- >>n count-down-check ] if ;

 : await-timeout ( count-down timeout -- )
--- a/basis/concurrency/count-downs/tags.txt
+++ b/basis/concurrency/count-downs/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/distributed/tags.txt
+++ b/basis/concurrency/distributed/tags.txt
@ -1,2 +1,2 @@
+concurrency
 enterprise
-extensions
--- a/basis/concurrency/exchangers/tags.txt
+++ b/basis/concurrency/exchangers/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/flags/tags.txt
+++ b/basis/concurrency/flags/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/futures/tags.txt
+++ b/basis/concurrency/futures/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/locks/tags.txt
+++ b/basis/concurrency/locks/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/mailboxes/tags.txt
+++ b/basis/concurrency/mailboxes/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/messaging/messaging.factor
+++ b/basis/concurrency/messaging/messaging.factor
@ -4,7 +4,7 @@
 ! Concurrency library for Factor, based on Erlang/Termite style
 ! concurrency.
 USING: kernel threads concurrency.mailboxes continuations
-namespaces assocs random accessors ;
+namespaces assocs random accessors summary ;
 IN: concurrency.messaging

 GENERIC: send ( message thread -- )
@ -52,9 +52,14 @@ TUPLE: reply data tag ;
    [ >r tag>> r> tag>> = ]
    [ 2drop f ] if ;

+ERROR: cannot-send-synchronous-to-self message thread ;
+
+M: cannot-send-synchronous-to-self summary
+    drop "Cannot synchronous send to myself" ;
+
 : send-synchronous ( message thread -- reply )
    dup self eq? [
-        "Cannot synchronous send to myself" throw
+        cannot-send-synchronous-to-self
    ] [
        >r <synchronous> dup r> send
        [ synchronous-reply? ] curry receive-if
--- a/basis/concurrency/messaging/tags.txt
+++ b/basis/concurrency/messaging/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/promises/promises.factor
+++ b/basis/concurrency/promises/promises.factor
@ -11,9 +11,10 @@ TUPLE: promise mailbox ;
 : promise-fulfilled? ( promise -- ? )
    mailbox>> mailbox-empty? not ;

+ERROR: promise-already-fulfilled promise ;
 : fulfill ( value promise -- )
    dup promise-fulfilled? [ 
-        "Promise already fulfilled" throw
+        promise-already-fulfilled
    ] [
        mailbox>> mailbox-put
    ] if ;
--- a/basis/concurrency/promises/tags.txt
+++ b/basis/concurrency/promises/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/concurrency/semaphores/tags.txt
+++ b/basis/concurrency/semaphores/tags.txt
@ -0,0 +1 @@
+concurrency
--- a/basis/core-foundation/fsevents/fsevents.factor
+++ b/basis/core-foundation/fsevents/fsevents.factor
@ -3,13 +3,10 @@
 USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
 continuations combinators core-foundation
-core-foundation.run-loop io.encodings.utf8 destructors ;
+core-foundation.run-loop core-foundation.run-loop.thread
+io.encodings.utf8 destructors ;
 IN: core-foundation.fsevents

-! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
-! FSEventStream API, Leopard only !
-! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
-
 : kFSEventStreamCreateFlagUseCFTypes 2 ; inline
 : kFSEventStreamCreateFlagWatchRoot 4 ; inline

--- a/basis/core-foundation/run-loop/run-loop.factor
+++ b/basis/core-foundation/run-loop/run-loop.factor
@ -35,5 +35,3 @@ FUNCTION: SInt32 CFRunLoopRunInMode (

 : start-run-loop-thread ( -- )
    [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
-
-[ start-run-loop-thread ] "core-foundation.run-loop" add-init-hook
--- a/basis/core-foundation/run-loop/thread/thread.factor
+++ b/basis/core-foundation/run-loop/thread/thread.factor
@ -0,0 +1,8 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: init core-foundation.run-loop ;
+IN: core-foundation.run-loop.thread
+
+! Load this vocabulary if you need a run loop running.
+
+[ start-run-loop-thread ] "core-foundation.run-loop.thread" add-init-hook
--- a/basis/db/db-docs.factor
+++ b/basis/db/db-docs.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes kernel help.markup help.syntax sequences
-alien assocs strings math multiline ;
+alien assocs strings math multiline quotations ;
 IN: db

 HELP: db
@ -45,7 +45,22 @@ HELP: prepared-statement
 { $description } ;

 HELP: result-set
-{ $description } ;
+{ $description "An object encapsulating a raw SQL result object. There are two ways in which a result set can be accessed, but they are specific to the database backend in use."
+    { $subsection "db-random-access-result-set" }
+    { $subsection "db-sequential-result-set" }
+} ;
+
+HELP: init-result-set
+{ $values
+     { "result-set" result-set } }
+{ $description "" } ;
+
+HELP: new-result-set
+{ $values
+     { "query" "a query" } { "handle" alien } { "class" class }
+     { "result-set" result-set } }
+{ $description "Creates a new " { $link result-set } " object of type " { $snippet "class" } "." } ;
+

 HELP: new-statement
 { $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } }
@ -81,7 +96,7 @@ HELP: query-results
 { $values { "query" object }
    { "result-set" result-set }
 }
-{ $description "" } ;
+{ $description "Returns a " { $link result-set } " object representing the reults of a SQL query." } ;

 HELP: #rows
 { $values { "result-set" result-set } { "n" integer } }
@ -95,36 +110,126 @@ HELP: row-column
 { $values { "result-set" result-set } { "column" integer }
    { "obj" object }
 }
-{ $description "" } ;
+{ $description "Returns the value indexed by " { $snippet "column" } " in the current row of a " { $link result-set } "." } ;

 HELP: row-column-typed
 { $values { "result-set" result-set } { "column" integer }
    { "sql" "sql" } }
-{ $description "" } ;
+{ $description "Returns the value indexed by " { $snippet "column" } " in the current row of a " { $link result-set } " and converts the result based on a type stored in the " { $link result-set } "'s " { $slot "out-params" } "." } ;

 HELP: advance-row
 { $values { "result-set" result-set } }
-;
+{ $description "Advanced the pointer to an underlying SQL result set stored in a " { $link result-set } " object." } ;

 HELP: more-rows?
 { $values { "result-set" result-set } { "?" "a boolean" } }
-;
+{ $description "Returns true if the " { $link result-set } " has more rows to traverse." } ;

 HELP: execute-statement*
 { $values { "statement" statement } { "type" object } }
 { $description } ;

+HELP: execute-one-statement
+{ $values
+     { "statement" null } }
+{ $description "" } ;
+
 HELP: execute-statement
 { $values { "statement" statement } }
-{ $description } ;
+{ $description "" } ;

-ARTICLE: "db" "Low-level database library"
+
+
+
+
+
+HELP: begin-transaction
+{ $description "Begins a new transaction. User code should make use of the " { $link with-transaction } " combinator." } ;
+
+HELP: bind-statement
+{ $values
+     { "obj" object } { "statement" null } }
+{ $description "" } ;
+
+HELP: commit-transaction
+{ $description "Commits a transaction. User code should make use of the " { $link with-transaction } " combinator." } ;
+
+HELP: default-query
+{ $values
+     { "query" null }
+     { "result-set" null } }
+{ $description "" } ;
+
+HELP: in-transaction
+{ $description "A variable that is set true when a transaction is in progress." } ;
+
+HELP: in-transaction?
+{ $values
+     { "?" "a boolean" } }
+{ $description "Returns true if there is currently a transaction in progress in this scope." } ;
+
+HELP: query-each
+{ $values
+     { "statement" null } { "quot" quotation } }
+{ $description "" } ;
+
+HELP: query-map
+{ $values
+     { "statement" null } { "quot" quotation }
+     { "seq" sequence } }
+{ $description "" } ;
+
+HELP: rollback-transaction
+{ $description "Rolls back a transaction; no data is committed to the database. User code should make use of the " { $link with-transaction } " combinator." } ;
+
+HELP: sql-command
+{ $values
+     { "sql" string } }
+{ $description "Executes a SQL string using the databse in the " { $link db } " symbol." } ;
+
+HELP: sql-query
+{ $values
+     { "sql" string }
+     { "rows" "an array of arrays of strings" } }
+{ $description "Runs a SQL query of raw text in the database in the " { $link db } " symbol. Each row is returned as an array of strings; no type-conversions are done on the resulting data." } ;
+
+{ sql-command sql-query } related-words
+
+HELP: sql-row
+{ $values
+     { "result-set" result-set }
+     { "seq" sequence } }
+{ $description "Returns the current row in a " { $link result-set } " as an array of strings." } ;
+
+HELP: sql-row-typed
+{ $values
+     { "result-set" result-set }
+     { "seq" sequence } }
+{ $description "Returns the current row in a " { $link result-set } " as an array of typed Factor objects." } ;
+
+{ sql-row sql-row-typed } related-words
+
+HELP: with-db
+{ $values
+     { "seq" sequence } { "class" class } { "quot" quotation } }
+{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. The database called is based on the " { $snippet "class" } " with the " } ;
+
+HELP: with-transaction
+{ $values
+     { "quot" quotation } }
+{ $description "" } ;
+
+ARTICLE: "db" "Database library"
 { $subsection "db-custom-database-combinators" }
 { $subsection "db-protocol" }
+{ $subsection "db-result-sets" }
 { $subsection "db-lowlevel-tutorial" }
 "Higher-level database:"
 { $vocab-subsection "Database types" "db.types" }
 { $vocab-subsection "High-level tuple/database integration" "db.tuples" }
+! { $subsection "db-tuples" }
+! { $subsection "db-tuples-protocol" }
+! { $subsection "db-tuples-tutorial" }
 "Supported database backends:"
 { $vocab-subsection "SQLite" "db.sqlite" }
 { $vocab-subsection "PostgreSQL" "db.postgresql" }
@ -132,6 +237,40 @@ ARTICLE: "db" "Low-level database library"
 { $subsection "db-porting-the-library" }
 ;

+ARTICLE: "db-random-access-result-set" "Random access result sets"
+"Random-access result sets do not have to be traversed in order. For instance, PostgreSQL's result set object can be accessed as a matrix with i,j coordinates."
+$nl
+"Databases which work in this way must provide methods for the following traversal words:"
+{ $subsection #rows }
+{ $subsection #columns }
+{ $subsection row-column }
+{ $subsection row-column-typed } ;
+
+ARTICLE: "db-sequential-result-set" "Sequential result sets"
+"Sequential result sets can be iterated one element after the next.  SQLite's result sets offer this method of traversal."
+$nl
+"Databases which work in this way must provide methods for the following traversal words:"
+{ $subsection more-rows? }
+{ $subsection advance-row }
+{ $subsection row-column }
+{ $subsection row-column-typed } ;
+
+ARTICLE: "db-result-sets" "Result sets"
+"Result sets are the encapsulated, database-specific results from a SQL query."
+$nl
+"Two possible protocols for iterating over result sets exist:"
+{ $subsection "db-random-access-result-set" }
+{ $subsection "db-sequential-result-set" }
+"Query the number of rows or columns:"
+{ $subsection #rows }
+{ $subsection #columns }
+"Traversing a result set:"
+{ $subsection advance-row }
+{ $subsection more-rows? }
+"Pulling out a single row of results:"
+{ $subsection row-column }
+{ $subsection row-column-typed } ;
+
 ARTICLE: "db-protocol" "Low-level database protocol"
 "The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries."
 ;
@ -144,7 +283,6 @@ ARTICLE: "db-porting-the-library" "Porting the database library"
 "This section is not yet written."
 ;

-
 ARTICLE: "db-custom-database-combinators" "Custom database combinators"
 "Every database library requires some effort on the programmer's part to initialize and open a database.  SQLite uses files on your harddisk, so a simple pathname is all the setup required. With PostgreSQL, you log in to a networked server as a user on a specfic port." $nl

@ -155,7 +293,6 @@ USING: db.sqlite db io.files ;
    { "my-database.db" temp-file } sqlite-db rot with-db ;
 "> }

-
 ;

 ABOUT: "db"
--- a/basis/db/db.factor
+++ b/basis/db/db.factor
@ -80,11 +80,14 @@ GENERIC: execute-statement* ( statement type -- )
 M: object execute-statement* ( statement type -- )
    drop query-results dispose ;

+: execute-one-statement ( statement -- )
+    dup type>> execute-statement* ;
+
 : execute-statement ( statement -- )
    dup sequence? [
-        [ execute-statement ] each
+        [ execute-one-statement ] each
    ] [
-        dup type>> execute-statement*
+        execute-one-statement
    ] if ;

 : bind-statement ( obj statement -- )
--- a/basis/db/postgresql/postgresql.factor
+++ b/basis/db/postgresql/postgresql.factor
@ -5,7 +5,7 @@ kernel math math.parser namespaces make prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
 combinators classes locals words tools.walker
-nmake accessors random db.queries destructors ;
+nmake accessors random db.queries destructors db.tuples.private ;
 USE: tools.walker
 IN: db.postgresql

@ -37,8 +37,7 @@ M: postgresql-db db-open ( db -- db )
 M: postgresql-db dispose ( db -- )
    handle>> PQfinish ;

-M: postgresql-statement bind-statement* ( statement -- )
-    drop ;
+M: postgresql-statement bind-statement* ( statement -- ) drop ;

 GENERIC: postgresql-bind-conversion ( tuple object -- low-level-binding )

@ -67,11 +66,11 @@ M: postgresql-result-set #columns ( result-set -- n )
    [ handle>> ] [ n>> ] bi ;

 M: postgresql-result-set row-column ( result-set column -- object )
-    >r result-handle-n r> pq-get-string ;
+    [ result-handle-n ] dip pq-get-string ;

 M: postgresql-result-set row-column-typed ( result-set column -- object )
    dup pick out-params>> nth type>>
-    >r >r result-handle-n r> r> postgresql-column-typed ;
+    [ result-handle-n ] 2dip postgresql-column-typed ;

 M: postgresql-statement query-results ( query -- result-set )
    dup bind-params>> [
@ -126,13 +125,20 @@ M: postgresql-db bind# ( spec object -- )

 : create-table-sql ( class -- statement )
    [
+        dupd
        "create table " 0% 0%
        "(" 0% [ ", " 0% ] [
            dup column-name>> 0%
            " " 0%
            dup type>> lookup-create-type 0%
            modifiers 0%
-        ] interleave ");" 0%
+        ] interleave
+
+        ", " 0%
+        find-primary-key
+        "primary key(" 0%
+        [ "," 0% ] [ column-name>> 0% ] interleave
+        "));" 0%
    ] query-make ;

 : create-function-sql ( class -- statement )
@ -160,8 +166,7 @@ M: postgresql-db bind# ( spec object -- )
 M: postgresql-db create-sql-statement ( class -- seq )
    [
        [ create-table-sql , ] keep
-        dup db-columns find-primary-key db-assigned-id-spec?
-        [ create-function-sql , ] [ drop ] if
+        dup db-assigned? [ create-function-sql , ] [ drop ] if
    ] { } make ;

 : drop-function-sql ( class -- statement )
@ -181,15 +186,14 @@ M: postgresql-db create-sql-statement ( class -- seq )
 M: postgresql-db drop-sql-statement ( class -- seq )
    [
        [ drop-table-sql , ] keep
-        dup db-columns find-primary-key db-assigned-id-spec?
-        [ drop-function-sql , ] [ drop ] if
+        dup db-assigned? [ drop-function-sql , ] [ drop ] if
    ] { } make ;

 M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
    [
        "select add_" 0% 0%
        "(" 0%
-        dup find-primary-key 2,
+        dup find-primary-key first 2,
        remove-id
        [ ", " 0% ] [ bind% ] interleave
        ");" 0%
@ -218,14 +222,23 @@ M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
        ");" 0%
    ] query-make ;

-M: postgresql-db insert-tuple* ( tuple statement -- )
+M: postgresql-db insert-tuple-set-key ( tuple statement -- )
    query-modify-tuple ;

 M: postgresql-db persistent-table ( -- hashtable )
    H{
-        { +db-assigned-id+ { "integer" "serial primary key" f } }
-        { +user-assigned-id+ { f f "primary key" } }
-        { +random-id+ { "bigint" "bigint primary key" f } }
+        { +db-assigned-id+ { "integer" "serial" f } }
+        { +user-assigned-id+ { f f f } }
+        { +random-id+ { "bigint" "bigint" f } }
+
+        { +foreign-id+ { f f "references" } }
+
+        { +on-delete+ { f f "on delete" } }
+        { +restrict+ { f f "restrict" } }
+        { +cascade+ { f f "cascade" } }
+        { +set-null+ { f f "set null" } }
+        { +set-default+ { f f "set default" } }
+
        { TEXT { "text" "text" f } }
        { VARCHAR { "varchar" "varchar" f } }
        { INTEGER { "integer" "integer" f } }
@ -240,7 +253,6 @@ M: postgresql-db persistent-table ( -- hashtable )
        { BLOB { "bytea" "bytea" f } }
        { FACTOR-BLOB { "bytea" "bytea" f } }
        { URL { "varchar" "varchar" f } }
-        { +foreign-id+ { f f "references" } }
        { +autoincrement+ { f f "autoincrement" } }
        { +unique+ { f f "unique" } }
        { +default+ { f f "default" } }
@ -256,10 +268,6 @@ M: postgresql-db compound ( string object -- string' )
    over {
        { "default" [ first number>string join-space ] }
        { "varchar" [ first number>string paren append ] }
-        { "references" [
-                first2 >r [ unparse join-space ] keep db-columns r>
-                swap [ slot-name>> = ] with find nip
-                column-name>> paren append
-            ] }
+        { "references" [ >reference-string ] }
        [ drop no-compound-found ]
    } case ;
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@ -3,7 +3,7 @@
 USING: accessors kernel math namespaces make sequences random
 strings math.parser math.intervals combinators math.bitwise
 nmake db db.tuples db.types db.sql classes words shuffle arrays
-destructors continuations ;
+destructors continuations db.tuples.private ;
 IN: db.queries

 GENERIC: where ( specs obj -- )
@ -46,13 +46,18 @@ M: retryable execute-statement* ( statement type -- )
    [ db-columns ] [ db-table ] bi ;

 : query-make ( class quot -- )
-    >r sql-props r>
-    [ 0 sql-counter rot with-variable ] curry { "" { } { } } nmake
+    [ sql-props ] dip
+    [ 0 sql-counter rot with-variable ] curry
+    { "" { } { } } nmake
    <simple-statement> maybe-make-retryable ; inline

 : where-primary-key% ( specs -- )
    " where " 0%
-    find-primary-key dup column-name>> 0% " = " 0% bind% ;
+    find-primary-key [
+        " and " 0%
+    ] [
+        dup column-name>> 0% " = " 0% bind%
+    ] interleave ;

 M: db <update-tuple-statement> ( class -- statement )
    [
@ -121,16 +126,15 @@ M: string where ( spec obj -- ) object-where ;
        dup double-infinite-interval? [ drop f ] when
    ] with filter ;

-: where-clause ( tuple specs -- )
-    dupd filter-slots [
-        drop
+: many-where ( tuple seq -- )
+    " where " 0% [
+        " and " 0%
    ] [
-        " where " 0% [
-            " and " 0%
-        ] [
-            2dup slot-name>> swap get-slot-named where
-        ] interleave drop
-    ] if-empty ;
+        2dup slot-name>> swap get-slot-named where
+    ] interleave drop ;
+
+: where-clause ( tuple specs -- )
+    dupd filter-slots [ drop ] [ many-where ] if-empty ;

 M: db <delete-tuples-statement> ( tuple table -- sql )
    [
@ -168,7 +172,7 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
        number>string " limit " swap 3append
    ] curry change-sql drop ;

-: make-query ( tuple query -- tuple' )
+: make-query* ( tuple query -- tuple' )
    dupd
    {
        [ group>> [ drop ] [ do-group ] if-empty ]
@ -177,8 +181,9 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
        [ offset>> [ do-offset ] [ drop ] if* ]
    } 2cleave ;

-M: db <query> ( tuple class query -- tuple )
-    [ <select-by-slots-statement> ] dip make-query ;
+M: db query>statement ( query -- tuple )
+    [ tuple>> dup class ] keep
+    [ <select-by-slots-statement> ] dip make-query* ;

 ! select ID, NAME, SCORE from EXAM limit 1 offset 3

@ -194,11 +199,10 @@ M: db <query> ( tuple class query -- tuple )
    >r >r parse-sql 4drop r> r>
    <simple-statement> maybe-make-retryable do-select ;

-M: db <count-statement> ( tuple class groups -- statement )
-    \ query new
-        swap >>group
+M: db <count-statement> ( query -- statement )
+    [ tuple>> dup class ] keep
    [ [ "select count(*) from " 0% 0% where-clause ] query-make ]
-    dip make-query ;
+    dip make-query* ;

 : create-index ( index-name table-name columns -- )
    [
--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@ -5,7 +5,7 @@ io.files kernel math math.parser namespaces prettyprint
 sequences strings classes.tuple alien.c-types continuations
 db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
 math.intervals io nmake accessors vectors math.ranges random
-math.bitwise db.queries destructors ;
+math.bitwise db.queries destructors db.tuples.private ;
 IN: db.sqlite

 TUPLE: sqlite-db < db path ;
@ -88,7 +88,7 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
    db get handle>> sqlite3_last_insert_rowid
    dup zero? [ "last-id failed" throw ] when ;

-M: sqlite-db insert-tuple* ( tuple statement -- )
+M: sqlite-db insert-tuple-set-key ( tuple statement -- )
    execute-statement last-insert-id swap set-primary-key ;

 M: sqlite-result-set #columns ( result-set -- n )
@ -114,13 +114,20 @@ M: sqlite-statement query-results ( query -- result-set )

 M: sqlite-db create-sql-statement ( class -- statement )
    [
+        dupd
        "create table " 0% 0%
        "(" 0% [ ", " 0% ] [
            dup column-name>> 0%
            " " 0%
            dup type>> lookup-create-type 0%
            modifiers 0%
-        ] interleave ");" 0%
+        ] interleave
+
+        ", " 0%
+        find-primary-key
+        "primary key(" 0%
+        [ "," 0% ] [ column-name>> 0% ] interleave
+        "));" 0%
    ] query-make ;

 M: sqlite-db drop-sql-statement ( class -- statement )
@ -161,23 +168,31 @@ M: sqlite-db bind% ( spec -- )

 M: sqlite-db persistent-table ( -- assoc )
    H{
-        { +db-assigned-id+ { "integer primary key" "integer primary key" "primary key" } }
-        { +user-assigned-id+ { f f "primary key" } }
-        { +random-id+ { "integer primary key" "integer primary key" "primary key" } }
-        { INTEGER { "integer" "integer" "primary key" } }
-        { BIG-INTEGER { "bigint" "bigint" } }
-        { SIGNED-BIG-INTEGER { "bigint" "bigint" } }
-        { UNSIGNED-BIG-INTEGER { "bigint" "bigint" } }
-        { TEXT { "text" "text" } }
-        { VARCHAR { "text" "text" } }
-        { DATE { "date" "date" } }
-        { TIME { "time" "time" } }
-        { DATETIME { "datetime" "datetime" } }
-        { TIMESTAMP { "timestamp" "timestamp" } }
-        { DOUBLE { "real" "real" } }
-        { BLOB { "blob" "blob" } }
-        { FACTOR-BLOB { "blob" "blob" } }
-        { URL { "text" "text" } }
+        { +db-assigned-id+ { "integer" "integer" f } }
+        { +user-assigned-id+ { f f f } }
+        { +random-id+ { "integer" "integer" f } }
+        { +foreign-id+ { "integer" "integer" "references" } }
+
+        { +on-delete+ { f f "on delete" } }
+        { +restrict+ { f f "restrict" } }
+        { +cascade+ { f f "cascade" } }
+        { +set-null+ { f f "set null" } }
+        { +set-default+ { f f "set default" } }
+
+        { INTEGER { "integer" "integer" f } }
+        { BIG-INTEGER { "bigint" "bigint" f } }
+        { SIGNED-BIG-INTEGER { "bigint" "bigint" f } }
+        { UNSIGNED-BIG-INTEGER { "bigint" "bigint" f } }
+        { TEXT { "text" "text" f } }
+        { VARCHAR { "text" "text" f } }
+        { DATE { "date" "date" f } }
+        { TIME { "time" "time" f } }
+        { DATETIME { "datetime" "datetime" f } }
+        { TIMESTAMP { "timestamp" "timestamp" f } }
+        { DOUBLE { "real" "real" f } }
+        { BLOB { "blob" "blob" f } }
+        { FACTOR-BLOB { "blob" "blob" f } }
+        { URL { "text" "text" f } }
        { +autoincrement+ { f f "autoincrement" } }
        { +unique+ { f f "unique" } }
        { +default+ { f f "default" } }
@ -188,8 +203,9 @@ M: sqlite-db persistent-table ( -- assoc )
        { random-generator { f f f } }
    } ;

-M: sqlite-db compound ( str seq -- str' )
+M: sqlite-db compound ( string seq -- new-string )
    over {
        { "default" [ first number>string join-space ] }
-        [ 2drop ] 
+        { "references" [ >reference-string ] }
+        [ 2drop ]
    } case ;
--- a/basis/db/tuples/tuples-docs.factor
+++ b/basis/db/tuples/tuples-docs.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes help.markup help.syntax io.streams.string kernel
-quotations sequences strings multiline math ;
+quotations sequences strings multiline math db.types ;
 IN: db.tuples

 HELP: define-persistent
@ -11,7 +11,18 @@ HELP: define-persistent
 { $list
    { "a slot name from the " { $snippet "tuple class" } }
    { "the name of a database column that maps to the slot" }        { "a database type (see " { $link "db.types" } ")" }
-} } ;
+} "Throws an error if the slot name (column one from each row) is not a slot in the tuple or its superclases." }
+{ $examples
+    { $unchecked-example "USING: db.tuples db.types ;"
+        "TUPLE: boat id year name ;"
+        "boat \"BOAT\" {"
+        "    { \"id\" \"ID\" +db-assigned-id+ }"
+        "    { \"year\" \"YEAR\" INTEGER }"
+        "    { \"name\" \"NAME\" TEXT }"
+        "} define-persistent"
+        ""
+    }
+} ;

 HELP: create-table
 { $values
@ -64,36 +75,35 @@ HELP: delete-tuples

 HELP: select-tuple
 { $values
-     { "tuple" tuple }
+     { "query/tuple" tuple }
     { "tuple/f" "a tuple or f" } }
 { $description "A SQL query is constructed from the slots of the exemplar tuple that are not " { $link f } ". Returns a single tuple from the database if it matches the query constructed from the exemplar tuple." } ;

 HELP: select-tuples
 { $values
-     { "tuple" tuple }
+     { "query/tuple" tuple }
     { "tuples" "an array of tuples" } }
 { $description "A SQL query is constructed from the slots of the exemplar tuple that are not " { $link f } ". Returns a multiple tuples from the database that match the query constructed from the exemplar tuple." } ;

 HELP: count-tuples
 { $values
-     { "tuple" tuple } { "groups" "an array of slots to group by" }
+     { "query/tuple" tuple }
     { "n" integer } }
-{ $description "" } ;
+{ $description "Returns the number of items that would be returned if the query were a select query. Counting the tuples with this word is more efficient than calling " { $link length } " on the result of " { $link select-tuples } "." } ;
+
+{ select-tuple select-tuples count-tuples } related-words

-HELP: query
-{ $values
-     { "tuple" tuple } { "query" query }
-     { "tuples" "a sequence of tuples" } }
-{ $description "Allows for queries with group by, order by, limit, and offset clauses.  " } ;

-{ select-tuple select-tuples count-tuples query } related-words

 ARTICLE: "db-tuples" "High-level tuple/database integration"
 "Start with a tutorial:"
 { $subsection "db-tuples-tutorial" }
+"Database types supported:"
+{ $subsection "db.types" }
 "Useful words:"
 { $subsection "db-tuples-words" }
-
+"For porting db.tuples to other databases:"
+{ $subsection "db-tuples-protocol" }
 ;

 ARTICLE: "db-tuples-words" "High-level tuple/database words"
@ -115,12 +125,9 @@ ARTICLE: "db-tuples-words" "High-level tuple/database words"
 "Querying tuples:"
 { $subsection select-tuple }
 { $subsection select-tuples }
-{ $subsection count-tuples }
-"Advanced querying of tuples:"
-{ $subsection query } ;
+{ $subsection count-tuples } ;

-
-ARTICLE: "db-tuples-protocol" "High-level tuple/database protocol"
+ARTICLE: "db-tuples-protocol" "Tuple database protocol"
 ;

 ARTICLE: "db-tuples-tutorial" "Tuple database tutorial"
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@ -4,9 +4,20 @@ USING: io.files kernel tools.test db db.tuples classes
 db.types continuations namespaces math math.ranges
 prettyprint calendar sequences db.sqlite math.intervals
 db.postgresql accessors random math.bitwise
-math.ranges strings urls fry ;
+math.ranges strings urls fry db.tuples.private ;
 IN: db.tuples.tests

+: test-sqlite ( quot -- )
+    [ ] swap '[
+        "tuples-test.db" temp-file sqlite-db _ with-db
+    ] unit-test ;
+
+: test-postgresql ( quot -- )
+    [ ] swap '[
+        { "localhost" "postgres" "foob" "factor-test" }
+        postgresql-db _ with-db
+    ] unit-test ;
+
 TUPLE: person the-id the-name the-number the-real
 ts date time blob factor-blob url ;

@ -177,34 +188,55 @@ TUPLE: annotation n paste-id summary author mode contents ;
        { "channel" "CHANNEL" TEXT }
        { "mode" "MODE" TEXT }
        { "contents" "CONTENTS" TEXT }
-        { "date" "DATE" TIMESTAMP }
+        { "timestamp" "DATE" TIMESTAMP }
        { "annotations" { +has-many+ annotation } }
    } define-persistent

    annotation "ANNOTATION"
    {
        { "n" "ID" +db-assigned-id+ }
-        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
+        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" }
+            +on-delete+ +cascade+ }
        { "summary" "SUMMARY" TEXT }
        { "author" "AUTHOR" TEXT }
        { "mode" "MODE" TEXT }
        { "contents" "CONTENTS" TEXT }
    } define-persistent ;

-! { "localhost" "postgres" "" "factor-test" } postgresql-db [
-    ! [ paste drop-table ] [ drop ] recover
-    ! [ annotation drop-table ] [ drop ] recover
-    ! [ paste drop-table ] [ drop ] recover
-    ! [ annotation drop-table ] [ drop ] recover
-    ! [ ] [ paste create-table ] unit-test
-    ! [ ] [ annotation create-table ] unit-test
-! ] with-db
+: test-paste-schema ( -- )
+    [ ] [ db-assigned-paste-schema ] unit-test
+    [ ] [ paste ensure-table ] unit-test
+    [ ] [ annotation ensure-table ] unit-test
+    [ ] [ annotation drop-table ] unit-test
+    [ ] [ paste drop-table ] unit-test
+    [ ] [ paste create-table ] unit-test
+    [ ] [ annotation create-table ] unit-test

-: test-sqlite ( quot -- )
-    [ ] swap '[ "tuples-test.db" temp-file sqlite-db _ with-db ] unit-test ;
+    [ ] [
+        paste new
+            "summary1" >>summary
+            "erg" >>author
+            "#lol" >>channel
+            "contents1" >>contents
+            now >>timestamp
+        insert-tuple
+    ] unit-test

-: test-postgresql ( quot -- )
-    [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db _ with-db ] unit-test ;
+    [ ] [
+        annotation new
+            1 >>paste-id
+            "annotation1" >>summary
+            "erg" >>author
+            "annotation contents" >>contents
+        insert-tuple
+    ] unit-test
+
+    [ ] [
+    ] unit-test
+    ;
+
+[ test-paste-schema ] test-sqlite
+[ test-paste-schema ] test-postgresql

 : test-repeated-insert
    [ ] [ person ensure-table ] unit-test
@ -236,6 +268,17 @@ TUPLE: exam id name score ;
    exam boa ;

 : test-intervals ( -- )
+    [
+        exam "EXAM"
+        {
+            { "idd" "ID" +db-assigned-id+ }
+            { "named" "NAME" TEXT }
+            { "score" "SCORE" INTEGER }
+        } define-persistent
+    ] [
+        seq>> { "idd" "named" } =
+    ] must-fail-with
+
    exam "EXAM"
    {
        { "id" "ID" +db-assigned-id+ }
@ -346,7 +389,7 @@ TUPLE: exam id name score ;
        T{ exam } select-tuples
    ] unit-test

-    [ 4 ] [ T{ exam } f count-tuples ] unit-test ;
+    [ 4 ] [ T{ exam } count-tuples ] unit-test ;

 TUPLE: bignum-test id m n o ;
 : <bignum-test> ( m n o -- obj )
@ -499,3 +542,42 @@ string-encoding-test "STRING_ENCODING_TEST" {
 \ ensure-table must-infer
 \ create-table must-infer
 \ drop-table must-infer
+
+: test-queries ( -- )
+    [ ] [ exam ensure-table ] unit-test
+    [ ] [ 1000 [ random-exam insert-tuple ] times ] unit-test
+    [ 5 ] [
+        <query>
+        T{ exam { score T{ interval { from { 0 t } } { to { 100 t } } } } }
+            >>tuple
+        5 >>limit select-tuples length
+    ] unit-test ;
+
+TUPLE: compound-foo a b c ;
+
+compound-foo "COMPOUND_FOO" 
+{
+    { "a" "A" INTEGER +user-assigned-id+ }
+    { "b" "B" INTEGER +user-assigned-id+ }
+    { "c" "C" INTEGER }
+} define-persistent
+
+: test-compound-primary-key ( -- )
+    [ ] [ compound-foo ensure-table ] unit-test
+    [ ] [ compound-foo drop-table ] unit-test
+    [ ] [ compound-foo create-table ] unit-test
+    [ ] [ 1 2 3 compound-foo boa insert-tuple ] unit-test
+    [ 1 2 3 compound-foo boa insert-tuple ] must-fail
+    [ ] [ 2 3 4 compound-foo boa insert-tuple ] unit-test
+    [ T{ compound-foo { a 2 } { b 3 } { c 4 } } ]
+    [ compound-foo new 4 >>c select-tuple ] unit-test ;
+
+[ test-compound-primary-key ] test-sqlite
+[ test-compound-primary-key ] test-postgresql
+
+: sqlite-test-db ( -- )
+    "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
+
+: postgresql-test-db ( -- )
+    { "localhost" "postgres" "foob" "factor-test" } postgresql-db
+    make-db db-open db set ;
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@ -3,36 +3,10 @@
 USING: arrays assocs classes db kernel namespaces
 classes.tuple words sequences slots math accessors
 math.parser io prettyprint db.types continuations
-destructors mirrors ;
+destructors mirrors sets db.types ;
 IN: db.tuples

-: define-persistent ( class table columns -- )
-    >r dupd "db-table" set-word-prop dup r>
-    [ relation? ] partition swapd
-    dupd [ spec>tuple ] with map
-    "db-columns" set-word-prop
-    "db-relations" set-word-prop ;
-
-ERROR: not-persistent class ;
-
-: db-table ( class -- object )
-    dup "db-table" word-prop [ ] [ not-persistent ] ?if ;
-
-: db-columns ( class -- object )
-    superclasses [ "db-columns" word-prop ] map concat ;
-
-: db-relations ( class -- object )
-    "db-relations" word-prop ;
-
-: set-primary-key ( key tuple -- )
-    [
-        class db-columns find-primary-key slot-name>>
-    ] keep set-slot-named ;
-
-SYMBOL: sql-counter
-: next-sql-counter ( -- str )
-    sql-counter [ inc ] [ get ] bi number>string ;
-
+<PRIVATE
 ! returns a sequence of prepared-statements
 HOOK: create-sql-statement db ( class -- object )
 HOOK: drop-sql-statement db ( class -- object )
@ -42,19 +16,20 @@ HOOK: <insert-user-assigned-statement> db ( class -- object )
 HOOK: <update-tuple-statement> db ( class -- object )
 HOOK: <delete-tuples-statement> db ( tuple class -- object )
 HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
-TUPLE: query group order offset limit ;
-HOOK: <query> db ( tuple class query -- statement' )
-HOOK: <count-statement> db ( tuple class groups -- n )
+HOOK: <count-statement> db ( query -- statement )
+HOOK: query>statement db ( query -- statement )

-HOOK: insert-tuple* db ( tuple statement -- )
+HOOK: insert-tuple-set-key db ( tuple statement -- )
+
+SYMBOL: sql-counter
+: next-sql-counter ( -- str )
+    sql-counter [ inc ] [ get ] bi number>string ;

 GENERIC: eval-generator ( singleton -- object )

 : resulting-tuple ( exemplar-tuple row out-params -- tuple )
    rot class new [
-        [
-            [ slot-name>> ] dip set-slot-named
-        ] curry 2each
+        [ [ slot-name>> ] dip set-slot-named ] curry 2each
    ] keep ;

 : query-tuples ( exemplar-tuple statement -- seq )
@ -75,6 +50,51 @@ GENERIC: eval-generator ( singleton -- object )
        with-disposal
    ] if ; inline

+: insert-db-assigned-statement ( tuple -- )
+    dup class
+    db get insert-statements>> [ <insert-db-assigned-statement> ] cache
+    [ bind-tuple ] 2keep insert-tuple-set-key ;
+
+: insert-user-assigned-statement ( tuple -- )
+    dup class
+    db get insert-statements>> [ <insert-user-assigned-statement> ] cache
+    [ bind-tuple ] keep execute-statement ;
+
+: do-select ( exemplar-tuple statement -- tuples )
+    [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
+
+: do-count ( exemplar-tuple statement -- tuples )
+    [ [ bind-tuple ] [ nip default-query ] 2bi ] with-disposal ;
+PRIVATE>
+
+
+! High level
+ERROR: no-slots-named class seq ;
+: check-columns ( class columns -- )
+    tuck
+    [ [ first ] map ]
+    [ all-slots [ name>> ] map ] bi* diff
+    [ drop ] [ no-slots-named ] if-empty ;
+
+: define-persistent ( class table columns -- )
+    pick dupd
+    check-columns
+    [ dupd "db-table" set-word-prop dup ] dip
+    [ relation? ] partition swapd
+    dupd [ spec>tuple ] with map
+    "db-columns" set-word-prop
+    "db-relations" set-word-prop ;
+
+TUPLE: query tuple group order offset limit ;
+
+: <query> ( -- query ) \ query new ;
+
+GENERIC: >query ( object -- query )
+
+M: query >query clone ;
+
+M: tuple >query <query> swap >>tuple ;
+
 : create-table ( class -- )
    create-sql-statement [ execute-statement ] with-disposals ;

@ -87,21 +107,9 @@ GENERIC: eval-generator ( singleton -- object )
        ] curry ignore-errors
    ] [ create-table ] bi ;

-: ensure-table ( class -- )
-    [ create-table ] curry ignore-errors ;
+: ensure-table ( class -- ) [ create-table ] curry ignore-errors ;

-: ensure-tables ( classes -- )
-    [ ensure-table ] each ;
-
-: insert-db-assigned-statement ( tuple -- )
-    dup class
-    db get insert-statements>> [ <insert-db-assigned-statement> ] cache
-    [ bind-tuple ] 2keep insert-tuple* ;
-
-: insert-user-assigned-statement ( tuple -- )
-    dup class
-    db get insert-statements>> [ <insert-user-assigned-statement> ] cache
-    [ bind-tuple ] keep execute-statement ;
+: ensure-tables ( classes -- ) [ ensure-table ] each ;

 : insert-tuple ( tuple -- )
    dup class db-columns find-primary-key db-assigned-id-spec?
@ -117,25 +125,14 @@ GENERIC: eval-generator ( singleton -- object )
        [ bind-tuple ] keep execute-statement
    ] with-disposal ;

-: do-select ( exemplar-tuple statement -- tuples )
-    [ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
+: select-tuples ( query/tuple -- tuples )
+    >query [ tuple>> ] [ query>statement ] bi do-select ;

-: query ( tuple query -- tuples )
-    [ dup dup class ] dip <query> do-select ;
-
-: select-tuples ( tuple -- tuples )
-    dup dup class <select-by-slots-statement> do-select ;
-
-: select-tuple ( tuple -- tuple/f )
-    dup dup class \ query new 1 >>limit <query> do-select
+: select-tuple ( query/tuple -- tuple/f )
+    >query 1 >>limit [ tuple>> ] [ query>statement ] bi do-select
    [ f ] [ first ] if-empty ;

-: do-count ( exemplar-tuple statement -- tuples )
-    [
-        [ bind-tuple ] [ nip default-query ] 2bi
-    ] with-disposal ;
-
-: count-tuples ( tuple groups -- n )
-    >r dup dup class r> <count-statement> do-count
+: count-tuples ( query/tuple -- n )
+    >query [ tuple>> ] [ <count-statement> ] bi do-count
    dup length 1 =
    [ first first string>number ] [ [ first string>number ] map ] if ;
--- a/basis/db/types/types-docs.factor
+++ b/basis/db/types/types-docs.factor
@ -1,14 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: classes hashtables help.markup help.syntax io.streams.string kernel sequences strings ;
+USING: classes hashtables help.markup help.syntax io.streams.string
+kernel sequences strings math ;
 IN: db.types

-HELP: (lookup-type)
-{ $values
-     { "obj" object }
-     { "string" string } }
-{ $description "" } ;
-
 HELP: +autoincrement+
 { $description "" } ;

@ -55,7 +50,7 @@ HELP: <low-level-binding>
 { $description "" } ;

 HELP: BIG-INTEGER
-{ $description "A 64-bit integer." } ;
+{ $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ;

 HELP: BLOB
 { $description "A serialized Factor object.  The database library automatically serializes the object for a SQL insert or update and deserializes it on a tuple query." } ;
@ -73,13 +68,13 @@ HELP: DOUBLE
 { $description "Corresponds to Factor's 64bit floating-point numbers." } ;

 HELP: FACTOR-BLOB
-{ $description "" } ;
+{ $description "A serialized Factor object." } ;

 HELP: INTEGER
-{ $description "" } ;
+{ $description "A small integer, at least 32 bits in length. Whether this number is signed or unsigned depends on the database backend." } ;

 HELP: NULL
-{ $description "" } ;
+{ $description "The SQL null type." } ;

 HELP: REAL
 { $description "" } ;
@ -94,22 +89,24 @@ HELP: TIME
 { $description "" } ;

 HELP: TIMESTAMP
-{ $description "" } ;
+{ $description "A Factor timestamp." } ;

 HELP: UNSIGNED-BIG-INTEGER
-{ $description "" } ;
+{ $description "For portability, if a number is known to be 64bit, then this datatype may be used.  Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types.  If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ;
+
+{ INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER } related-words

 HELP: URL
-{ $description "" } ;
+{ $description "A Factor " { $link "urls" } "  object." } ;

 HELP: VARCHAR
-{ $description "" } ;
+{ $description "The SQL varchar type.  This type can take an integer as an argument." } ;

-HELP: assigned-id-spec?
+HELP: user-assigned-id-spec?
 { $values
-     { "spec" null }
+     { "specs" "a sequence of sql specs" }
     { "?" "a boolean" } }
-{ $description "" } ;
+{ $description "Tests if any of the sql specs has the type " { $link +user-assigned-id+ } "." } ;

 HELP: bind#
 { $values
@ -129,24 +126,25 @@ HELP: compound

 HELP: db-assigned-id-spec?
 { $values
-     { "spec" null }
+     { "specs" "a sequence of sql specs" }
     { "?" "a boolean" } }
-{ $description "" } ;
+{ $description "Tests if any of the sql specs has the type " { $link +db-assigned-id+ } "." } ;

 HELP: find-primary-key
 { $values
-     { "specs" null }
-     { "obj" object } }
-{ $description "" } ;
+     { "specs" "a sequence of sql-specs" }
+     { "seq" "a sequence of sql-specs" } }
+{ $description "Returns the rows from the sql-specs array that are part of the primary key. Composite primary keys are supported, so this word must return a sequence." }
+{ $notes "This is a low-level word." } ;

 HELP: generator-bind
 { $description "" } ;

 HELP: get-slot-named
 { $values
-     { "name" null } { "obj" object }
-     { "value" null } }
-{ $description "" } ;
+     { "name" "a slot name" } { "tuple" tuple }
+     { "value" "the value stored in the slot" } }
+{ $description "Returns the value stored in a tuple slot, where the tuple slot is a string." } ;

 HELP: join-space
 { $values
@ -185,30 +183,20 @@ HELP: modifiers
 { $description "" } ;

 HELP: no-sql-type
-{ $description "" } ;
+{ $values
+     { "type" "a sql type" } }
+{ $description "Throws an error containing a sql type that is unsupported or the result of a typo." } ;

 HELP: normalize-spec
 { $values
     { "spec" null } }
 { $description "" } ;

-HELP: number>string*
-{ $values
-     { "n/string" null }
-     { "string" string } }
-{ $description "" } ;
-
 HELP: offset-of-slot
 { $values
-     { "string" string } { "obj" object }
-     { "n" null } }
-{ $description "" } ;
-
-HELP: paren
-{ $values
-     { "string" string }
-     { "new-string" null } }
-{ $description "" } ;
+     { "string" string } { "tuple" tuple }
+     { "n" integer } }
+{ $description "Returns the offset of a tuple slot accessed by name." } ;

 HELP: persistent-table
 { $values
@ -264,7 +252,8 @@ HELP: sql-spec
 { $description "" } ;

 HELP: unknown-modifier
-{ $description "" } ;
+{ $values { "modifier" string } }
+{ $description "Throws an error containing an unknown sql modifier." } ;

 ARTICLE: "db.types" "Database types"
 "The " { $vocab-link "db.types" } " vocabulary maps Factor types to database types." $nl
@ -294,7 +283,6 @@ ARTICLE: "db.types" "Database types"
 { $subsection BLOB }
 { $subsection FACTOR-BLOB }
 "Factor URLs:"
-{ $subsection URL }
-;
+{ $subsection URL } ;

 ABOUT: "db.types"
--- a/basis/db/types/types.factor
+++ b/basis/db/types/types.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs db kernel math math.parser
-sequences continuations sequences.deep
+sequences continuations sequences.deep prettyprint
 words namespaces slots slots.private classes mirrors
 classes.tuple combinators calendar.format symbols
 classes.singleton accessors quotations random ;
@ -22,22 +22,51 @@ SINGLETON: random-id-generator
 TUPLE: low-level-binding value ;
 C: <low-level-binding> low-level-binding

-SINGLETON: +db-assigned-id+
-SINGLETON: +user-assigned-id+
-SINGLETON: +random-id+
+SINGLETONS: +db-assigned-id+ +user-assigned-id+ +random-id+ ;
 UNION: +primary-key+ +db-assigned-id+ +user-assigned-id+ +random-id+ ;

 SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
-+foreign-id+ +has-many+ ;
+foreign-id+ +has-many+ +on-delete+ +restrict+ +cascade+ +set-null+
+set-default+ ;
+
+: offset-of-slot ( string tuple -- n )
+    class superclasses [ "slots" word-prop ] map concat
+    slot-named offset>> ;
+
+: get-slot-named ( name tuple -- value )
+    tuck offset-of-slot slot ;
+
+: set-slot-named ( value name obj -- )
+    tuck offset-of-slot set-slot ;
+
+ERROR: not-persistent class ;
+
+: db-table ( class -- object )
+    dup "db-table" word-prop [ ] [ not-persistent ] ?if ;
+
+: db-columns ( class -- object )
+    superclasses [ "db-columns" word-prop ] map concat ;
+
+: db-relations ( class -- object )
+    "db-relations" word-prop ;
+
+: find-primary-key ( specs -- seq )
+    [ primary-key>> ] filter ;
+
+: set-primary-key ( value tuple -- )
+    [
+        class db-columns
+        find-primary-key first slot-name>>
+    ] keep set-slot-named ;

 : primary-key? ( spec -- ? )
    primary-key>> +primary-key+? ;

-: db-assigned-id-spec? ( spec -- ? )
-    primary-key>> +db-assigned-id+? ;
+: db-assigned-id-spec? ( specs -- ? )
+    [ primary-key>> +db-assigned-id+? ] contains? ;

-: assigned-id-spec? ( spec -- ? )
-    primary-key>> +user-assigned-id+? ;
+: user-assigned-id-spec? ( specs -- ? )
+    [ primary-key>> +user-assigned-id+? ] contains? ;

 : normalize-spec ( spec -- )
    dup type>> dup +primary-key+? [
@ -49,8 +78,8 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
        [ >>primary-key drop ] [ drop ] if*
    ] if ;

-: find-primary-key ( specs -- obj )
-    [ primary-key>> ] find nip ;
+: db-assigned? ( class -- ? )
+    db-columns find-primary-key db-assigned-id-spec? ;

 : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ;

@ -86,18 +115,22 @@ FACTOR-BLOB NULL URL ;
 ! PostgreSQL Types:
 ! http://developer.postgresql.org/pgdocs/postgres/datatype.html

-ERROR: unknown-modifier ;
+
+: ?at ( obj assoc -- value/obj ? )
+    dupd at* [ [ nip ] [ drop ] if ] keep ;
+
+ERROR: unknown-modifier modifier ;

 : lookup-modifier ( obj -- string )
    {
        { [ dup array? ] [ unclip lookup-modifier swap compound ] }
-        [ persistent-table at* [ unknown-modifier ] unless third ]
+        [ persistent-table ?at [ unknown-modifier ] unless third ]
    } cond ;

-ERROR: no-sql-type ;
+ERROR: no-sql-type type ;

 : (lookup-type) ( obj -- string )
-    persistent-table at* [ no-sql-type ] unless ;
+    persistent-table ?at [ no-sql-type ] unless ;

 : lookup-type ( obj -- string )
    dup array? [
@ -113,25 +146,21 @@ ERROR: no-sql-type ;
        (lookup-type) second
    ] if ;

-: paren ( string -- new-string )
-    "(" swap ")" 3append ;
-
-: join-space ( string1 string2 -- new-string )
-    " " swap 3append ;
-
 : modifiers ( spec -- string )
    modifiers>> [ lookup-modifier ] map " " join
    [ "" ] [ " " prepend ] if-empty ;

+: join-space ( string1 string2 -- new-string )
+    " " swap 3append ;
+
+: paren ( string -- new-string )
+    "(" swap ")" 3append ;
+
 HOOK: bind% db ( spec -- )
 HOOK: bind# db ( spec obj -- )

-: offset-of-slot ( string obj -- n )
-    class superclasses [ "slots" word-prop ] map concat
-    slot-named offset>> ;
-
-: get-slot-named ( name obj -- value )
-    tuck offset-of-slot slot ;
-
-: set-slot-named ( value name obj -- )
-    tuck offset-of-slot set-slot ;
+: >reference-string ( string pair -- string )
+    first2
+    [ [ unparse join-space ] [ db-columns ] bi ] dip
+    swap [ slot-name>> = ] with find nip
+    column-name>> paren append ;
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@ -22,6 +22,9 @@ M: tuple error-help class ;

 M: string error. print ;

+: :error ( -- )
+    error get error. ;
+
 : :s ( -- )
    error-continuation get data>> stack. ;

@ -323,3 +326,5 @@ M: bad-effect summary
    drop "Bad stack effect declaration" ;

 M: bad-escape summary drop "Bad escape code" ;
+
+M: bad-literal-tuple summary drop "Bad literal tuple" ;
--- a/basis/delegate/delegate-docs.factor
+++ b/basis/delegate/delegate-docs.factor
@ -45,5 +45,4 @@ $nl
 { $subsection define-consult }
 "The " { $vocab-link "delegate.protocols" } " vocabulary defines formal protocols for the various informal protocols used in the Factor core, such as " { $link "sequence-protocol" } ", " { $link "assocs-protocol" } " or " { $link "stream-protocol" } ;

-IN: delegate
 ABOUT: { "delegate" "intro" }
--- a/basis/delegate/delegate.factor
+++ b/basis/delegate/delegate.factor
@ -62,7 +62,7 @@ M: tuple-class group-words
    protocol-consult keys ;

 : lost-words ( protocol wordlist -- lost-words )
-    >r protocol-words r> diff ;
+    [ protocol-words ] dip diff ;

 : forget-old-definitions ( protocol new-wordlist -- )
    [ drop protocol-users ] [ lost-words ] 2bi
--- a/basis/deques/deques-docs.factor
+++ b/basis/deques/deques-docs.factor
@ -1,45 +1,29 @@
+USING: help.markup help.syntax kernel math sequences
+quotations ;
 IN: deques
-USING: help.markup help.syntax kernel ;
-
-ARTICLE: "deques" "Dequeues"
-"A deque is a data structure with constant-time insertion and removal of elements at both ends. Dequeue operations are defined in the " { $vocab-link "deques" } " vocabulary."
-$nl
-"Dequeues must be instances of a mixin class:"
-{ $subsection deque }
-"Dequeues must implement a protocol."
-$nl
-"Querying the deque:"
-{ $subsection peek-front }
-{ $subsection peek-back }
-{ $subsection deque-length }
-{ $subsection deque-member? }
-"Adding and removing elements:"
-{ $subsection push-front* }
-{ $subsection push-back* }
-{ $subsection pop-front* }
-{ $subsection pop-back* }
-{ $subsection clear-deque }
-"Working with node objects output by " { $link push-front* } " and " { $link push-back* } ":"
-{ $subsection delete-node }
-{ $subsection node-value }
-"Utility operations built in terms of the above:"
-{ $subsection deque-empty? }
-{ $subsection push-front }
-{ $subsection push-all-front }
-{ $subsection push-back }
-{ $subsection push-all-back }
-{ $subsection pop-front }
-{ $subsection pop-back }
-{ $subsection slurp-deque }
-"When using a deque as a queue, the convention is to queue elements with " { $link push-front } " and deque them with " { $link pop-back } "." ;
-
-ABOUT: "deques"

 HELP: deque-empty?
-{ $values { "deque" { $link deque } } { "?" "a boolean" } }
+{ $values { "deque" deque } { "?" "a boolean" } }
 { $description "Returns true if a deque is empty." }
 { $notes "This operation is O(1)." } ;

+HELP: clear-deque
+{ $values
+     { "deque" deque } }
+{ $description "Removes all elements from a deque." } ;
+
+HELP: deque-length
+{ $values
+     { "deque" deque }
+     { "n" integer } }
+{ $description "Returns the number of elements in a deque." } ;
+
+HELP: deque-member?
+{ $values
+     { "value" object } { "deque" deque }
+     { "?" "a boolean" } }
+{ $description "Returns true if the " { $snippet "value" } " is found in the deque." } ;
+
 HELP: push-front
 { $values { "obj" object } { "deque" deque } }
 { $description "Push the object onto the front of the deque." } 
@ -60,6 +44,16 @@ HELP: push-back*
 { $description "Push the object onto the back of the deque and return the newly created node." } 
 { $notes "This operation is O(1)." } ;

+HELP: push-all-back
+{ $values
+     { "seq" sequence } { "deque" deque } }
+{ $description "Pushes a sequence of elements onto the back of a deque." } ;
+
+HELP: push-all-front
+{ $values
+     { "seq" sequence } { "deque" deque } }
+{ $description "Pushes a sequence of elements onto the front of a deque." } ;
+
 HELP: peek-front
 { $values { "deque" deque } { "obj" object } }
 { $description "Returns the object at the front of the deque." } ;
@ -87,3 +81,56 @@ HELP: pop-back*
 { $values { "deque" deque } }
 { $description "Pop the object off the back of the deque." }
 { $notes "This operation is O(1)." } ;
+
+HELP: delete-node
+{ $values
+     { "node" object } { "deque" deque } }
+{ $description "Deletes the node from the deque." } ;
+
+HELP: deque
+{ $description "A data structure that has constant-time insertion and removal of elements at both ends." } ;
+
+HELP: node-value
+{ $values
+     { "node" object }
+     { "value" object } }
+{ $description "Accesses the value stored at a node." } ;
+
+HELP: slurp-deque
+{ $values
+     { "deque" deque } { "quot" quotation } }
+{ $description "Pops off the back element of the deque and calls the quotation in a loop until the deque is empty." } ;
+
+ARTICLE: "deques" "Deques"
+"The " { $vocab-link "deques" } " vocabulary implements the deque data structure which has constant-time insertion and removal of elements at both ends."
+$nl
+"Deques must be instances of a mixin class:"
+{ $subsection deque }
+"Deques must implement a protocol."
+$nl
+"Querying the deque:"
+{ $subsection peek-front }
+{ $subsection peek-back }
+{ $subsection deque-length }
+{ $subsection deque-member? }
+"Adding and removing elements:"
+{ $subsection push-front* }
+{ $subsection push-back* }
+{ $subsection pop-front* }
+{ $subsection pop-back* }
+{ $subsection clear-deque }
+"Working with node objects output by " { $link push-front* } " and " { $link push-back* } ":"
+{ $subsection delete-node }
+{ $subsection node-value }
+"Utility operations built in terms of the above:"
+{ $subsection deque-empty? }
+{ $subsection push-front }
+{ $subsection push-all-front }
+{ $subsection push-back }
+{ $subsection push-all-back }
+{ $subsection pop-front }
+{ $subsection pop-back }
+{ $subsection slurp-deque }
+"When using a deque as a queue, the convention is to queue elements with " { $link push-front } " and deque them with " { $link pop-back } "." ;
+
+ABOUT: "deques"
--- a/basis/disjoint-sets/disjoint-sets-docs.factor
+++ b/basis/disjoint-sets/disjoint-sets-docs.factor
@ -37,7 +37,7 @@ HELP: assoc>disjoint-set
 } ;

 ARTICLE: "disjoint-sets" "Disjoint sets"
-"The " { $emphasis "disjoint set" } " data structure, also known as " { $emphasis "union-find" } " (after the two main operations which it supports) represents a set of elements partitioned into disjoint equivalence classes, or alternatively, an equivalence relation on a set."
+"The " { $vocab-link "disjoint-sets" } " vocabulary implements the " { $emphasis "disjoint set" } " data structure (also known as " { $emphasis "union-find" } ", after the two main operations which it supports) that represents a set of elements partitioned into disjoint equivalence classes, or alternatively, an equivalence relation on a set."
 $nl
 "The two main supported operations are equating two elements, which joins their equivalence classes, and checking if two elements belong to the same equivalence class. Both operations have the time complexity of the inverse Ackermann function, which for all intents and purposes is constant time."
 $nl
--- a/basis/editors/macvim/authors.txt
+++ b/basis/editors/macvim/authors.txt
@ -0,0 +1 @@
+John Benediktsson
--- a/basis/editors/macvim/macvim.factor
+++ b/basis/editors/macvim/macvim.factor
@ -0,0 +1,13 @@
+USING: definitions io.launcher kernel math math.parser parser
+namespaces prettyprint editors make ;
+
+IN: editors.macvim
+
+: macvim-location ( file line -- )
+    drop
+    [ "open" , "-a" , "MacVim", , ] { } make
+    try-process ;
+
+[ macvim-location ] edit-hook set-global
+
+
--- a/basis/editors/macvim/summary.txt
+++ b/basis/editors/macvim/summary.txt
@ -0,0 +1 @@
+MacVim editor integration
--- a/basis/editors/macvim/tags.txt
+++ b/basis/editors/macvim/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/editors/textedit/authors.txt
+++ b/basis/editors/textedit/authors.txt
@ -0,0 +1 @@
+John Benediktsson
--- a/basis/editors/textedit/summary.txt
+++ b/basis/editors/textedit/summary.txt
@ -0,0 +1 @@
+TextEdit editor integration
--- a/basis/editors/textedit/tags.txt
+++ b/basis/editors/textedit/tags.txt
@ -0,0 +1 @@
+unportable
--- a/basis/editors/textedit/textedit.factor
+++ b/basis/editors/textedit/textedit.factor
@ -0,0 +1,13 @@
+USING: definitions io.launcher kernel math math.parser parser
+namespaces prettyprint editors make ;
+
+IN: editors.textedit
+
+: textedit-location ( file line -- )
+    drop
+    [ "open" , "-a" , "TextEdit", , ] { } make
+    try-process ;
+
+[ textedit-location ] edit-hook set-global
+
+
--- a/basis/eval/authors.txt
+++ b/basis/eval/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/eval/summary.txt
+++ b/basis/eval/summary.txt
@ -0,0 +1 @@
+Ad-hoc evaluation of strings of code
--- a/basis/farkup/farkup-docs.factor
+++ b/basis/farkup/farkup-docs.factor
@ -9,7 +9,7 @@ HELP: write-farkup
 { $values { "string" string } }
 { $description "Parse a Farkup string and writes the resulting HTML to " { $link output-stream } "." } ;

-HELP: farkup ( string -- farkup )
+HELP: parse-farkup ( string -- farkup )
 { $values { "string" string } { "farkup" "a Farkup syntax tree node" } }
 { $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ;

@ -18,7 +18,7 @@ HELP: (write-farkup)
 { $description "Writes a Farkup syntax tree as HTML on " { $link output-stream } "." } ;

 ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
-"The " { $link farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
+"The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
 { $subsection heading1 }
 { $subsection heading2 }
 { $subsection heading3 }
@ -30,7 +30,8 @@ ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
 { $subsection inline-code }
 { $subsection paragraph }
 { $subsection list-item }
-{ $subsection list }
+{ $subsection unordered-list }
+{ $subsection ordered-list }
 { $subsection table }
 { $subsection table-row }
 { $subsection link }
@ -44,7 +45,7 @@ $nl
 { $subsection convert-farkup }
 { $subsection write-farkup }
 "The syntax tree of a piece of Farkup can also be inspected and modified:"
-{ $subsection farkup }
+{ $subsection parse-farkup }
 { $subsection (write-farkup) }
 { $subsection "farkup-ast" } ;

--- a/basis/farkup/farkup-tests.factor
+++ b/basis/farkup/farkup-tests.factor
@ -11,13 +11,11 @@ link-no-follow? off
 [ "Baz" ] [ "Baz" simple-link-title ] unit-test

 [ ] [
-    "abcd-*strong*\nasdifj\nweouh23ouh23"
-    "paragraph" \ farkup rule parse drop
+    "abcd-*strong*\nasdifj\nweouh23ouh23" parse-farkup drop
 ] unit-test

 [ ] [
-    "abcd-*strong*\nasdifj\nweouh23ouh23\n"
-    "paragraph" \ farkup rule parse drop
+    "abcd-*strong*\nasdifj\nweouh23ouh23\n" parse-farkup drop
 ] unit-test

 [ "<p>a-b</p>" ] [ "a-b" convert-farkup ] unit-test
@ -37,22 +35,30 @@ link-no-follow? off

 [ "<ul><li>foo</li>\n</ul><p>bar\n</p>" ] [ "-foo\nbar\n" convert-farkup ] unit-test

+[ "<ol><li>a-b</li></ol>" ] [ "#a-b" convert-farkup ] unit-test
+[ "<ol><li>foo</li></ol>" ] [ "#foo" convert-farkup ] unit-test
+[ "<ol><li>foo</li>\n</ol>" ] [ "#foo\n" convert-farkup ] unit-test
+[ "<ol><li>foo</li>\n<li>bar</li></ol>" ] [ "#foo\n#bar" convert-farkup ] unit-test
+[ "<ol><li>foo</li>\n<li>bar</li>\n</ol>" ] [ "#foo\n#bar\n" convert-farkup ] unit-test
+
+[ "<ol><li>foo</li>\n</ol><p>bar\n</p>" ] [ "#foo\nbar\n" convert-farkup ] unit-test
+

 [ "\n\n" ] [ "\n\n" convert-farkup ] unit-test
 [ "\n\n" ] [ "\r\n\r\n" convert-farkup ] unit-test
 [ "\n\n\n\n" ] [ "\r\r\r\r" convert-farkup ] unit-test
 [ "\n\n\n" ] [ "\r\r\r" convert-farkup ] unit-test
 [ "\n\n\n" ] [ "\n\n\n" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\r\rbar" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\r\r\nbar" convert-farkup ] unit-test
+[ "<p>foo\n</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test
+[ "<p>foo\n</p><p>bar</p>" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test
+[ "<p>foo\n</p><p>bar</p>" ] [ "foo\r\rbar" convert-farkup ] unit-test
+[ "<p>foo\n</p><p>bar</p>" ] [ "foo\r\r\nbar" convert-farkup ] unit-test

 [ "\n<p>bar\n</p>" ] [ "\nbar\n" convert-farkup ] unit-test
 [ "\n<p>bar\n</p>" ] [ "\rbar\r" convert-farkup ] unit-test
 [ "\n<p>bar\n</p>" ] [ "\r\nbar\r\n" convert-farkup ] unit-test

-[ "<p>foo</p><p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test
+[ "<p>foo\n</p><p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test

 [ "" ] [ "" convert-farkup ] unit-test

@ -107,7 +113,7 @@ link-no-follow? off
 ] [ "Feature comparison:\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test

 [
-    "<p>Feature comparison:</p><table><tr><td>a</td><td>Factor</td><td>Java</td><td>Lisp</td></tr><tr><td>Coolness</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Badass</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Enterprise</td><td>Yes</td><td>Yes</td><td>No</td></tr><tr><td>Kosher</td><td>Yes</td><td>No</td><td>Yes</td></tr></table>"
+    "<p>Feature comparison:\n</p><table><tr><td>a</td><td>Factor</td><td>Java</td><td>Lisp</td></tr><tr><td>Coolness</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Badass</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Enterprise</td><td>Yes</td><td>Yes</td><td>No</td></tr><tr><td>Kosher</td><td>Yes</td><td>No</td><td>Yes</td></tr></table>"
 ] [ "Feature comparison:\n\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test

 [
@ -118,3 +124,36 @@ link-no-follow? off
 ] unit-test

 [ "<p><a href='a'>a</a> <a href='b'>c</a></p>" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test
+
+[ "<p><a href='C%2b%2b'>C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
+
+[ "<p>&lt;foo&gt;</p>" ] [ "<foo>" convert-farkup ] unit-test
+
+[ "<p>asdf\n<ul><li>lol</li>\n<li>haha</li></ul></p>" ] [ "asdf\n-lol\n-haha" convert-farkup ] unit-test
+
+[ "<p>asdf\n</p><ul><li>lol</li>\n<li>haha</li></ul>" ]
+ [ "asdf\n\n-lol\n-haha" convert-farkup ] unit-test
+
+[ "<hr/>" ] [ "___" convert-farkup ] unit-test
+[ "<hr/>\n" ] [ "___\n" convert-farkup ] unit-test
+
+[ "<p>before:\n<pre><span class='OPERATOR'>{</span> <span class='DIGIT'>1</span> <span class='DIGIT'>2</span> <span class='DIGIT'>3</span> <span class='OPERATOR'>}</span> <span class='DIGIT'>1</span> tail\n</pre></p>" ] 
+[ "before:\n[factor{{ 1 2 3 } 1 tail}]" convert-farkup ] unit-test
+ 
+[ "<p><a href='Factor'>Factor</a>-rific!</p>" ]
+[ "[[Factor]]-rific!" convert-farkup ] unit-test
+
+[ "<p>[ factor { 1 2 3 }]</p>" ]
+[ "[ factor { 1 2 3 }]" convert-farkup ] unit-test
+
+[ "<p>paragraph\n<hr/></p>" ]
+[ "paragraph\n___" convert-farkup ] unit-test
+
+[ "<p>paragraph\n a ___ b</p>" ]
+[ "paragraph\n a ___ b" convert-farkup ] unit-test
+
+[ "\n<ul><li> a</li>\n</ul><hr/>" ]
+[ "\n- a\n___" convert-farkup ] unit-test
+
+[ "<p>hello_world how are you today?\n<ul><li> hello_world how are you today?</li></ul></p>" ]
+[ "hello_world how are you today?\n- hello_world how are you today?" convert-farkup ] unit-test
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@ -1,32 +1,34 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators html.elements io io.streams.string
-kernel math memoize namespaces peg peg.ebnf prettyprint
-sequences sequences.deep strings xml.entities vectors splitting
-xmode.code2html ;
+USING: accessors arrays combinators html.elements io
+io.streams.string kernel math namespaces peg peg.ebnf
+sequences sequences.deep strings xml.entities
+vectors splitting xmode.code2html urls.encoding ;
 IN: farkup

 SYMBOL: relative-link-prefix
 SYMBOL: disable-images?
 SYMBOL: link-no-follow?

-TUPLE: heading1 obj ;
-TUPLE: heading2 obj ;
-TUPLE: heading3 obj ;
-TUPLE: heading4 obj ;
-TUPLE: strong obj ;
-TUPLE: emphasis obj ;
-TUPLE: superscript obj ;
-TUPLE: subscript obj ;
-TUPLE: inline-code obj ;
-TUPLE: paragraph obj ;
-TUPLE: list-item obj ;
-TUPLE: list obj ;
-TUPLE: table obj ;
-TUPLE: table-row obj ;
+TUPLE: heading1 child ;
+TUPLE: heading2 child ;
+TUPLE: heading3 child ;
+TUPLE: heading4 child ;
+TUPLE: strong child ;
+TUPLE: emphasis child ;
+TUPLE: superscript child ;
+TUPLE: subscript child ;
+TUPLE: inline-code child ;
+TUPLE: paragraph child ;
+TUPLE: list-item child ;
+TUPLE: unordered-list child ;
+TUPLE: ordered-list child ;
+TUPLE: table child ;
+TUPLE: table-row child ;
 TUPLE: link href text ;
 TUPLE: image href text ;
 TUPLE: code mode string ;
+TUPLE: line ;

 : absolute-url? ( string -- ? )
    { "http://" "https://" "ftp://" } [ head? ] with contains? ;
@ -34,9 +36,9 @@ TUPLE: code mode string ;
 : simple-link-title ( string -- string' )
    dup absolute-url? [ "/" last-split1 swap or ] unless ;

-EBNF: farkup
+EBNF: parse-farkup
 nl               = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]
-2nl              = nl nl
+whitespace       = " " | "\t" | nl

 heading1      = "=" (!("=" | nl).)+ "="
    => [[ second >string heading1 boa ]]
@ -50,6 +52,10 @@ heading3      = "===" (!("=" | nl).)+ "==="
 heading4      = "====" (!("=" | nl).)+ "===="
    => [[ second >string heading4 boa ]]

+heading          = heading4 | heading3 | heading2 | heading1
+
+
+
 strong        = "*" (!("*" | nl).)+ "*"
    => [[ second >string strong boa ]]

@ -65,8 +71,6 @@ subscript     = "~" (!("~" | nl).)+ "~"
 inline-code   = "%" (!("%" | nl).)+ "%"
    => [[ second >string inline-code boa ]]

-escaped-char  = "\" .                => [[ second ]]
-
 link-content     = (!("|"|"]").)+

 image-link       = "[[image:" link-content  "|" link-content "]]"
@ -82,44 +86,71 @@ labelled-link    = "[[" link-content "|" link-content "]]"

 link             = image-link | labelled-link | simple-link

-heading          = heading4 | heading3 | heading2 | heading1
+escaped-char  = "\" .
+    => [[ second 1string ]]

 inline-tag       = strong | emphasis | superscript | subscript | inline-code
                   | link | escaped-char

+
+
 inline-delimiter = '*' | '_' | '^' | '~' | '%' | '\' | '['

-table-column     = (list | (!(nl | inline-delimiter | '|').)+ | inline-tag | inline-delimiter  ) '|'
+cell             = (!(inline-delimiter | '|' | nl).)+
+    => [[ >string ]]
+    
+table-column     = (list | cell | inline-tag | inline-delimiter  ) '|'
    => [[ first ]]
 table-row        = "|" (table-column)+
    => [[ second table-row boa ]]
 table            =  ((table-row nl => [[ first ]] )+ table-row? | table-row)
    => [[ table boa ]]

-paragraph-item = ( table | (!(nl | code | heading | inline-delimiter | table ).) | inline-tag | inline-delimiter)+
-paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]]
-             | (paragraph-item nl)+ paragraph-item?
+text = (!(nl | code | heading | inline-delimiter | table ).)+
+    => [[ >string ]]
+
+paragraph-nl-item = nl (list | line)?
+paragraph-item = (table | code | text | inline-tag | inline-delimiter)+
+paragraph = ((paragraph-item paragraph-nl-item)+ nl+ => [[ first ]]
+             | (paragraph-item paragraph-nl-item)+ paragraph-item?
             | paragraph-item)
    => [[ paragraph boa ]]
-                
-list-item      = '-' ((!(inline-delimiter | nl).)+ | inline-tag)*
-    => [[ second list-item boa ]]
-list = ((list-item nl)+ list-item? | list-item)
-    => [[ list boa ]]

-code       =  '[' (!('{' | nl | '[').)+ '{' (!("}]").)+ "}]"
+
+list-item     = (cell | inline-tag | inline-delimiter)*
+
+ordered-list-item      = '#' list-item
+    => [[ second list-item boa ]]
+ordered-list = ((ordered-list-item nl)+ ordered-list-item? | ordered-list-item)
+    => [[ ordered-list boa ]]
+
+unordered-list-item    = '-' list-item
+    => [[ second list-item boa ]]
+unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-list-item)
+    => [[ unordered-list boa ]]
+
+list = ordered-list | unordered-list
+
+
+line = '___'
+    => [[ drop line new ]]
+
+
+named-code
+           =  '[' (!('{' | whitespace | '[').)+ '{' (!("}]").)+ "}]"
    => [[ [ second >string ] [ fourth >string ] bi code boa ]]

 simple-code
           = "[{" (!("}]").)+ "}]"
    => [[ second f swap code boa ]]

+code = named-code | simple-code
+
+
 stand-alone
-           = (code | simple-code | heading | list | table | paragraph | nl)*
+           = (line | code | heading | list | table | paragraph | nl)*
 ;EBNF

-
-
 : invalid-url "javascript:alert('Invalid URL in farkup');" ;

 : check-url ( href -- href' )
@ -136,7 +167,7 @@ stand-alone

 : write-link ( href text -- )
    escape-link
-    [ <a =href link-no-follow? get [ "true" =nofollow ] when a> ]
+    [ <a url-encode =href link-no-follow? get [ "true" =nofollow ] when a> ]
    [ write </a> ]
    bi* ;

@ -146,7 +177,7 @@ stand-alone
        <strong> "Images are not allowed" write </strong>
    ] [
        escape-link
-        [ <img =src ] [ [ =alt ] unless-empty img/> ] bi*
+        [ <img url-encode =src ] [ [ =alt ] unless-empty img/> ] bi*
    ] if ;

 : render-code ( string mode -- string' )
@ -161,31 +192,32 @@ GENERIC: (write-farkup) ( farkup -- )
 : <foo.> ( string -- ) <foo> write ;
 : </foo.> ( string -- ) </foo> write ;
 : in-tag. ( obj quot string -- ) [ <foo.> call ] keep </foo.> ; inline
-M: heading1 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h1" in-tag. ;
-M: heading2 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h2" in-tag. ;
-M: heading3 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h3" in-tag. ;
-M: heading4 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h4" in-tag. ;
-M: strong (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "strong" in-tag. ;
-M: emphasis (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "em" in-tag. ;
-M: superscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sup" in-tag. ;
-M: subscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sub" in-tag. ;
-M: inline-code (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "code" in-tag. ;
-M: list-item (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "li" in-tag. ;
-M: list (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "ul" in-tag. ;
-M: paragraph (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "p" in-tag. ;
-M: link (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-link ;
-M: image (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-image-link ;
-M: code (write-farkup) ( obj -- ) [ string>> ] [ mode>> ] bi render-code ;
+M: heading1 (write-farkup) [ child>> (write-farkup) ] "h1" in-tag. ;
+M: heading2 (write-farkup) [ child>> (write-farkup) ] "h2" in-tag. ;
+M: heading3 (write-farkup) [ child>> (write-farkup) ] "h3" in-tag. ;
+M: heading4 (write-farkup) [ child>> (write-farkup) ] "h4" in-tag. ;
+M: strong (write-farkup) [ child>> (write-farkup) ] "strong" in-tag. ;
+M: emphasis (write-farkup) [ child>> (write-farkup) ] "em" in-tag. ;
+M: superscript (write-farkup) [ child>> (write-farkup) ] "sup" in-tag. ;
+M: subscript (write-farkup) [ child>> (write-farkup) ] "sub" in-tag. ;
+M: inline-code (write-farkup) [ child>> (write-farkup) ] "code" in-tag. ;
+M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
+M: unordered-list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ;
+M: ordered-list (write-farkup) [ child>> (write-farkup) ] "ol" in-tag. ;
+M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ;
+M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ;
+M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ;
+M: code (write-farkup) [ string>> ] [ mode>> ] bi render-code ;
+M: line (write-farkup) drop <hr/> ;
 M: table-row (write-farkup) ( obj -- )
-    obj>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
-M: table (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "table" in-tag. ;
-M: fixnum (write-farkup) ( obj -- ) write1 ;
-M: string (write-farkup) ( obj -- ) write ;
-M: vector (write-farkup) ( obj -- ) [ (write-farkup) ] each ;
-M: f (write-farkup) ( obj -- ) drop ;
+    child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
+M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ;
+M: string (write-farkup) escape-string write ;
+M: vector (write-farkup) [ (write-farkup) ] each ;
+M: f (write-farkup) drop ;

 : write-farkup ( string -- )
-    farkup (write-farkup) ;
+    parse-farkup (write-farkup) ;

 : convert-farkup ( string -- string' )
-    farkup [ (write-farkup) ] with-string-writer ;
+    parse-farkup [ (write-farkup) ] with-string-writer ;
--- a/basis/furnace/actions/actions.factor
+++ b/basis/furnace/actions/actions.factor
@ -14,7 +14,8 @@ html.elements
 html.components
 html.components
 html.templates.chloe
-html.templates.chloe.syntax ;
+html.templates.chloe.syntax
+html.templates.chloe.compiler ;
 IN: furnace.actions

 SYMBOL: params
@ -29,7 +30,8 @@ SYMBOL: rest
        </ul>
    ] unless-empty ;

-CHLOE: validation-messages drop render-validation-messages ;
+CHLOE: validation-messages
+    drop [ render-validation-messages ] [code] ;

 TUPLE: action rest authorize init display validate submit ;

@ -77,14 +79,14 @@ TUPLE: action rest authorize init display validate submit ;

 : revalidate-url ( -- url/f )
    revalidate-url-key param
-    dup [ >url [ same-host? ] keep and ] when ;
+    dup [ >url ensure-port [ same-host? ] keep and ] when ;

 : validation-failed ( -- * )
    post-request? revalidate-url and [
        begin-conversation
        nested-forms-key param " " split harvest nested-forms cset
        form get form cset
-        <redirect>
+        <continue-conversation>
    ] [ <400> ] if*
    exit-with ;

--- a/basis/furnace/actions/authors.txt
+++ b/basis/furnace/actions/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/furnace/actions/summary.txt
+++ b/basis/furnace/actions/summary.txt
@ -0,0 +1 @@
+Actions and form validation
--- a/basis/furnace/actions/tags.txt
+++ b/basis/furnace/actions/tags.txt
@ -0,0 +1 @@
+web
--- a/basis/furnace/alloy/alloy.factor
+++ b/basis/furnace/alloy/alloy.factor
@ -3,6 +3,7 @@
 USING: kernel sequences db.tuples alarms calendar db fry
 furnace.db
 furnace.cache
+furnace.asides
 furnace.referrer
 furnace.sessions
 furnace.conversations
@ -10,20 +11,24 @@ furnace.auth.providers
 furnace.auth.login.permits ;
 IN: furnace.alloy

-: <alloy> ( responder db params -- responder' )
-    '[
-        <conversations>
-        <sessions>
-        _ _ <db-persistence>
-        <check-form-submissions>
-    ] call ;
-
-: state-classes { session conversation permit } ; inline
+: state-classes { session aside conversation permit } ; inline

 : init-furnace-tables ( -- )
    state-classes ensure-tables
    user ensure-table ;

+: <alloy> ( responder db params -- responder' )
+    [ [ init-furnace-tables ] with-db ]
+    [
+        [
+            <asides>
+            <conversations>
+            <sessions>
+        ] 2dip
+        <db-persistence>
+        <check-form-submissions>
+    ] 2bi ;
+
 : start-expiring ( db params -- )
    '[
        _ _ [ state-classes [ expire-state ] each ] with-db
--- a/basis/furnace/alloy/authors.txt
+++ b/basis/furnace/alloy/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/furnace/alloy/summary.txt
+++ b/basis/furnace/alloy/summary.txt
@ -0,0 +1 @@
+Convenience responder combines several features
--- a/basis/furnace/alloy/tags.txt
+++ b/basis/furnace/alloy/tags.txt
@ -0,0 +1 @@
+web
--- a/basis/furnace/asides/asides.factor
+++ b/basis/furnace/asides/asides.factor
@ -0,0 +1,111 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces assocs kernel sequences accessors hashtables
+urls db.types db.tuples math.parser fry logging combinators
+html.templates.chloe.syntax
+http http.server http.server.filters http.server.redirection
+furnace
+furnace.cache
+furnace.sessions
+furnace.redirection ;
+IN: furnace.asides
+
+TUPLE: aside < server-state
+session method url post-data ;
+
+: <aside> ( id -- aside )
+    aside new-server-state ;
+
+aside "ASIDES" {
+    { "session" "SESSION" BIG-INTEGER +not-null+ }
+    { "method" "METHOD" { VARCHAR 10 } }
+    { "url" "URL" URL }
+    { "post-data" "POST_DATA" FACTOR-BLOB }
+} define-persistent
+
+: aside-id-key "__a" ;
+
+TUPLE: asides < server-state-manager ;
+
+: <asides> ( responder -- responder' )
+    asides new-server-state-manager ;
+
+SYMBOL: aside-id
+
+: get-aside ( id -- aside )
+    dup [ aside get-state ] when check-session ;
+
+: request-aside-id ( request -- id )
+    aside-id-key swap request-params at string>number ;
+
+: request-aside ( request -- aside )
+    request-aside-id get-aside ;
+
+: set-aside ( aside -- )
+    [ id>> aside-id set ] when* ;
+
+: init-asides ( asides -- )
+    asides set
+    request get request-aside-id
+    get-aside
+    set-aside ;
+
+M: asides call-responder*
+    [ init-asides ] [ asides set ] [ call-next-method ] tri ;
+
+: touch-aside ( aside -- )
+    asides get touch-state ;
+
+: begin-aside ( url -- )
+    f <aside>
+        swap >>url
+        session get id>> >>session
+        request get method>> >>method
+        request get post-data>> >>post-data
+    [ touch-aside ] [ insert-tuple ] [ set-aside ] tri ;
+
+: end-aside-post ( aside -- response )
+    [ url>> ] [ post-data>> ] bi
+    request [
+        clone
+            swap >>post-data
+            over >>url
+    ] change
+    [ url set ] [ path>> split-path ] bi
+    asides get responder>> call-responder ;
+
+\ end-aside-post DEBUG add-input-logging
+
+ERROR: end-aside-in-get-error ;
+
+: move-on ( id -- response )
+    post-request? [ end-aside-in-get-error ] unless
+    dup method>> {
+        { "GET" [ url>> <redirect> ] }
+        { "HEAD" [ url>> <redirect> ] }
+        { "POST" [ end-aside-post ] }
+    } case ;
+
+: end-aside ( default -- response )
+    aside-id get aside-id off get-aside [ move-on ] [ <redirect> ] ?if ;
+
+M: asides link-attr ( tag -- )
+    drop
+    "aside" optional-attr {
+        { "none" [ aside-id off ] }
+        { "begin" [ url get begin-aside ] }
+        { "current" [ ] }
+        { f [ ] }
+    } case ;
+
+M: asides modify-query ( query asides -- query' )
+    drop
+    aside-id get [
+        aside-id-key associate assoc-union
+    ] when* ;
+
+M: asides modify-form ( asides -- )
+    drop
+    aside-id get
+    aside-id-key
+    hidden-form-field ;
--- a/basis/furnace/asides/authors.txt
+++ b/basis/furnace/asides/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/furnace/asides/summary.txt
+++ b/basis/furnace/asides/summary.txt
@ -0,0 +1 @@
+Asides start an interaction which can return to the original page
--- a/basis/furnace/asides/tags.txt
+++ b/basis/furnace/asides/tags.txt
@ -0,0 +1 @@
+web
--- a/basis/furnace/auth/auth.factor
+++ b/basis/furnace/auth/auth.factor
@ -3,7 +3,7 @@
 USING: accessors assocs namespaces kernel sequences sets
 destructors combinators fry logging
 io.encodings.utf8 io.encodings.string io.binary random
-checksums checksums.sha2
+checksums checksums.sha2 urls
 html.forms
 http.server
 http.server.filters
@ -60,6 +60,10 @@ TUPLE: realm < dispatcher name users checksum secure ;

 GENERIC: login-required* ( description capabilities realm -- response )

+GENERIC: user-registered ( user realm -- response )
+
+M: object user-registered 2drop URL" $realm" <redirect> ;
+
 GENERIC: init-realm ( realm -- )

 GENERIC: logged-in-username ( realm -- username )
--- a/basis/furnace/auth/authors.txt
+++ b/basis/furnace/auth/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/furnace/auth/basic/summary.txt
+++ b/basis/furnace/auth/basic/summary.txt
@ -0,0 +1 @@
+Basic client authentication
--- a/basis/furnace/auth/features/deactivate-user/authors.txt
+++ b/basis/furnace/auth/features/deactivate-user/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/furnace/auth/features/deactivate-user/deactivate-user.factor
+++ b/basis/furnace/auth/features/deactivate-user/deactivate-user.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel assocs namespaces accessors db db.tuples urls
 http.server.dispatchers
-furnace.conversations
+furnace.asides
 furnace.actions
 furnace.auth
 furnace.auth.providers ;
--- a/basis/furnace/auth/features/deactivate-user/summary.txt
+++ b/basis/furnace/auth/features/deactivate-user/summary.txt
@ -0,0 +1 @@
+Allow users to deactivate their accounts
--- a/basis/furnace/auth/features/deactivate-user/tags.txt
+++ b/basis/furnace/auth/features/deactivate-user/tags.txt
@ -0,0 +1 @@
+web
--- a/basis/furnace/auth/features/edit-profile/authors.txt
+++ b/basis/furnace/auth/features/edit-profile/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/furnace/auth/features/edit-profile/edit-profile.factor
+++ b/basis/furnace/auth/features/edit-profile/edit-profile.factor
@ -3,8 +3,8 @@
 USING: kernel accessors namespaces sequences assocs
 validators urls html.forms http.server.dispatchers
 furnace.auth
-furnace.actions
-furnace.conversations ;
+furnace.asides
+furnace.actions ;
 IN: furnace.auth.features.edit-profile

 : <edit-profile-action> ( -- action )
--- a/basis/furnace/auth/features/edit-profile/edit-profile.xml
+++ b/basis/furnace/auth/features/edit-profile/edit-profile.xml
@ -4,7 +4,7 @@

 	<t:title>Edit Profile</t:title>

-	<t:form t:action="$realm/edit-profile">
+	<t:form t:action="$realm/edit-profile" autocomplete="off">

 	<table>
 	
@ -61,7 +61,7 @@
 	</table>

 	<p>
-		<input type="submit" value="Update" />
+		<button>Update</button>
 		<t:validation-messages />
 	</p>

--- a/basis/furnace/auth/features/edit-profile/summary.txt
+++ b/basis/furnace/auth/features/edit-profile/summary.txt
@ -0,0 +1 @@
+Allow users to edit account info
--- a/basis/furnace/auth/features/edit-profile/tags.txt
+++ b/basis/furnace/auth/features/edit-profile/tags.txt
@ -0,0 +1 @@
+web
--- a/basis/furnace/auth/features/recover-password/authors.txt
+++ b/basis/furnace/auth/features/recover-password/authors.txt
@ -0,0 +1 @@
+Slava Pestov
--- a/basis/furnace/auth/features/recover-password/recover-1.xml
+++ b/basis/furnace/auth/features/recover-password/recover-1.xml
@ -32,7 +32,7 @@

 		</table>

-		<input type="submit" value="Recover password" />
+		<button>Recover password</button>

 	</t:form>

--- a/basis/furnace/auth/features/recover-password/recover-3.xml
+++ b/basis/furnace/auth/features/recover-password/recover-3.xml
@ -31,7 +31,7 @@
 		</table>

 		<p>
-			<input type="submit" value="Set password" />
+			<button>Set password</button>
 			<t:validation-messages />
 		</p>

--- a/basis/furnace/auth/features/recover-password/recover-password.factor
+++ b/basis/furnace/auth/features/recover-password/recover-password.factor
@ -19,7 +19,7 @@ SYMBOL: lost-password-from
        [ username>> "username" set-query-param ]
        [ ticket>> "ticket" set-query-param ]
        bi
-    adjust-url relative-to-request ;
+    adjust-url ;

 : password-email ( user -- email )
    <email>
--- a/Show More
+++ b/Show More
				`@ -0,0 +1 @@`
				`An abstraction for enforcing a mutual-exclusion invariant`
				`@ -0,0 +1 @@`
				`Convenience responder combines several features`
				`@ -0,0 +1 @@`
				`Asides start an interaction which can return to the original page`