Working on converting io backends to use inheritance

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/io/mmap/mmap-tests.factor

@@ -4,7 +4,7 @@ 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/nonblocking/nonblocking-docs.factor

@@ -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

@@ -12,9 +12,10 @@ SYMBOL: default-buffer-size
 ! Common delegate of native stream readers and writers
 TUPLE: port
 handle
+buffer
 error
 timeout
-type eof? ;
+type eof ;
 
 M: port timeout port-timeout ;
 
@@ -28,15 +29,14 @@ PREDICATE: output-port < port port-type output-port eq? ;
 GENERIC: init-handle ( handle -- )
 GENERIC: close-handle ( handle -- )
 
-: <port> ( handle buffer type -- port )
+: <port> ( handle type -- port )
-    pick init-handle {
+    port construct-empty
-        set-port-handle
+        swap >>type
-        set-delegate
+        swap dup init-handle >>handle ;
-        set-port-type
-    } port construct ;
 
 : <buffered-port> ( handle type -- port )
-    default-buffer-size get <buffer> swap <port> ;
+    <port>
+        default-buffer-size get <buffer> >>buffer ;
 
 : <reader> ( handle -- input-port )
     input-port <buffered-port> ;
@@ -48,7 +48,7 @@ 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* ;
 
 HOOK: cancel-io io-backend ( port -- )
 
@@ -59,21 +59,21 @@ 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 ;
+    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 > [
@@ -94,55 +94,53 @@ 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 )
     >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 ;
+    1 over wait-to-write
+    buffer>> byte>buffer ;
 
 M: output-port stream-write
-    over length over buffer-size > [
+    over length over buffer>> buffer-size > [
-        [ buffer-size <groups> ] keep
+        [ buffer>> buffer-size <groups> ]
-        [ stream-write ] curry each
+        [ [ 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 ;
+    [ port-flush ] [ pending-error ] bi ;
 
 : close-port ( port type -- )
     output-port eq? [ dup port-flush ] when
     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 type>> closed eq?
     [ drop ]
-    [ dup port-type >r closed over set-port-type r> close-port ]
+    [ [ closed ] change-type swap close-port ]
     if ;
 
 TUPLE: server-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 }
     server-port construct ;
 
@@ -152,7 +150,7 @@ TUPLE: server-port addr client client-addr encoding ;
 TUPLE: datagram-port addr packet packet-addr ;
 
 : <datagram-port> ( handle addr -- datagram )
-    >r f datagram-port <port> r>
+    >r datagram-port <port> r>
     { set-delegate set-datagram-port-addr }
     datagram-port construct ;
 

extra/io/unix/backend/backend.factor

@@ -119,10 +119,12 @@ 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
@@ -151,8 +153,13 @@ 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 < output-task ;
 
@@ -160,11 +167,11 @@ TUPLE: 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 ;
 
@@ -172,7 +179,7 @@ M: write-task do-io-task
     [ add-write-io-task ] with-port-continuation drop ;
 
 M: 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 ;
@@ -186,7 +193,7 @@ M: unix (init-stdio) ( -- )
 TUPLE: mx-port mx ;
 
 : <mx-port> ( mx -- port )
-    dup fd>> f mx-port <port>
+    dup fd>> mx-port <port>
     { set-mx-port-mx set-delegate } mx-port construct ;
 
 TUPLE: mx-task < io-task ;

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/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/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/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> ;
 

extra/tools/deploy/deploy-tests.factor

@@ -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