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

basis/alias/alias-docs.factor

@@ -1,26 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words help.markup help.syntax ;
-IN: alias
-
-HELP: ALIAS:
-{ $syntax "ALIAS: new-word existing-word" }
-{ $values { "new-word" word } { "existing-word" word } }
-{ $description "Creates a " { $snippet "new" } " inlined word that calls the " { $snippet "existing" } " word." }
-{ $examples
-    { $example "USING: alias prettyprint sequences ;"
-               "IN: alias.test"
-               "ALIAS: sequence-nth nth"
-               "0 { 10 20 30 } sequence-nth ."
-               "10"
-    }
-} ;
-
-ARTICLE: "alias" "Word aliasing"
-"The " { $vocab-link "alias" } " vocabulary implements a way to make many different names for the same word. Although creating new names for words is generally frowned upon, aliases are useful for the Win32 API and other cases where words need to be renamed for symmetry." $nl 
-"Make a new word that aliases another word:"
-{ $subsection define-alias }
-"Make an alias at parse-time:"
-{ $subsection POSTPONE: ALIAS: } ;
-
-ABOUT: "alias"

basis/alien/syntax/syntax.factor

@@ -4,7 +4,7 @@ USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
 effects assocs combinators lexer strings.parser alien.parser 
-fry ;
+fry vocabs.parser ;
 IN: alien.syntax
 
 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing

basis/bootstrap/stage2.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors init namespaces words io kernel.private math
+USING: accessors init namespaces words words.symbol io
-memory continuations kernel io.files io.pathnames io.backend
+kernel.private math memory continuations kernel io.files
-system parser vocabs sequences vocabs.loader combinators
+io.pathnames io.backend system parser vocabs sequences
-splitting source-files strings definitions assocs
+vocabs.loader combinators splitting source-files strings
-compiler.errors compiler.units math.parser generic sets
+definitions assocs compiler.errors compiler.units math.parser
-command-line ;
+generic sets command-line ;
 IN: bootstrap.stage2
 
 SYMBOL: core-bootstrap-time

basis/cairo/cairo.factor

@@ -17,20 +17,21 @@ M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ;
     [ cairo_status_to_string "Cairo error: " prepend throw ] if ;
 
 SYMBOL: cairo
-: cr ( -- cairo ) cairo get ;
+: cr ( -- cairo ) cairo get ; inline
 
 : (with-cairo) ( cairo-t quot -- )
-    >r alien>> cairo r> [ cr cairo_status check-cairo ]
+    [ alien>> cairo ] dip
-    compose with-variable ; inline
+    '[ @ cr cairo_status check-cairo ]
+    with-variable ; inline
     
 : with-cairo ( cairo quot -- )
-    >r <cairo-t> r> [ (with-cairo) ] curry with-disposal ; inline
+    [ <cairo-t> ] dip '[ _ (with-cairo) ] with-disposal ; inline
 
 : (with-surface) ( cairo-surface-t quot -- )
-    >r alien>> r> [ cairo_surface_status check-cairo ] bi ; inline
+    [ alien>> ] dip [ cairo_surface_status check-cairo ] bi ; inline
 
 : with-surface ( cairo_surface quot -- )
-    >r <cairo-surface-t> r> [ (with-surface) ] curry with-disposal ; inline
+    [ <cairo-surface-t> ] dip '[ _ (with-surface) ] with-disposal ; inline
 
 : with-cairo-from-surface ( cairo_surface quot -- )
     '[ cairo_create _ with-cairo ] with-surface ; inline

basis/cairo/ffi/ffi.factor

@@ -37,7 +37,7 @@ TYPEDEF: void* cairo_pattern_t
 
 TYPEDEF: void* cairo_destroy_func_t
 : cairo-destroy-func ( quot -- callback )
-    >r "void" { "void*" } "cdecl" r> alien-callback ; inline
+    [ "void" { "void*" } "cdecl" ] dip alien-callback ; inline
 
 ! See cairo.h for details
 C-STRUCT: cairo_user_data_key_t
@@ -78,13 +78,11 @@ TYPEDEF: int cairo_content_t
 
 TYPEDEF: void* cairo_write_func_t
 : cairo-write-func ( quot -- callback )
