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

core/graphs/graphs-docs.factor

@@ -21,12 +21,12 @@ HELP: graph
 
 HELP: add-vertex
 { $values { "vertex" object } { "edges" "a sequence" } { "graph" "an assoc mapping vertices to sequences of edges" } }
-{ $description "Adds a vertex to a directed graph, using the " { $snippet "edges" } " quotation to generate a sequence of edges leaving the vertex." }
+{ $description "Adds a vertex to a directed graph, with " { $snippet "edges" } "  as the outward edges from the vertex." }
 { $side-effects "graph" } ;
 
 HELP: remove-vertex
 { $values { "vertex" object } { "edges" "a sequence" } { "graph" "an assoc mapping vertices to sequences of edges" } }
-{ $description "Removes a vertex from a graph, using the quotation to generate a sequence of edges leaving the vertex." } 
+{ $description "Removes a vertex from a graph, using the given edges sequence." } 
 { $notes "The " { $snippet "edges" } " sequence must equal the value passed to " { $link add-vertex } ", otherwise some vertices of the graph may continue to refer to the removed vertex." }
 { $side-effects "graph" } ;
 

extra/cocoa/application/application.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien io kernel namespaces core-foundation cocoa.messages
+USING: alien io kernel namespaces core-foundation
-cocoa cocoa.classes cocoa.runtime sequences threads
+core-foundation.run-loop cocoa.messages cocoa cocoa.classes
-debugger init inspector kernel.private ;
+cocoa.runtime sequences threads debugger init inspector
+kernel.private ;
 IN: cocoa.application
 
 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
@@ -21,8 +22,6 @@ IN: cocoa.application
 : with-cocoa ( quot -- )
     [ NSApp drop call ] with-autorelease-pool ;
 
-: CFRunLoopDefaultMode "kCFRunLoopDefaultMode" <NSString> ;
-
 : next-event ( app -- event )
     0 f CFRunLoopDefaultMode 1
     -> nextEventMatchingMask:untilDate:inMode:dequeue: ;

extra/core-foundation/core-foundation.factor

@@ -9,9 +9,9 @@ TYPEDEF: void* CFBundleRef
 TYPEDEF: void* CFStringRef
 TYPEDEF: void* CFURLRef
 TYPEDEF: void* CFUUIDRef
-TYPEDEF: void* CFRunLoopRef
 TYPEDEF: bool Boolean
 TYPEDEF: int CFIndex
+TYPEDEF: int SInt32
 TYPEDEF: double CFTimeInterval
 TYPEDEF: double CFAbsoluteTime
 
@@ -85,5 +85,3 @@ FUNCTION: void CFRelease ( void* cf ) ;
     ] [
         "Cannot load bundled named " prepend throw
     ] ?if ;
-
-FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;

extra/core-foundation/fsevents/fsevents.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.syntax kernel math sequences
-namespaces assocs init continuations core-foundation ;
+namespaces assocs init accessors continuations combinators
+core-foundation core-foundation.run-loop ;
 IN: core-foundation.fsevents
 
 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
@@ -182,11 +183,11 @@ SYMBOL: event-stream-callbacks
     }
     "cdecl" [
         [ >event-triple ] 3curry map
-        swap event-stream-callbacks get at call
+        swap event-stream-callbacks get at
-        drop
+        dup [ call drop ] [ 3drop ] if
     ] alien-callback ;
 
-TUPLE: event-stream info handle ;
+TUPLE: event-stream info handle closed ;
 
 : <event-stream> ( quot paths latency flags -- event-stream )
     >r >r >r
@@ -194,9 +195,15 @@ TUPLE: event-stream info handle ;
     >r master-event-source-callback r>
     r> r> r> <FSEventStream>
     dup enable-event-stream
-    event-stream construct-boa ;
+    f event-stream construct-boa ;
 
 M: event-stream dispose
-    dup event-stream-info remove-event-source-callback
+    dup closed>> [ drop ] [
-    event-stream-handle dup disable-event-stream
+        t >>closed
-    FSEventStreamRelease ;
+        {
+            [ info>> remove-event-source-callback ]
+            [ handle>> disable-event-stream ]
+            [ handle>> FSEventStreamInvalidate ]
+            [ handle>> FSEventStreamRelease ]
+        } cleave
+    ] if ;

extra/core-foundation/run-loop/run-loop.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2008 Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel threads init namespaces alien
+core-foundation ;
+IN: core-foundation.run-loop
+
+: kCFRunLoopRunFinished 1 ; inline
+: kCFRunLoopRunStopped 2 ; inline
+: kCFRunLoopRunTimedOut 3 ; inline
+: kCFRunLoopRunHandledSource 4 ; inline
+
+TYPEDEF: void* CFRunLoopRef
+
+FUNCTION: CFRunLoopRef CFRunLoopGetMain ( ) ;
+
+FUNCTION: SInt32 CFRunLoopRunInMode (
+   CFStringRef mode,
+   CFTimeInterval seconds,
+   Boolean returnAfterSourceHandled
+) ;
+
+: CFRunLoopDefaultMode ( -- alien )
+    #! Ugly, but we don't have static NSStrings
+    \ CFRunLoopDefaultMode get-global dup expired? [
+        drop
+        "kCFRunLoopDefaultMode" <CFString>
+        dup \ CFRunLoopDefaultMode set-global
+    ] when ;
+
+: run-loop-thread ( -- )
+    CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
+    kCFRunLoopRunHandledSource = [ 1000 sleep ] unless
+    run-loop-thread ;
+
+: start-run-loop-thread ( -- )
+    [ run-loop-thread t ] "CFRunLoop dispatcher" spawn-server drop ;
+
+[ start-run-loop-thread ] "core-foundation.run-loop" add-init-hook

extra/help/cookbook/cookbook.factor

@@ -199,7 +199,7 @@ ARTICLE: "cookbook-io" "Input and output cookbook"
 }
 "Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
 { $code
-    "\"mydata.dat\" dup file-info file-info-length ["
+    "\"mydata.dat\" dup file-info size>> ["
     "    4 <sliced-groups> [ reverse-here ] change-each"
     "] with-mapped-file"
 }

extra/http/server/static/static.factor

@@ -10,7 +10,7 @@ IN: http.server.static
 TUPLE: file-responder root hook special ;
 
 : file-http-date ( filename -- string )
