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

Factor.app/Contents/Info.plist

@@ -32,7 +32,7 @@
 	<key>CFBundlePackageType</key>
 	<string>APPL</string>
 	<key>NSHumanReadableCopyright</key>
-	<string>Copyright © 2003-2007, Slava Pestov and friends</string>
+	<string>Copyright © 2003-2008, Slava Pestov and friends</string>
 	<key>NSServices</key>
 	<array>
 		<dict>

core/alien/alien-docs.factor

@@ -265,7 +265,7 @@ ARTICLE: "embedding-restrictions" "Embedding API restrictions"
 ARTICLE: "embedding-factor" "What embedding looks like from Factor"
 "Factor code will run inside an embedded instance in the same way it would run in a stand-alone instance."
 $nl
-"One exception is the global " { $link stdio } " stream, which is by default not bound to the terminal where the process is running, to avoid conflicting with any I/O the host process might perform. To initialize the terminal stream, " { $link init-stdio } " must be called explicitly."
+"One exception is that the global " { $link input-stream } " and " { $link output-stream } " streams are not bound by default, to avoid conflicting with any I/O the host process might perform. The " { $link init-stdio } " words must be called explicitly to initialize terminal streams."
 $nl
 "There is a word which can detect when Factor is embedded:"
 { $subsection embedded? }

core/bootstrap/image/image.factor

@@ -404,7 +404,7 @@ M: quotation '
     [
         {
             dictionary source-files builtins
-            update-map class<=-cache class<=>-cache
+            update-map class<=-cache
             class-not-cache classes-intersect-cache class-and-cache
             class-or-cache
         } [ dup get swap bootstrap-word set ] each
@@ -475,7 +475,7 @@ M: quotation '
     "Writing image to " write
     architecture get boot-image-name resource-path
     [ write "..." print flush ]
-    [ binary <file-writer> [ (write-image) ] with-stream ] bi ;
+    [ binary [ (write-image) ] with-file-writer ] bi ;
 
 PRIVATE>
 

core/bootstrap/stage2.factor

@@ -87,7 +87,7 @@ f error-continuation set-global
             parse-command-line
             run-user-init
             "run" get run
-            stdio get [ stream-flush ] when*
+            output-stream get [ stream-flush ] when*
         ] [ print-error 1 exit ] recover
     ] set-boot-quot
 

core/checksums/checksums-tests.factor

@@ -0,0 +1,7 @@
+IN: checksums.tests
+USING: checksums tools.test ;
+
+\ checksum-bytes must-infer
+\ checksum-stream must-infer
+\ checksum-lines must-infer
+\ checksum-file must-infer

core/classes/algebra/algebra-docs.factor

@@ -23,30 +23,19 @@ ARTICLE: "class-linearization" "Class linearization"
     "If a generic word defines a method on a mixin class A and another class B, and B is the only instance of A, there is an ambiguity because A and B are equal as sets; any object that is an instance of one is an instance of both."
     { "If a generic word defines methods on two union classes which are incomparable but not disjoint, for example " { $link sequence } " and " { $link number } ", there is an ambiguity because the generic word may be called on an object that is an instance of both unions." }
 }
-"These difficulties are resolved by imposing a linear order on classes, computed as follows for two classes A and B:"
+"The first ambiguity is resolved with a tie-breaker that compares metaclasses. The intrinsic meta-class order, from most-specific to least-specific:"
-{ $list
-    "If A and B are the same class (not just equal as sets), then comparison stops."
-    "If A is a proper subset of B, or B is a proper subset of A, then comparison stops."
-    { "Next, the metaclasses of A and B are compared, with intrinsic meta-class order, from most-specific to least-specific:"
 { $list
     "Built-in classes and tuple classes"
     "Predicate classes"
     "Union classes"
     "Mixin classes"
 }
-    "If this yields an unambiguous answer, comparison stops."
+"This means that in the above example, the generic word with methods on a mixin and its sole instance will always call the method for the sole instance, since it is more specific than a mixin class."
-    }
+$nl
-    "If the metaclasses of A and B occupy the same position in the order, then the vocabularies of A and B are compared lexicographically. If this yields an unambiguous answer, comparison stops."
+"The second problem is resolved with another tie-breaker. When performing the topological sort of classes, if there are multiple candidates at any given step of the sort, lexicographical order on the class name is used."
-    "If A and B belong to the same vocabulary, their names are compared lexicographically. This must yield an unambiguous result, since if the names equal they must be the same class and this case was already handled in the first step."
+$nl
-}
-"Some examples:"
-{ $list
-    { { $link integer } " precedes " { $link number } " because it is a strict subset" }
-    { { $link number } " precedes " { $link sequence } " because the " { $vocab-link "math" } " vocabulary precedes the " { $vocab-link "sequences" } " vocabulary" }
-    { { $link crc32 } " precedes " { $link checksum } ", even if it were the only instance, because " { $link crc32 } " is a singleton class which is more specific than a mixin class" }
-}
 "Operations:"
-{ $subsection class<=> }
+{ $subsection class< }
 { $subsection sort-classes }
 "Metaclass order:"
 { $subsection rank-class } ;
@@ -72,8 +61,6 @@ HELP: sort-classes
 { $values { "seq" "a sequence of class" } { "newseq" "a new seqence of classes" } }
 { $description "Outputs a linear sort of a sequence of classes. Larger classes come before their subclasses." } ;
 
-{ sort-classes class<=> } related-words
-
 HELP: class-or
 { $values { "first" class } { "second" class } { "class" class } }
 { $description "Outputs the smallest anonymous class containing both " { $snippet "class1" } " and " { $snippet "class2" } "." } ;
@@ -89,7 +76,3 @@ HELP: classes-intersect?
 HELP: min-class
 { $values { "class" class } { "seq" "a sequence of class words" } { "class/f" "a class word or " { $link f } } }
 { $description "If all classes in " { $snippet "seq" } " that intersect " { $snippet "class" } " are subtypes of " { $snippet "class" } ", outputs the last such element of " { $snippet "seq" } ". If any conditions fail to hold, outputs " { $link f } "." } ;
-
-HELP: class<=>
-{ $values { "first" class } { "second" class } { "n" symbol } }
-{ $description "Compares two classes with the class linearization order." } ;

core/classes/algebra/algebra-tests.factor

@@ -248,7 +248,16 @@ UNION: yyy xxx ;
 [ { yyy xxx } ] [ { xxx yyy } sort-classes ] unit-test
 [ { yyy xxx } ] [ { yyy xxx } sort-classes ] unit-test
 
-[ { number integer ratio } ] [ { ratio number integer } sort-classes ] unit-test
+[ { number ratio integer } ] [ { ratio number integer } sort-classes ] unit-test
 [ { sequence number ratio } ] [ { ratio number sequence } sort-classes ] unit-test
 
-[ +lt+ ] [ \ real sequence class<=> ] unit-test
+TUPLE: xa ;
+TUPLE: xb ;
+TUPLE: xc < xa ;
+TUPLE: xd < xb ;
+TUPLE: xe ;
+TUPLE: xf < xb ;
+TUPLE: xg < xb ;
+TUPLE: xh < xb ;
+
+[ t ] [ { xa xb xc xd xe xf xg xh } sort-classes dup sort-classes = ] unit-test

core/classes/algebra/algebra.factor

@@ -187,31 +187,15 @@ C: <anonymous-complement> anonymous-complement
         [ [ rank-class ] bi@ < ]
     } cond ;
 
-: class-tie-breaker ( first second -- n )
+: largest-class ( seq -- n elt )
-    2dup [ rank-class ] compare {
+    dup [ [ class< ] with contains? not ] curry find-last
-        { +lt+ [ 2drop +lt+ ] }
+    [ "Topological sort failed" throw ] unless* ;
-        { +gt+ [ 2drop +gt+ ] }
-        { +eq+ [ <=> ] }
-    } case ;
-
-: (class<=>) ( first second -- n )
-    {
-        { [ 2dup class<= ] [
-            2dup swap class<=
-            [ class-tie-breaker ] [ 2drop +lt+ ] if
-        ] }
-        { [ 2dup swap class<= ] [
-            2dup class<=
-            [ class-tie-breaker ] [ 2drop +gt+ ] if
-        ] }
-        [ class-tie-breaker ]
-    } cond ;
-
-: class<=> ( first second -- n )
-    class<=>-cache get [ (class<=>) ] 2cache ;
 
 : sort-classes ( seq -- newseq )
-    [ class<=> invert-comparison ] sort ;
+    [ [ word-name ] compare ] sort >vector
+    [ dup empty? not ]
+    [ dup largest-class >r over delete-nth r> ]
+    [ ] unfold nip ;
 
 : min-class ( class seq -- class/f )
     over [ classes-intersect? ] curry filter

core/classes/classes.factor

@@ -6,7 +6,6 @@ quotations combinators sorting effects graphs vocabs ;
 IN: classes
 
 SYMBOL: class<=-cache
-SYMBOL: class<=>-cache
 SYMBOL: class-not-cache
 SYMBOL: classes-intersect-cache
 SYMBOL: class-and-cache
@@ -14,7 +13,6 @@ SYMBOL: class-or-cache
 
 : init-caches ( -- )
     H{ } clone class<=-cache set
-    H{ } clone class<=>-cache set
     H{ } clone class-not-cache set
     H{ } clone classes-intersect-cache set
     H{ } clone class-and-cache set
@@ -22,7 +20,6 @@ SYMBOL: class-or-cache
 
 : reset-caches ( -- )
     class<=-cache get clear-assoc
-    class<=>-cache get clear-assoc
     class-not-cache get clear-assoc
     classes-intersect-cache get clear-assoc
     class-and-cache get clear-assoc

core/classes/tuple/tuple-tests.factor

@@ -542,3 +542,15 @@ TUPLE: another-forget-accessors-test ;
 
 ! Missing error check
 [ "IN: tuples.test USE: words TUPLE: wrong-superclass < word ;" eval ] must-fail
+
+TUPLE: subclass-forget-test ;
+
+TUPLE: subclass-forget-test-1 < subclass-forget-test ;
+TUPLE: subclass-forget-test-2 < subclass-forget-test ;
+TUPLE: subclass-forget-test-3 < subclass-forget-test-2 ;
+
+[ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" eval ] unit-test
+
+[ f ] [ subclass-forget-test-1 tuple-class? ] unit-test
+[ f ] [ subclass-forget-test-2 tuple-class? ] unit-test
+[ subclass-forget-test-3 new ] must-fail

core/classes/tuple/tuple.factor

@@ -102,7 +102,7 @@ ERROR: bad-superclass class ;
     dup tuple-predicate-quot define-predicate ;
 
 : superclass-size ( class -- n )
-    superclasses 1 head-slice*
+    superclasses but-last-slice
     [ slot-names length ] map sum ;
 
 : generate-tuple-slots ( class slots -- slot-specs )

core/compiler/compiler.factor

@@ -4,38 +4,55 @@ USING: kernel namespaces arrays sequences io inference.backend
 inference.state generator debugger words compiler.units
 continuations vocabs assocs alien.compiler dlists optimizer
 definitions math compiler.errors threads graphs generic
-inference ;
+inference combinators ;
 IN: compiler
 
 : ripple-up ( word -- )
     compiled-usage [ drop queue-compile ] assoc-each ;
 
 : save-effect ( word effect -- )
-    over "compiled-uses" word-prop [
-        2dup swap "compiled-effect" word-prop =
-        [ over ripple-up ] unless
-    ] when
-    "compiled-effect" set-word-prop ;
-
-: finish-compile ( word effect dependencies -- )
-    >r dupd save-effect r>
-    over compiled-unxref
-    over compiled-crossref? [ compiled-xref ] [ 2drop ] if ;
-
-: compile-succeeded ( word -- effect dependencies )
     [
-        [ word-dataflow optimize ] keep dup generate
+        over "compiled-effect" word-prop = [
-    ] computing-dependencies ;
+            dup "compiled-uses" word-prop
+            [ dup ripple-up ] when
+        ] unless drop
+    ]
+    [ "compiled-effect" set-word-prop ] 2bi ;
+
+: compile-begins ( word -- )
+    f swap compiler-error ;
 
 : compile-failed ( word error -- )
-    f pick compiled get set-at
+    [ swap compiler-error ]
-    swap compiler-error ;
+    [
+        drop
+        [ f swap compiled get set-at ]
+        [ f save-effect ]
+        bi
+    ] 2bi ;
+
+: compile-succeeded ( effect word -- )
+    [ swap save-effect ]
+    [ compiled-unxref ]
+    [
+        dup compiled-crossref?
+        [ dependencies get compiled-xref ] [ drop ] if
+    ] tri ;
 
 : (compile) ( word -- )