-    >r "cairo_status_t" { "void*" "uchar*" "int" }
+    [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
-    "cdecl" r> alien-callback ; inline
                           
 TYPEDEF: void* cairo_read_func_t
 : cairo-read-func ( quot -- callback )
-    >r "cairo_status_t" { "void*" "uchar*" "int" }
+    [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
-    "cdecl" r> alien-callback ; inline
 
 ! Functions for manipulating state objects
 FUNCTION: cairo_t*

basis/cairo/gadgets/gadgets.factor

@@ -26,7 +26,7 @@ M: cairo-gadget draw-gadget*
     [ dim>> ] [ render-cairo ] bi
     origin get first2 glRasterPos2i
     1.0 -1.0 glPixelZoom
-    >r first2 GL_BGRA GL_UNSIGNED_BYTE r>
+    [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
     glDrawPixels ;
 
 : copy-surface ( surface -- )

basis/checksums/common/common.factor

@@ -1,21 +1,20 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.bitwise strings io.binary namespaces
-make grouping ;
+make grouping byte-arrays ;
 IN: checksums.common
 
 SYMBOL: bytes-read
 
-: calculate-pad-length ( length -- pad-length )
+: calculate-pad-length ( length -- length' )
-    dup 56 < 55 119 ? swap - ;
+    [ 56 < 55 119 ? ] keep - ;
 
 : pad-last-block ( str big-endian? length -- str )
     [
-        rot %
+        [ % ] 2dip HEX: 80 ,
-        HEX: 80 ,
+        [ HEX: 3f bitand calculate-pad-length <byte-array> % ]
-        dup HEX: 3f bitand calculate-pad-length 0 <string> %
+        [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
-        3 shift 8 rot [ >be ] [ >le ] if %
+    ] B{ } make 64 group ;
-    ] "" make 64 group ;
 
 : update-old-new ( old new -- )
     [ [ get ] bi@ w+ dup ] 2keep [ set ] bi@ ; inline

basis/checksums/md5/md5.factor

@@ -3,7 +3,7 @@
 USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting grouping strings
 sequences byte-arrays locals sequences.private
-io.encodings.binary symbols math.bitwise checksums
+io.encodings.binary math.bitwise checksums
 checksums.common checksums.stream ;
 IN: checksums.md5
 

basis/checksums/sha1/sha1.factor

@@ -3,7 +3,7 @@
 USING: arrays combinators kernel io io.encodings.binary io.files
 io.streams.byte-array math.vectors strings sequences namespaces
 make math parser sequences assocs grouping vectors io.binary
-hashtables symbols math.bitwise checksums checksums.common
+hashtables math.bitwise checksums checksums.common
 checksums.stream ;
 IN: checksums.sha1
 

basis/checksums/sha2/sha2.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel splitting grouping math sequences namespaces make
-io.binary symbols math.bitwise checksums checksums.common
+io.binary math.bitwise checksums checksums.common
 sbufs strings ;
 IN: checksums.sha2
 

basis/compiler/cfg/builder/builder-tests.factor

@@ -14,7 +14,7 @@ kernel.private math ;
     [ ]
     [ dup ]
     [ swap ]
-    [ >r r> ]
+    [ [ ] dip ]
     [ fixnum+ ]
     [ fixnum+fast ]
     [ 3 fixnum+fast ]

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -1,7 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: qualified words sequences kernel combinators
+USING: words sequences kernel combinators cpu.architecture
-cpu.architecture
 compiler.cfg.hats
 compiler.cfg.instructions
 compiler.cfg.intrinsics.alien

basis/compiler/cfg/linear-scan/linear-scan-tests.factor

@@ -249,7 +249,7 @@ SYMBOL: max-uses
     ] with-scope ;
 
 : random-test ( num-intervals max-uses max-registers max-insns -- )
-    over >r random-live-intervals r> int-regs associate check-linear-scan ;
+    over [ random-live-intervals ] dip int-regs associate check-linear-scan ;
 
 [ ] [ 30 2 1 60 random-test ] unit-test
 [ ] [ 60 2 2 60 random-test ] unit-test

basis/compiler/tests/codegen.factor

@@ -75,7 +75,7 @@ unit-test
     -12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call
 ] unit-test
 
-[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test
+[ -1 2 ] [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test
 
 [ 12 13 ] [
     -12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call
@@ -88,13 +88,13 @@ unit-test
 ! Test slow shuffles
 [ 3 1 2 3 4 5 6 7 8 9 ] [
     1 2 3 4 5 6 7 8 9
-    [ >r >r >r >r >r >r >r >r >r 3 r> r> r> r> r> r> r> r> r> ]
+    [ [ [ [ [ [ [ [ [ [ 3 ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ]
     compile-call
 ] unit-test
 
 [ 2 2 2 2 2 2 2 2 2 2 1 ] [
     1 2
-    [ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-call
+    [ swap [ dup dup dup dup dup dup dup dup dup ] dip ] compile-call
 ] unit-test
 
 [ ] [ [ 9 [ ] times ] compile-call ] unit-test
@@ -110,7 +110,7 @@ unit-test
     float+ swap { [ "hey" ] [ "bye" ] } dispatch ;
 
 : try-breaking-dispatch-2 ( -- ? )
-    1 1.0 2.5 try-breaking-dispatch "bye" = >r 3.5 = r> and ;
+    1 1.0 2.5 try-breaking-dispatch "bye" = [ 3.5 = ] dip and ;
 
 [ t ] [
     10000000 [ drop try-breaking-dispatch-2 ] all?
@@ -131,10 +131,10 @@ unit-test
     2dup 1 slot eq? [ 2drop ] [ 
         2dup array-nth tombstone? [ 
             [
-                [ array-nth ] 2keep >r 1 fixnum+fast r> array-nth
+                [ array-nth ] 2keep [ 1 fixnum+fast ] dip array-nth
                 pick 2dup hellish-bug-1 3drop
             ] 2keep
-        ] unless >r 2 fixnum+fast r> hellish-bug-2
+        ] unless [ 2 fixnum+fast ] dip hellish-bug-2
     ] if ; inline recursive
 
 : hellish-bug-3 ( hash array -- ) 
@@ -159,9 +159,9 @@ TUPLE: my-tuple ;
 [ 5 ] [ "hi" foox ] unit-test
 
 ! Making sure we don't needlessly unbox/rebox
-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-call ] unit-test
+[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test
 
-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call >r eq? r> ] unit-test
+[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test
 
 [ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test
 
@@ -188,7 +188,7 @@ TUPLE: my-tuple ;
 
 [ 2 1 ] [
     2 1
-    [ 2dup fixnum< [ >r die r> ] when ] compile-call
+    [ 2dup fixnum< [ [ die ] dip ] when ] compile-call
 ] unit-test
 
 ! Regression

basis/compiler/tests/curry.factor

@@ -8,7 +8,7 @@ IN: compiler.tests
 [ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test
 [ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test
 [ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test
-[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test
+[ 3 ] [ 5 2 [ [ - ] 2curry [ 9 ] dip call /i ] compile-call ] unit-test
 
 [ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test
 
@@ -21,14 +21,14 @@ IN: compiler.tests
 [ [ 6 2 + ] ]
 [
     2 5
-    [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ]
+    [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry ]
     compile-call >quotation
 ] unit-test
 
 [ 8 ]
 [
     2 5
-    [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ]
+    [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry call ]
     compile-call
 ] unit-test
 

basis/compiler/tests/optimizer.factor

@@ -248,12 +248,12 @@ USE: binary-search.private
 
 : lift-loop-tail-test-1 ( a quot -- )
     over even? [
-        [ >r 3 - r> call ] keep lift-loop-tail-test-1
+        [ [ 3 - ] dip call ] keep lift-loop-tail-test-1
     ] [
         over 0 < [
             2drop
         ] [
-            [ >r 2 - r> call ] keep lift-loop-tail-test-1
+            [ [ 2 - ] dip call ] keep lift-loop-tail-test-1
         ] if
     ] if ; inline
 
@@ -290,7 +290,7 @@ HINTS: recursive-inline-hang-3 array ;
 
 ! Wow
 : counter-example ( a b c d -- a' b' c' d' )
-    dup 0 > [ 1 - >r rot 2 * r> counter-example ] when ; inline
+    dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline
 
 : counter-example' ( -- a' b' c' d' )
     1 2 3.0 3 counter-example ;
@@ -330,7 +330,7 @@ PREDICATE: list < improper-list
 [ 0 5 ] [ 0 interval-inference-bug ] unit-test
 
 : aggressive-flush-regression ( a -- b )
-    f over >r <array> drop r> 1 + ;
+    f over [ <array> drop ] dip 1 + ;
 
 [ 1.0 aggressive-flush-regression drop ] must-fail
 

basis/compiler/tree/dead-code/dead-code-tests.factor

@@ -79,7 +79,7 @@ IN: compiler.tree.dead-code.tests
 
 [ [ read drop 1 2 ] ] [ [ read [ 1 2 ] dip drop ] optimize-quot ] unit-test
 
-[ [ over >r + r> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
+[ [ over >R + R> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
 
 [ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test
 

basis/compiler/tree/debugger/debugger.factor

@@ -4,7 +4,7 @@ USING: kernel assocs match fry accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.custom
 prettyprint.sections math words combinators
-combinators.short-circuit io sorting hints qualified
+combinators.short-circuit io sorting hints
 compiler.tree
 compiler.tree.recursive
 compiler.tree.normalization
@@ -80,10 +80,12 @@ M: shuffle-node pprint* effect>> effect>string text ;
         [ out-d>> length 1 = ]
     } 1&& ;
 
+SYMBOLS: >R R> ;
+
 M: #shuffle node>quot
     {
-        { [ dup #>r? ] [ drop \ >r , ] }
+        { [ dup #>r? ] [ drop \ >R , ] }
-        { [ dup #r>? ] [ drop \ r> , ] }
+        { [ dup #r>? ] [ drop \ R> , ] }
         {
             [ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ]
             [

basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor

@@ -8,13 +8,13 @@ compiler.tree.debugger ;
 : test-modular-arithmetic ( quot -- quot' )
     build-tree optimize-tree nodes>quot ;
 
-[ [ >r >fixnum r> >fixnum fixnum+fast ] ]
+[ [ >R >fixnum R> >fixnum fixnum+fast ] ]
 [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
 
 [ [ +-integer-integer dup >fixnum ] ]
 [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
 
-[ [ >r >fixnum r> >fixnum fixnum+fast 4 fixnum*fast ] ]
+[ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] ]
 [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
 
 TUPLE: declared-fixnum { x fixnum } ;

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private
 arrays assocs classes classes.algebra combinators generic.math
 splitting fry locals classes.tuple alien.accessors
 classes.tuple.private slots.private definitions strings.private
-vectors hashtables
+vectors hashtables generic
 stack-checker.state
 compiler.tree.comparisons
 compiler.tree.propagation.info
@@ -337,3 +337,12 @@ generic-comparison-ops [
         bi
     ] [ 2drop object-info ] if
 ] "outputs" set-word-prop
+
+\ equal? [
+    ! If first input has a known type and second input is an
+    ! object, we convert this to [ swap equal? ].
+    in-d>> first2 value-info class>> object class= [
+        value-info class>> \ equal? specific-method
+        [ swap equal? ] f ?
+    ] [ drop f ] if
+] "custom-inlining" set-word-prop

basis/compiler/tree/propagation/propagation-tests.factor

@@ -18,7 +18,7 @@ IN: compiler.tree.propagation.tests
 
 [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test
 
-[ V{ fixnum } ] [ [ 1 >r r> ] final-classes ] unit-test
+[ V{ fixnum } ] [ [ 1 [ ] dip ] final-classes ] unit-test
 
 [ V{ fixnum object } ] [ [ 1 swap ] final-classes ] unit-test
 
@@ -198,7 +198,7 @@ IN: compiler.tree.propagation.tests
     [
         { fixnum byte-array } declare
         [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
-        >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
+        [ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift
         255 min 0 max
     ] final-classes
 ] unit-test
@@ -640,6 +640,10 @@ MIXIN: empty-mixin
     [ { fixnum } declare log2 0 >= ] final-classes
 ] unit-test
 
+[ V{ POSTPONE: f } ] [
+    [ { word object } declare equal? ] final-classes
+] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test

basis/concurrency/distributed/distributed.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: serialize sequences concurrency.messaging threads io
 io.servers.connection io.encodings.binary
-qualified arrays namespaces kernel accessors ;
+arrays namespaces kernel accessors ;
 FROM: io.sockets => host-name <inet> with-client ;
 IN: concurrency.distributed
 

basis/concurrency/messaging/messaging.factor

@@ -20,13 +20,13 @@ M: thread send ( message thread -- )
     my-mailbox mailbox-get ?linked ;
 
 : receive-timeout ( timeout -- message )
-    my-mailbox swap mailbox-get-timeout ?linked ;
+    [ my-mailbox ] dip mailbox-get-timeout ?linked ;
 
 : receive-if ( pred -- message )
-    my-mailbox swap mailbox-get? ?linked ; inline
+    [ my-mailbox ] dip mailbox-get? ?linked ; inline
 
 : receive-if-timeout ( timeout pred -- message )
-    my-mailbox -rot mailbox-get-timeout? ?linked ; inline
+    [ my-mailbox ] 2dip mailbox-get-timeout? ?linked ; inline
 
 : rethrow-linked ( error process supervisor -- )
     [ <linked-error> ] dip send ;

basis/constants/constants.factor

@@ -1,8 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: parser kernel words ;
-IN: constants
-
-: CONSTANT:
-    CREATE scan-object [ ] curry (( -- value ))
-    define-inline ; parsing

basis/cpu/ppc/bootstrap.factor

@@ -302,9 +302,7 @@ big-endian on
     4 ds-reg 0 STW
 ] f f f \ -rot define-sub-primitive
 
-[ jit->r ] f f f \ >r define-sub-primitive
+[ jit->r ] f f f \ load-local define-sub-primitive
-
-[ jit-r> ] f f f \ r> define-sub-primitive
 
 ! Comparisons
 : jit-compare ( insn -- )

basis/cpu/x86/64/64.factor

@@ -50,8 +50,8 @@ M: x86.64 %prologue ( n -- )
 
 M: stack-params %load-param-reg
     drop
-    >r R11 swap param@ MOV
+    [ R11 swap param@ MOV ] dip
-    r> param@ R11 MOV ;
+    param@ R11 MOV ;
 
 M: stack-params %save-param-reg
     drop

basis/cpu/x86/assembler/syntax/syntax.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words sequences lexer parser fry ;
+USING: kernel words words.symbol sequences lexer parser fry ;
 IN: cpu.x86.assembler.syntax
 
 : define-register ( name num size -- )

basis/cpu/x86/bootstrap.factor

@@ -319,9 +319,7 @@ big-endian off
     ds-reg [] temp1 MOV
 ] f f f \ -rot define-sub-primitive
 
-[ jit->r ] f f f \ >r define-sub-primitive
+[ jit->r ] f f f \ load-local define-sub-primitive
-
-[ jit-r> ] f f f \ r> define-sub-primitive
 
 ! Comparisons
 : jit-compare ( insn -- )

basis/db/db-docs.factor

@@ -1,20 +1,20 @@
 ! 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 quotations ;
+alien assocs strings math multiline quotations db.private ;
 IN: db
 
-HELP: db
+HELP: db-connection
-{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ;
+{ $description "The " { $snippet "db-connection" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries. Stores the current database object as a dynamic variable." } ;
 
-HELP: new-db
+HELP: new-db-connection
-{ $values { "class" class } { "obj" object } }
+{ $values { "class" class } { "obj" db-connection } }
 { $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." }
 { $notes "User-defined databases must call this constructor word instead of " { $link new } "." } ;
 
 HELP: db-open
-{ $values { "db" db } { "db" db } }
+{ $values { "db" "a database configuration object" } { "db-connection" db-connection } }
-{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ;
+{ $description "Opens a database using the configuration data stored in a " { $snippet "database configuration object" } "tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ;
 
 HELP: db-close
 { $values { "handle" alien } }
@@ -141,13 +141,13 @@ HELP: rollback-transaction
 HELP: sql-command
 { $values
      { "sql" string } }
-{ $description "Executes a SQL string using the databse in the " { $link db } " symbol." } ;
+{ $description "Executes a SQL string using the databse in the " { $link db-connection } " 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." } ;
+{ $description "Runs a SQL query of raw text in the database in the " { $link db-connection } " 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
 
@@ -167,8 +167,8 @@ HELP: sql-row-typed
 
 HELP: with-db
 { $values
-     { "db" db } { "quot" quotation } }
+     { "db" "a database configuration object" } { "quot" quotation } }
-{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ;
+{ $description "Calls the quotation with a database bound to the " { $link db-connection } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ;
 
 HELP: with-transaction
 { $values

basis/db/db.factor

@@ -5,25 +5,29 @@ namespaces sequences classes.tuple words strings
 tools.walker accessors combinators fry ;
 IN: db
 
-TUPLE: db
+<PRIVATE
+
+TUPLE: db-connection
     handle
     insert-statements
     update-statements
     delete-statements ;
 
-: new-db ( class -- obj )
+: new-db-connection ( class -- obj )
     new
         H{ } clone >>insert-statements
         H{ } clone >>update-statements
         H{ } clone >>delete-statements ; inline
 
-GENERIC: db-open ( db -- db )
+PRIVATE>
-HOOK: db-close db ( handle -- )
+
+GENERIC: db-open ( db -- db-connection )
+HOOK: db-close db-connection ( handle -- )
 
 : dispose-statements ( assoc -- ) values dispose-each ;
 
-M: db dispose ( db -- ) 
+M: db-connection dispose ( db-connection -- ) 
-    dup db [
+    dup db-connection [
         [ dispose-statements H{ } clone ] change-insert-statements
         [ dispose-statements H{ } clone ] change-update-statements
         [ dispose-statements H{ } clone ] change-delete-statements
@@ -63,8 +67,8 @@ TUPLE: prepared-statement < statement ;
         swap >>in-params
         swap >>sql ;
 
-HOOK: <simple-statement> db ( string in out -- statement )
+HOOK: <simple-statement> db-connection ( string in out -- statement )
-HOOK: <prepared-statement> db ( string in out -- statement )
+HOOK: <prepared-statement> db-connection ( string in out -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( statement -- )
 GENERIC: low-level-bind ( statement -- )
@@ -107,8 +111,8 @@ M: object execute-statement* ( statement type -- )
     accumulator [ query-each ] dip { } like ; inline
 
 : with-db ( db quot -- )
-    [ db-open db ] dip
+    [ db-open db-connection ] dip
-    '[ db get [ drop @ ] with-disposal ] with-variable ; inline
+    '[ db-connection get [ drop @ ] with-disposal ] with-variable ; inline
 
 ! Words for working with raw SQL statements
 : default-query ( query -- result-set )
@@ -126,13 +130,13 @@ M: object execute-statement* ( statement type -- )
 ! Transactions
 SYMBOL: in-transaction
 
-HOOK: begin-transaction db ( -- )
+HOOK: begin-transaction db-connection ( -- )
-HOOK: commit-transaction db ( -- )
+HOOK: commit-transaction db-connection ( -- )
-HOOK: rollback-transaction db ( -- )
+HOOK: rollback-transaction db-connection ( -- )
 
-M: db begin-transaction ( -- ) "BEGIN" sql-command ;
+M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ;
-M: db commit-transaction ( -- ) "COMMIT" sql-command ;
+M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ;
-M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
+M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
 
 : in-transaction? ( -- ? ) in-transaction get ;
 

basis/db/pools/pools.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel arrays namespaces sequences continuations
-io.pools db fry ;
+io.pools db fry db.private ;
 IN: db.pools
 
 TUPLE: db-pool < pool db ;
@@ -17,4 +17,4 @@ M: db-pool make-connection ( pool -- )
     db>> db-open ;
 
 : with-pooled-db ( pool quot -- )
-    '[ db _ with-variable ] with-pooled-connection ; inline
+    '[ db-connection _ with-variable ] with-pooled-connection ; inline

basis/db/postgresql/lib/lib.factor

@@ -6,7 +6,7 @@ db.types tools.walker ascii splitting math.parser combinators
 libc shuffle calendar.format byte-arrays destructors prettyprint
 accessors strings serialize io.encodings.binary io.encodings.utf8
 alien.strings io.streams.byte-array summary present urls
-specialized-arrays.uint specialized-arrays.alien ;
+specialized-arrays.uint specialized-arrays.alien db.private ;
 IN: db.postgresql.lib
 
 : postgresql-result-error-message ( res -- str/f )
@@ -24,7 +24,7 @@ IN: db.postgresql.lib
     "\n" split [ [ blank? ] trim ] map "\n" join ;
 
 : postgresql-error-message ( -- str )
-    db get handle>> (postgresql-error-message) ;
+    db-connection get handle>> (postgresql-error-message) ;
 
 : postgresql-error ( res -- res )
     dup [ postgresql-error-message throw ] unless ;
@@ -44,7 +44,7 @@ M: postgresql-result-null summary ( obj -- str )
     dup PQstatus zero? [ (postgresql-error-message) throw ] unless ;
 
 : do-postgresql-statement ( statement -- res )
-    db get handle>> swap sql>> PQexec dup postgresql-result-ok? [
+    db-connection get handle>> swap sql>> PQexec dup postgresql-result-ok? [
         [ postgresql-result-error-message ] [ PQclear ] bi throw
     ] unless ;
 
@@ -99,7 +99,7 @@ M: postgresql-result-null summary ( obj -- str )
 
 : do-postgresql-bound-statement ( statement -- res )
     [
-        [ db get handle>> ] dip
+        [ db-connection get handle>> ] dip
         {
             [ sql>> ]
             [ bind-params>> length ]

basis/db/postgresql/postgresql-tests.factor

@@ -1,5 +1,5 @@
 USING: kernel db.postgresql alien continuations io classes
-prettyprint sequences namespaces tools.test db
+prettyprint sequences namespaces tools.test db db.private
 db.tuples db.types unicode.case accessors system ;
 IN: db.postgresql.tests
 
@@ -92,7 +92,3 @@ os windows? cpu x86.64? and [
         ] with-db
     ] unit-test
 ] unless
-
-
-: with-dummy-db ( quot -- )
-    [ T{ postgresql-db } db ] dip with-variable ;

basis/db/postgresql/postgresql.factor

@@ -4,23 +4,31 @@ USING: arrays assocs alien alien.syntax continuations io
 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
+combinators classes locals words tools.walker db.private
 nmake accessors random db.queries destructors db.tuples.private ;
 USE: tools.walker
 IN: db.postgresql
 
-TUPLE: postgresql-db < db
+TUPLE: postgresql-db host port pgopts pgtty database username password ;
-    host port pgopts pgtty database username password ;
 
 : <postgresql-db> ( -- postgresql-db )
-    postgresql-db new-db ;
+    postgresql-db new ;
+
+<PRIVATE
+
+TUPLE: postgresql-db-connection < db-connection ;
+: <postgresql-db-connection> ( handle -- db-connection )
+    postgresql-db-connection new-db-connection
+        swap >>handle ;
+
+PRIVATE>
 
 TUPLE: postgresql-statement < statement ;
 
 TUPLE: postgresql-result-set < result-set ;
 
-M: postgresql-db db-open ( db -- db )
+M: postgresql-db db-open ( db -- db-connection )
-    dup {
+    {
         [ host>> ]
         [ port>> ]
         [ pgopts>> ]
@@ -28,10 +36,9 @@ M: postgresql-db db-open ( db -- db )
         [ database>> ]
         [ username>> ]
         [ password>> ]
-    } cleave connect-postgres >>handle ;
+    } cleave connect-postgres <postgresql-db-connection> ;
 
-M: postgresql-db db-close ( handle -- )
+M: postgresql-db-connection db-close ( handle -- ) PQfinish ;
-    PQfinish ;
 
 M: postgresql-statement bind-statement* ( statement -- ) drop ;
 
@@ -98,25 +105,25 @@ M: postgresql-result-set dispose ( result-set -- )
 
 M: postgresql-statement prepare-statement ( statement -- )
     dup
-    [ db get handle>> f ] dip
+    [ db-connection get handle>> f ] dip
     [ sql>> ] [ in-params>> ] bi
     length f PQprepare postgresql-error
     >>handle drop ;
 
-M: postgresql-db <simple-statement> ( sql in out -- statement )
+M: postgresql-db-connection <simple-statement> ( sql in out -- statement )
     postgresql-statement new-statement ;
 
-M: postgresql-db <prepared-statement> ( sql in out -- statement )
+M: postgresql-db-connection <prepared-statement> ( sql in out -- statement )
     <simple-statement> dup prepare-statement ;
 
 : bind-name% ( -- )
     CHAR: $ 0,
     sql-counter [ inc ] [ get 0# ] bi ;
 
-M: postgresql-db bind% ( spec -- )
+M: postgresql-db-connection bind% ( spec -- )
     bind-name% 1, ;
 
-M: postgresql-db bind# ( spec object -- )
+M: postgresql-db-connection bind# ( spec object -- )
     [ bind-name% f swap type>> ] dip
     <literal-bind> 1, ;
 
@@ -162,7 +169,7 @@ M: postgresql-db bind# ( spec object -- )
         "_seq'');' language sql;" 0%
     ] query-make ;
 
-M: postgresql-db create-sql-statement ( class -- seq )
+M: postgresql-db-connection create-sql-statement ( class -- seq )
     [
         [ create-table-sql , ] keep
         dup db-assigned? [ create-function-sql , ] [ drop ] if
@@ -182,13 +189,13 @@ M: postgresql-db create-sql-statement ( class -- seq )
         "drop table " 0% 0% drop
     ] query-make ;
 
-M: postgresql-db drop-sql-statement ( class -- seq )
+M: postgresql-db-connection drop-sql-statement ( class -- seq )
     [
         [ drop-table-sql , ] keep
         dup db-assigned? [ drop-function-sql , ] [ drop ] if
     ] { } make ;
 
-M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
+M: postgresql-db-connection <insert-db-assigned-statement> ( class -- statement )
     [
         "select add_" 0% 0%
         "(" 0%
@@ -198,7 +205,7 @@ M: postgresql-db <insert-db-assigned-statement> ( class -- statement )
         ");" 0%
     ] query-make ;
 
-M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
+M: postgresql-db-connection <insert-user-assigned-statement> ( class -- statement )
     [
         "insert into " 0% 0%
         "(" 0%
@@ -221,10 +228,10 @@ M: postgresql-db <insert-user-assigned-statement> ( class -- statement )
         ");" 0%
     ] query-make ;
 
-M: postgresql-db insert-tuple-set-key ( tuple statement -- )
+M: postgresql-db-connection insert-tuple-set-key ( tuple statement -- )
     query-modify-tuple ;
 
-M: postgresql-db persistent-table ( -- hashtable )
+M: postgresql-db-connection persistent-table ( -- hashtable )
     H{
         { +db-assigned-id+ { "integer" "serial" f } }
         { +user-assigned-id+ { f f f } }
@@ -264,7 +271,7 @@ M: postgresql-db persistent-table ( -- hashtable )
     } ;
 
 ERROR: no-compound-found string object ;
-M: postgresql-db compound ( string object -- string' )
+M: postgresql-db-connection compound ( string object -- string' )
     over {
         { "default" [ first number>string " " glue ] }
         { "varchar" [ first number>string "(" ")" surround append ] }

basis/db/queries/queries.factor

@@ -3,7 +3,8 @@
 USING: accessors kernel math namespaces make sequences random
 strings math.parser math.intervals combinators math.bitwise
 nmake db db.tuples db.types classes words shuffle arrays
-destructors continuations db.tuples.private prettyprint ;
+destructors continuations db.tuples.private prettyprint
+db.private ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -62,7 +63,7 @@ M: retryable execute-statement* ( statement type -- )
         dup column-name>> 0% " = " 0% bind%
     ] interleave ;
 
-M: db <update-tuple-statement> ( class -- statement )
+M: db-connection <update-tuple-statement> ( class -- statement )
     [
         "update " 0% 0%
         " set " 0%
@@ -142,7 +143,7 @@ M: string where ( spec obj -- ) object-where ;
 : where-clause ( tuple specs -- )
     dupd filter-slots [ drop ] [ many-where ] if-empty ;
 
-M: db <delete-tuples-statement> ( tuple table -- sql )
+M: db-connection <delete-tuples-statement> ( tuple table -- sql )
     [
         "delete from " 0% 0%
         where-clause
@@ -150,7 +151,7 @@ M: db <delete-tuples-statement> ( tuple table -- sql )
 
 ERROR: all-slots-ignored class ;
 
-M: db <select-by-slots-statement> ( tuple class -- statement )
+M: db-connection <select-by-slots-statement> ( tuple class -- statement )
     [
         "select " 0%
         [ dupd filter-ignores ] dip
@@ -185,13 +186,13 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
         [ offset>> [ do-offset ] [ drop ] if* ]
     } 2cleave ;
 
-M: db query>statement ( query -- tuple )
+M: db-connection 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
 
-M: db <count-statement> ( query -- statement )
+M: db-connection <count-statement> ( query -- statement )
     [ tuple>> dup class ] keep
     [ [ "select count(*) from " 0% 0% where-clause ] query-make ]
     dip make-query* ;

basis/db/sqlite/lib/lib.factor

@@ -5,7 +5,8 @@ namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary
 io.backend db.errors present urls io.encodings.utf8
-io.encodings.string accessors shuffle ;
+io.encodings.string accessors shuffle io prettyprint
+db.private ;
 IN: db.sqlite.lib
 
 ERROR: sqlite-error < db-error n string ;
@@ -16,7 +17,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
 
 : sqlite-statement-error ( -- * )
     SQLITE_ERROR
-    db get handle>> sqlite3_errmsg sqlite-sql-error ;
+    db-connection get handle>> sqlite3_errmsg sqlite-sql-error ;
 
 : sqlite-check-result ( n -- )
     {
@@ -42,7 +43,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
     sqlite3_bind_parameter_index ;
 
 : parameter-index ( handle name text -- handle name text )
-    >r dupd sqlite-bind-parameter-index r> ;
+    [ dupd sqlite-bind-parameter-index ] dip ;
 
 : sqlite-bind-text ( handle index text -- )
     utf8 encode dup length SQLITE_TRANSIENT
@@ -124,7 +125,8 @@ ERROR: sqlite-sql-error < sql-error n string ;
     ] if* (sqlite-bind-type) ;
 
 : sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ;
-: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
+: sqlite-reset ( handle -- )
+"resetting: " write dup . sqlite3_reset sqlite-check-result ;
 : sqlite-clear-bindings ( handle -- )
     sqlite3_clear_bindings sqlite-check-result ;
 : sqlite-#columns ( query -- int ) sqlite3_column_count ;

basis/db/sqlite/sqlite-tests.factor

@@ -3,8 +3,8 @@ kernel namespaces prettyprint tools.test db.sqlite db sequences
 continuations db.types db.tuples unicode.case ;
 IN: db.sqlite.tests
 
-: db-path "test.db" temp-file ;
+: db-path ( -- path ) "test.db" temp-file ;
-: test.db db-path <sqlite-db> ;
+: test.db ( -- sqlite-db ) db-path <sqlite-db> ;
 
 [ ] [ [ db-path delete-file ] ignore-errors ] unit-test
 

basis/db/sqlite/sqlite.factor

@@ -6,33 +6,43 @@ 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 db.tuples.private interpolate
-io.streams.string multiline make ;
+io.streams.string multiline make db.private ;
 IN: db.sqlite
 
-TUPLE: sqlite-db < db path ;
+TUPLE: sqlite-db path ;
 
 : <sqlite-db> ( path -- sqlite-db )
-    sqlite-db new-db
+    sqlite-db new
         swap >>path ;
 
-M: sqlite-db db-open ( db -- db )
+<PRIVATE
-    dup path>> sqlite-open >>handle ;
 
-M: sqlite-db db-close ( handle -- ) sqlite-close ;
+TUPLE: sqlite-db-connection < db-connection ;
+
+: <sqlite-db-connection> ( handle -- db-connection )
+    sqlite-db-connection new-db-connection
+        swap >>handle ;
+
+PRIVATE>
+
+M: sqlite-db db-open ( db -- db-connection )
+    path>> sqlite-open <sqlite-db-connection> ;
+
+M: sqlite-db-connection db-close ( handle -- ) sqlite-close ;
 
 TUPLE: sqlite-statement < statement ;
 
 TUPLE: sqlite-result-set < result-set has-more? ;
 
-M: sqlite-db <simple-statement> ( str in out -- obj )
+M: sqlite-db-connection <simple-statement> ( str in out -- obj )
     <prepared-statement> ;
 
-M: sqlite-db <prepared-statement> ( str in out -- obj )
+M: sqlite-db-connection <prepared-statement> ( str in out -- obj )
     sqlite-statement new-statement ;
 
 : sqlite-maybe-prepare ( statement -- statement )
     dup handle>> [
-        db get handle>> over sql>> sqlite-prepare
+        db-connection get handle>> over sql>> sqlite-prepare
         >>handle
     ] unless ;
 
@@ -89,10 +99,10 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
 ERROR: sqlite-last-id-fail ;
 
 : last-insert-id ( -- id )
-    db get handle>> sqlite3_last_insert_rowid
+    db-connection get handle>> sqlite3_last_insert_rowid
     dup zero? [ sqlite-last-id-fail ] when ;
 
-M: sqlite-db insert-tuple-set-key ( tuple statement -- )
+M: sqlite-db-connection insert-tuple-set-key ( tuple statement -- )
     execute-statement last-insert-id swap set-primary-key ;
 
 M: sqlite-result-set #columns ( result-set -- n )
@@ -116,7 +126,7 @@ M: sqlite-statement query-results ( query -- result-set )
     dup handle>> sqlite-result-set new-result-set
     dup advance-row ;
 
-M: sqlite-db create-sql-statement ( class -- statement )
+M: sqlite-db-connection create-sql-statement ( class -- statement )
     [
         dupd
         "create table " 0% 0%
@@ -135,10 +145,10 @@ M: sqlite-db create-sql-statement ( class -- statement )
         "));" 0%
     ] query-make ;
 
-M: sqlite-db drop-sql-statement ( class -- statement )
+M: sqlite-db-connection drop-sql-statement ( class -- statement )
     [ "drop table " 0% 0% ";" 0% drop ] query-make ;
 
-M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
+M: sqlite-db-connection <insert-db-assigned-statement> ( tuple -- statement )
     [
         "insert into " 0% 0%
         "(" 0%
@@ -159,19 +169,19 @@ M: sqlite-db <insert-db-assigned-statement> ( tuple -- statement )
         ");" 0%
     ] query-make ;
 
-M: sqlite-db <insert-user-assigned-statement> ( tuple -- statement )
+M: sqlite-db-connection <insert-user-assigned-statement> ( tuple -- statement )
     <insert-db-assigned-statement> ;
 
-M: sqlite-db bind# ( spec obj -- )
+M: sqlite-db-connection bind# ( spec obj -- )
     [
         [ column-name>> ":" next-sql-counter surround dup 0% ]
         [ type>> ] bi
     ] dip <literal-bind> 1, ;
 
-M: sqlite-db bind% ( spec -- )
+M: sqlite-db-connection bind% ( spec -- )
     dup 1, column-name>> ":" prepend 0% ;
 
-M: sqlite-db persistent-table ( -- assoc )
+M: sqlite-db-connection persistent-table ( -- assoc )
     H{
         { +db-assigned-id+ { "integer" "integer" f } }
         { +user-assigned-id+ { f f f } }
@@ -306,7 +316,7 @@ M: sqlite-db persistent-table ( -- assoc )
         delete-trigger-restrict sqlite-trigger,
     ] if ;
 
-M: sqlite-db compound ( string seq -- new-string )
+M: sqlite-db-connection compound ( string seq -- new-string )
     over {
         { "default" [ first number>string " " glue ] }
         { "references" [

basis/db/tuples/tuples-tests.factor

@@ -4,7 +4,7 @@ USING: io.files io.files.temp 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 system
-math.ranges strings urls fry db.tuples.private ;
+math.ranges strings urls fry db.tuples.private db.private ;
 IN: db.tuples.tests
 
 : sqlite-db ( -- sqlite-db )
@@ -33,10 +33,10 @@ IN: db.tuples.tests
 
 ! These words leak resources, but are useful for interactivel testing 
 : sqlite-test-db ( -- )
-    sqlite-db db-open db set ;
+    sqlite-db db-open db-connection set ;
 
 : postgresql-test-db ( -- )
-    postgresql-db db-open db set ;
+    postgresql-db db-open db-connection set ;
 
 TUPLE: person the-id the-name the-number the-real
 ts date time blob factor-blob url ;

basis/db/tuples/tuples.factor

@@ -3,20 +3,20 @@
 USING: arrays assocs classes db kernel namespaces
 classes.tuple words sequences slots math accessors
 math.parser io prettyprint db.types continuations
-destructors mirrors sets db.types ;
+destructors mirrors sets db.types db.private ;
 IN: db.tuples
 
-HOOK: create-sql-statement db ( class -- object )
+HOOK: create-sql-statement db-connection ( class -- object )
-HOOK: drop-sql-statement db ( class -- object )
+HOOK: drop-sql-statement db-connection ( class -- object )
 
-HOOK: <insert-db-assigned-statement> db ( class -- object )
+HOOK: <insert-db-assigned-statement> db-connection ( class -- object )
-HOOK: <insert-user-assigned-statement> db ( class -- object )
+HOOK: <insert-user-assigned-statement> db-connection ( class -- object )
-HOOK: <update-tuple-statement> db ( class -- object )
+HOOK: <update-tuple-statement> db-connection ( class -- object )
-HOOK: <delete-tuples-statement> db ( tuple class -- object )
+HOOK: <delete-tuples-statement> db-connection ( tuple class -- object )
-HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
+HOOK: <select-by-slots-statement> db-connection ( tuple class -- tuple )
-HOOK: <count-statement> db ( query -- statement )
+HOOK: <count-statement> db-connection ( query -- statement )
-HOOK: query>statement db ( query -- statement )
+HOOK: query>statement db-connection ( query -- statement )
-HOOK: insert-tuple-set-key db ( tuple statement -- )
+HOOK: insert-tuple-set-key db-connection ( tuple statement -- )
 
 <PRIVATE
 
@@ -52,12 +52,14 @@ GENERIC: eval-generator ( singleton -- object )
 
 : insert-db-assigned-statement ( tuple -- )
     dup class
-    db get insert-statements>> [ <insert-db-assigned-statement> ] cache
+    db-connection 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
+    db-connection get insert-statements>>
+    [ <insert-user-assigned-statement> ] cache
     [ bind-tuple ] keep execute-statement ;
 
 : do-select ( exemplar-tuple statement -- tuples )
@@ -117,7 +119,7 @@ M: tuple >query <query> swap >>tuple ;
 
 : update-tuple ( tuple -- )
     dup class
-    db get update-statements>> [ <update-tuple-statement> ] cache
+    db-connection get update-statements>> [ <update-tuple-statement> ] cache
     [ bind-tuple ] keep execute-statement ;
 
 : delete-tuples ( tuple -- )

basis/db/types/types.factor

@@ -3,12 +3,12 @@
 USING: arrays assocs db kernel math math.parser
 sequences continuations sequences.deep prettyprint
 words namespaces slots slots.private classes mirrors
-classes.tuple combinators calendar.format symbols
+classes.tuple combinators calendar.format classes.singleton
-classes.singleton accessors quotations random ;
+accessors quotations random db.private ;
 IN: db.types
 
-HOOK: persistent-table db ( -- hash )
+HOOK: persistent-table db-connection ( -- hash )
-HOOK: compound db ( string obj -- hash )
+HOOK: compound db-connection ( string obj -- hash )
 
 TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
 
@@ -158,8 +158,8 @@ ERROR: no-sql-type type ;
     modifiers>> [ lookup-modifier ] map " " join
     [ "" ] [ " " prepend ] if-empty ;
 
-HOOK: bind% db ( spec -- )
+HOOK: bind% db-connection ( spec -- )
-HOOK: bind# db ( spec obj -- )
+HOOK: bind# db-connection ( spec obj -- )
 
 ERROR: no-column column ;
 

basis/debugger/debugger.factor

@@ -9,7 +9,7 @@ combinators generic.math classes.builtin classes compiler.units
 generic.standard vocabs init kernel.private io.encodings
 accessors math.order destructors source-files parser
 classes.tuple.parser effects.parser lexer compiler.errors
-generic.parser strings.parser ;
+generic.parser strings.parser vocabs.parser ;
 IN: debugger
 
 GENERIC: error. ( error -- )

basis/delegate/delegate-tests.factor

@@ -20,7 +20,7 @@ PROTOCOL: baz foo { bar 0 } { whoa 1 } ;
 CONSULT: baz goodbye these>> ;
 M: hello foo this>> ;
 M: hello bar hello-test ;
-M: hello whoa >r this>> r> + ;
+M: hello whoa [ this>> ] dip + ;
 
 GENERIC: bing ( c -- d )
 PROTOCOL: bee bing ;

basis/delegate/delegate.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors parser generic kernel classes classes.tuple
 words slots assocs sequences arrays vectors definitions
-math hashtables sets generalizations namespaces make ;
+math hashtables sets generalizations namespaces make
+words.symbol ;
 IN: delegate
 
 : protocol-words ( protocol -- words )

basis/fry/fry-docs.factor

@@ -20,7 +20,7 @@ HELP: '[
 { $examples "See " { $link "fry.examples" } "." } ;
 
 HELP: >r/r>-in-fry-error
-{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to " { $link >r } " or " { $link r> } ". Explicit retain stack manipulation of this form does not work with fry; use " { $link dip } " instead." } ;
+{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to retain stack manipulation primitives." } ;
 
 ARTICLE: "fry.examples" "Examples of fried quotations"
 "The easiest way to understand fried quotations is to look at some examples."

basis/fry/fry-tests.factor

@@ -56,7 +56,7 @@ sequences eval accessors ;
     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
 ] unit-test
 
-[ "USING: fry kernel ; f '[ >r _ r> ]" eval ]
+[ "USING: fry locals.backend ; f '[ load-local _ ]" eval ]
 [ error>> >r/r>-in-fry-error? ] must-fail-with
 
 [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [

basis/fry/fry.factor

@@ -25,7 +25,7 @@ M: >r/r>-in-fry-error summary
     "Explicit retain stack manipulation is not permitted in fried quotations" ;
 
 : check-fry ( quot -- quot )
-    dup { >r r> load-locals get-local drop-locals } intersect
+    dup { load-local load-locals get-local drop-locals } intersect
     empty? [ >r/r>-in-fry-error ] unless ;
 
 PREDICATE: fry-specifier < word { _ @ } memq? ;

basis/functors/functors.factor

@@ -3,7 +3,8 @@
 USING: kernel quotations classes.tuple make combinators generic
 words interpolate namespaces sequences io.streams.string fry
 classes.mixin effects lexer parser classes.tuple.parser
-effects.parser locals.types locals.parser locals.rewrite.closures ;
+effects.parser locals.types locals.parser
+locals.rewrite.closures vocabs.parser ;
 IN: functors
 
 : scan-param ( -- obj )

basis/furnace/alloy/alloy-docs.factor

@@ -5,7 +5,7 @@ HELP: init-furnace-tables
 { $description "Initializes database tables used by asides, conversations and session management. This word must be invoked inside a " { $link with-db } " scope." } ;
 
 HELP: <alloy>
-{ $values { "responder" "a responder" } { "db" db } { "responder'" "an alloy responder" } }
+{ $values { "responder" "a responder" } { "db" "a database descriptor" } { "responder'" "an alloy responder" } }
 { $description "Wraps the responder with support for asides, conversations, sessions and database persistence." }
 { $examples
     "The " { $vocab-link "webapps.counter" } " vocabulary uses an alloy to configure the counter:"
@@ -21,7 +21,7 @@ HELP: <alloy>
 } ;
 
 HELP: start-expiring
-{ $values { "db" db } }
+{ $values { "db" "a database descriptor" } }
 { $description "Starts a timer which expires old session state from the given database." } ;
 
 ARTICLE: "furnace.alloy" "Furnace alloy responder"

basis/furnace/auth/auth-docs.factor

@@ -1,5 +1,5 @@
 USING: assocs classes help.markup help.syntax kernel
-quotations strings words furnace.auth.providers.db
+quotations strings words words.symbol furnace.auth.providers.db
 checksums.sha2 furnace.auth.providers math byte-arrays
 http multiline ;
 IN: furnace.auth

basis/furnace/chloe-tags/chloe-tags.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel combinators assocs
 namespaces sequences splitting words
-fry urls multiline present qualified
+fry urls multiline present
 xml
 xml.data
 xml.entities
@@ -32,7 +32,7 @@ IN: furnace.chloe-tags
     [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
 
 : a-url ( href rest query value-name -- url )
-    dup [ >r 3drop r> value ] [
+    dup [ [ 3drop ] dip value ] [
         drop
         <url>
             swap parse-query-attr >>query

basis/furnace/conversations/conversations-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax urls http words kernel
-furnace.sessions furnace.db ;
+furnace.sessions furnace.db words.symbol ;
 IN: furnace.conversations
 
 HELP: <conversations>

basis/furnace/db/db-docs.factor

@@ -3,7 +3,7 @@ IN: furnace.db
 
 HELP: <db-persistence>
 { $values
-     { "responder" "a responder" } { "db" db }
+     { "responder" "a responder" } { "db" "a database descriptor" }
      { "responder'" db-persistence }
 }
 { $description "Wraps a responder with database persistence support. The responder's " { $link call-responder* } " method will run in a " { $link with-db } " scope." } ;

basis/furnace/db/db.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors continuations namespaces destructors
-db db.pools io.pools http.server http.server.filters ;
+db db.private db.pools io.pools http.server http.server.filters ;
 IN: furnace.db
 
 TUPLE: db-persistence < filter-responder pool ;
@@ -12,6 +12,6 @@ TUPLE: db-persistence < filter-responder pool ;
 M: db-persistence call-responder*
     [
         pool>> [ acquire-connection ] keep
-        [ return-connection-later ] [ drop db set ] 2bi
+        [ return-connection-later ] [ drop db-connection set ] 2bi
     ]
     [ call-next-method ] bi ;

basis/furnace/sessions/sessions-docs.factor

@@ -1,4 +1,6 @@
-USING: help.markup help.syntax io.streams.string quotations strings calendar serialize kernel furnace.db words kernel ;
+USING: help.markup help.syntax io.streams.string quotations
+strings calendar serialize kernel furnace.db words words.symbol
+kernel ;
 IN: furnace.sessions
 
 HELP: <sessions>

basis/grouping/grouping-docs.factor

@@ -20,7 +20,7 @@ ARTICLE: "grouping" "Groups and clumps"
         { $unchecked-example "dup n groups concat sequence= ." "t" }
     }
     { "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
-        { $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" }
+        { $unchecked-example "dup n clumps unclip-last [ [ first ] map ] dip append sequence= ." "t" }
     }
 } ;
 

basis/heaps/heaps-tests.factor

@@ -61,7 +61,7 @@ IN: heaps.tests
         random-alist
         <min-heap> [ heap-push-all ] keep
         dup data>> clone swap
-    ] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times
+    ] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times
     data>>
     [ [ key>> ] map ] bi@
     [ natural-sort ] bi@ ;

basis/help/cookbook/cookbook.factor

@@ -360,7 +360,7 @@ ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid"
 { $list
     "Factor only makes use of one native thread, and Factor threads are scheduled co-operatively. C library calls block the entire VM."
     "Factor does not hide anything from the programmer, all internals are exposed. It is your responsibility to avoid writing fragile code which depends too much on implementation detail."
-    { "When a source file uses two vocabularies which define words with the same name, the order of the vocabularies in the " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " forms is important. The parser prints warnings when vocabularies shadow words from other vocabularies; see " { $link "vocabulary-search-shadow" } ". The " { $vocab-link "qualified" } " vocabulary implements qualified naming, which can be used to resolve ambiguities." }
+    { "When a source file uses two vocabularies which define words with the same name, the order of the vocabularies in the " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " forms is important. The " { $link POSTPONE: QUALIFIED: } " word implements qualified naming, which can be used to resolve ambiguities." }
     { "If a literal object appears in a word definition, the object itself is pushed on the stack when the word executes, not a copy. If you intend to mutate this object, you must " { $link clone } " it first. See " { $link "syntax-literals" } "." }
     { "For a discussion of potential issues surrounding the " { $link f } " object, see " { $link "booleans" } "." }
     { "Factor's object system is quite flexible. Careless usage of union, mixin and predicate classes can lead to similar problems to those caused by ``multiple inheritance'' in other languages. In particular, it is possible to have two classes such that they have a non-empty intersection and yet neither is a subclass of the other. If a generic word defines methods on two such classes, various disambiguation rules are applied to ensure method dispatch remains deterministic, however they may not be what you expect. See " { $link "method-order" } " for details." }

basis/help/help.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays io io.styles kernel namespaces make
-parser prettyprint sequences words assocs definitions generic
+parser prettyprint sequences words words.symbol assocs
-quotations effects slots continuations classes.tuple debugger
+definitions generic quotations effects slots continuations
-combinators vocabs help.stylesheet help.topics help.crossref
+classes.tuple debugger combinators vocabs help.stylesheet
-help.markup sorting classes vocabs.loader ;
+help.topics help.crossref help.markup sorting classes
+vocabs.loader ;
 IN: help
 
 GENERIC: word-help* ( word -- content )

basis/help/lint/lint.factor

@@ -5,7 +5,8 @@ help.topics words strings classes tools.vocabs namespaces make
 io io.streams.string prettyprint definitions arrays vectors
 combinators combinators.short-circuit splitting debugger
 hashtables sorting effects vocabs vocabs.loader assocs editors
-continuations classes.predicate macros math sets eval ;
+continuations classes.predicate macros math sets eval
+vocabs.parser words.symbol ;
 IN: help.lint
 
 : check-example ( element -- )

basis/help/markup/markup.factor

@@ -3,8 +3,7 @@
 USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces make parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots
-vocabs help.stylesheet help.topics vocabs.loader alias
+vocabs help.stylesheet help.topics vocabs.loader quotations ;
-quotations ;
 IN: help.markup
 
 ! Simple markup language.

basis/help/syntax/syntax.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel parser sequences words help
-help.topics namespaces vocabs definitions compiler.units ;
+help.topics namespaces vocabs definitions compiler.units
+vocabs.parser ;
 IN: help.syntax
 
 : HELP:

basis/hints/hints.factor

@@ -3,7 +3,8 @@
 USING: parser words definitions kernel sequences assocs arrays
 kernel.private fry combinators accessors vectors strings sbufs
 byte-arrays byte-vectors io.binary io.streams.string splitting
-math generic generic.standard generic.standard.engines classes ;
+math generic generic.standard generic.standard.engines classes
+hashtables ;
 IN: hints
 
 GENERIC: specializer-predicate ( spec -- quot )
@@ -50,14 +51,10 @@ M: object specializer-declaration class ;
     ] [ drop f ] if ;
 
 : specialized-def ( word -- quot )
-    dup def>> swap {
+    [ def>> ] keep
-        {
+    [ dup standard-method? [ specialize-method ] [ drop ] if ]
-            [ dup "specializer" word-prop ]
+    [ "specializer" word-prop [ specialize-quot ] when* ]
-            [ "specializer" word-prop specialize-quot ]
+    bi ;
-        }
-        { [ dup standard-method? ] [ specialize-method ] }
-        [ drop ]
-    } cond ;
 
 : specialized-length ( specializer -- n )
     dup [ array? ] all? [ first ] when length ;
@@ -120,3 +117,7 @@ M: object specializer-declaration class ;
 \ >le { { fixnum fixnum } { bignum fixnum } } "specializer" set-word-prop
 
 \ >be { { bignum fixnum } { fixnum fixnum } } "specializer" set-word-prop
+
+\ hashtable \ at* method { { fixnum hashtable } { word hashtable } } "specializer" set-word-prop
+
+\ hashtable \ set-at method { { object fixnum object } { object word object } } "specializer" set-word-prop

basis/html/templates/fhtml/fhtml.factor

@@ -3,7 +3,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations sequences kernel namespaces debugger
 combinators math quotations generic strings splitting
-accessors assocs fry
+accessors assocs fry vocabs.parser
 parser lexer io io.files io.streams.string io.encodings.utf8
 html.elements
 html.templates ;

basis/http/http.factor

@@ -8,7 +8,7 @@ calendar.format present urls
 io io.encodings io.encodings.iana io.encodings.binary
 io.encodings.8-bit
 
-unicode.case unicode.categories qualified
+unicode.case unicode.categories
 
 http.parsers ;
 

basis/io/backend/unix/unix.factor

@@ -3,7 +3,7 @@
 USING: alien alien.c-types alien.syntax generic assocs kernel
 kernel.private math io.ports sequences strings sbufs threads
 unix vectors io.buffers io.backend io.encodings math.parser
-continuations system libc qualified namespaces make io.timeouts
+continuations system libc namespaces make io.timeouts
 io.encodings.utf8 destructors accessors summary combinators
 locals unix.time fry io.backend.unix.multiplexers ;
 QUALIFIED: io

basis/io/backend/windows/nt/nt.factor

@@ -3,7 +3,7 @@ continuations destructors io io.backend io.ports io.timeouts
 io.backend.windows io.files.windows io.files.windows.nt io.files
 io.pathnames io.buffers io.streams.c libc kernel math namespaces
 sequences threads windows windows.errors windows.kernel32
-strings splitting qualified ascii system accessors locals ;
+strings splitting ascii system accessors locals ;
 QUALIFIED: windows.winsock
 IN: io.backend.windows.nt
 

basis/io/encodings/8-bit/8-bit.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math.parser arrays io.encodings sequences kernel assocs
 hashtables io.encodings.ascii generic parser classes.tuple words
-io io.files splitting namespaces math compiler.units accessors ;
+words.symbol io io.files splitting namespaces math
+compiler.units accessors ;
 IN: io.encodings.8-bit
 
 <PRIVATE

basis/io/files/info/unix/linux/linux.factor

@@ -3,8 +3,9 @@
 USING: accessors alien.c-types alien.syntax combinators csv
 io.backend io.encodings.utf8 io.files io.files.info io.streams.string
 io.files.unix kernel math.order namespaces sequences sorting
-system unix unix.statfs.linux unix.statvfs.linux
+system unix unix.statfs.linux unix.statvfs.linux io.files.links
-specialized-arrays.direct.uint arrays io.files.info.unix ;
+specialized-arrays.direct.uint arrays io.files.info.unix assocs
+io.pathnames ;
 IN: io.files.info.unix.linux
 
 TUPLE: linux-file-system-info < unix-file-system-info
@@ -70,6 +71,16 @@ M: linux file-systems
         } cleave
     ] map ;
 
+: (find-mount-point) ( path mtab-paths -- mtab-entry )
+    [ follow-links ] dip 2dup at* [
+        2nip
+    ] [
+        drop [ parent-directory ] dip (find-mount-point)
+    ] if ;
+
+: find-mount-point ( path -- mtab-entry )
+    parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc (find-mount-point) ;
+
 ERROR: file-system-not-found ;
 
 M: linux file-system-info ( path -- )
@@ -80,9 +91,7 @@ M: linux file-system-info ( path -- )
         [ file-system-statvfs statvfs>file-system-info ] bi
         file-system-calculations
     ] keep
-    
+    find-mount-point
-    parse-mtab [ [ mount-point>> ] bi@ <=> invert-comparison ] sort
-    [ mount-point>> head? ] with find nip [ file-system-not-found ] unless*
     {
         [ file-system-name>> >>device-name drop ]
         [ mount-point>> >>mount-point drop ]

basis/io/files/info/windows/windows.factor

@@ -102,10 +102,7 @@ M: windows link-info ( path -- info )
     [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ;
 
 : calculate-file-system-info ( file-system-info -- file-system-info' )
-    {
+    [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ] keep ;
-        [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ]
-        [ ]
-    } cleave ;
 
 TUPLE: win32-file-system-info < file-system-info max-component flags device-serial ;
 

basis/io/files/links/links-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io.files.info ;
+USING: help.markup help.syntax io.files.info math ;
 IN: io.files.links
 
 HELP: make-link
@@ -13,11 +13,40 @@ HELP: copy-link
 { $values { "target" "a path to an existing symlink" } { "symlink" "a path to a new symbolic link" } }
 { $description "Copies a symbolic link without following the link." } ;
 
-{ make-link read-link copy-link } related-words
+HELP: follow-link
+{ $values
+     { "path" "a pathname string" }
+     { "path'" "a pathname string" }
+}
+{ $description "Returns an absolute path from " { $link read-link } "." } ;
+
+HELP: follow-links
+{ $values
+     { "path" "a pathname string" }
+     { "path'" "a pathname string" }
+}
+{ $description "Follows a chain of symlinks up to " { $link symlink-depth } "." } ;
+
+{ read-link follow-link follow-links } related-words
+
+HELP: symlink-depth
+{ $values
+     { "value" integer }
+}
+{ $description "The number of redirections " { $link follow-links } " will follow." } ;
+
+HELP: too-many-symlinks
+{ $values
+     { "path" "a pathname string" } { "n" integer }
+}
+{ $description "An error thrown when the number of redirections in a chain of symlinks surpasses the value in the " { $link symlink-depth } " variable." } ;
 
 ARTICLE: "io.files.links" "Symbolic links"
-"Reading and creating links:"
+"Reading links:"
 { $subsection read-link }
+{ $subsection follow-link }
+{ $subsection follow-links }
+"Creating links:"
 { $subsection make-link }
 "Copying links:"
 { $subsection copy-link }

basis/io/files/links/links-tests.factor

@@ -0,0 +1,31 @@
+USING: io.directories io.files.links tools.test
+io.files.unique tools.files fry ;
+IN: io.files.links.tests
+
+: make-test-links ( n path -- )
+    [ '[ [ 1+ ] keep [ number>string _ prepend ] bi@ make-link ] each ]
+    [ [ number>string ] dip prepend touch-file ] 2bi ; inline
+
+[ t ] [
+    [
+        5 "lol" make-test-links
+        "lol1" follow-links
+        current-directory get "lol5" append-path =
+    ] with-unique-directory
+] unit-test
+
+[
+    [
+        100 "laf" make-test-links "laf1" follow-links
+    ] with-unique-directory
+] [ too-many-symlinks? ] must-fail-with
+
+[ t ] [
+    110 symlink-depth [
+        [
+            100 "laf" make-test-links
+            "laf1" follow-links
+            current-directory get "laf100" append-path =
+        ] with-unique-directory
+    ] with-variable
+] unit-test

basis/io/files/links/links.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel vocabs.loader ;
+USING: accessors io.backend io.files.info io.files.types
+io.pathnames kernel math namespaces system vocabs.loader ;
 IN: io.files.links
 
 HOOK: make-link os ( target symlink -- )
@@ -11,3 +12,24 @@ HOOK: read-link os ( symlink -- path )
     [ read-link ] dip make-link ;
 
 os unix? [ "io.files.links.unix" require ] when
+
+: follow-link ( path -- path' )
+    [ parent-directory ] [ read-link ] bi append-path ;
+
+SYMBOL: symlink-depth
+10 symlink-depth set-global
+
+ERROR: too-many-symlinks path n ;
+
+<PRIVATE
+
+: (follow-links) ( n path -- path' )
+    over 0 = [ symlink-depth get too-many-symlinks ] when
+    dup link-info type>> +symbolic-link+ =
+    [ [ 1- ] [ follow-link ] bi* (follow-links) ]
+    [ nip ] if ; inline recursive
+
+PRIVATE>
+
+: follow-links ( path -- path' )
+    [ symlink-depth get ] dip normalize-path (follow-links) ;

basis/io/files/windows/windows.factor

@@ -4,7 +4,7 @@ USING: alien.c-types io.binary io.backend io.files
 io.files.types io.buffers io.encodings.utf16n io.ports
 io.backend.windows kernel math splitting fry alien.strings
 windows windows.kernel32 windows.time calendar combinators
-math.functions sequences namespaces make words symbols system
+math.functions sequences namespaces make words system
 destructors accessors math.bitwise continuations windows.errors
 arrays byte-arrays generalizations ;
 IN: io.files.windows

basis/io/pipes/unix/unix.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel unix math sequences qualified
+USING: system kernel unix math sequences
 io.backend.unix io.ports specialized-arrays.int accessors ;
 IN: io.pipes.unix
 QUALIFIED: io.pipes

basis/io/sockets/secure/secure.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel symbols namespaces continuations
+USING: accessors kernel namespaces continuations
 destructors io debugger io.sockets sequences summary calendar
 delegate system vocabs.loader combinators present ;
 IN: io.sockets.secure

basis/io/sockets/sockets.factor

@@ -6,7 +6,7 @@ sequences arrays io.encodings io.ports io.streams.duplex
 io.encodings.ascii alien.strings io.binary accessors destructors
 classes byte-arrays system combinators parser
 alien.c-types math.parser splitting grouping math assocs summary
-system vocabs.loader combinators present fry ;
+system vocabs.loader combinators present fry vocabs.parser ;
 IN: io.sockets
 
 << {

basis/io/sockets/unix/unix.factor

@@ -5,7 +5,7 @@ namespaces threads sequences byte-arrays io.ports
 io.binary io.backend.unix io.streams.duplex
 io.backend io.ports io.pathnames io.files.private
 io.encodings.utf8 math.parser continuations libc combinators
-system accessors qualified destructors unix locals init ;
+system accessors destructors unix locals init ;
 
 EXCLUDE: io => read write close ;
 EXCLUDE: io.sockets => accept ;

basis/lcs/diff2html/diff2html.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: lcs html.elements kernel qualified ;
+USING: lcs html.elements kernel ;
 FROM: accessors => item>> ;
 FROM: io => write ;
 FROM: sequences => each if-empty ;

basis/lcs/lcs.factor

@@ -5,7 +5,7 @@ IN: lcs
 
 <PRIVATE
 : levenshtein-step ( insert delete change same? -- next )
-    0 1 ? + >r [ 1+ ] bi@ r> min min ;
+    0 1 ? + [ [ 1+ ] bi@ ] dip min min ;
 
 : lcs-step ( insert delete change same? -- next )
     1 -1./0. ? + max max ; ! -1./0. is -inf (float)

basis/listener/listener-tests.factor

@@ -1,6 +1,6 @@
 USING: io io.streams.string io.streams.duplex listener
 tools.test parser math namespaces continuations vocabs kernel
-compiler.units eval ;
+compiler.units eval vocabs.parser ;
 IN: listener.tests
 
 : hello "Hi" print ; parsing

basis/listener/listener.factor

@@ -4,7 +4,7 @@ USING: arrays hashtables io kernel math math.parser memory
 namespaces parser lexer sequences strings io.styles
 vectors words generic system combinators continuations debugger
 definitions compiler.units accessors colors prettyprint fry
-sets ;
+sets vocabs.parser ;
 IN: listener
 
 GENERIC: stream-read-quot ( stream -- quot/f )

basis/locals/locals-tests.factor

@@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel
 namespaces arrays strings prettyprint io.streams.string parser
 accessors generic eval combinators combinators.short-circuit
 combinators.short-circuit.smart math.order math.functions
-definitions compiler.units fry lexer ;
+definitions compiler.units fry lexer words.symbol ;
 IN: locals.tests
 
 :: foo ( a b -- a a ) a a ;