-    file-info file-info-modified timestamp>http-string ;
+    file-info modified>> timestamp>http-string ;
 
 : last-modified-matches? ( filename -- ? )
     file-http-date dup [
@@ -27,7 +27,7 @@ TUPLE: file-responder root hook special ;
     [
         <content>
         swap
-        [ file-info file-info-size "content-length" set-header ]
+        [ file-info size>> "content-length" set-header ]
         [ file-http-date "last-modified" set-header ]
         [ '[ , binary <file-reader> stdio get stream-copy ] >>body ]
         tri

extra/inverse/inverse-tests.factor

@@ -1,5 +1,5 @@
 USING: inverse tools.test arrays math kernel sequences
-math.functions math.constants ;
+math.functions math.constants continuations ;
 IN: inverse-tests
 
 [ 2 ] [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
@@ -51,7 +51,7 @@ C: <nil> nil
     {
         { [ <cons> ] [ list-sum + ] }
         { [ <nil> ] [ 0 ] }
-        { [ ] [ "Malformed list" throw ] }
+        [ "Malformed list" throw ]
     } switch ;
 
 [ 10 ] [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
@@ -59,6 +59,7 @@ C: <nil> nil
 [ 1 2 ] [ 1 2 <cons> [ <cons> ] undo ] unit-test
 [ t ] [ 1 2 <cons> [ <cons> ] matches? ] unit-test
 [ f ] [ 1 2 <cons> [ <foo> ] matches? ] unit-test
+[ "Malformed list" ] [ [ f list-sum ] [ ] recover ] unit-test
 
 : empty-cons ( -- cons ) cons construct-empty ;
 : cons* ( cdr car -- cons ) { set-cons-cdr set-cons-car } cons construct ;
@@ -68,3 +69,4 @@ C: <nil> nil
 
 [ t ] [ pi [ pi ] matches? ] unit-test
 [ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
+[ ] [ 3 [ _ ] undo ] unit-test

extra/inverse/inverse.factor

@@ -60,11 +60,13 @@ PREDICATE: math-inverse < word "math-inverse" word-prop ;
 PREDICATE: pop-inverse < word "pop-length" word-prop ;
 UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
 
-: enough? ( stack quot -- ? )
+: enough? ( stack word -- ? )
-    [ >r length r> 1quotation infer effect-in >= ] [ 3drop f ]
+    dup deferred? [ 2drop f ] [
-    recover ;
+        [ >r length r> 1quotation infer effect-in >= ]
+        [ 3drop f ] recover
+    ] if ;
 
-: fold-word ( stack quot -- stack )
+: fold-word ( stack word -- stack )
     2dup enough?
     [ 1quotation with-datastack ] [ >r % r> , { } ] if ;
 
@@ -72,10 +74,10 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
     [ { } swap [ fold-word ] each % ] [ ] make ; 
 
 : flattenable? ( object -- ? )
-    [ [ word? ] [ primitive? not ] and? ] [
+    { [ word? ] [ primitive? not ] [
         { "inverse" "math-inverse" "pop-inverse" }
         [ word-prop ] with contains? not
-    ] and? ; 
+    ] } <-&& ; 
 
 : (flatten) ( quot -- )
     [ dup flattenable? [ word-def (flatten) ] [ , ] if ] each ;
@@ -159,7 +161,7 @@ MACRO: undo ( quot -- ) [undo] ;
     2curry
 ] define-pop-inverse
 
-: _ f ;
+DEFER: _
 \ _ [ drop ] define-inverse
 
 : both ( object object -- object )
@@ -256,6 +258,7 @@ M: no-match summary drop "Fall through in switch" ;
     [ no-match ] [ swap \ recover-fail 3array >quotation ] reduce ;
 
 : [switch]  ( quot-alist -- quot )
+    [ dup quotation? [ [ ] swap 2array ] when ] map
     reverse [ >r [undo] r> compose ] { } assoc>map
     recover-chain ;
 

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

@@ -29,9 +29,10 @@ IN: io.encodings.8-bit
     { "mac-roman" "ROMAN" }
 } ;
 
-: full-path ( file-name -- path )
+: encoding-file ( file-name -- stream )
     "extra/io/encodings/8-bit/" ".TXT"
-    swapd 3append resource-path ;
+    swapd 3append resource-path
+    ascii <file-reader> ;
 
 : tail-if ( seq n -- newseq )
     2dup swap length <= [ tail ] [ drop ] if ;
@@ -48,8 +49,8 @@ IN: io.encodings.8-bit
 : ch>byte ( assoc -- newassoc )
     [ swap ] assoc-map >hashtable ;
 
-: parse-file ( file-name -- byte>ch ch>byte )
+: parse-file ( path -- byte>ch ch>byte )
-    ascii file-lines process-contents
+    lines process-contents
     [ byte>ch ] [ ch>byte ] bi ;
 
 TUPLE: 8-bit name decode encode ;
@@ -71,13 +72,13 @@ M: 8-bit decode-char
 : make-8-bit ( word byte>ch ch>byte -- )
     [ 8-bit construct-boa ] 2curry dupd curry define ;
 
-: define-8-bit-encoding ( name path -- )
+: define-8-bit-encoding ( name stream -- )
     >r in get create r> parse-file make-8-bit ;
 
 PRIVATE>
 
 [
     "io.encodings.8-bit" in [
-        mappings [ full-path define-8-bit-encoding ] assoc-each
+        mappings [ encoding-file define-8-bit-encoding ] assoc-each
     ] with-variable
 ] with-compilation-unit

extra/io/launcher/launcher-docs.factor

@@ -129,9 +129,6 @@ HELP: <process>
 { $values { "process" process } }
 { $description "Creates a new, empty process. It must be filled in before being passed to " { $link run-process } "." } ;
 
-HELP: process-stream
-{ $class-description "A bidirectional stream for interacting with a running process. Instances are created by calling " { $link <process-stream> } ". The " { $link process-stream-process } " slot holds a " { $link process } " instance." } ;
-
 HELP: <process-stream>
 { $values
   { "desc" "a launch descriptor" }
@@ -144,7 +141,7 @@ HELP: with-process-stream
   { "desc" "a launch descriptor" }
   { "quot" quotation }
   { "status" "an exit code" } }
-{ $description "Calls " { $snippet "quot" } " in a dynamic scope where " { $link stdio } " is rebound to a " { $link process-stream } ". After the quotation returns, waits for the process to end and outputs the exit code." } ;
+{ $description "Calls " { $snippet "quot" } " in a dynamic scope where " { $link stdio } " is rebound to a process stream. After the quotation returns, waits for the process to end and outputs the exit code." } ;
 
 HELP: wait-for-process
 { $values { "process" process } { "status" integer } }

extra/io/launcher/launcher.factor

@@ -150,18 +150,18 @@ M: process timed-out kill-process ;
 
 HOOK: (process-stream) io-backend ( process -- handle in out )
 
-TUPLE: process-stream process ;
+: <process-stream*> ( desc encoding -- stream process )
+    >r >process dup dup (process-stream) <reader&writer>
+    r> <encoder-duplex> -roll
+    process-started ;
 
 : <process-stream> ( desc encoding -- stream )
-    >r >process dup dup (process-stream)
+    <process-stream*> drop ; inline
-    >r >r process-started process-stream construct-boa
-    r> r> <reader&writer> r> <encoder-duplex>
-    over set-delegate ;
 
 : with-process-stream ( desc quot -- status )
-    swap <process-stream>
+    swap <process-stream*> >r
     [ swap with-stream ] keep
-    process>> wait-for-process ; inline
+    r> wait-for-process ; inline
 
 : notify-exit ( process status -- )
     >>status

extra/io/mmap/mmap-tests.factor

@@ -1,10 +1,10 @@
 USING: io io.mmap io.files kernel tools.test continuations
-sequences io.encodings.ascii ;
+sequences io.encodings.ascii accessors ;
 IN: io.mmap.tests
 
 [ "mmap-test-file.txt" resource-path delete-file ] ignore-errors
 [ ] [ "12345" "mmap-test-file.txt" resource-path ascii set-file-contents ] unit-test
-[ ] [ "mmap-test-file.txt" resource-path dup file-info file-info-size [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
+[ ] [ "mmap-test-file.txt" resource-path dup file-info size>> [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
-[ 5 ] [ "mmap-test-file.txt" resource-path dup file-info file-info-size [ length ] with-mapped-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" resource-path dup file-info size>> [ length ] with-mapped-file ] unit-test
 [ "22345" ] [ "mmap-test-file.txt" resource-path ascii file-contents ] unit-test
 [ "mmap-test-file.txt" resource-path delete-file ] ignore-errors

extra/io/monitors/monitors-tests.factor

@@ -75,13 +75,13 @@ os { winnt linux macosx } member? [
         
         [ ] [ "monitor-test/xyz/test.txt" temp-file touch-file ] unit-test
 
-        [ ] [ "c1" get 5 seconds await-timeout ] unit-test
+        [ ] [ "c1" get 15 seconds await-timeout ] unit-test
         
         [ ] [ "monitor-test/subdir/blah/yxy" temp-file make-directories ] unit-test
 
         [ ] [ "monitor-test/subdir/blah/yxy/test.txt" temp-file touch-file ] unit-test
 
-        [ ] [ "c2" get 5 seconds await-timeout ] unit-test
+        [ ] [ "c2" get 15 seconds await-timeout ] unit-test
 
         ! Dispose twice
         [ ] [ "m" get dispose ] unit-test

extra/io/nonblocking/nonblocking-docs.factor

@@ -36,10 +36,10 @@ HELP: port
 $nl
 "Ports have the following slots:"
 { $list
-    { { $link port-handle } " - a native handle identifying the underlying native resource used by the port" }
+    { { $snippet "handle" } " - a native handle identifying the underlying native resource used by the port" }
-    { { $link port-error } " - the most recent I/O error, if any. This error is thrown to the waiting thread when " { $link pending-error } " is called by stream operations" }
+    { { $snippet "error" } " - the most recent I/O error, if any. This error is thrown to the waiting thread when " { $link pending-error } " is called by stream operations" }
-    { { $link port-type } " - a symbol identifying the port's intended purpose" }
+    { { $snippet "type" } " - a symbol identifying the port's intended purpose" }
-    { { $link port-eof? } " - a flag indicating if the port has reached the end of file while reading" }
+    { { $snippet "eof" } " - a flag indicating if the port has reached the end of file while reading" }
 } } ;
 
 HELP: input-port
@@ -53,8 +53,8 @@ HELP: init-handle
 { $contract "Prepares a native handle for use by the port; called by " { $link <port> } "." } ;
 
 HELP: <port>
-{ $values { "handle" "a native handle identifying an I/O resource" } { "buffer" "a " { $link buffer } " or " { $link f } } { "type" symbol } { "port" "a new " { $link port } } }
+{ $values { "handle" "a native handle identifying an I/O resource" } { "type" symbol } { "port" "a new " { $link port } } }
-{ $description "Creates a new " { $link port } " using the specified native handle and I/O buffer." }
+{ $description "Creates a new " { $link port } " with no buffer." }
 $low-level-note ;
 
 HELP: <buffered-port>

extra/io/nonblocking/nonblocking.factor

@@ -1,46 +1,39 @@
 ! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-IN: io.nonblocking
 USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.streams.duplex io.encodings
 io.backend continuations debugger classes byte-arrays namespaces
-splitting dlists assocs io.encodings.binary ;
+splitting dlists assocs io.encodings.binary accessors ;
+IN: io.nonblocking
 
 SYMBOL: default-buffer-size
 64 1024 * default-buffer-size set-global
 
-! Common delegate of native stream readers and writers
+TUPLE: port handle buffer error timeout closed eof ;
-TUPLE: port
-handle
-error
-timeout
-type eof? ;
 
-M: port timeout port-timeout ;
+M: port timeout timeout>> ;
 
-M: port set-timeout set-port-timeout ;
+M: port set-timeout (>>timeout) ;
-
-SYMBOL: closed
-
-PREDICATE: input-port < port port-type input-port eq? ;
-PREDICATE: output-port < port port-type output-port eq? ;
 
 GENERIC: init-handle ( handle -- )
+
 GENERIC: close-handle ( handle -- )
 
-: <port> ( handle buffer type -- port )
+: <port> ( handle class -- port )
-    pick init-handle {
+    construct-empty
-        set-port-handle
+        swap dup init-handle >>handle ; inline
-        set-delegate
-        set-port-type
-    } port construct ;
 
-: <buffered-port> ( handle type -- port )
+: <buffered-port> ( handle class -- port )
-    default-buffer-size get <buffer> swap <port> ;
+    <port>
+        default-buffer-size get <buffer> >>buffer ; inline
+
+TUPLE: input-port < port ;
 
 : <reader> ( handle -- input-port )
     input-port <buffered-port> ;
 
+TUPLE: output-port < port ;
+
 : <writer> ( handle -- output-port )
     output-port <buffered-port> ;
 
@@ -48,7 +41,10 @@ GENERIC: close-handle ( handle -- )
     swap <reader> [ swap <writer> ] [ ] [ dispose drop ] cleanup ;
 
 : pending-error ( port -- )
-    dup port-error f rot set-port-error [ throw ] when* ;
+    [ f ] change-error drop [ throw ] when* ;
+
+: check-closed ( port -- port )
+    dup closed>> [ "Port closed" throw ] when ;
 
 HOOK: cancel-io io-backend ( port -- )
 
@@ -59,21 +55,22 @@ M: port timed-out cancel-io ;
 GENERIC: (wait-to-read) ( port -- )
 
 : wait-to-read ( count port -- )
-    tuck buffer-length > [ (wait-to-read) ] [ drop ] if ;
+    tuck buffer>> buffer-length > [ (wait-to-read) ] [ drop ] if ;
 
 : wait-to-read1 ( port -- )
     1 swap wait-to-read ;
 
 : unless-eof ( port quot -- value )
-    >r dup buffer-empty? over port-eof? and
+    >r dup buffer>> buffer-empty? over eof>> and
-    [ f swap set-port-eof? f ] r> if ; inline
+    [ f >>eof drop f ] r> if ; inline
 
 M: input-port stream-read1
-    dup wait-to-read1 [ buffer-pop ] unless-eof ;
+    check-closed
+    dup wait-to-read1 [ buffer>> buffer-pop ] unless-eof ;
 
 : read-step ( count port -- byte-array/f )
     [ wait-to-read ] 2keep
-    [ dupd buffer-read ] unless-eof nip ;
+    [ dupd buffer>> buffer-read ] unless-eof nip ;
 
 : read-loop ( count port accum -- )
     pick over length - dup 0 > [
@@ -87,6 +84,7 @@ M: input-port stream-read1
     ] if ;
 
 M: input-port stream-read
+    check-closed
     >r 0 max >fixnum r>
     2dup read-step dup [
         pick over length > [
@@ -94,72 +92,75 @@ M: input-port stream-read
             [ push-all ] keep
             [ read-loop ] keep
             B{ } like
-        ] [
+        ] [ 2nip ] if
-            2nip
+    ] [ 2nip ] if ;
-        ] if
-    ] [
-        2nip
-    ] if ;
 
 M: input-port stream-read-partial ( max stream -- byte-array/f )
+    check-closed
     >r 0 max >fixnum r> read-step ;
 
-: can-write? ( len writer -- ? )
+: can-write? ( len buffer -- ? )
     [ buffer-fill + ] keep buffer-capacity <= ;
 
 : wait-to-write ( len port -- )
-    tuck can-write? [ drop ] [ stream-flush ] if ;
+    tuck buffer>> can-write? [ drop ] [ stream-flush ] if ;
 
 M: output-port stream-write1
-    1 over wait-to-write byte>buffer ;
+    check-closed
+    1 over wait-to-write
+    buffer>> byte>buffer ;
 
 M: output-port stream-write
-    over length over buffer-size > [
+    check-closed
-        [ buffer-size <groups> ] keep
+    over length over buffer>> buffer-size > [
-        [ stream-write ] curry each
+        [ buffer>> buffer-size <groups> ]
+        [ [ stream-write ] curry ] bi
+        each
     ] [
-        over length over wait-to-write >buffer
+        [ >r length r> wait-to-write ]
+        [ buffer>> >buffer ] 2bi
     ] if ;
 
 GENERIC: port-flush ( port -- )
 
 M: output-port stream-flush ( port -- )
-    dup port-flush pending-error ;
+    check-closed
+    [ port-flush ] [ pending-error ] bi ;
 
-: close-port ( port type -- )
+GENERIC: close-port ( port -- )
-    output-port eq? [ dup port-flush ] when
+
+M: output-port close-port
+    [ port-flush ] [ call-next-method ] bi ;
+
+M: port close-port
     dup cancel-io
-    dup port-handle close-handle
+    dup handle>> close-handle
-    dup delegate [ buffer-free ] when*
+    [ [ buffer-free ] when* f ] change-buffer drop ;
-    f swap set-delegate ;
 
 M: port dispose
-    dup port-type closed eq?
+    dup closed>> [ drop ] [ t >>closed close-port ] if ;
-    [ drop ]
-    [ dup port-type >r closed over set-port-type r> close-port ]
-    if ;
 
-TUPLE: server-port addr client client-addr encoding ;
+TUPLE: server-port < port addr client client-addr encoding ;
 
 : <server-port> ( handle addr encoding -- server )
-    rot f server-port <port>
+    rot server-port <port>
-    { set-server-port-addr set-server-port-encoding set-delegate }
+        swap >>encoding
-    server-port construct ;
+        swap >>addr ;
 
-: check-server-port ( port -- )
+: check-server-port ( port -- port )
-    port-type server-port assert= ;
+    dup server-port? [ "Not a server port" throw ] unless ; inline
 
-TUPLE: datagram-port addr packet packet-addr ;
+TUPLE: datagram-port < port addr packet packet-addr ;
 
 : <datagram-port> ( handle addr -- datagram )
-    >r f datagram-port <port> r>
+    swap datagram-port <port>
-    { set-delegate set-datagram-port-addr }
+        swap >>addr ;
-    datagram-port construct ;
 
-: check-datagram-port ( port -- )
+: check-datagram-port ( port -- port )
-    port-type datagram-port assert= ;
+    check-closed
+    dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
 
-: check-datagram-send ( packet addrspec port -- )
+: check-datagram-send ( packet addrspec port -- packet addrspec port )
-    dup check-datagram-port
+    check-datagram-port
-    datagram-port-addr [ class ] bi@ assert=
+    2dup addr>> [ class ] bi@ assert=
-    class byte-array assert= ;
+    pick class byte-array assert= ;

extra/io/server/server.factor

@@ -12,17 +12,17 @@ SYMBOL: servers
 
 LOG: accepted-connection NOTICE
 
-: with-client ( client quot -- )
+: with-client ( client addrspec quot -- )
     [
-        over client-stream-addr accepted-connection
+        swap accepted-connection
         with-stream*
-    ] curry with-disposal ; inline
+    ] 2curry with-disposal ; inline
 
 \ with-client DEBUG add-error-logging
 
 : accept-loop ( server quot -- )
     [
-        >r accept r> [ with-client ] 2curry "Client" spawn drop
+        >r accept r> [ with-client ] 3curry "Client" spawn drop
     ] 2keep accept-loop ; inline
 
 : server-loop ( addrspec encoding quot -- )

extra/io/sockets/sockets-docs.factor

@@ -17,8 +17,6 @@ ARTICLE: "network-connection" "Connection-oriented networking"
 "Connection-oriented network servers are implemented by first opening a server socket, then waiting for connections:"
 { $subsection <server> }
 { $subsection accept }
-"The stream returned by " { $link accept } " holds the address specifier of the remote client:"
-{ $subsection client-stream-addr }
 "Server sockets are closed by calling " { $link dispose } "."
 $nl
 "Address specifiers have the following interpretation with connection-oriented networking words:"
@@ -118,10 +116,8 @@ HELP: <server>
 { $errors "Throws an error if the address is already in use, or if it if the system forbids access." } ;
 
 HELP: accept
-{ $values { "server" "a handle" } { "client" "a bidirectional stream" } }
+{ $values { "server" "a handle" } { "client" "a bidirectional stream" } { "addrspec" "an address specifier" } }
-{ $description "Waits for a connection to a server socket created by " { $link <server> } ", and outputs a bidirectional stream when the connection has been established. The encoding of this stream is the one that was passed to the server constructor."
+{ $description "Waits for a connection to a server socket created by " { $link <server> } ", and outputs a bidirectional stream when the connection has been established. The encoding of this stream is the one that was passed to the server constructor." }
-$nl
-"The returned client stream responds to the " { $link client-stream-addr } " word with the address of the incoming connection." }
 { $errors "Throws an error if the server socket is closed or otherwise is unavailable." } ;
 
 HELP: <datagram>

extra/io/sockets/sockets.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: generic kernel io.backend namespaces continuations
-sequences arrays io.encodings io.nonblocking ;
+sequences arrays io.encodings io.nonblocking accessors ;
 IN: io.sockets
 
 TUPLE: local path ;
@@ -21,20 +21,14 @@ TUPLE: inet host port ;
 
 C: <inet> inet
 
-TUPLE: client-stream addr ;
+HOOK: ((client)) io-backend ( addrspec -- client-in client-out )
 
-: <client-stream> ( addrspec delegate -- stream )
+GENERIC: (client) ( addrspec -- client-in client-out )
-    { set-client-stream-addr set-delegate }
+M: array (client) [ ((client)) 2array ] attempt-all first2 ;
-    client-stream construct ;
+M: object (client) ((client)) ;
-
-HOOK: (client) io-backend ( addrspec -- client-in client-out )
-
-GENERIC: client* ( addrspec -- client-in client-out )
-M: array client* [ (client) 2array ] attempt-all first2 ;
-M: object client* (client) ;
 
 : <client> ( addrspec encoding -- stream )
-    >r client* r> <encoder-duplex> ;
+    >r (client) r> <encoder-duplex> ;
 
 HOOK: (server) io-backend ( addrspec -- handle )
 
@@ -43,10 +37,9 @@ HOOK: (server) io-backend ( addrspec -- handle )
 
 HOOK: (accept) io-backend ( server -- addrspec handle )
 
-: accept ( server -- client )
+: accept ( server -- client addrspec )
-    [ (accept) dup <reader&writer> ] keep
+    [ (accept) dup <reader&writer> ] [ encoding>> ] bi
-    server-port-encoding <encoder-duplex>
+    <encoder-duplex> swap ;
-    <client-stream> ;
 
 HOOK: <datagram> io-backend ( addrspec -- datagram )
 
@@ -58,7 +51,8 @@ HOOK: resolve-host io-backend ( host serv passive? -- seq )
 
 HOOK: host-name io-backend ( -- string )
 
-M: inet client*
+M: inet (client)
-    dup inet-host swap inet-port f resolve-host
+    [ host>> ] [ port>> ] bi f resolve-host
-    dup empty? [ "Host name lookup failed" throw ] when
+    [ empty? [ "Host name lookup failed" throw ] when ]
-    client* ;
+    [ (client) ]
+    bi ;

extra/io/unix/backend/backend.factor

@@ -14,18 +14,13 @@ TUPLE: io-task port callbacks ;
 : io-task-fd port>> handle>> ;
 
 : <io-task> ( port continuation/f class -- task )
-    >r [ 1vector ] [ V{ } clone ] if* io-task construct-boa
+    construct-empty
-    r> construct-delegate ; inline
+        swap [ 1vector ] [ V{ } clone ] if* >>callbacks
+        swap >>port ; inline
 
-TUPLE: input-task ;
+TUPLE: input-task < io-task ;
 
-: <input-task> ( port continuation class -- task )
+TUPLE: output-task < io-task ;
-    >r input-task <io-task> r> construct-delegate ; inline
-
-TUPLE: output-task ;
-
-: <output-task> ( port continuation class -- task )
-    >r output-task <io-task> r> construct-delegate ; inline
 
 GENERIC: do-io-task ( task -- ? )
 GENERIC: io-task-container ( mx task -- hashtable )
@@ -37,9 +32,10 @@ M: input-task io-task-container drop reads>> ;
 
 M: output-task io-task-container drop writes>> ;
 
-: <mx> ( -- mx ) f H{ } clone H{ } clone mx construct-boa ;
+: construct-mx ( class -- obj )
-
+    construct-empty
-: construct-mx ( class -- obj ) <mx> swap construct-delegate ;
+        H{ } clone >>reads
+        H{ } clone >>writes ; inline
 
 GENERIC: register-io-task ( task mx -- )
 GENERIC: unregister-io-task ( task mx -- )
@@ -123,16 +119,18 @@ M: unix cancel-io ( port -- )
 
 ! Readers
 : reader-eof ( reader -- )
-    dup buffer-empty? [ t >>eof? ] when drop ;
+    dup buffer>> buffer-empty? [ t >>eof ] when drop ;
 
 : (refill) ( port -- n )
-    [ handle>> ] [ buffer-end ] [ buffer-capacity ] tri read ;
+    [ handle>> ]
+    [ buffer>> buffer-end ]
+    [ buffer>> buffer-capacity ] tri read ;
 
 : refill ( port -- ? )
     #! Return f if there is a recoverable error
-    dup buffer-empty? [
+    dup buffer>> buffer-empty? [
         dup (refill)  dup 0 >= [
-            swap n>buffer t
+            swap buffer>> n>buffer t
         ] [
             drop defer-error
         ] if
@@ -140,10 +138,10 @@ M: unix cancel-io ( port -- )
         drop t
     ] if ;
 
-TUPLE: read-task ;
+TUPLE: read-task < input-task ;
 
 : <read-task> ( port continuation -- task )
-    read-task <input-task> ;
+    read-task <io-task> ;
 
 M: read-task do-io-task
     io-task-port dup refill
@@ -155,28 +153,33 @@ M: input-port (wait-to-read)
 
 ! Writers
 : write-step ( port -- ? )
-    dup [ handle>> ] [ buffer@ ] [ buffer-length ] tri write
+    dup
-    dup 0 >= [ swap buffer-consume f ] [ drop defer-error ] if ;
+    [ handle>> ]
+    [ buffer>> buffer@ ]
+    [ buffer>> buffer-length ] tri
+    write dup 0 >=
+    [ swap buffer>> buffer-consume f ]
+    [ drop defer-error ] if ;
 
-TUPLE: write-task ;
+TUPLE: write-task < output-task ;
 
 : <write-task> ( port continuation -- task )
-    write-task <output-task> ;
+    write-task <io-task> ;
 
 M: write-task do-io-task
-    io-task-port dup [ buffer-empty? ] [ port-error ] bi or
+    io-task-port dup [ buffer>> buffer-empty? ] [ port-error ] bi or
-    [ 0 swap buffer-reset t ] [ write-step ] if ;
+    [ 0 swap buffer>> buffer-reset t ] [ write-step ] if ;
 
 : add-write-io-task ( port continuation -- )
-    over port-handle mx get-global mx-writes at*
+    over handle>> mx get-global writes>> at*
     [ io-task-callbacks push drop ]
     [ drop <write-task> add-io-task ] if ;
 
 : (wait-to-write) ( port -- )
     [ add-write-io-task ] with-port-continuation drop ;
 
-M: port port-flush ( port -- )
+M: output-port port-flush ( port -- )
-    dup buffer-empty? [ drop ] [ (wait-to-write) ] if ;
+    dup buffer>> buffer-empty? [ drop ] [ (wait-to-write) ] if ;
 
 M: unix io-multiplex ( ms/f -- )
     mx get-global wait-for-events ;
@@ -187,13 +190,12 @@ M: unix (init-stdio) ( -- )
     2 <writer> ;
 
 ! mx io-task for embedding an fd-based mx inside another mx
-TUPLE: mx-port mx ;
+TUPLE: mx-port < port mx ;
 
 : <mx-port> ( mx -- port )
-    dup fd>> f mx-port <port>
+    dup fd>> mx-port <port> swap >>mx ;
-    { set-mx-port-mx set-delegate } mx-port construct ;
 
-TUPLE: mx-task ;
+TUPLE: mx-task < io-task ;
 
 : <mx-task> ( port -- task )
     f mx-task <io-task> ;

extra/io/unix/epoll/epoll.factor

@@ -5,7 +5,7 @@ bit-arrays sequences assocs unix unix.linux.epoll math
 namespaces structs ;
 IN: io.unix.epoll
 
-TUPLE: epoll-mx events ;
+TUPLE: epoll-mx < mx events ;
 
 : max-events ( -- n )
     #! We read up to 256 events at a time. This is an arbitrary
@@ -33,12 +33,10 @@ M: output-task io-task-events drop EPOLLOUT ;
     epoll_ctl io-error ;
 
 M: epoll-mx register-io-task ( task mx -- )
-    2dup EPOLL_CTL_ADD do-epoll-ctl 
+    [ EPOLL_CTL_ADD do-epoll-ctl ] [ call-next-method ] 2bi ;
-    delegate register-io-task ;
 
 M: epoll-mx unregister-io-task ( task mx -- )
-    2dup delegate unregister-io-task
+    [ call-next-method ] [ EPOLL_CTL_DEL do-epoll-ctl ] 2bi ;
-    EPOLL_CTL_DEL do-epoll-ctl ;
 
 : wait-event ( mx timeout -- n )
     >r { mx-fd epoll-mx-events } get-slots max-events

extra/io/unix/files/files.factor

@@ -72,7 +72,7 @@ M: unix delete-directory ( path -- )
 M: unix copy-file ( from to -- )
     [ normalize-path ] bi@
     [ (copy-file) ]
-    [ swap file-info file-info-permissions chmod io-error ]
+    [ swap file-info permissions>> chmod io-error ]
     2bi ;
 
 : stat>type ( stat -- type )

extra/io/unix/kqueue/kqueue.factor

@@ -8,7 +8,7 @@ io.nonblocking io.unix.backend io.launcher io.unix.launcher
 io.monitors ;
 IN: io.unix.kqueue
 
-TUPLE: kqueue-mx events monitors ;
+TUPLE: kqueue-mx < mx events monitors ;
 
 : max-events ( -- n )
     #! We read up to 256 events at a time. This is an arbitrary
@@ -43,12 +43,14 @@ M: io-task io-task-fflags drop 0 ;
     0 < [ err_no ESRCH = [ (io-error) ] unless ] when ;
 
 M: kqueue-mx register-io-task ( task mx -- )
-    over EV_ADD make-kevent over register-kevent
+    [ >r EV_ADD make-kevent r> register-kevent ]
-    delegate register-io-task ;
+    [ call-next-method ]
+    2bi ;
 
 M: kqueue-mx unregister-io-task ( task mx -- )
-    2dup delegate unregister-io-task
+    [ call-next-method ]
-    swap EV_DELETE make-kevent swap register-kevent ;
+    [ >r EV_DELETE make-kevent r> register-kevent ]
+    2bi ;
 
 : wait-kevent ( mx timespec -- n )
     >r [ fd>> f 0 ] keep events>> max-events r> kevent

extra/io/unix/linux/monitors/monitors.factor

@@ -103,8 +103,8 @@ M: linux-monitor dispose ( monitor -- )
 
 : inotify-read-loop ( port -- )
     dup wait-to-read1
-    0 over parse-file-notifications
+    0 over buffer>> parse-file-notifications
-    0 over buffer-reset
+    0 over buffer>> buffer-reset
     inotify-read-loop ;
 
 : inotify-read-thread ( port -- )

extra/io/unix/select/select.factor

@@ -5,7 +5,7 @@ bit-arrays sequences assocs unix math namespaces structs
 accessors ;
 IN: io.unix.select
 
-TUPLE: select-mx read-fdset write-fdset ;
+TUPLE: select-mx < mx read-fdset write-fdset ;
 
 ! Factor's bit-arrays are an array of bytes, OS X expects
 ! FD_SET to be an array of cells, so we have to account for

extra/io/unix/sockets/sockets.factor

@@ -7,7 +7,7 @@ USING: alien alien.c-types generic io kernel math namespaces
 io.nonblocking parser threads unix sequences
 byte-arrays io.sockets io.binary io.unix.backend
 io.streams.duplex io.sockets.impl math.parser continuations libc
-combinators io.backend io.files io.files.private system ;
+combinators io.backend io.files io.files.private system accessors ;
 IN: io.unix.sockets
 
 : pending-init-error ( port -- )
@@ -30,10 +30,10 @@ M: unix addrinfo-error ( n -- )
 : init-client-socket ( fd -- )
     SOL_SOCKET SO_OOBINLINE sockopt ;
 
-TUPLE: connect-task ;
+TUPLE: connect-task < output-task ;
 
 : <connect-task> ( port continuation -- task )
-    connect-task <output-task> ;
+    connect-task <io-task> ;
 
 M: connect-task do-io-task
     io-task-port dup port-handle f 0 write
@@ -42,7 +42,7 @@ M: connect-task do-io-task
 : wait-to-connect ( port -- )
     [ <connect-task> add-io-task ] with-port-continuation drop ;
 
-M: unix (client) ( addrspec -- client-in client-out )
+M: unix ((client)) ( addrspec -- client-in client-out )
     dup make-sockaddr/size >r >r
     protocol-family SOCK_STREAM socket-fd
     dup r> r> connect
@@ -61,10 +61,10 @@ USE: unix
 : init-server-socket ( fd -- )
     SOL_SOCKET SO_REUSEADDR sockopt ;
 
-TUPLE: accept-task ;
+TUPLE: accept-task < input-task ;
 
 : <accept-task> ( port continuation  -- task )
-    accept-task <input-task> ;
+    accept-task <io-task> ;
 
 : accept-sockaddr ( port -- fd sockaddr )
     dup port-handle swap server-port-addr sockaddr-type
@@ -97,11 +97,10 @@ M: unix (server) ( addrspec -- handle )
 
 M: unix (accept) ( server -- addrspec handle )
     #! Wait for a client connection.
-    dup check-server-port
+    check-server-port
-    dup wait-to-accept
+    [ wait-to-accept ]
-    dup pending-error
+    [ pending-error ]
-    dup server-port-client-addr
+    [ [ client-addr>> ] [ client>> ] bi ] tri ;
-    swap server-port-client ;
 
 ! Datagram sockets - UDP and Unix domain
 M: unix <datagram>
@@ -128,10 +127,10 @@ packet-size <byte-array> receive-buffer set-global
         rot head
     ] if ;
 
-TUPLE: receive-task ;
+TUPLE: receive-task < input-task ;
 
 : <receive-task> ( stream continuation  -- task )
-    receive-task <input-task> ;
+    receive-task <io-task> ;
 
 M: receive-task do-io-task
     io-task-port
@@ -148,19 +147,18 @@ M: receive-task do-io-task
     [ <receive-task> add-io-task ] with-port-continuation drop ;
 
 M: unix receive ( datagram -- packet addrspec )
-    dup check-datagram-port
+    check-datagram-port
-    dup wait-receive
+    [ wait-receive ]
-    dup pending-error
+    [ pending-error ]
-    dup datagram-port-packet
+    [ [ packet>> ] [ packet-addr>> ] bi ] tri ;
-    swap datagram-port-packet-addr ;
 
 : do-send ( socket data sockaddr len -- n )
     >r >r dup length 0 r> r> sendto ;
 
-TUPLE: send-task packet sockaddr len ;
+TUPLE: send-task < output-task packet sockaddr len ;
 
 : <send-task> ( packet sockaddr len stream continuation -- task )
-    send-task <output-task> [
+    send-task <io-task> [
         {
             set-send-task-packet
             set-send-task-sockaddr
@@ -180,7 +178,7 @@ M: send-task do-io-task
     2drop 2drop ;
 
 M: unix send ( packet addrspec datagram -- )
-    3dup check-datagram-send
+    check-datagram-send
     [ >r make-sockaddr/size r> wait-send ] keep
     pending-error ;
 

extra/io/unix/unix-tests.factor

@@ -11,7 +11,7 @@ IN: io.unix.tests
 
     socket-server <local>
     ascii <server> [
-        accept [
+        accept drop [
             "Hello world" print flush
             readln "XYZ" = "FOO" "BAR" ? print flush
         ] with-stream

extra/io/windows/nt/files/files.factor

@@ -64,7 +64,7 @@ M: winnt FileArgs-overlapped ( port -- overlapped )
     dup pending-error
     tuck get-overlapped-result
     dup pick update-file-ptr
-    swap buffer-consume ;
+    swap buffer>> buffer-consume ;
 
 : (flush-output) ( port -- )
     dup make-FileArgs
@@ -73,7 +73,7 @@ M: winnt FileArgs-overlapped ( port -- overlapped )
         >r FileArgs-lpOverlapped r>
         [ save-callback ] 2keep
         [ finish-flush ] keep
-        dup buffer-empty? [ drop ] [ (flush-output) ] if
+        dup buffer>> buffer-empty? [ drop ] [ (flush-output) ] if
     ] [
         2drop
     ] if ;
@@ -82,7 +82,7 @@ M: winnt FileArgs-overlapped ( port -- overlapped )
     [ [ (flush-output) ] with-timeout ] with-destructors ;
 
 M: port port-flush
-    dup buffer-empty? [ dup flush-output ] unless drop ;
+    dup buffer>> buffer-empty? [ dup flush-output ] unless drop ;
 
 : finish-read ( overlapped port -- )
     dup pending-error

extra/io/windows/nt/monitors/monitors.factor

@@ -37,10 +37,12 @@ M: winnt <monitor> ( path recursive? -- monitor )
     ] with-destructors ;
 
 : begin-reading-changes ( monitor -- overlapped )
-    dup port-handle win32-file-handle
+    {
-    over buffer-ptr
+        [ handle>> handle>> ]
-    pick buffer-size
+        [ buffer>> buffer-ptr ]
-    roll win32-monitor-recursive? 1 0 ?
+        [ buffer>> buffer-size ]
+        [ win32-monitor-recursive? 1 0 ? ]
+    } cleave
     FILE_NOTIFY_CHANGE_ALL
     0 <uint>
     (make-overlapped)
@@ -82,6 +84,6 @@ M: winnt <monitor> ( path recursive? -- monitor )
     [ 2drop ] [ swap <displaced-alien> (changed-files) ] if ;
 
 M: win32-monitor fill-queue ( monitor -- )
-    dup buffer-ptr over read-changes
+    dup buffer>> buffer-ptr over read-changes
     [ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc
     swap set-monitor-queue ;

extra/io/windows/nt/sockets/sockets.factor

@@ -122,7 +122,7 @@ TUPLE: AcceptEx-args port
 M: winnt (accept) ( server -- addrspec handle )
     [
         [
-            dup check-server-port
+            check-server-port
             \ AcceptEx-args construct-empty
             [ init-accept ] keep
             [ ((accept)) ] keep
@@ -159,7 +159,7 @@ TUPLE: WSARecvFrom-args port
 : init-WSARecvFrom ( datagram WSARecvFrom -- )
     [ set-WSARecvFrom-args-port ] 2keep
     [
-        >r delegate port-handle delegate win32-file-handle r>
+        >r handle>> handle>> r>
         set-WSARecvFrom-args-s*
     ] 2keep [
         >r datagram-port-addr sockaddr-type heap-size r>
@@ -192,7 +192,7 @@ TUPLE: WSARecvFrom-args port
 
 M: winnt receive ( datagram -- packet addrspec )
     [
-        dup check-datagram-port
+        check-datagram-port
         \ WSARecvFrom-args construct-empty
         [ init-WSARecvFrom ] keep
         [ call-WSARecvFrom ] keep
@@ -244,7 +244,7 @@ USE: io.sockets
 
 M: winnt send ( packet addrspec datagram -- )
     [
-        3dup check-datagram-send
+        check-datagram-send
         \ WSASendTo-args construct-empty
         [ init-WSASendTo ] keep
         [ call-WSASendTo ] keep

extra/io/windows/windows.factor

@@ -92,7 +92,7 @@ M: win32-file close-handle ( handle -- )
     ] when drop ;
 
 : open-append ( path -- handle length )
-    [ dup file-info file-info-size ] [ drop 0 ] recover
+    [ dup file-info size>> ] [ drop 0 ] recover
     >r (open-append) r> 2dup set-file-pointer ;
 
 TUPLE: FileArgs
@@ -103,9 +103,9 @@ C: <FileArgs> FileArgs
 
 : make-FileArgs ( port -- <FileArgs> )
     [ port-handle win32-file-handle ] keep
-    [ delegate ] keep
+    [ buffer>> ] keep
     [
-        buffer-length
+        buffer>> buffer-length
         "DWORD" <c-object>
     ] keep FileArgs-overlapped <FileArgs> ;
 
@@ -152,11 +152,10 @@ M: windows delete-directory ( path -- )
 
 HOOK: WSASocket-flags io-backend ( -- DWORD )
 
-TUPLE: win32-socket ;
+TUPLE: win32-socket < win32-file ;
 
 : <win32-socket> ( handle -- win32-socket )
-    f <win32-file>
+    f win32-file construct-boa ;
-    \ win32-socket construct-delegate ;
 
 : open-socket ( family type -- socket )
     0 f 0 WSASocket-flags WSASocket dup socket-error ;

extra/tools/deploy/backend/backend.factor

@@ -22,9 +22,8 @@ IN: tools.deploy.backend
         +stdout+ >>stderr
         +closed+ >>stdin
         +low-priority+ >>priority
-    utf8 <process-stream>
+    utf8 <process-stream*>
-    dup copy-lines
+    >r copy-lines r> wait-for-process zero? [
-    process>> wait-for-process zero? [
         "Deployment failed" throw
     ] unless ;
 

extra/tools/deploy/deploy-tests.factor

@@ -1,7 +1,7 @@
 IN: tools.deploy.tests
 USING: tools.test system io.files kernel tools.deploy.config
 tools.deploy.backend math sequences io.launcher arrays
-namespaces continuations layouts ;
+namespaces continuations layouts accessors ;
 
 : shake-and-bake ( vocab -- )
     [ "test.image" temp-file delete-file ] ignore-errors
@@ -12,7 +12,7 @@ namespaces continuations layouts ;
     ] with-directory ;
 
 : small-enough? ( n -- ? )
-    >r "test.image" temp-file file-info file-info-size r> <= ;
+    >r "test.image" temp-file file-info size>> r> <= ;
 
 [ ] [ "hello-world" shake-and-bake ] unit-test
 

extra/ui/tools/interactor/interactor-tests.factor

@@ -1,8 +1,9 @@
 IN: ui.tools.interactor.tests
 USING: ui.tools.interactor ui.gadgets.panes namespaces
 ui.gadgets.editors concurrency.promises threads listener
-tools.test kernel calendar ;
+tools.test kernel calendar parser ;
 
+[
     \ <interactor> must-infer
 
     [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
@@ -25,3 +26,4 @@ tools.test kernel calendar ;
     [ ] [ "interactor" get evaluate-input ] unit-test
 
     [ [ [ 1 2 3 ] ] ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
+] with-interactive-vocabs