-    f over compiler-error
+    [
-    [ dup compile-succeeded finish-compile ]
+        H{ } clone dependencies set
-    [ dupd compile-failed f save-effect ]
+
-    recover ;
+        {
+            [ compile-begins ]
+            [
+                [ word-dataflow ] [ compile-failed return ] recover
+                optimize
+            ]
+            [ dup generate ]
+            [ compile-succeeded ]
+        } cleave
+    ] curry with-return ;
 
 : compile-loop ( assoc -- )
     dup assoc-empty? [ drop ] [

core/compiler/errors/errors-docs.factor

@@ -21,19 +21,19 @@ HELP: compiler-error
 
 HELP: compiler-error.
 { $values { "error" "an error" } { "word" word } }
-{ $description "Prints a compiler error to the " { $link stdio } " stream." } ;
+{ $description "Prints a compiler error to " { $link output-stream } "." } ;
 
 HELP: compiler-errors.
 { $values { "type" symbol } }
-{ $description "Prints compiler errors to the " { $link stdio } " stream. The type parameter is one of " { $link +error+ } ", " { $link +warning+ } ", or " { $link +linkage+ } "." } ;
+{ $description "Prints compiler errors to " { $link output-stream } ". The type parameter is one of " { $link +error+ } ", " { $link +warning+ } ", or " { $link +linkage+ } "." } ;
 HELP: :errors
-{ $description "Prints all serious compiler errors from the most recent compile to the " { $link stdio } " stream." } ;
+{ $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;
 
 HELP: :warnings
-{ $description "Prints all ignorable compiler warnings from the most recent compile to the " { $link stdio } " stream." } ;
+{ $description "Prints all ignorable compiler warnings from the most recent compile to " { $link output-stream } "." } ;
 
 HELP: :linkage
-{ $description "Prints all C library interface linkage errors from the most recent compile to the " { $link stdio } " stream." } ;
+{ $description "Prints all C library interface linkage errors from the most recent compile to " { $link output-stream } "." } ;
 
 { :errors :warnings } related-words
 

core/continuations/continuations-docs.factor

@@ -34,7 +34,7 @@ $nl
 { $code
     "<external-resource> ... do stuff ... dispose"
 }
-"The reason being that if " { $snippet "do stuff" } " throws an error, the resource will not be disposed of. The most important case where this can occur is with I/O streams, and the correct solution is to always use " { $link with-stream } "; see " { $link "stdio" } " for details." ;
+"The reason being that if " { $snippet "do stuff" } " throws an error, the resource will not be disposed of. The most important case where this can occur is with I/O streams, and the correct solution is to always use " { $link with-input-stream } " and " { $link with-output-stream } "; see " { $link "stdio" } " for details." ;
 
 ARTICLE: "errors" "Error handling"
 "Support for handling exceptional situations such as bad user input, implementation bugs, and input/output errors is provided by a set of words built using continuations."

core/continuations/continuations-tests.factor

@@ -39,7 +39,7 @@ IN: continuations.tests
 
 "!!! The following error is part of the test" print
 
-[ ] [ [ [ "2 car" ] eval ] [ print-error ] recover ] unit-test
+[ ] [ [ [ "2 car" ] eval ] try ] unit-test
 
 [ f throw ] must-fail
 
@@ -117,3 +117,5 @@ T{ dispose-dummy } "b" set
 [ { "a" "b" } [ get ] map dispose-each ] [ 3 = ] must-fail-with
 
 [ t ] [ "b" get disposed?>> ] unit-test
+
+[ ] [ [ return ] with-return ] unit-test

core/continuations/continuations.factor

@@ -101,6 +101,14 @@ PRIVATE>
 : continue ( continuation -- )
     f swap continue-with ;
 
+SYMBOL: return-continuation
+
+: with-return ( quot -- )
+    [ [ return-continuation set ] prepose callcc0 ] with-scope ; inline
+
+: return ( -- )
+    return-continuation get continue ;
+
 GENERIC: compute-restarts ( error -- seq )
 
 <PRIVATE

core/debugger/debugger-docs.factor

@@ -1,7 +1,7 @@
 USING: alien arrays generic generic.math help.markup help.syntax
 kernel math memory strings sbufs vectors io io.files classes
 help generic.standard continuations system debugger.private
-io.files.private ;
+io.files.private listener ;
 IN: debugger
 
 ARTICLE: "errors-assert" "Assertions"
@@ -64,7 +64,7 @@ HELP: :3
 
 HELP: error.
 { $values { "error" "an error" } }
-{ $contract "Print an error to the " { $link stdio } " stream.  You can define methods on this generic word to print human-readable messages for custom errors." }
+{ $contract "Print an error to " { $link output-stream } ". You can define methods on this generic word to print human-readable messages for custom errors." }
 { $notes "Code should call " { $link print-error } " instead, which handles the case where the printing of the error itself throws an error." } ;
 
 HELP: error-help
@@ -75,19 +75,15 @@ HELP: error-help
 
 HELP: print-error
 { $values { "error" "an error" } }
-{ $description "Print an error to the " { $link stdio } " stream." }
+{ $description "Print an error to " { $link output-stream } "." }
 { $notes "This word is called by the listener and other tools which report caught errors to the user." } ;
 
 HELP: restarts.
-{ $description "Print a list of restarts for the most recently thrown error to the " { $link stdio } " stream." } ;
+{ $description "Print a list of restarts for the most recently thrown error to " { $link output-stream } "." } ;
-
-HELP: error-hook
-{ $var-description "A quotation with stack effect " { $snippet "( error -- )" } " which is used by " { $link try } " to report the error to the user." }
-{ $examples "The default value prints the error with " { $link print-error } ", followed by a list of restarts and a help message. The graphical listener sets this variable to display a popup instead." } ;
 
 HELP: try
 { $values { "quot" "a quotation" } }
-{ $description "Attempts to call a quotation; if it throws an error, the " { $link error-hook } " gets called, stacks are restored, and execution continues after the call to " { $link try } "." }
+{ $description "Attempts to call a quotation; if it throws an error, the error is printed to " { $link output-stream } ", stacks are restored, and execution continues after the call to " { $link try } "." }
 { $examples
     "The following example prints an error and keeps going:"
     { $code

core/debugger/debugger.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays definitions generic hashtables inspector io kernel
-math namespaces prettyprint sequences assocs sequences.private
+math namespaces prettyprint prettyprint.config sequences assocs
-strings io.styles vectors words system splitting math.parser
+sequences.private strings io.styles vectors words system
-classes.tuple continuations continuations.private combinators
+splitting math.parser classes.tuple continuations
-generic.math io.streams.duplex classes.builtin classes
+continuations.private combinators generic.math
-compiler.units generic.standard vocabs threads threads.private
+classes.builtin classes compiler.units generic.standard vocabs
-init kernel.private libc io.encodings mirrors accessors
+threads threads.private init kernel.private libc io.encodings
-math.order ;
+mirrors accessors math.order ;
 IN: debugger
 
 GENERIC: error. ( error -- )
@@ -64,17 +64,14 @@ M: string error. print ;
     [ global [ "Error in print-error!" print drop ] bind ]
     recover ;
 
-SYMBOL: error-hook
+: print-error-and-restarts ( error -- )
-
-[
     print-error
     restarts.
     nl
-    "Type :help for debugging help." print flush
+    "Type :help for debugging help." print flush ;
-] error-hook set-global
 
 : try ( quot -- )
-    [ error-hook get call ] recover ;
+    [ print-error-and-restarts ] recover ;
 
 ERROR: assert got expect ;
 
@@ -209,9 +206,6 @@ M: no-next-method summary
 M: inconsistent-next-method summary
     drop "Executing call-next-method with inconsistent parameters" ;
 
-M: stream-closed-twice summary
-    drop "Attempt to perform I/O on closed stream" ;
-
 M: check-method summary
     drop "Invalid parameters for create-method" ;
 
@@ -241,6 +235,15 @@ M: condition error-help error>> error-help ;
 
 M: assert summary drop "Assertion failed" ;
 
+M: assert error.
+    "Assertion failed" print
+    standard-table-style [
+        15 length-limit set
+        5 line-limit set
+        [ expect>> [ [ "Expect:" write ] with-cell pprint-cell ] with-row ]
+        [ got>> [ [ "Got:" write ] with-cell pprint-cell ] with-row ] bi
+    ] tabular-output ;
+
 M: immutable summary drop "Sequence is immutable" ;
 
 M: redefine-error error.
@@ -267,8 +270,7 @@ M: double-free summary
 M: realloc-error summary
     drop "Memory reallocation failed" ;
 
-: error-in-thread. ( -- )
+: error-in-thread. ( thread -- )
-    error-thread get-global
     "Error in thread " write
     [
         dup thread-id #
@@ -282,7 +284,7 @@ M: thread error-in-thread ( error thread -- )
         die drop
     ] [
         global [
-            error-in-thread. print-error flush
+            error-thread get-global error-in-thread. print-error flush
         ] bind
     ] if ;
 

core/generic/standard/engines/tuple/tuple.factor

@@ -127,8 +127,6 @@ M: echelon-dispatch-engine engine>quot
     1 slot { tuple-layout } declare
     5 slot ; inline
 
-: unclip-last [ 1 head* ] [ peek ] bi ;
-
 M: tuple-dispatch-engine engine>quot
     [
         picker %

core/inference/inference-docs.factor

@@ -135,7 +135,7 @@ HELP: infer
 
 HELP: infer.
 { $values { "quot" "a quotation" } }
-{ $description "Attempts to infer the quotation's stack effect, and prints this data to the " { $link stdio } " stream." }
+{ $description "Attempts to infer the quotation's stack effect, and prints this data to " { $link output-stream } "." }
 { $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;
 
 { infer infer. } related-words

core/inference/state/state-tests.factor

@@ -1,6 +1,10 @@
 IN: inference.state.tests
 USING: tools.test inference.state words ;
 
+: computing-dependencies ( quot -- dependencies )
+    H{ } clone [ dependencies rot with-variable ] keep ;
+    inline
+
 SYMBOL: a
 SYMBOL: b
 

core/inference/state/state.factor

@@ -36,10 +36,6 @@ SYMBOL: dependencies
         2dup at +inlined+ eq? [ 3drop ] [ set-at ] if
     ] [ 3drop ] if ;
 
-: computing-dependencies ( quot -- dependencies )
-    H{ } clone [ dependencies rot with-variable ] keep ;
-    inline
-
 ! Did the current control-flow path throw an error?
 SYMBOL: terminated?
 

core/inference/transforms/transforms.factor

@@ -32,7 +32,7 @@ IN: inference.transforms
         drop [ no-case ]
     ] [
         dup peek quotation? [
-            dup peek swap 1 head*
+            dup peek swap but-last
         ] [
             [ no-case ] swap
         ] if case>quot

core/inspector/inspector-docs.factor

@@ -108,4 +108,4 @@ HELP: me
 HELP: inspector-hook
 { $var-description "A quotation with stack effect " { $snippet "( obj -- )" } ", called by the inspector to display an overview of an object."
 $nl
-"The default implementation calls " { $link describe } " which outputs on the " { $link stdio } " stream, but the graphical listener sets this variable so that calling " { $link inspect } " in the UI opens the graphical inspector." } ;
+"The default implementation calls " { $link describe } " which outputs on " { $link output-stream } ", but the graphical listener sets this variable so that calling " { $link inspect } " in the UI opens the graphical inspector." } ;

core/io/backend/backend-docs.factor

@@ -9,4 +9,4 @@ HELP: init-io
 { $contract "Initializes the I/O system. Called on startup." } ;
 
 HELP: init-stdio
-{ $contract "Initializes the global " { $link stdio } " stream.  Called on startup." } ;
+{ $contract "Initializes the global " { $link input-stream } " and " { $link output-stream } ".  Called on startup." } ;

core/io/backend/backend.factor

@@ -11,8 +11,10 @@ HOOK: init-io io-backend ( -- )
 HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )
 
 : init-stdio ( -- )
-    (init-stdio) utf8 <encoder> stderr set-global
+    (init-stdio)
-    utf8 <encoder-duplex> stdio set-global ;
+    [ utf8 <decoder> input-stream set-global ]
+    [ utf8 <encoder> output-stream set-global ]
+    [ utf8 <encoder> error-stream set-global ] tri* ;
 
 HOOK: io-multiplex io-backend ( ms -- )
 

core/io/encodings/encodings-docs.factor

@@ -12,8 +12,7 @@ ARTICLE: "io.encodings" "I/O encodings"
 ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"
 "The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves. Most stream constructors take an encoding descriptor as a parameter and internally call these constructors."
 { $subsection <encoder> }
-{ $subsection <decoder> }
+{ $subsection <decoder> } ;
-{ $subsection <encoder-duplex> } ;
 
 HELP: <encoder>
 { $values { "stream" "an output stream" }
@@ -29,16 +28,6 @@ HELP: <decoder>
 { $description "Wraps the given stream in a new stream using the given encoding for all input. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." }
 $low-level-note ;
 
-HELP: <encoder-duplex>
-{ $values { "stream-in" "an input stream" }
-    { "stream-out" "an output stream" }
-    { "encoding" "an encoding descriptor" }
-    { "duplex" "an encoded duplex stream" } }
-{ $description "Wraps the given streams in an encoder or decoder stream, and puts them together in a duplex stream for input and output. If either input stream is already encoded, that encoding is stripped off before it is reencoded. The encoding descriptor must conform to the " { $link "encodings-protocol" } "." }
-$low-level-note ;
-
-{ <encoder> <decoder> <encoder-duplex> } related-words
-
 ARTICLE: "encodings-descriptors" "Encoding descriptors"
 "An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
 { $subsection "io.encodings.binary" }

core/io/encodings/encodings-tests.factor

@@ -2,35 +2,35 @@ USING: io.files io.streams.string io
 tools.test kernel io.encodings.ascii ;
 IN: io.streams.encodings.tests
 
-: <resource-reader> ( resource -- stream )
-    resource-path ascii <file-reader> ;
-    
 [ { } ]
-[ "core/io/test/empty-file.txt" <resource-reader> lines ]
+[ "resource:core/io/test/empty-file.txt" ascii <file-reader> lines ]
 unit-test
 
 : lines-test ( stream -- line1 line2 )
-    [ readln readln ] with-stream ;
+    [ readln readln ] with-input-stream ;
 
 [
     "This is a line."
     "This is another line."
 ] [
-    "core/io/test/windows-eol.txt" <resource-reader> lines-test
+    "resource:core/io/test/windows-eol.txt"
+    ascii <file-reader> lines-test
 ] unit-test
 
 [
     "This is a line."
     "This is another line."
 ] [
-    "core/io/test/mac-os-eol.txt" <resource-reader> lines-test
+    "resource:core/io/test/mac-os-eol.txt"
+    ascii <file-reader> lines-test
 ] unit-test
 
 [
     "This is a line."
     "This is another line."
 ] [
-    "core/io/test/unix-eol.txt" <resource-reader> lines-test
+    "resource:core/io/test/unix-eol.txt"
+    ascii <file-reader> lines-test
 ] unit-test
 
 [

core/io/encodings/encodings.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel sequences sbufs vectors namespaces growable
 strings io classes continuations combinators io.styles
-io.streams.plain splitting io.streams.duplex byte-arrays
+io.streams.plain splitting byte-arrays sequences.private
-sequences.private accessors ;
+accessors ;
 IN: io.encodings
 
 ! The encoding descriptor protocol
@@ -131,6 +131,3 @@ INSTANCE: encoder plain-writer
     over decoder? [ >r decoder-stream r> ] when <decoder> ;
 
 PRIVATE>
-
-: <encoder-duplex> ( stream-in stream-out encoding -- duplex )
-    tuck reencode >r redecode r> <duplex-stream> ;

core/io/files/files-docs.factor

@@ -184,8 +184,12 @@ HELP: +unknown+
 { $description "A unknown file type." } ;
 
 HELP: <file-reader>
-{ $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" { "stream" "an input stream" } }
+{
-    { "stream" "an input stream" } }
+  $values
+  { "path" "a pathname string" }
+  { "encoding" "an encoding descriptor" }
+  { "stream" "an input stream" }
+}
 { $description "Outputs an input stream for reading from the specified pathname using the given encoding." }
 { $errors "Throws an error if the file is unreadable." } ;
 
@@ -201,17 +205,17 @@ HELP: <file-appender>
 
 HELP: with-file-reader
 { $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
-{ $description "Opens a file for reading and calls the quotation using " { $link with-stream } "." }
+{ $description "Opens a file for reading and calls the quotation using " { $link with-input-stream } "." }
 { $errors "Throws an error if the file is unreadable." } ;
 
 HELP: with-file-writer
 { $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
-{ $description "Opens a file for writing using the given encoding and calls the quotation using " { $link with-stream } "." }
+{ $description "Opens a file for writing using the given encoding and calls the quotation using " { $link with-output-stream } "." }
 { $errors "Throws an error if the file cannot be opened for writing." } ;
 
 HELP: with-file-appender
 { $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "quot" "a quotation" } }
-{ $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-stream } "." }
+{ $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-output-stream } "." }
 { $errors "Throws an error if the file cannot be opened for writing." } ;
 
 HELP: set-file-lines

core/io/files/files.factor

@@ -25,13 +25,13 @@ HOOK: (file-appender) io-backend ( path -- stream )
     <file-reader> lines ;
 
 : with-file-reader ( path encoding quot -- )
-    >r <file-reader> r> with-stream ; inline
+    >r <file-reader> r> with-input-stream ; inline
 
 : file-contents ( path encoding -- str )
     <file-reader> contents ;
 
 : with-file-writer ( path encoding quot -- )
-    >r <file-writer> r> with-stream ; inline
+    >r <file-writer> r> with-output-stream ; inline
 
 : set-file-lines ( seq path encoding -- )
     [ [ print ] each ] with-file-writer ;
@@ -40,7 +40,7 @@ HOOK: (file-appender) io-backend ( path -- stream )
     [ write ] with-file-writer ;
 
 : with-file-appender ( path encoding quot -- )
-    >r <file-appender> r> with-stream ; inline
+    >r <file-appender> r> with-output-stream ; inline
 
 ! Pathnames
 : path-separator? ( ch -- ? ) os windows? "/\\" "/" ? member? ;

core/io/io-docs.factor

@@ -5,7 +5,7 @@ IN: io
 ARTICLE: "stream-protocol" "Stream protocol"
 "The stream protocol consists of a large number of generic words, many of which are optional."
 $nl
-"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in a " { $link with-stream } ". This leads more simpler, more reusable and more robust code."
+"Stream protocol words are rarely called directly, since code which only works with one stream at a time should be written use " { $link "stdio" } " instead, wrapping I/O operations such as " { $link read } " and " { $link write } " in " { $link with-input-stream } " and " { $link with-output-stream } "."
 $nl
 "All streams must implement the " { $link dispose } " word in addition to the stream protocol."
 $nl
@@ -26,24 +26,24 @@ $nl
 { $subsection stream-write-table }
 { $see-also "io.timeouts" } ;
 
-ARTICLE: "stdio" "The default stream"
+ARTICLE: "stdio" "Default input and output streams"
-"Most I/O code only operates on one stream at a time. The " { $emphasis "default stream" } " is an implicit parameter used by many I/O words designed for this particular use-case. Using this idiom improves code in three ways:"
+"Most I/O code only operates on one stream at a time. The " { $link input-stream } " and " { $link output-stream } " variables are implicit parameters used by many I/O words. Using this idiom improves code in three ways:"
 { $list
     { "Code becomes simpler because there is no need to keep a stream around on the stack." }
-    { "Code becomes more robust because " { $link with-stream } " automatically closes the stream if there is an error." }
+    { "Code becomes more robust because " { $link with-input-stream } " and " { $link with-output-stream } " automatically close the streams if there is an error." }
-    { "Code becomes more reusable because it can be written to not worry about which stream is being used, and instead the caller can use " { $link with-stream } " to specify the source or destination for I/O operations." }
+    { "Code becomes more reusable because it can be written to not worry about which stream is being used, and instead the caller can use " { $link with-input-stream } " or " { $link with-output-stream } " to specify the source or destination for I/O operations." }
 }
 "For example, here is a program which reads the first line of a file, converts it to an integer, then reads that many characters, and splits them into groups of 16:"
 { $code
     "USING: continuations kernel io io.files math.parser splitting ;"
-    "\"data.txt\" <file-reader>"
+    "\"data.txt\" utf8 <file-reader>"
     "dup stream-readln number>string over stream-read 16 group"
     "swap dispose"
 }
 "This code has two problems: it has some unnecessary stack shuffling, and if either " { $link stream-readln } " or " { $link stream-read } " throws an I/O error, the stream is not closed because " { $link dispose } " is never reached. So we can add a call to " { $link with-disposal } " to ensure the stream is always closed:"
 { $code
     "USING: continuations kernel io io.files math.parser splitting ;"
-    "\"data.txt\" <file-reader> ["
+    "\"data.txt\" utf8 <file-reader> ["
     "    dup stream-readln number>string over stream-read"
     "    16 group"
     "] with-disposal"
@@ -51,17 +51,34 @@ ARTICLE: "stdio" "The default stream"
 "This code is robust however it is more complex than it needs to be since. This is where the default stream words come in; using them, the above can be rewritten as follows:"
 { $code
     "USING: continuations kernel io io.files math.parser splitting ;"
-    "\"data.txt\" <file-reader> ["
+    "\"data.txt\" utf8 <file-reader> ["
     "    readln number>string read 16 group"
-    "] with-stream"
+    "] with-input-stream"
 }
-"The default stream is stored in a dynamically-scoped variable:"
+"An even better implementation that takes advantage of a utility word:"
-{ $subsection stdio }
+{ $code
-"Unless rebound in a child namespace, this variable will be set to a console stream for interacting with the user."
+    "USING: continuations kernel io io.files math.parser splitting ;"
+    "\"data.txt\" utf8 ["
+    "    readln number>string read 16 group"
+    "] with-file-reader"
+}
+"The default input stream is stored in a dynamically-scoped variable:"
+{ $subsection input-stream }
+"Unless rebound in a child namespace, this variable will be set to a console stream for reading input from the user."
+$nl
+"Words reading from the default input stream:"
 { $subsection read1 }
 { $subsection read }
 { $subsection read-until }
 { $subsection readln }
+"A pair of combinators for rebinding the " { $link input-stream } " variable:"
+{ $subsection with-input-stream }
+{ $subsection with-input-stream* }
+"The default output stream is stored in a dynamically-scoped variable:"
+{ $subsection output-stream }
+"Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user."
+$nl
+"Words writing to the default input stream:"
 { $subsection flush }
 { $subsection write1 }
 { $subsection write }
@@ -78,9 +95,12 @@ ARTICLE: "stdio" "The default stream"
 { $subsection with-row }
 { $subsection with-cell }
 { $subsection write-cell }
-"A pair of combinators support rebinding the " { $link stdio } " variable:"
+"A pair of combinators for rebinding the " { $link output-stream } " variable:"
-{ $subsection with-stream }
+{ $subsection with-output-stream }
-{ $subsection with-stream* } ;
+{ $subsection with-output-stream* }
+"A pair of combinators for rebinding both default streams at once:"
+{ $subsection with-streams }
+{ $subsection with-streams* } ;
 
 ARTICLE: "stream-utils" "Stream utilities"
 "There are a few useful stream-related words which are not generic, but merely built up from the stream protocol."
@@ -204,62 +224,65 @@ HELP: stream-copy
 { $description "Copies the contents of one stream into another, closing both streams when done." } 
 $io-error ;
 
-HELP: stdio
+HELP: input-stream
-{ $var-description "Holds a stream, used for various implicit stream operations. Rebound using " { $link with-stream } " and " { $link with-stream* } "." } ;
+{ $var-description "Holds an input stream for various implicit stream operations. Rebound using " { $link with-input-stream } " and " { $link with-input-stream* } "." } ;
+
+HELP: output-stream
+{ $var-description "Holds an output stream for various implicit stream operations. Rebound using " { $link with-output-stream } " and " { $link with-output-stream* } "." } ;
 
 HELP: readln
 { $values { "str/f" "a string or " { $link f } } }
-{ $description "Reads a line of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
+{ $description "Reads a line of input from " { $link input-stream } ". Outputs " { $link f } " on stream exhaustion." }
 $io-error ;
 
 HELP: read1
 { $values { "ch/f" "a character or " { $link f } } }
-{ $description "Reads a character of input from the " { $link stdio } " stream. Outputs " { $link f } " on stream exhaustion." }
+{ $description "Reads a character of input from " { $link input-stream } ". Outputs " { $link f } " on stream exhaustion." }
 $io-error ;
 
 HELP: read
 { $values { "n" "a non-negative integer" } { "str/f" "a string or " { $link f } } }
-{ $description "Reads " { $snippet "n" } " characters of input from the " { $link stdio } " stream. Outputs a truncated string or " { $link f } " on stream exhaustion." }
+{ $description "Reads " { $snippet "n" } " characters of input from " { $link input-stream } ". Outputs a truncated string or " { $link f } " on stream exhaustion." }
 $io-error ;
 
 HELP: read-until
 { $values { "seps" string } { "str/f" "a string or " { $link f } } { "sep/f" "a character or " { $link f } } }
-{ $contract "Reads characters from the " { $link stdio } " stream. until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
+{ $contract "Reads characters from " { $link input-stream } ". until the first occurrence of a separator character, or stream exhaustion. In the former case, the separator character is pushed on the stack, and is not part of the output string. In the latter case, the entire stream contents are output, along with " { $link f } "." }
 $io-error ;
 
 HELP: write1
 { $values { "ch" "a character" } }
-{ $contract "Writes a character of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $contract "Writes a character of output to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 $io-error ;
 
 HELP: write
 { $values { "str" string } }
-{ $description "Writes a string of output to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes a string of output to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 $io-error ;
 
 HELP: flush
-{ $description "Waits for any pending output to the " { $link stdio } " stream to complete." }
+{ $description "Waits for any pending output on " { $link output-stream } " to complete." }
 $io-error ;
 
 HELP: nl
-{ $description "Writes a line terminator to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes a line terminator to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 $io-error ;
 
 HELP: format
 { $values { "str" string } { "style" "a hashtable" } }
-{ $description "Writes formatted text to the " { $link stdio } " stream. If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
+{ $description "Writes formatted text to " { $link output-stream } ". If the stream does buffering, output may not be performed immediately; use " { $link flush } " to force output." }
 { $notes "Details are in the documentation for " { $link stream-format } "." }
 $io-error ;
 
 HELP: with-nesting
-{ $values { "style" "a hashtable" } { "quot" "a quotation" } }
+{ $values { "style" "a hashtable" } { "quot" quotation } }
-{ $description "Calls the quotation in a new dynamic scope with the " { $link stdio } " stream rebound to a nested paragraph stream, with formatting information applied." }
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to a nested paragraph stream, with formatting information applied." }
 { $notes "Details are in the documentation for " { $link make-block-stream } "." }
 $io-error ;
 
 HELP: tabular-output
 { $values { "style" "a hashtable" } { "quot" quotation } }
-{ $description "Calls a quotation which emits a series of equal-length table rows using " { $link with-row } ". The results are laid out in a tabular fashion on the " { $link stdio } " stream."
+{ $description "Calls a quotation which emits a series of equal-length table rows using " { $link with-row } ". The results are laid out in a tabular fashion on " { $link output-stream } "."
 $nl
 "The " { $snippet "style" } " hashtable holds table style information. See " { $link "table-styles" } "." }
 { $examples
@@ -279,7 +302,7 @@ $io-error ;
 
 HELP: with-cell
 { $values { "quot" quotation } }
-{ $description "Calls a quotation in a new scope with the " { $link stdio } " stream rebound. Output performed by the quotation is displayed in a table cell. This word can only be called inside the quotation given to " { $link with-row } "." }
+{ $description "Calls a quotation in a new scope with " { $link output-stream } " rebound. Output performed by the quotation is displayed in a table cell. This word can only be called inside the quotation given to " { $link with-row } "." }
 $io-error ;
 
 HELP: write-cell
@@ -288,34 +311,54 @@ HELP: write-cell
 $io-error ;
 
 HELP: with-style
-{ $values { "style" "a hashtable" } { "quot" "a quotation" } }
+{ $values { "style" "a hashtable" } { "quot" quotation } }
 { $description "Calls the quotation in a new dynamic scope where calls to " { $link write } ", " { $link format } " and other stream output words automatically inherit style settings from " { $snippet "style" } "." }
 { $notes "Details are in the documentation for " { $link make-span-stream } "." }
 $io-error ;
 
 HELP: print
 { $values { "string" string } }
-{ $description "Writes a newline-terminated string to the " { $link stdio } " stream." }
+{ $description "Writes a newline-terminated string to " { $link output-stream } "." }
 $io-error ;
 
-HELP: with-stream
+HELP: with-input-stream
-{ $values { "stream" "an input or output stream" } { "quot" "a quotation" } }
+{ $values { "stream" "an input stream" } { "quot" quotation } }
-{ $description "Calls the quotation in a new dynamic scope, with the " { $link stdio } " variable rebound to  " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to  " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
 
-{ with-stream with-stream* } related-words
+HELP: with-output-stream
+{ $values { "stream" "an output stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link output-stream } " rebound to  " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
 
-HELP: with-stream*
+HELP: with-streams
-{ $values { "stream" "an input or output stream" } { "quot" "a quotation" } }
+{ $values { "input" "an input stream" } { "output" "an output stream" } { "quot" quotation } }
-{ $description "Calls the quotation in a new dynamic scope, with the " { $link stdio } " variable rebound to  " { $snippet "stream" } "." }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to  " { $snippet "input" } " and " { $link output-stream } " rebound to  " { $snippet "output" } ". The stream is closed if the quotation returns or throws an error." } ;
-{ $notes "This word does not close the stream. Compare with " { $link with-stream } "." } ;
+
+HELP: with-streams*
+{ $values { "input" "an input stream" } { "output" "an output stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to  " { $snippet "input" } " and " { $link output-stream } " rebound to  " { $snippet "output" } "." }
+{ $notes "This word does not close the stream. Compare with " { $link with-streams } "." } ;
+
+{ with-input-stream with-input-stream* } related-words
+
+{ with-output-stream with-output-stream* } related-words
+
+HELP: with-input-stream*
+{ $values { "stream" "an input stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link input-stream } " rebound to  " { $snippet "stream" } "." }
+{ $notes "This word does not close the stream. Compare with " { $link with-input-stream } "." } ;
+
+HELP: with-output-stream*
+{ $values { "stream" "an output stream" } { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope, with " { $link output-stream } " rebound to  " { $snippet "stream" } "." }
+{ $notes "This word does not close the stream. Compare with " { $link with-output-stream } "." } ;
 
 HELP: bl
-{ $description "Outputs a space character (" { $snippet "\" \"" } ")." }
+{ $description "Outputs a space character (" { $snippet "\" \"" } ") to " { $link output-stream } "." }
 $io-error ;
 
 HELP: write-object
 { $values { "str" string } { "obj" "an object" } }
-{ $description "Writes a string to the " { $link stdio } " stream, associating it with the object. If formatted output is supported, the string will become a clickable presentation of the object, otherwise this word behaves like a call to " { $link write } "." }
+{ $description "Writes a string to " { $link output-stream } ", associating it with the object. If formatted output is supported, the string will become a clickable presentation of the object, otherwise this word behaves like a call to " { $link write } "." }
 $io-error ;
 
 HELP: lines

core/io/io-tests.factor

@@ -8,21 +8,18 @@ IN: io.tests
     "foo" "io.tests" lookup
 ] unit-test
 
-: <resource-reader> ( resource -- stream )
-    resource-path latin1 <file-reader> ;
-
 [
     "This is a line.\rThis is another line.\r"
 ] [
-    "core/io/test/mac-os-eol.txt" <resource-reader>
+    "resource:core/io/test/mac-os-eol.txt" latin1 <file-reader>
-    [ 500 read ] with-stream
+    [ 500 read ] with-input-stream
 ] unit-test
 
 [
     255
 ] [
-    "core/io/test/binary.txt" <resource-reader>
+    "resource:core/io/test/binary.txt" latin1 <file-reader>
-    [ read1 ] with-stream >fixnum
+    [ read1 ] with-input-stream >fixnum
 ] unit-test
 
 ! Make sure we use correct to_c_string form when writing
@@ -36,11 +33,12 @@ IN: io.tests
     }
 ] [
     [
-        "core/io/test/separator-test.txt" <resource-reader> [
+        "resource:core/io/test/separator-test.txt"
+        latin1 <file-reader> [
             "J" read-until 2array ,
             "i" read-until 2array ,
             "X" read-until 2array ,
-        ] with-stream
+        ] with-input-stream
     ] { } make
 ] unit-test
 
@@ -49,12 +47,3 @@ IN: io.tests
         10 [ 65536 read drop ] times
     ] with-file-reader
 ] unit-test
-
-! [ "" ] [ 0 read ] unit-test
-
-! [ ] [ "123" write 9000 CHAR: x <string> write flush ] unit-test
-
-! [
-!     "/core/io/test/binary.txt" <resource-reader>
-!     [ 0.2 read ] with-stream
-! ] must-fail

core/io/io.factor

@@ -30,39 +30,52 @@ GENERIC: stream-write-table ( table-cells style stream -- )
     [ 2dup (stream-copy) ] [ dispose dispose ] [ ]
     cleanup ;
 
-! Default stream
+! Default streams
-SYMBOL: stdio
+SYMBOL: input-stream
+SYMBOL: output-stream
+SYMBOL: error-stream
 
-! Default error stream
+: readln ( -- str/f ) input-stream get stream-readln ;
-SYMBOL: stderr
+: read1 ( -- ch/f ) input-stream get stream-read1 ;
+: read ( n -- str/f ) input-stream get stream-read ;
+: read-until ( seps -- str/f sep/f ) input-stream get stream-read-until ;
 
-: readln ( -- str/f ) stdio get stream-readln ;
+: write1 ( ch -- ) output-stream get stream-write1 ;
-: read1 ( -- ch/f ) stdio get stream-read1 ;
+: write ( str -- ) output-stream get stream-write ;
-: read ( n -- str/f ) stdio get stream-read ;
+: flush ( -- ) output-stream get stream-flush ;
-: read-until ( seps -- str/f sep/f ) stdio get stream-read-until ;
 
-: write1 ( ch -- ) stdio get stream-write1 ;
+: nl ( -- ) output-stream get stream-nl ;
-: write ( str -- ) stdio get stream-write ;
+: format ( str style -- ) output-stream get stream-format ;
-: flush ( -- ) stdio get stream-flush ;
 
-: nl ( -- ) stdio get stream-nl ;
+: with-input-stream* ( stream quot -- )
-: format ( str style -- ) stdio get stream-format ;
+    input-stream swap with-variable ; inline
 
-: with-stream* ( stream quot -- )
+: with-input-stream ( stream quot -- )
-    stdio swap with-variable ; inline
+    [ with-input-stream* ] curry with-disposal ; inline
 
-: with-stream ( stream quot -- )
+: with-output-stream* ( stream quot -- )
-    [ with-stream* ] curry with-disposal ; inline
+    output-stream swap with-variable ; inline
+
+: with-output-stream ( stream quot -- )
+    [ with-output-stream* ] curry with-disposal ; inline
+
+: with-streams* ( input output quot -- )
+    [ output-stream set input-stream set ] prepose with-scope ; inline
+
+: with-streams ( input output quot -- )
+    [ [ with-streams* ] 3curry ]
+    [ [ drop dispose dispose ] 3curry ] 3bi
+    [ ] cleanup ; inline
 
 : tabular-output ( style quot -- )
-    swap >r { } make r> stdio get stream-write-table ; inline
+    swap >r { } make r> output-stream get stream-write-table ; inline
 
 : with-row ( quot -- )
     { } make , ; inline
 
 : with-cell ( quot -- )
-    H{ } stdio get make-cell-stream
+    H{ } output-stream get make-cell-stream
-    [ swap with-stream ] keep , ; inline
+    [ swap with-output-stream ] keep , ; inline
 
 : write-cell ( str -- )
     [ write ] with-cell ; inline
@@ -71,13 +84,14 @@ SYMBOL: stderr
     swap dup assoc-empty? [
         drop call
     ] [
-        stdio get make-span-stream swap with-stream
+        output-stream get make-span-stream swap with-output-stream
     ] if ; inline
 
 : with-nesting ( style quot -- )
-    >r stdio get make-block-stream r> with-stream ; inline
+    >r output-stream get make-block-stream
+    r> with-output-stream ; inline
 
-: print ( string -- ) stdio get stream-print ;
+: print ( string -- ) output-stream get stream-print ;
 
 : bl ( -- ) " " write ;
 
@@ -85,9 +99,9 @@ SYMBOL: stderr
     presented associate format ;
 
 : lines ( stream -- seq )
-    [ [ readln dup ] [ ] [ drop ] unfold ] with-stream ;
+    [ [ readln dup ] [ ] [ drop ] unfold ] with-input-stream ;
 
 : contents ( stream -- str )
     [
         [ 65536 read dup ] [ ] [ drop ] unfold concat f like
-    ] with-stream  ;
+    ] with-input-stream ;

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

@@ -25,10 +25,10 @@ HELP: <byte-writer>
 HELP: with-byte-reader
 { $values { "encoding" "an encoding descriptor" }
     { "quot" quotation } { "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream for reading from a byte array using an encoding." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link input-stream } " rebound to an input stream for reading from a byte array using an encoding." } ;
 
 HELP: with-byte-writer
 { $values  { "encoding" "an encoding descriptor" }
     { "quot" quotation }
     { "byte-array" byte-array } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an output stream writing data to a byte array using an encoding." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an output stream writing data to a byte array using an encoding." } ;

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

@@ -1,16 +1,16 @@
 USING: byte-arrays byte-vectors kernel io.encodings io.streams.string
-sequences io namespaces io.encodings.private ;
+sequences io namespaces io.encodings.private accessors ;
 IN: io.streams.byte-array
 
 : <byte-writer> ( encoding -- stream )
     512 <byte-vector> swap <encoder> ;
 
 : with-byte-writer ( encoding quot -- byte-array )
-    >r <byte-writer> r> [ stdio get ] compose with-stream*
+    >r <byte-writer> r> [ output-stream get ] compose with-output-stream*
-    dup encoder? [ encoder-stream ] when >byte-array ; inline
+    dup encoder? [ stream>> ] when >byte-array ; inline
 
 : <byte-reader> ( byte-array encoding -- stream )
     >r >byte-vector dup reverse-here r> <decoder> ;
 
 : with-byte-reader ( byte-array encoding quot -- )
-    >r <byte-reader> r> with-stream ; inline
+    >r <byte-reader> r> with-input-stream* ; inline

core/io/streams/c/c.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private namespaces io io.encodings
 sequences math generic threads.private classes io.backend
-io.streams.duplex io.files continuations byte-arrays ;
+io.files continuations byte-arrays ;
 IN: io.streams.c
 
 TUPLE: c-writer handle ;

core/io/streams/duplex/duplex-docs.factor

@@ -1,19 +0,0 @@
-USING: help.markup help.syntax io continuations ;
-IN: io.streams.duplex
-
-ARTICLE: "io.streams.duplex" "Duplex streams"
-"Duplex streams combine an input stream and an output stream into a bidirectional stream."
-{ $subsection duplex-stream }
-{ $subsection <duplex-stream> } ;
-
-ABOUT: "io.streams.duplex"
-
-HELP: duplex-stream
-{ $class-description "A bidirectional stream wrapping an input and output stream." } ;
-
-HELP: <duplex-stream>
-{ $values { "in" "an input stream" } { "out" "an output stream" } { "stream" " a duplex stream" } }
-{ $description "Creates a duplex stream. Writing to a duplex stream will write to " { $snippet "out" } ", and reading from a duplex stream will read from " { $snippet "in" } ". Closing a duplex stream closes both the input and output streams." } ;
-
-HELP: stream-closed-twice
-{ $error-description "This error is thrown when performing an I/O operation on a " { $link duplex-stream } " which has been closed with " { $link dispose } "." } ;

core/io/streams/string/string-docs.factor

@@ -17,7 +17,7 @@ HELP: <string-writer>
 
 HELP: with-string-writer
 { $values { "quot" quotation } { "str" string } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to a new string writer. The accumulated string is output when the quotation returns." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to a new string writer. The accumulated string is output when the quotation returns." } ;
 
 HELP: <string-reader>
 { $values { "str" string } { "stream" "an input stream" } }
@@ -26,4 +26,4 @@ HELP: <string-reader>
 
 HELP: with-string-reader
 { $values { "str" string } { "quot" quotation } }
-{ $description "Calls the quotation in a new dynamic scope with " { $link stdio } " rebound to an input stream reading " { $snippet "str" } " from beginning to end." } ;
+{ $description "Calls the quotation in a new dynamic scope with " { $link input-stream } " rebound to an input stream reading " { $snippet "str" } " from beginning to end." } ;

core/io/streams/string/string-tests.factor

@@ -35,7 +35,7 @@ unit-test
             "J" read-until 2array ,
             "i" read-until 2array ,
             "X" read-until 2array ,
-        ] with-stream
+        ] with-input-stream
     ] { } make
 ] unit-test
 

core/io/streams/string/string.factor

@@ -15,7 +15,7 @@ M: growable stream-flush drop ;
     512 <sbuf> ;
 
 : with-string-writer ( quot -- str )
-    <string-writer> swap [ stdio get ] compose with-stream*
+    <string-writer> swap [ output-stream get ] compose with-output-stream*
     >string ; inline
 
 M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ;
@@ -56,7 +56,7 @@ M: null decode-char drop stream-read1 ;
     >sbuf dup reverse-here null <decoder> ;
 
 : with-string-reader ( str quot -- )
-    >r <string-reader> r> with-stream ; inline
+    >r <string-reader> r> with-input-stream ; inline
 
 INSTANCE: growable plain-writer
 
@@ -67,15 +67,14 @@ INSTANCE: growable plain-writer
     ] unless ;
 
 : map-last ( seq quot -- seq )
-    swap dup length <reversed>
+    >r dup length <reversed> [ zero? ] r> compose 2map ; inline
-    [ zero? rot [ call ] keep swap ] 2map nip ; inline
 
 : format-table ( table -- seq )
     flip [ format-column ] map-last
     flip [ " " join ] map ;
 
 M: plain-writer stream-write-table
-    [ drop format-table [ print ] each ] with-stream* ;
+    [ drop format-table [ print ] each ] with-output-stream* ;
 
 M: plain-writer make-cell-stream 2drop <string-writer> ;
 

core/listener/listener-docs.factor

@@ -32,14 +32,14 @@ HELP: listener-hook
 
 HELP: read-quot
 { $values { "quot/f" "a parsed quotation, or " { $link f } " indicating end of file" } }
-{ $description "Reads a Factor expression which possibly spans more than one line from " { $link stdio } " stream. Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
+{ $description "Reads a Factor expression which possibly spans more than one line from " { $link input-stream } ". Additional lines of input are read while the parser stack height is greater than one. Since structural parsing words push partial quotations on the stack, this will keep on reading input until all delimited parsing words are terminated." } ;
 
 HELP: listen
-{ $description "Prompts for an expression on the " { $link stdio } " stream and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }
+{ $description "Prompts for an expression on " { $link input-stream } " and evaluates it. On end of file, " { $link quit-flag } " is set to terminate the listener loop." }
-{ $errors "If the expression input by the user throws an error, the error is printed to the " { $link stdio } " stream and the word returns normally." } ;
+{ $errors "If the expression input by the user throws an error, the error is printed to " { $link output-stream } " and the word returns normally." } ;
 
 HELP: listener
-{ $description "Prompts for expressions on the " { $link stdio } " stream and evaluates them until end of file is reached." } ;
+{ $description "Prompts for expressions on " { $link input-stream } " and evaluates them until end of file is reached." } ;
 
 HELP: bye
 { $description "Exits the current listener." }

core/listener/listener.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables io kernel math math.parser memory
 namespaces parser sequences strings io.styles
-io.streams.duplex vectors words generic system combinators
+vectors words generic system combinators continuations debugger
-continuations debugger definitions compiler.units accessors ;
+definitions compiler.units accessors ;
 IN: listener
 
 SYMBOL: quit-flag
@@ -35,10 +35,7 @@ GENERIC: stream-read-quot ( stream -- quot/f )
 M: object stream-read-quot
     V{ } clone read-quot-loop ;
 
-M: duplex-stream stream-read-quot
+: read-quot ( -- quot/f ) input-stream get stream-read-quot ;
-    duplex-stream-in stream-read-quot ;
-
-: read-quot ( -- quot/f ) stdio get stream-read-quot ;
 
 : bye ( -- ) quit-flag on ;
 
@@ -46,9 +43,13 @@ M: duplex-stream stream-read-quot
     "( " in get " )" 3append
     H{ { background { 1 0.7 0.7 1 } } } format bl flush ;
 
+SYMBOL: error-hook
+
+[ print-error-and-restarts ] error-hook set-global
+
 : listen ( -- )
     listener-hook get call prompt.
-    [ read-quot [ try ] [ bye ] if* ]
+    [ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ]
     [
         dup parse-error? [
             error-hook get call

core/math/order/order-docs.factor

@@ -25,8 +25,8 @@ HELP: +gt+
 { $description "Returned by " { $link <=> } " when the first object is strictly greater than the second object." } ;
 
 HELP: invert-comparison
-{ $values { "symbol" "a comparison symbol, +lt+, +eq+, or +gt+" }
+{ $values { "symbol" symbol }
-          { "new-symbol" "a comparison symbol, +lt+, +eq+, or +gt+" } }
+          { "new-symbol" symbol } }
 { $description "Invert the comparison symbol returned by " { $link <=> } ". The output for the symbol " { $snippet "+eq+" } " is itself." }
 { $examples
     { $example "USING: math.order prettyprint ;" "+lt+ invert-comparison ." "+gt+" } } ;

core/math/parser/parser-tests.factor

@@ -98,3 +98,9 @@ unit-test
 [ 1 1 >base ] must-fail
 [ 1 0 >base ] must-fail
 [ 1 -1 >base ] must-fail
+
+[ "0.0/0.0" ] [ 0.0 0.0 / number>string ] unit-test
+
+[ "1.0/0.0" ] [ 1.0 0.0 / number>string ] unit-test
+
+[ "-1.0/0.0" ] [ -1.0 0.0 / number>string ] unit-test

core/math/parser/parser.factor

@@ -140,9 +140,9 @@ M: ratio >base
 
 M: float >base
     drop {
+        { [ dup fp-nan? ] [ drop "0.0/0.0" ] }
         { [ dup 1.0/0.0 = ] [ drop "1.0/0.0" ] }
         { [ dup -1.0/0.0 = ] [ drop "-1.0/0.0" ] }
-        { [ dup fp-nan? ] [ drop "0.0/0.0" ] }
         [ float>string fix-float ]
     } cond ;
 

core/optimizer/def-use/def-use-tests.factor

@@ -1,6 +1,6 @@
 IN: optimizer.def-use.tests
 USING: inference inference.dataflow optimizer optimizer.def-use
-namespaces assocs kernel sequences math tools.test words ;
+namespaces assocs kernel sequences math tools.test words sets ;
 
 [ 3 { 1 1 1 } ] [
     [ 1 2 3 ] dataflow compute-def-use drop

core/parser/parser-docs.factor

@@ -5,7 +5,7 @@ quotations namespaces compiler.units assocs ;
 IN: parser
 
 ARTICLE: "vocabulary-search-shadow" "Shadowing word names"
-"If adding a vocabulary to the search path results in a word in another vocabulary becoming inaccessible due to the new vocabulary defining a word with the same name, a message is printed to the " { $link stdio } " stream. Except when debugging suspected name clashes, these messages can be ignored."
+"If adding a vocabulary to the search path results in a word in another vocabulary becoming inaccessible due to the new vocabulary defining a word with the same name, we say that the old word has been " { $emphasis "shadowed" } "."
 $nl
 "Here is an example where shadowing occurs:"
 { $code
@@ -13,18 +13,18 @@ $nl
     "USING: sequences io ;"
     ""
     ": append"
-    "    \"foe::append calls sequences::append\" print  append ;"
+    "    \"foe::append calls sequences:append\" print  append ;"
     ""
     "IN: fee"
     ""
     ": append"
-    "    \"fee::append calls fee::append\" print  append ;"
+    "    \"fee::append calls fee:append\" print  append ;"
     ""
     "IN: fox"
     "USE: foe"
     ""
     ": append"
-    "    \"fox::append calls foe::append\" print  append ;"
+    "    \"fox::append calls foe:append\" print  append ;"
     ""
     "\"1234\" \"5678\" append print"
     ""
@@ -33,12 +33,13 @@ $nl
 }
 "When placed in a source file and run, the above code produces the following output:"
 { $code
-    "foe::append calls sequences::append"
+    "foe:append calls sequences:append"
     "12345678"
-    "fee::append calls foe::append"
+    "fee:append calls foe:append"
-    "foe::append calls sequences::append"
+    "foe:append calls sequences:append"
     "12345678"
-} ;
+}
+"The " { $vocab-link "qualified" } " vocabulary contains some tools for helping with shadowing." ;
 
 ARTICLE: "vocabulary-search-errors" "Word lookup errors"
 "If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies. Then, one of three things happen:"
@@ -215,7 +216,7 @@ HELP: save-location
 { $description "Saves the location of a definition and associates this definition with the current source file." } ;
 
 HELP: parser-notes
-{ $var-description "A boolean controlling whether the parser will print various notes and warnings. Switched on by default. If a source file is being run for its effect on the " { $link stdio } " stream, this variable should be switched off, to prevent parser notes from polluting the output." } ;
+{ $var-description "A boolean controlling whether the parser will print various notes and warnings. Switched on by default. If a source file is being run for its effect on " { $link output-stream } ", this variable should be switched off, to prevent parser notes from polluting the output." } ;
 
 HELP: parser-notes?
 { $values { "?" "a boolean" } }
@@ -506,7 +507,7 @@ HELP: bootstrap-file
 
 HELP: eval>string
 { $values { "str" string } { "output" string } }
-{ $description "Evaluates the Factor code in " { $snippet "str" } " with the " { $link stdio } " stream rebound to a string output stream, then outputs the resulting string." } ;
+{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string." } ;
 
 HELP: staging-violation
 { $values { "word" word } }

core/prettyprint/prettyprint-docs.factor

@@ -135,7 +135,7 @@ ARTICLE: "prettyprint" "The prettyprinter"
 $nl
 "Prettyprinter words are found in the " { $vocab-link "prettyprint" } " vocabulary."
 $nl
-"The key words to print an object to the " { $link stdio } " stream; the first two emit a trailing newline, the second two do not:"
+"The key words to print an object to " { $link output-stream } "; the first two emit a trailing newline, the second two do not:"
 { $subsection . }
 { $subsection short. }
 { $subsection pprint }
@@ -161,17 +161,17 @@ ABOUT: "prettyprint"
 
 HELP: with-pprint
 { $values { "obj" object } { "quot" quotation } }
-{ $description "Sets up the prettyprinter and calls the quotation in a new scope. The quotation should add sections to the top-level block. When the quotation returns, the top-level block is printed to the " { $link stdio } " stream." } ;
+{ $description "Sets up the prettyprinter and calls the quotation in a new scope. The quotation should add sections to the top-level block. When the quotation returns, the top-level block is printed to " { $link output-stream } "." } ;
 
 HELP: pprint
 { $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
+{ $description "Prettyprints an object to " { $link output-stream } ". Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
 
 { pprint pprint* with-pprint } related-words
 
 HELP: .
 { $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream with a trailing line break. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
+{ $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. Output is influenced by many variables; see " { $link "prettyprint-variables" } "." } ;
 
 HELP: unparse
 { $values { "obj" object } { "str" "Factor source string" } }
@@ -179,11 +179,11 @@ HELP: unparse
 
 HELP: pprint-short
 { $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream. This word rebinds printer control variables to enforce ``shorter'' output. See " { $link "prettyprint-variables" } "." } ;
+{ $description "Prettyprints an object to " { $link output-stream } ". This word rebinds printer control variables to enforce ``shorter'' output. See " { $link "prettyprint-variables" } "." } ;
 
 HELP: short.
 { $values { "obj" object } }
-{ $description "Prettyprints an object to the " { $link stdio } " stream with a trailing line break. This word rebinds printer control variables to enforce ``shorter'' output." } ;
+{ $description "Prettyprints an object to " { $link output-stream } " with a trailing line break. This word rebinds printer control variables to enforce ``shorter'' output." } ;
 
 HELP: .b
 { $values { "n" "an integer" } }

core/prettyprint/prettyprint-tests.factor

@@ -114,7 +114,7 @@ unit-test
             [ parse-fresh drop ] with-compilation-unit
             [
                 "prettyprint.tests" lookup see
-            ] with-string-writer "\n" split 1 head*
+            ] with-string-writer "\n" split but-last
         ] keep =
     ] with-scope ;
 

core/prettyprint/sections/sections-docs.factor

@@ -15,7 +15,7 @@ HELP: line-limit?
 
 
 HELP: do-indent
-{ $description "Outputs the current indent nesting to the " { $link stdio } " stream." } ;
+{ $description "Outputs the current indent nesting to " { $link output-stream } "." } ;
 
 HELP: fresh-line
 { $values { "n" "the current column position" } }

core/prettyprint/sections/sections.factor

@@ -15,9 +15,9 @@ SYMBOL: pprinter-stack
 SYMBOL: pprinter-in
 SYMBOL: pprinter-use
 
-TUPLE: pprinter last-newline line-count end-printing indent ;
+TUPLE: pprinter last-newline line-count indent ;
 
-: <pprinter> ( -- pprinter ) 0 1 f 0 pprinter boa ;
+: <pprinter> ( -- pprinter ) 0 1 0 pprinter boa ;
 
 : record-vocab ( word -- )
     word-vocabulary [ dup pprinter-use get set-at ] when* ;
@@ -34,7 +34,7 @@ TUPLE: pprinter last-newline line-count end-printing indent ;
     ] [
         pprinter get (>>last-newline)
         line-limit? [
-            "..." write pprinter get end-printing>> continue
+            "..." write pprinter get return
         ] when
         pprinter get [ 1+ ] change-line-count drop
         nl do-indent
@@ -275,16 +275,15 @@ M: colon unindent-first-line? drop t ;
         [
             dup style>> [
                 [
-                    >r pprinter get (>>end-printing) r>
                     short-section
-                ] curry callcc0
+                ] curry with-return
             ] with-nesting
         ] if-nonempty
     ] with-variable ;
 
 ! Long section layout algorithm
 : chop-break ( seq -- seq )
-    dup peek line-break? [ 1 head-slice* chop-break ] when ;
+    dup peek line-break? [ but-last-slice chop-break ] when ;
 
 SYMBOL: prev
 SYMBOL: next

core/sequences/sequences-docs.factor

@@ -92,9 +92,11 @@ ARTICLE: "sequences-slices" "Subsequences and slices"
 { $subsection subseq }
 { $subsection head }
 { $subsection tail }
-{ $subsection rest }
 { $subsection head* }
 { $subsection tail* }
+"Removing the first or last element:"
+{ $subsection rest }
+{ $subsection but-last }
 "Taking a sequence apart into a head and a tail:"
 { $subsection unclip }
 { $subsection cut }
@@ -106,6 +108,7 @@ ARTICLE: "sequences-slices" "Subsequences and slices"
 { $subsection <slice> }
 { $subsection head-slice }
 { $subsection tail-slice }
+{ $subsection but-last-slice }
 { $subsection rest-slice }
 { $subsection head-slice* }
 { $subsection tail-slice* }
@@ -836,11 +839,16 @@ HELP: tail-slice
 { $description "Outputs a virtual sequence sharing storage with all elements from the " { $snippet "n" } "th index until the end of the input sequence." }
 { $errors "Throws an error if the index is out of bounds." } ;
 
+HELP: but-last-slice
+{ $values { "seq" sequence } { "slice" "a slice" } }
+{ $description "Outputs a virtual sequence sharing storage with all but the last element of the input sequence." }
+{ $errors "Throws an error on an empty sequence." } ;
+
 HELP: rest-slice
 { $values { "seq" sequence } { "slice" "a slice" } }
 { $description "Outputs a virtual sequence sharing storage with all elements from the 1st index until the end of the input sequence." }
 { $notes "Equivalent to " { $snippet "1 tail" } }
-{ $errors "Throws an error if the index is out of bounds." } ;
+{ $errors "Throws an error on an empty sequence." } ;
 
 HELP: head-slice*
 { $values { "seq" sequence } { "n" "a non-negative integer" } { "slice" "a slice" } }
@@ -862,6 +870,11 @@ HELP: tail
 { $description "Outputs a new sequence consisting of the input sequence with the first n items removed." }
 { $errors "Throws an error if the index is out of bounds." } ;
 
+HELP: but-last
+{ $values { "seq" sequence } { "headseq" "a new sequence" } }
+{ $description "Outputs a new sequence consisting of the input sequence with the last item removed." }
+{ $errors "Throws an error on an empty sequence." } ;
+
 HELP: rest
 { $values { "seq" sequence } { "tailseq" "a new sequence" } }
 { $description "Outputs a new sequence consisting of the input sequence with the first item removed." }

core/sequences/sequences.factor

@@ -216,6 +216,8 @@ M: slice length dup slice-to swap slice-from - ;
 
 : tail-slice* ( seq n -- slice ) from-end tail-slice ;
 
+: but-last-slice ( seq -- slice ) 1 head-slice* ;
+
 INSTANCE: slice virtual-sequence
 
 ! One element repeated many times
@@ -263,6 +265,8 @@ PRIVATE>
 
 : tail* ( seq n -- tailseq ) from-end tail ;
 
+: but-last ( seq -- headseq ) 1 head* ;
+
 : copy ( src i dst -- )
     pick length >r 3dup check-copy spin 0 r>
     (copy) drop ; inline
@@ -670,9 +674,15 @@ PRIVATE>
 : unclip ( seq -- rest first )
     [ rest ] [ first ] bi ;
 
+: unclip-last ( seq -- butfirst last )
+    [ but-last ] [ peek ] bi ;
+
 : unclip-slice ( seq -- rest first )
     [ rest-slice ] [ first ] bi ;
 
+: unclip-last-slice ( seq -- butfirst last )
+    [ but-last-slice ] [ peek ] bi ;
+
 : <flat-slice> ( seq -- slice )
     dup slice? [ { } like ] when 0 over length rot <slice> ;
     inline

core/splitting/splitting.factor

@@ -1,42 +1,72 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math namespaces strings arrays vectors sequences
-sets math.order ;
+sets math.order accessors ;
 IN: splitting
 
-TUPLE: groups seq n sliced? ;
+TUPLE: abstract-groups seq n ;
 
-: check-groups 0 <= [ "Invalid group count" throw ] when ;
+: check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
+
+: construct-groups ( seq n class -- groups )
+    >r check-groups r> boa ; inline
+
+GENERIC: group@ ( n groups -- from to seq )
+
+M: abstract-groups nth group@ subseq ;
+
+M: abstract-groups set-nth group@ <slice> 0 swap copy ;
+
+M: abstract-groups like drop { } like ;
+
+INSTANCE: abstract-groups sequence
+
+TUPLE: groups < abstract-groups ;
 
 : <groups> ( seq n -- groups )
-    dup check-groups f groups boa ; inline
+    groups construct-groups ; inline
-
-: <sliced-groups> ( seq n -- groups )
-    <groups> t over set-groups-sliced? ;
 
 M: groups length
-    dup groups-seq length swap groups-n [ + 1- ] keep /i ;
+    [ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
 
 M: groups set-length
-    [ groups-n * ] keep groups-seq set-length ;
+    [ n>> * ] [ seq>> ] bi set-length ;
 
-: group@ ( n groups -- from to seq )
+M: groups group@
-    [ groups-n [ * dup ] keep + ] keep
+    [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
-    groups-seq [ length min ] keep ;
 
-M: groups nth
+TUPLE: sliced-groups < groups ;
-    [ group@ ] keep
-    groups-sliced? [ <slice> ] [ subseq ] if ;
 
-M: groups set-nth
+: <sliced-groups> ( seq n -- groups )
-    group@ <slice> 0 swap copy ;
+    sliced-groups construct-groups ; inline
 
-M: groups like drop { } like ;
+M: sliced-groups nth group@ <slice> ;
 
-INSTANCE: groups sequence
+TUPLE: clumps < abstract-groups ;
+
+: <clumps> ( seq n -- groups )
+    clumps construct-groups ; inline
+
+M: clumps length
+    [ seq>> length ] [ n>> ] bi - 1+ ;
+
+M: clumps set-length
+    [ n>> + 1- ] [ seq>> ] bi set-length ;
+
+M: clumps group@
+    [ n>> over + ] [ seq>> ] bi ;
+
+TUPLE: sliced-clumps < groups ;
+
+: <sliced-clumps> ( seq n -- groups )
+    sliced-clumps construct-groups ; inline
+
+M: sliced-clumps nth group@ <slice> ;
 
 : group ( seq n -- array ) <groups> { } like ;
 
+: clump ( seq n -- array ) <clumps> { } like ;
+
 : ?head ( seq begin -- newseq ? )
     2dup head? [ length tail t ] [ drop f ] if ;
 
@@ -74,7 +104,7 @@ INSTANCE: groups sequence
         1array
     ] [
         "\n" split [
-            1 head-slice* [
+            but-last-slice [
                 "\r" ?tail drop "\r" split
             ] map
         ] keep peek "\r" split suffix concat

core/threads/threads-docs.factor

@@ -116,10 +116,13 @@ $nl
 "Other threads may interrupt the sleep by calling " { $link interrupt } "." } ;
 
 HELP: sleep
-{ $values { "ms" "a non-negative integer" } }
+{ $values { "dt" "a duration" } }
-{ $description "Suspends the current thread for " { $snippet "ms" } " milliseconds."
+{ $description "Suspends the current thread for the given duration."
 $nl
-"Other threads may interrupt the sleep by calling " { $link interrupt } "." } ;
+"Other threads may interrupt the sleep by calling " { $link interrupt } "." }
+{ $examples
+    { $code "USING: threads calendar ;" "10 seconds sleep" }
+} ;
 
 HELP: interrupt
 { $values { "thread" thread } }

core/threads/threads-tests.factor

@@ -1,5 +1,6 @@
 USING: namespaces io tools.test threads kernel
-concurrency.combinators math ;
+concurrency.combinators concurrency.promises locals math
+words ;
 IN: threads.tests
 
 3 "x" set
@@ -27,3 +28,16 @@ yield
         "i" tget
     ] parallel-map
 ] unit-test
+
+[ [ 3 throw ] "A" suspend ] [ 3 = ] must-fail-with
+
+:: spawn-namespace-test ( -- )
+    [let | p [ <promise> ] g [ gensym ] |
+        [
+            g "x" set
+            [ "x" get p fulfill ] "B" spawn drop
+        ] with-scope
+        p ?promise g eq?
+    ] ;
+
+[ t ] [ spawn-namespace-test ] unit-test

core/threads/threads.factor

@@ -12,7 +12,7 @@ SYMBOL: initial-thread
 TUPLE: thread
 name quot exit-handler
 id
-continuation state
+continuation state runnable
 mailbox variables sleep-entry ;
 
 : self ( -- thread ) 40 getenv ; inline
@@ -91,9 +91,11 @@ PRIVATE>
         [ sleep-queue heap-peek nip millis [-] ]
     } cond ;
 
+DEFER: stop
+
 <PRIVATE
 
-: schedule-sleep ( thread ms -- )
+: schedule-sleep ( thread dt -- )
     >r check-registered dup r> sleep-queue heap-push*
     >>sleep-entry drop ;
 
@@ -111,9 +113,19 @@ PRIVATE>
     [ ] while
     drop ;
 
-: next ( -- * )
+: start ( namestack thread -- )
-    expire-sleep-loop
+    [
-    run-queue dup dlist-empty? [
+        set-self
+        set-namestack
+        V{ } set-catchstack
+        { } set-retainstack
+        { } set-datastack
+        self quot>> [ call stop ] call-clear
+    ] 2 (throw) ;
+
+DEFER: next
+
+: no-runnable-threads ( -- * )
     ! We should never be in a state where the only threads
     ! are sleeping; the I/O wait thread is always runnable.
     ! However, if it dies, we handle this case
@@ -121,26 +133,37 @@ PRIVATE>
     !
     ! And if sleep-time outputs f, there are no sleeping
     ! threads either... so WTF.
-        drop sleep-time [ die 0 ] unless* (sleep) next
+    sleep-time [ die 0 ] unless* (sleep) next ;
-    ] [
+
-        pop-back
+: (next) ( arg thread -- * )
-        dup array? [ first2 ] [ f swap ] if dup set-self
     f >>state
-        continuation>> box>
+    dup set-self
-        continue-with
+    dup runnable>> [
+        continuation>> box> continue-with
+    ] [
+        t >>runnable start
+    ] if ;
+
+: next ( -- * )
+    expire-sleep-loop
+    run-queue dup dlist-empty? [
+        drop no-runnable-threads
+    ] [
+        pop-back dup array? [ first2 ] [ f swap ] if (next)
     ] if ;
 
 PRIVATE>
 
 : stop ( -- )
-    self dup exit-handler>> call
+    self [ exit-handler>> call ] [ unregister-thread ] bi next ;
-    unregister-thread next ;
 
 : suspend ( quot state -- obj )
     [
-        self continuation>> >box
+        >r
-        self (>>state)
+        >r self swap call
-        self swap call next
+        r> self (>>state)
+        r> self continuation>> >box
+        next
     ] callcc1 2nip ; inline
 
 : yield ( -- ) [ resume ] f suspend drop ;
@@ -153,7 +176,7 @@ M: integer sleep-until
 M: f sleep-until
     drop [ drop ] "interrupt" suspend drop ;
 
-GENERIC: sleep ( ms -- )
+GENERIC: sleep ( dt -- )
 
 M: real sleep
     millis + >integer sleep-until ;
@@ -166,16 +189,7 @@ M: real sleep
     ] when drop ;
 
 : (spawn) ( thread -- )
-    [
+    [ register-thread ] [ namestack swap resume-with ] bi ;
-        resume-now [
-            dup set-self
-            dup register-thread
-            V{ } set-catchstack
-            { } set-retainstack
-            >r { } set-datastack r>
-            quot>> [ call stop ] call-clear
-        ] 1 (throw)
-    ] "spawn" suspend 2drop ;
 
 : spawn ( quot name -- thread )
     <thread> [ (spawn) ] keep ;
@@ -184,8 +198,8 @@ M: real sleep
     >r [ [ ] [ ] while ] curry r> spawn ;
 
 : in-thread ( quot -- )
-    >r datastack namestack r>
+    >r datastack r>
-    [ >r set-namestack set-datastack r> call ] 3curry
+    [ >r set-datastack r> call ] 2curry
     "Thread" spawn drop ;
 
 GENERIC: error-in-thread ( error thread -- )
@@ -199,6 +213,7 @@ GENERIC: error-in-thread ( error thread -- )
     initial-thread global
     [ drop f "Initial" <thread> ] cache
     <box> >>continuation
+    t >>runnable
     f >>state
     dup register-thread
     set-self ;

extra/asn1/asn1-tests.factor

@@ -1,16 +1,16 @@
 USING: asn1 asn1.ldap io io.streams.string tools.test ;
 
 [ 6 ] [
-    "\u000002\u000001\u000006" <string-reader> [ asn-syntax read-ber ] with-stream
+    "\u000002\u000001\u000006" <string-reader> [ asn-syntax read-ber ] with-input-stream
 ] unit-test
 
 [ "testing" ] [
-    "\u000004\u000007testing" <string-reader> [ asn-syntax read-ber ] with-stream
+    "\u000004\u000007testing" <string-reader> [ asn-syntax read-ber ] with-input-stream
 ] unit-test
 
 [ { 1 { 3 "Administrator" "ad_is_bogus" } } ] [
     "0$\u000002\u000001\u000001`\u00001f\u000002\u000001\u000003\u000004\rAdministrator\u000080\u00000bad_is_bogus"
-    <string-reader> [ asn-syntax read-ber ] with-stream
+    <string-reader> [ asn-syntax read-ber ] with-input-stream
 ] unit-test
 
 [

extra/asn1/asn1.factor

@@ -98,7 +98,7 @@ DEFER: read-ber
 
 SYMBOL: end
 
-: (read-array) ( stream -- )
+: (read-array) ( -- )
     elements get element-id [
         elements get element-syntax read-ber
         dup end = [ drop ] [ , (read-array) ] if
@@ -106,7 +106,7 @@ SYMBOL: end
 
 : read-array ( -- array ) [ (read-array) ] { } make ;
 
-: set-case ( -- )
+: set-case ( -- object )
     elements get element-newobj
     elements get element-objtype {
         { "boolean" [ "\0" = not ] }

extra/bank/bank.factor

@@ -26,8 +26,6 @@ C: <transaction> transaction
 : daily-rate>> ( account date -- rate )
     [ interest-rate>> ] dip daily-rate ;
 
-: before? ( date date -- ? ) <=> 0 < ;
-
 : transactions-on-date ( account date -- transactions )
     [ before? ] curry filter ;
 

extra/benchmark/fasta/fasta.factor

@@ -81,7 +81,7 @@ HINTS: random fixnum ;
     write-description
     [let | k! [ 0 ] alu [ ] |
         [| len | k len alu make-repeat-fasta k! ] split-lines
-    ] with-locals ; inline
+    ] ; inline
 
 : fasta ( n out -- )
     homo-sapiens make-cumulative
@@ -103,7 +103,7 @@ HINTS: random fixnum ;
             drop
         ] with-file-writer
 
-    ] with-locals ;
+    ] ;
 
 : run-fasta 2500000 reverse-complement-in fasta ;
 

extra/benchmark/knucleotide/knucleotide.factor

@@ -56,7 +56,7 @@ IN: benchmark.knucleotide
     drop ;
 
 : knucleotide ( -- )
-    "extra/benchmark/knucleotide/knucleotide-input.txt" resource-path
+    "resource:extra/benchmark/knucleotide/knucleotide-input.txt"
     ascii [ read-input ] with-file-reader
     process-input ;
 

extra/benchmark/reverse-complement/reverse-complement.factor

@@ -32,13 +32,11 @@ HINTS: do-line vector string ;
     readln [ do-line (reverse-complement) ] [ show-seq ] if* ;
 
 : reverse-complement ( infile outfile -- )
-    ascii <file-writer> [
+    ascii [
-        swap ascii <file-reader> [
+        ascii [
-            swap <duplex-stream> [
             500000 <vector> (reverse-complement)
-            ] with-stream
+        ] with-file-reader
-        ] with-disposal
+    ] with-file-writer ;
-    ] with-disposal ;
 
 : reverse-complement-in
     "reverse-complement-in.txt" temp-file ;

extra/benchmark/sockets/sockets.factor

@@ -1,6 +1,6 @@
 USING: io.sockets io kernel math threads io.encodings.ascii
-debugger tools.time prettyprint concurrency.count-downs
+io.streams.duplex debugger tools.time prettyprint
-namespaces arrays continuations ;
+concurrency.count-downs namespaces arrays continuations ;
 IN: benchmark.sockets
 
 SYMBOL: counter
@@ -10,7 +10,7 @@ SYMBOL: counter
 : server-addr "127.0.0.1" 7777 <inet4> ;
 
 : server-loop ( server -- )
-    dup accept [
+    dup accept drop [
         [
             read1 CHAR: x = [
                 "server" get dispose
@@ -30,17 +30,17 @@ SYMBOL: counter
     ] ignore-errors ;
 
 : simple-client ( -- )
-    server-addr ascii <client> [
+    server-addr ascii [
         CHAR: b write1 flush
         number-of-requests
         [ CHAR: a dup write1 flush read1 assert= ] times
         counter get count-down
-    ] with-stream ;
+    ] with-client ;
 
 : stop-server ( -- )
-    server-addr ascii <client> [
+    server-addr ascii [
         CHAR: x write1
-    ] with-stream ;
+    ] with-client ;
 
 : clients ( n -- )
     dup pprint " clients: " write [

extra/builder/util/util.factor

@@ -16,7 +16,7 @@ IN: builder.util
 
 : minutes>ms ( min -- ms ) 60 * 1000 * ;
 
-: file>string ( file -- string ) utf8 [ stdio get contents ] with-file-reader ;
+: file>string ( file -- string ) utf8 file-contents ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -107,5 +107,5 @@ USE: prettyprint
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : git-id ( -- id )
-  { "git" "show" } utf8 <process-stream> [ readln ] with-stream
+  { "git" "show" } utf8 <process-reader> [ readln ] with-input-stream
   " " split second ;

extra/cairo/png/png.factor

@@ -21,7 +21,7 @@ ERROR: cairo-error string ;
         { CAIRO_STATUS_FILE_NOT_FOUND [ "Cairo: file not found" cairo-error ] }
         { CAIRO_STATUS_READ_ERROR [ "Cairo: read error" cairo-error ] }
         [ drop ]
-    } cond ;
+    } case ;
 
 : <png> ( path -- png )
     normalize-path

extra/checksums/md5/md5.factor

@@ -180,4 +180,4 @@ SINGLETON: md5
 INSTANCE: md5 checksum
 
 M: md5 checksum-stream ( stream -- byte-array )
-    drop [ initialize-md5 stream>md5 get-md5 ] with-stream ;
+    drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;

extra/checksums/null/null.factor

@@ -1,8 +1,8 @@
-USING: checksums ;
+USING: checksums kernel ;
 IN: checksums.null
 
 SINGLETON: null
 
 INSTANCE: null checksum
 
-M: null checksum-bytes ;
+M: null checksum-bytes drop ;

extra/checksums/sha1/sha1.factor

@@ -111,7 +111,7 @@ SINGLETON: sha1
 INSTANCE: sha1 checksum
 
 M: sha1 checksum-stream ( stream -- sha1 )
-    drop [ initialize-sha1 stream>sha1 get-sha1 ] with-stream ;
+    drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;
 
 : sha1-interleave ( string -- seq )
     [ zero? ] left-trim

extra/combinators/lib/lib.factor

@@ -169,3 +169,8 @@ MACRO: multikeep ( word out-indexes -- ... )
 : generate ( generator predicate -- obj )
     [ dup ] swap [ dup [ nip ] unless not ] 3compose
     swap [ ] do-while ;
+
+MACRO: predicates ( seq -- quot/f )
+    dup [ 1quotation [ drop ] prepend ] map
+    >r [ [ dup ] prepend ] map r> zip [ drop f ] suffix
+    [ cond ] curry ;

extra/concurrency/combinators/combinators-docs.factor

@@ -6,11 +6,21 @@ HELP: parallel-map
 { $description "Spawns a new thread for applying " { $snippet "quot" } " to every element of " { $snippet "seq" } ", collecting the results at the end." }
 { $errors "Throws an error if one of the iterations throws an error." } ;
 
+HELP: 2parallel-map
+{ $values { "seq1" sequence } { "seq2" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt -- newelt )" } } { "newseq" sequence } }
+{ $description "Spawns a new thread for applying " { $snippet "quot" } " to pairwise elements of " { $snippet "seq1" } " and " { $snippet "seq2" } ", collecting the results at the end." }
+{ $errors "Throws an error if one of the iterations throws an error." } ;
+
 HELP: parallel-each
 { $values { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt -- )" } } }
 { $description "Spawns a new thread for applying " { $snippet "quot" } " to every element of " { $snippet "seq" } ", blocking until all quotations complete." }
 { $errors "Throws an error if one of the iterations throws an error." } ;
 
+HELP: 2parallel-each
+{ $values { "seq1" sequence } { "seq2" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt -- )" } } }
+{ $description "Spawns a new thread for applying " { $snippet "quot" } " to pairwise elements of " { $snippet "seq1" } " and " { $snippet "seq2" } ", blocking until all quotations complete." }
+{ $errors "Throws an error if one of the iterations throws an error." } ;
+
 HELP: parallel-filter
 { $values { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "newseq" sequence } }
 { $description "Spawns a new thread for applying " { $snippet "quot" } " to every element of " { $snippet "seq" } ", collecting the elements for which the quotation yielded a true value." }
@@ -19,7 +29,9 @@ HELP: parallel-filter
 ARTICLE: "concurrency.combinators" "Concurrent combinators"
 "The " { $vocab-link "concurrency.combinators" } " vocabulary provides concurrent variants of " { $link each } ", " { $link map } " and " { $link filter } ":"
 { $subsection parallel-each }
+{ $subsection 2parallel-each }
 { $subsection parallel-map }
+{ $subsection 2parallel-map }
 { $subsection parallel-filter } ;
 
 ABOUT: "concurrency.combinators"

extra/concurrency/combinators/combinators-tests.factor

@@ -1,9 +1,11 @@
 IN: concurrency.combinators.tests
 USING: concurrency.combinators tools.test random kernel math 
-concurrency.mailboxes threads sequences accessors ;
+concurrency.mailboxes threads sequences accessors arrays ;
 
 [ [ drop ] parallel-each ] must-infer
+{ 2 0 } [ [ 2drop ] 2parallel-each ] must-infer-as
 [ [ ] parallel-map ] must-infer
+{ 2 1 } [ [ 2array ] 2parallel-map ] must-infer-as
 [ [ ] parallel-filter ] must-infer
 
 [ { 1 4 9 } ] [ { 1 2 3 } [ sq ] parallel-map ] unit-test
@@ -22,3 +24,24 @@ concurrency.mailboxes threads sequences accessors ;
     10 over [ push ] curry parallel-each
     length
 ] unit-test
+
+[ { 10 20 30 } ] [
+    { 1 4 3 } { 10 5 10 } [ * ] 2parallel-map
+] unit-test
+
+[ { -9 -1 -7 } ] [
+    { 1 4 3 } { 10 5 10 } [ - ] 2parallel-map
+] unit-test
+
+[
+    { 1 4 3 } { 1 0 1 } [ / drop ] 2parallel-each
+] must-fail
+
+[ 20 ]
+[
+    V{ } clone
+    10 10 pick [ [ push ] [ push ] bi ] curry 2parallel-each
+    length
+] unit-test
+
+[ { f } [ "OOPS" throw ] parallel-each ] must-fail

extra/concurrency/combinators/combinators.factor

@@ -4,14 +4,27 @@ USING: concurrency.futures concurrency.count-downs sequences
 kernel ;
 IN: concurrency.combinators
 
-: parallel-map ( seq quot -- newseq )
+: (parallel-each) ( n quot -- )
-    [ curry future ] curry map dup [ ?future ] change-each ;
+    >r <count-down> r> keep await ; inline
-    inline
 
 : parallel-each ( seq quot -- )
-    over length <count-down>
+    over length [
-    [ [ >r curry r> spawn-stage ] 2curry each ] keep await ;
+        [ >r curry r> spawn-stage ] 2curry each
-    inline
+    ] (parallel-each) ; inline
+
+: 2parallel-each ( seq1 seq2 quot -- )
+    2over min-length [
+        [ >r 2curry r> spawn-stage ] 2curry 2each
+    ] (parallel-each) ; inline
 
 : parallel-filter ( seq quot -- newseq )
     over >r pusher >r each r> r> like ; inline
+
+: future-values dup [ ?future ] change-each ; inline
+
+: parallel-map ( seq quot -- newseq )
+    [ curry future ] curry map future-values ;
+    inline
+
+: 2parallel-map ( seq1 seq2 quot -- newseq )
+    [ 2curry future ] curry 2map future-values ;

extra/concurrency/count-downs/count-downs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: dlists kernel math concurrency.promises
-concurrency.mailboxes ;
+concurrency.mailboxes debugger accessors ;
 IN: concurrency.count-downs
 
 ! http://java.sun.com/j2se/1.5.0/docs/api/java/util/concurrent/CountDownLatch.html
@@ -9,9 +9,7 @@ IN: concurrency.count-downs
 TUPLE: count-down n promise ;
 
 : count-down-check ( count-down -- )
-    dup count-down-n zero? [
+    dup n>> zero? [ t swap promise>> fulfill ] [ drop ] if ;
-        t swap count-down-promise fulfill
-    ] [ drop ] if ;
 
 : <count-down> ( n -- count-down )
     dup 0 < [ "Invalid count for count down" throw ] when
@@ -19,15 +17,12 @@ TUPLE: count-down n promise ;
     dup count-down-check ;
 
 : count-down ( count-down -- )
-    dup count-down-n dup zero? [
+    dup n>> dup zero?
-        "Count down already done" throw
+    [ "Count down already done" throw ]
-    ] [
+    [ 1- >>n count-down-check ] if ;
-        1- over set-count-down-n
-        count-down-check
-    ] if ;
 
 : await-timeout ( count-down timeout -- )
-    >r count-down-promise r> ?promise-timeout drop ;
+    >r promise>> r> ?promise-timeout ?linked t assert= ;
 
 : await ( count-down -- )
     f await-timeout ;
@@ -35,5 +30,4 @@ TUPLE: count-down n promise ;
 : spawn-stage ( quot count-down -- )
     [ [ count-down ] curry compose ] keep
     "Count down stage"
-    swap count-down-promise
+    swap promise>> mailbox>> spawn-linked-to drop ;
-    promise-mailbox spawn-linked-to drop ;

extra/concurrency/distributed/distributed.factor

@@ -3,7 +3,7 @@
 USING: serialize sequences concurrency.messaging threads io
 io.server qualified arrays namespaces kernel io.encodings.binary
 accessors ;
-QUALIFIED: io.sockets
+FROM: io.sockets => host-name <inet> with-client ;
 IN: concurrency.distributed
 
 SYMBOL: local-node
@@ -23,7 +23,7 @@ SYMBOL: local-node
 
 : start-node ( port -- )
     [ internet-server ]
-    [ io.sockets:host-name swap io.sockets:<inet> ] bi
+    [ host-name swap <inet> ] bi
     (start-node) ;
 
 TUPLE: remote-process id node ;
@@ -31,8 +31,7 @@ TUPLE: remote-process id node ;
 C: <remote-process> remote-process
 
 : send-remote-message ( message node -- )
-    binary io.sockets:<client>
+    binary [ serialize ] with-client ;
-    [ serialize ] with-stream ;
 
 M: remote-process send ( message thread -- )
     [ id>> 2array ] [ node>> ] bi

extra/concurrency/flags/flags-tests.factor

@@ -1,11 +1,12 @@
 IN: concurrency.flags.tests
-USING: tools.test concurrency.flags kernel threads locals ;
+USING: tools.test concurrency.flags concurrency.combinators
+kernel threads locals accessors ;
 
 :: flag-test-1 ( -- )
     [let | f [ <flag> ] |
         [ f raise-flag ] "Flag test" spawn drop
         f lower-flag
-        f flag-value?
+        f value>>
     ] ;
 
 [ f ] [ flag-test-1 ] unit-test
@@ -14,7 +15,7 @@ USING: tools.test concurrency.flags kernel threads locals ;
     [let | f [ <flag> ] |
         [ 1000 sleep f raise-flag ] "Flag test" spawn drop
         f lower-flag
-        f flag-value?
+        f value>>
     ] ;
 
 [ f ] [ flag-test-2 ] unit-test
@@ -22,7 +23,7 @@ USING: tools.test concurrency.flags kernel threads locals ;
 :: flag-test-3 ( -- )
     [let | f [ <flag> ] |
         f raise-flag
-        f flag-value?
+        f value>>
     ] ;
 
 [ t ] [ flag-test-3 ] unit-test
@@ -31,7 +32,7 @@ USING: tools.test concurrency.flags kernel threads locals ;
     [let | f [ <flag> ] |
         [ f raise-flag ] "Flag test" spawn drop
         f wait-for-flag
-        f flag-value?
+        f value>>
     ] ;
 
 [ t ] [ flag-test-4 ] unit-test
@@ -40,7 +41,13 @@ USING: tools.test concurrency.flags kernel threads locals ;
     [let | f [ <flag> ] |
         [ 1000 sleep f raise-flag ] "Flag test" spawn drop
         f wait-for-flag
-        f flag-value?
+        f value>>
     ] ;
 
 [ t ] [ flag-test-5 ] unit-test
+
+[ ] [
+    { 1 2 } <flag>
+    [ [ 1000 sleep raise-flag ] curry "Flag test" spawn drop ]
+    [ [ wait-for-flag drop ] curry parallel-each ] bi
+] unit-test

extra/concurrency/flags/flags.factor

@@ -1,22 +1,20 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: boxes kernel threads ;
+USING: dlists kernel threads concurrency.conditions accessors ;
 IN: concurrency.flags
 
-TUPLE: flag value? thread ;
+TUPLE: flag value threads ;
 
-: <flag> ( -- flag ) f <box> flag boa ;
+: <flag> ( -- flag ) f <dlist> flag boa ;
 
 : raise-flag ( flag -- )
-    dup flag-value? [
+    dup value>> [ drop ] [ t >>value threads>> notify-all ] if ;
-        t over set-flag-value?
+
-        dup flag-thread [ resume ] if-box?
+: wait-for-flag-timeout ( flag timeout -- )
-    ] unless drop ;
+    over value>> [ 2drop ] [ >r threads>> r> "flag" wait ] if ;
 
 : wait-for-flag ( flag -- )
-    dup flag-value? [ drop ] [
+    f wait-for-flag-timeout ;
-        [ flag-thread >box ] curry "flag" suspend drop
-    ] if ;
 
 : lower-flag ( flag -- )
-    dup wait-for-flag f swap set-flag-value? ;
+    [ wait-for-flag ] [ f >>value drop ] bi ;

extra/concurrency/mailboxes/mailboxes.factor

@@ -3,7 +3,7 @@
 IN: concurrency.mailboxes
 USING: dlists threads sequences continuations
 namespaces random math quotations words kernel arrays assocs
-init system concurrency.conditions accessors ;
+init system concurrency.conditions accessors debugger ;
 
 TUPLE: mailbox threads data closed ;
 
@@ -83,6 +83,9 @@ M: mailbox dispose
 
 TUPLE: linked-error error thread ;
 
+M: linked-error error.
+    [ thread>> error-in-thread. ] [ error>> error. ] bi ;
+
 C: <linked-error> linked-error
 
 : ?linked dup linked-error? [ rethrow ] when ;

extra/contributors/contributors-tests.factor

@@ -0,0 +1,5 @@
+IN: contributors.tests
+USING: contributors tools.test ;
+
+\ contributors must-infer
+[ ] [ contributors ] unit-test

extra/contributors/contributors.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.files io.launcher io.styles io hashtables kernel
+USING: io.files io.launcher io.styles io.encodings.ascii io
-sequences sequences.lib assocs system sorting math.parser
+hashtables kernel sequences sequences.lib assocs system sorting
-sets ;
+math.parser sets ;
 IN: contributors
 
 : changelog ( -- authors )
     image parent-directory [
-        "git-log --pretty=format:%an" <process-stream> lines
+        "git-log --pretty=format:%an" ascii <process-reader> lines
     ] with-directory ;
 
 : patch-counts ( authors -- assoc )

extra/cpu/8080/test/test.factor

@@ -1,5 +1,5 @@
 USING: kernel cpu.8080 cpu.8080.emulator math math io
-tools.time combinators sequences io.files ;
+tools.time combinators sequences io.files io.encodings.ascii ;
 IN: cpu.8080.test
 
 : step ( cpu -- )
@@ -29,7 +29,7 @@ IN: cpu.8080.test
 
 : >ppm ( cpu filename -- cpu )
   #! Dump the current screen image to a ppm image file with the given name.
-  <file-writer> [
+  ascii [
     "P3" print
     "256 224" print
     "1" print
@@ -45,7 +45,7 @@ IN: cpu.8080.test
         ] each-8bit drop
       ] each drop nl
     ] each
-  ] with-stream ;
+  ] with-file-writer ;
 
 : time-test ( -- )
   test-cpu [ 1000000 run-n drop ] time ;

extra/crypto/hmac/hmac.factor

@@ -30,7 +30,7 @@ MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
     ipad seq-bitxor ;
 
 : stream>sha1-hmac ( K stream -- hmac )
-    [ init-hmac sha1-hmac ] with-stream ;
+    [ init-hmac sha1-hmac ] with-input-stream ;
 
 : file>sha1-hmac ( K path -- hmac )
     binary <file-reader> stream>sha1-hmac ;
@@ -39,7 +39,7 @@ MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
     binary <byte-reader> stream>sha1-hmac ;
 
 : stream>md5-hmac ( K stream -- hmac )
-    [ init-hmac md5-hmac ] with-stream ;
+    [ init-hmac md5-hmac ] with-input-stream ;
 
 : file>md5-hmac ( K path -- hmac )
     binary <file-reader> stream>md5-hmac ;

extra/csv/csv.factor

@@ -61,11 +61,11 @@ VAR: delimiter
   
 : csv-row ( stream -- row )
   init-vars
-  [ row nip ] with-stream ;
+  [ row nip ] with-input-stream ;
 
 : csv ( stream -- rows )
   init-vars
-  [ [ (csv) ] { } make ] with-stream ;
+  [ [ (csv) ] { } make ] with-input-stream ;
 
 : with-delimiter ( char quot -- )
   delimiter swap with-variable ; inline

extra/delegate/protocols/protocols.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: delegate sequences.private sequences assocs prettyprint.sections 
-io definitions kernel continuations ;
+io definitions kernel continuations listener ;
 IN: delegate.protocols
 
 PROTOCOL: sequence-protocol
@@ -12,8 +12,10 @@ PROTOCOL: assoc-protocol
     at* assoc-size >alist set-at assoc-clone-like { assoc-find 1 }
     delete-at clear-assoc new-assoc assoc-like ;
 
-PROTOCOL: stream-protocol
+PROTOCOL: input-stream-protocol
-    stream-read1 stream-read stream-read-until dispose
+    stream-read1 stream-read stream-read-until stream-read-quot ;
+
+PROTOCOL: output-stream-protocol
     stream-flush stream-write1 stream-write stream-format
     stream-nl make-span-stream make-block-stream stream-readln
     make-cell-stream stream-write-table ;

extra/destructors/destructors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: continuations io.backend libc kernel namespaces
+USING: continuations io.backend io.nonblocking libc kernel
-sequences system vectors ;
+namespaces sequences system vectors ;
 IN: destructors
 
 SYMBOL: error-destructors
@@ -59,10 +59,8 @@ TUPLE: handle-destructor alien ;
 
 C: <handle-destructor> handle-destructor
 
-HOOK: destruct-handle io-backend ( obj -- )
-
 M: handle-destructor dispose ( obj -- )
-    handle-destructor-alien destruct-handle ;
+    handle-destructor-alien close-handle ;
 
 : close-always ( handle -- )
     <handle-destructor> add-always-destructor ;

extra/editors/jedit/jedit.factor

@@ -25,11 +25,11 @@ IN: editors.jedit
     ] with-byte-writer ;
 
 : send-jedit-request ( request -- )
-    jedit-server-info "localhost" rot <inet> binary <client> [
+    jedit-server-info "localhost" rot <inet> binary [
         4 >be write
         dup length 2 >be write
         write
-    ] with-stream ;
+    ] with-client ;
 
 : jedit-location ( file line -- )
     number>string "+line:" prepend 2array

extra/fry/fry-docs.factor

@@ -87,7 +87,7 @@ $nl
 } ;
 
 ARTICLE: "fry.limitations" "Fried quotation limitations"
-"As with " { $link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". Unlike " { $link "locals" } ", using " { $link dip } " is not a suitable workaround since unlike closure conversion, fry conversion is not recursive, and so the quotation passed to " { $link dip } " cannot contain fry specifiers." ;
+"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } "." ;
 
 ARTICLE: "fry" "Fried quotations"
 "A " { $emphasis "fried quotation" } " differs from a literal quotation in that when it is evaluated, instead of just pushing itself on the stack, it consumes zero or more stack values and inserts them into the quotation."

extra/fry/fry-tests.factor

@@ -48,3 +48,7 @@ sequences ;
 [ { 1 2 3 } ] [
     3 1 '[ , [ , + ] map ] call
 ] unit-test
+
+[ { 1 { 2 { 3 } } } ] [
+    1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
+] unit-test

extra/fry/fry.factor

@@ -54,7 +54,7 @@ DEFER: (shallow-fry)
                     [ { , namespaces:, @ } member? ] filter length
                     \ , <repetition> %
                 ]
-                [ deep-fry % ] bi
+                [ fry % ] bi
             ] [ namespaces:, ] if
         ] each
     ] [ ] make deep-fry ;

extra/gap-buffer/tags.txt

@@ -1,2 +1,2 @@
 collections
-collections sequences
+sequences

extra/geo-ip/geo-ip.factor

@@ -0,0 +1,46 @@
+USING: kernel sequences io.files io.launcher io.encodings.ascii
+io.streams.string http.client sequences.lib combinators
+math.parser math.vectors math.intervals interval-maps memoize
+csv accessors assocs strings math splitting ;
+IN: geo-ip
+
+: db-path "IpToCountry.csv" temp-file ;
+
+: db-url "http://software77.net/cgi-bin/ip-country/geo-ip.pl?action=download" ;
+
+: download-db ( -- path )
+    db-path dup exists? [
+        db-url over ".gz" append download-to
+        { "gunzip" } over ".gz" append (normalize-path) suffix try-process
+    ] unless ;
+
+TUPLE: ip-entry from to registry assigned city cntry country ;
+
+: parse-ip-entry ( row -- ip-entry )
+    7 firstn {
+        [ string>number ]
+        [ string>number ]
+        [ ]
+        [ ]
+        [ ]
+        [ ]
+        [ ]
+    } spread ip-entry boa ;
+
+MEMO: ip-db ( -- seq )
+    download-db ascii file-lines
+    [ "#" head? not ] filter "\n" join <string-reader> csv
+    [ parse-ip-entry ] map ;
+
+MEMO: ip-intervals ( -- interval-map )
+    ip-db [ [ [ from>> ] [ to>> ] bi [a,b] ] keep ] { } map>assoc
+    <interval-map> ;
+
+GENERIC: lookup-ip ( ip -- ip-entry )
+
+M: string lookup-ip
+    "." split [ string>number ] map
+    { HEX: 1000000 HEX: 10000 HEX: 100 1 } v.
+    lookup-ip ;
+
+M: integer lookup-ip ip-intervals interval-at ;

extra/geo-ip/summary.txt

@@ -0,0 +1 @@
+IP address geolocation using database from http://software77.net/cgi-bin/ip-country/

extra/geo-ip/tags.txt

@@ -0,0 +1 @@
+enterprise

extra/gesture-logger/gesture-logger.factor

@@ -15,13 +15,13 @@ TUPLE: gesture-logger stream ;
 M: gesture-logger handle-gesture*
     drop
     dup T{ button-down } = [ over request-focus ] when
-    swap gesture-logger-stream [ . ] with-stream*
+    swap gesture-logger-stream [ . ] with-output-stream*
     t ;
 
 M: gesture-logger user-input*
     gesture-logger-stream [
         "User input: " write print
-    ] with-stream* t ;
+    ] with-output-stream* t ;
 
 : gesture-logger ( -- )
     [

extra/help/cookbook/cookbook.factor

@@ -205,8 +205,8 @@ ARTICLE: "cookbook-io" "Input and output cookbook"
 }
 "Send some bytes to a remote host:"
 { $code
-    "\"myhost\" 1033 <inet> <client>"
+    "\"myhost\" 1033 <inet>"
-    "[ { 12 17 102 } >string write ] with-stream"
+    "[ { 12 17 102 } >string write ] with-client"
 }
 { $references
     { }

extra/help/handbook/handbook.factor

@@ -31,7 +31,7 @@ $nl
     { { $snippet "set-" { $emphasis "foo" } } { "sets " { $snippet "foo" } " to a new value" } { $links set-length } }
     { { $snippet { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple accessors) outputs the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } }
     { { $snippet "set-" { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple mutators) sets the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } }
-    { { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-stream } }
+    { { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-input-stream with-output-stream } }
     { { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } }
 }
 { $heading "Stack effect conventions" }
@@ -193,17 +193,19 @@ ARTICLE: "io" "Input and output"
 "Utilities:"
 { $subsection "stream-binary" }
 { $subsection "styles" }
-{ $heading "Files" }
-{ $subsection "io.files" }
-{ $subsection "io.mmap" }
-{ $subsection "io.monitors" }
 { $heading "Encodings" }
 { $subsection "encodings-introduction" }
 { $subsection "io.encodings" }
 { $subsection "io.encodings.string" }
-{ $heading "Other features" }
+{ $heading "Files" }
+{ $subsection "io.files" }
+{ $subsection "io.mmap" }
+{ $subsection "io.monitors" }
+{ $heading "Communications" }
 { $subsection "network-streams" }
 { $subsection "io.launcher" }
+{ $subsection "io.pipes" }
+{ $heading "Other features" }
 { $subsection "io.timeouts" }
 { $subsection "checksums" } ;
 

extra/help/help-docs.factor

@@ -126,7 +126,7 @@ HELP: $title
 HELP: help
 { $values { "topic" "an article name or a word" } }
 { $description
-    "Displays a help article or documentation associated to a word on the " { $link stdio } " stream."
+    "Displays a help article or documentation associated to a word on " { $link output-stream } "."
 } ;
 
 HELP: about
@@ -151,7 +151,7 @@ HELP: $index
 
 HELP: ($index)
 { $values { "articles" "a sequence of help articles" } }
-{ $description "Writes a list of " { $link $subsection } " elements to the " { $link stdio } " stream." } ;
+{ $description "Writes a list of " { $link $subsection } " elements to " { $link output-stream } "." } ;
 
 HELP: xref-help
 { $description "Update help cross-referencing. Usually this is done automatically." } ;
@@ -168,11 +168,11 @@ HELP: $predicate
 
 HELP: print-element
 { $values { "element" "a markup element" } }
-{ $description "Prints a markup element to the " { $link stdio } " stream." } ;
+{ $description "Prints a markup element to " { $link output-stream } "." } ;
 
 HELP: print-content
 { $values { "element" "a markup element" } }
-{ $description "Prints a top-level markup element to the " { $link stdio } " stream." } ;
+{ $description "Prints a top-level markup element to " { $link output-stream } "." } ;
 
 HELP: simple-element
 { $class-description "Class of simple elements, which are just arrays of elements." } ;

extra/help/lint/lint.factor

@@ -10,7 +10,7 @@ IN: help.lint
 
 : check-example ( element -- )
     rest [
-        1 head* "\n" join 1vector
+        but-last "\n" join 1vector
         [
             use [ clone ] change
             [ eval>string ] with-datastack