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

basis/cpu/x86/assembler/assembler.factor

@@ -130,7 +130,7 @@ M: register modifier drop BIN: 11 ;
 GENERIC# n, 1 ( value n -- )
 
 M: integer n, >le % ;
-M: byte n, >r value>> r> n, ;
+M: byte n, [ value>> ] dip n, ;
 : 1, ( n -- ) 1 n, ; inline
 : 4, ( n -- ) 4 n, ; inline
 : 2, ( n -- ) 2 n, ; inline
@@ -209,7 +209,7 @@ M: object operand-64? drop f ;
 : short-operand ( reg rex.w n -- )
     #! Some instructions encode their single operand as part of
     #! the opcode.
-    >r dupd prefix-1 reg-code r> + , ;
+    [ dupd prefix-1 reg-code ] dip + , ;
 
 : opcode, ( opcode -- ) dup array? [ % ] [ , ] if ;
 
@@ -224,7 +224,7 @@ M: object operand-64? drop f ;
 : 1-operand ( op reg,rex.w,opcode -- )
     #! The 'reg' is not really a register, but a value for the
     #! 'reg' field of the mod-r/m byte.
-    first3 >r >r over r> prefix-1 r> opcode, swap addressing ;
+    first3 [ [ over ] dip prefix-1 ] dip opcode, swap addressing ;
 
 : immediate-operand-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
     pick integer? [ first3 BIN: 1 opcode-or 3array ] when ;
@@ -250,7 +250,7 @@ M: object operand-64? drop f ;
     ] if ;
 
 : (2-operand) ( dst src op -- )
-    >r 2dup t rex-prefix r> opcode,
+    [ 2dup t rex-prefix ] dip opcode,
     reg-code swap addressing ;
 
 : direction-bit ( dst src op -- dst' src' op' )
@@ -271,11 +271,11 @@ M: object operand-64? drop f ;
 PRIVATE>
 
 : [] ( reg/displacement -- indirect )
-    dup integer? [ >r f f f r> ] [ f f f ] if <indirect> ;
+    dup integer? [ [ f f f ] dip ] [ f f f ] if <indirect> ;
 
 : [+] ( reg displacement -- indirect )
     dup integer?
-    [ dup zero? [ drop f ] when >r f f r> ]
+    [ dup zero? [ drop f ] when [ f f ] dip ]
     [ f f ] if
     <indirect> ;
 

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

@@ -4,8 +4,8 @@ USING: kernel words sequences lexer parser fry ;
 IN: cpu.x86.assembler.syntax
 
 : define-register ( name num size -- )
-    >r >r "cpu.x86.assembler" create dup define-symbol r> r>
+    [ "cpu.x86.assembler" create dup define-symbol ] 2dip
-    >r dupd "register" set-word-prop r>
+    [ dupd "register" set-word-prop ] dip
     "register-size" set-word-prop ;
 
 : define-registers ( names size -- )

basis/environment/environment.factor

@@ -27,6 +27,9 @@ HOOK: (set-os-envs) os ( seq -- )
 } cond
 
 [
-    "FACTOR_ROOTS" os-env os windows? ";" ":" ? split
+    "FACTOR_ROOTS" os-env
-    [ add-vocab-root ] each
+    [
+        os windows? ";" ":" ? split
+        [ add-vocab-root ] each
+    ] when*    
 ] "environment" add-init-hook

basis/fry/fry-docs.factor

@@ -46,10 +46,10 @@ $nl
     "{ 10 20 30 } [ sq ] [ . ] compose each"
     "{ 10 20 30 } [ sq . ] each"
 }
-"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed:"
+"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed, and the result is considerably more concise and readable than the version using " { $link curry } " and " { $link compose } " directly:"
 { $code
     "{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map"
-    "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map"
+    "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry compose compose map"
     "{ 8 13 14 27 } [ even? dup 5 ? ] map"
 }
 "The following is a no-op:"

basis/io/buffers/buffers-tests.factor

@@ -5,7 +5,7 @@ destructors ;
 
 : buffer-set ( string buffer -- )
     over >byte-array over ptr>> byte-array>memory
-    >r length r> buffer-reset ;
+    [ length ] dip buffer-reset ;
 
 : string>buffer ( string -- buffer )
     dup length <buffer> tuck buffer-set ;

basis/io/encodings/utf16/utf16.factor

@@ -25,7 +25,7 @@ ERROR: missing-bom ;
 : quad-be ( stream byte -- stream char )
     double-be over stream-read1 [
         dup -2 shift BIN: 110111 number= [
-            >r 2 shift r> BIN: 11 bitand bitor
+            [ 2 shift ] dip BIN: 11 bitand bitor
             over stream-read1 swap append-nums HEX: 10000 +
         ] [ 2drop dup stream-read1 drop replacement-char ] if
     ] when* ;

basis/io/monitors/monitors.factor

@@ -53,7 +53,7 @@ SYMBOL: +rename-file-new+
 SYMBOL: +rename-file+
 
 : with-monitor ( path recursive? quot -- )
-    >r <monitor> r> with-disposal ; inline
+    [ <monitor> ] dip with-disposal ; inline
 
 {
     { [ os macosx? ] [ "io.unix.macosx.monitors" require ] }

basis/io/monitors/recursive/recursive.factor

@@ -3,7 +3,7 @@
 USING: accessors sequences assocs arrays continuations
 destructors combinators kernel threads concurrency.messaging
 concurrency.mailboxes concurrency.promises io.files io.monitors
-debugger ;
+debugger fry ;
 IN: io.monitors.recursive
 
 ! Simulate recursive monitors on platforms that don't have them
@@ -29,10 +29,10 @@ DEFER: add-child-monitor
     qualify-path dup link-info directory? [
         [ add-child-monitors ]
         [
-            [
+            '[
-                [ f my-mailbox (monitor) ] keep
+                _ [ f my-mailbox (monitor) ] keep
                 monitor tget children>> set-at
-            ] curry ignore-errors
+            ] ignore-errors
         ] bi
     ] [ drop ] if ;
 
@@ -48,7 +48,7 @@ M: recursive-monitor dispose*
     monitor tget children>> [ nip dispose ] assoc-each ;
 
 : pump-step ( msg -- )
-    first3 path>> swap >r prepend-path r> monitor tget 3array
+    first3 path>> swap [ prepend-path ] dip monitor tget 3array
     monitor tget queue>>
     mailbox-put ;
 
@@ -71,9 +71,9 @@ M: recursive-monitor dispose*
 
 : pump-loop ( -- )
     receive dup synchronous? [
-        >r stop-pump t r> reply-synchronous
+        [ stop-pump t ] dip reply-synchronous
     ] [
-        [ [ update-hierarchy ] curry ignore-errors ] [ pump-step ] bi
+        [ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
         pump-loop
     ] if ;
 
@@ -88,7 +88,7 @@ M: recursive-monitor dispose*
     pump-loop ;
 
 : start-pump-thread ( monitor -- )
-    dup [ pump-thread ] curry
+    dup '[ _ pump-thread ]
     "Recursive monitor pump" spawn
     >>thread drop ;
 
@@ -96,7 +96,7 @@ M: recursive-monitor dispose*
     ready>> ?promise ?linked drop ;
 
 : <recursive-monitor> ( path mailbox -- monitor )
-    >r (normalize-path) r>
+    [ (normalize-path) ] dip
     recursive-monitor new-monitor
         H{ } clone >>children
         <promise> >>ready

basis/io/pools/pools.factor

@@ -42,7 +42,7 @@ GENERIC: make-connection ( pool -- conn )
     [ nip call ] [ drop return-connection ] 3bi ; inline
 
 : with-pooled-connection ( pool quot -- )
-    >r [ acquire-connection ] keep r>
+    [ [ acquire-connection ] keep ] dip
     [ (with-pooled-connection) ] [ ] [ 2drop dispose ] cleanup ; inline
 
 M: return-connection dispose

basis/io/streams/duplex/duplex.factor

@@ -27,7 +27,7 @@ M: duplex-stream dispose
     ] with-destructors ;
 
 : <encoder-duplex> ( stream-in stream-out encoding -- duplex )
-    tuck re-encode >r re-decode r> <duplex-stream> ;
+    tuck [ re-decode ] [ re-encode ] 2bi* <duplex-stream> ;
 
 : with-stream* ( stream quot -- )
     [ [ in>> ] [ out>> ] bi ] dip with-streams* ; inline

basis/io/timeouts/timeouts.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel calendar alarms io io.encodings accessors
-namespaces ;
+namespaces fry ;
 IN: io.timeouts
 
 GENERIC: timeout ( obj -- dt/f )
@@ -14,14 +14,14 @@ M: encoder set-timeout stream>> set-timeout ;
 GENERIC: cancel-operation ( obj -- )
 
 : queue-timeout ( obj timeout -- alarm )
-    >r [ cancel-operation ] curry r> later ;
+    [ '[ _ cancel-operation ] ] dip later ;
 
 : with-timeout* ( obj timeout quot -- )
-    3dup drop queue-timeout >r nip call r> cancel-alarm ;
+    3dup drop queue-timeout [ nip call ] dip cancel-alarm ;
     inline
 
 : with-timeout ( obj quot -- )
-    over timeout [ >r dup timeout r> with-timeout* ] [ call ] if ;
+    over timeout [ [ dup timeout ] dip with-timeout* ] [ call ] if ;
     inline
 
 : timeouts ( dt -- )

basis/io/unix/backend/backend.factor

@@ -5,7 +5,7 @@ math io.ports sequences strings sbufs threads unix
 vectors io.buffers io.backend io.encodings math.parser
 continuations system libc qualified namespaces make io.timeouts
 io.encodings.utf8 destructors accessors summary combinators
-locals unix.time ;
+locals unix.time fry ;
 QUALIFIED: io
 IN: io.unix.backend
 
@@ -88,19 +88,16 @@ M: io-timeout summary drop "I/O operation timed out" ;
 
 : wait-for-fd ( handle event -- )
     dup +retry+ eq? [ 2drop ] [
-        [
+        '[
-            >r
+            swap handle-fd mx get-global _ {
-            swap handle-fd
-            mx get-global
-            r> {
                 { +input+ [ add-input-callback ] }
                 { +output+ [ add-output-callback ] }
             } case
-        ] curry "I/O" suspend nip [ io-timeout ] when
+        ] "I/O" suspend nip [ io-timeout ] when
     ] if ;
 
 : wait-for-port ( port event -- )
-    [ >r handle>> r> wait-for-fd ] curry with-timeout ;
+    '[ handle>> _ wait-for-fd ] with-timeout ;
 
 ! Some general stuff
 : file-mode OCT: 0666 ;

basis/io/unix/files/files.factor

@@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar
 io.encodings.binary accessors sequences strings system
 io.files.private destructors vocabs.loader calendar.unix
 unix.stat alien.c-types arrays unix.users unix.groups
-environment fry io.encodings.utf8 alien.strings unix.statfs
+environment fry io.encodings.utf8 alien.strings
 combinators.short-circuit ;
 IN: io.unix.files
 
@@ -76,15 +76,64 @@ M: unix copy-file ( from to -- )
     [ swap file-info permissions>> chmod io-error ]
     2bi ;
 
-HOOK: stat>file-info os ( stat -- file-info )
+TUPLE: unix-file-system-info < file-system-info
+block-size preferred-block-size
+blocks blocks-free blocks-available
+files files-free files-available
+name-max flags id ;
 
-HOOK: stat>type os ( stat -- file-info )
+HOOK: new-file-system-info os ( --  file-system-info )
 
-HOOK: new-file-info os ( -- class )
+M: unix new-file-system-info ( -- ) unix-file-system-info new ;
+
+HOOK: file-system-statfs os ( path -- statfs )
+
+M: unix file-system-statfs drop f ;
+
+HOOK: file-system-statvfs os ( path -- statvfs )
+
+M: unix file-system-statvfs drop f ;
+
+HOOK: statfs>file-system-info os ( file-system-info statfs -- file-system-info' )
+
+M: unix statfs>file-system-info drop ;
+
+HOOK: statvfs>file-system-info os ( file-system-info statvfs -- file-system-info' )
+
+M: unix statvfs>file-system-info drop ;
+
+: file-system-calculations ( file-system-info -- file-system-info' )
+    {
+        [ dup [ blocks-available>> ] [ block-size>> ] bi * >>free-space drop ]
+        [ dup [ blocks>> ] [ block-size>> ] bi * >>total-space drop ]
+        [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ]
+        [ ]
+    } cleave ;
+
+M: unix file-system-info
+    normalize-path
+    [ new-file-system-info ] dip
+    [ file-system-statfs statfs>file-system-info ]
+    [ file-system-statvfs statvfs>file-system-info ] bi
+    file-system-calculations ;
+
+os {
+    { linux   [ "io.unix.files.linux"   require ] }
+    { macosx  [ "io.unix.files.macosx"  require ] }
+    { freebsd [ "io.unix.files.freebsd" require ] }
+    { netbsd  [ "io.unix.files.netbsd"  require ] }
+    { openbsd [ "io.unix.files.openbsd" require ] }
+} case
 
 TUPLE: unix-file-info < file-info uid gid dev ino
 nlink rdev blocks blocksize ;
 
+HOOK: new-file-info os ( -- file-info )
+
+HOOK: stat>file-info os ( stat -- file-info )
+
+HOOK: stat>type os ( stat -- file-info )
+
 M: unix file-info ( path -- info )
     normalize-path file-status stat>file-info ;
 

basis/io/unix/files/freebsd/freebsd.factor

@@ -0,0 +1,24 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.syntax combinators
+io.backend io.files io.unix.files kernel math system unix
+unix.statfs unix.statvfs.freebsd ;
+IN: io.unix.files.freebsd
+
+M: freebsd file-system-statvfs ( path -- byte-array )
+    "statvfs" <c-object> tuck statvfs io-error ;
+
+M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info )
+    {
+        [ statvfs-f_bavail >>blocks-available ]
+        [ statvfs-f_bfree >>blocks-free ]
+        [ statvfs-f_blocks >>blocks ]
+        [ statvfs-f_favail >>files-available ]
+        [ statvfs-f_ffree >>files-free ]
+        [ statvfs-f_files >>files ]
+        [ statvfs-f_bsize >>block-size ]
+        [ statvfs-f_flag >>flags ]
+        [ statvfs-f_frsize >>preferred-block-size ]
+        [ statvfs-f_fsid >>id ]
+        [ statvfs-f_namemax >>name-max ]
+    } cleave ;

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

@@ -0,0 +1,70 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.syntax combinators csv
+io.encodings.utf8 io.files io.streams.string io.unix.files
+kernel namespaces sequences system unix unix.statfs.linux
+unix.statvfs.linux ;
+IN: io.unix.files.linux
+
+TUPLE: linux-file-system-info < unix-file-system-info
+namelen spare ;
+
+M: linux new-file-system-info linux-file-system-info new ;
+
+M: linux file-system-statfs ( path -- byte-array )
+    "statfs64" <c-object> tuck statfs64 io-error ;
+
+M: linux statfs>file-system-info ( struct -- statfs )
+    {
+        [ statfs64-f_type >>type ]
+        [ statfs64-f_bsize >>block-size ]
+        [ statfs64-f_blocks >>blocks ]
+        [ statfs64-f_bfree >>blocks-free ]
+        [ statfs64-f_bavail >>blocks-available ]
+        [ statfs64-f_files >>files ]
+        [ statfs64-f_ffree >>files-free ]
+        [ statfs64-f_fsid >>id ]
+        [ statfs64-f_namelen >>namelen ]
+        [ statfs64-f_frsize >>preferred-block-size ]
+        [ statfs64-f_spare >>spare ]
+    } cleave ;
+
+M: linux file-system-statvfs ( path -- byte-array )
+    "statvfs64" <c-object> tuck statvfs64 io-error ;
+
+M: linux statvfs>file-system-info ( struct -- statfs )
+    {
+        [ statvfs64-f_flag >>flags ]
+        [ statvfs64-f_namemax >>name-max ]
+    } cleave ;
+
+TUPLE: mtab-entry file-system-name mount-point type options
+frequency pass-number ;
+
+: mtab-csv>mtab-entry ( csv -- mtab-entry )
+    [ mtab-entry new ] dip
+    {
+        [ first >>file-system-name ]
+        [ second >>mount-point ]
+        [ third >>type ]
+        [ fourth <string-reader> csv first >>options ]
+        [ 4 swap nth >>frequency ]
+        [ 5 swap nth >>pass-number ]
+    } cleave ;
+
+: parse-mtab ( -- array )
+    [
+        "/etc/mtab" utf8 <file-reader>
+        CHAR: \s delimiter set csv
+    ] with-scope
+    [ mtab-csv>mtab-entry ] map ;
+
+M: linux file-systems
+    parse-mtab [
+        [ mount-point>> file-system-info ] keep
+        {
+            [ file-system-name>> >>device-name ]
+            [ mount-point>> >>mount-point ]
+            [ type>> >>type ]
+        } cleave
+    ] map ;

basis/io/unix/files/macosx/macosx.factor

@@ -0,0 +1,50 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.strings combinators
+grouping io.encodings.utf8 io.files kernel math sequences
+system unix unix.statfs.macosx io.unix.files unix.statvfs.macosx ;
+IN: io.unix.files.macosx
+
+TUPLE: macosx-file-system-info < unix-file-system-info
+io-size owner type-id filesystem-subtype ;
+
+M: macosx file-systems ( -- array )
+    f <void*> dup 0 getmntinfo64 dup io-error
+    [ *void* ] dip
+    "statfs64" heap-size [ * memory>byte-array ] keep group
+    [ [ new-file-system-info ] dip statfs>file-system-info ] map ;
+
+M: macosx new-file-system-info macosx-file-system-info new ;
+
+M: macosx file-system-statfs ( normalized-path -- statfs )
+    "statfs64" <c-object> tuck statfs64 io-error ;
+
+M: macosx file-system-statvfs ( normalized-path -- statvfs )
+    "statvfs" <c-object> tuck statvfs io-error ;
+
+M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' )
+    {
+        [ statfs64-f_bsize >>block-size ]
+        [ statfs64-f_iosize >>io-size ]
+        [ statfs64-f_blocks >>blocks ]
+        [ statfs64-f_bfree >>blocks-free ]
+        [ statfs64-f_bavail >>blocks-available ]
+        [ statfs64-f_files >>files ]
+        [ statfs64-f_ffree >>files-free ]
+        [ statfs64-f_fsid >>id ]
+        [ statfs64-f_owner >>owner ]
+        [ statfs64-f_type >>type-id ]
+        [ statfs64-f_flags >>flags ]
+        [ statfs64-f_fssubtype >>filesystem-subtype ]
+        [ statfs64-f_fstypename utf8 alien>string >>type ]
+        [ statfs64-f_mntonname utf8 alien>string >>mount-point ]
+        [ statfs64-f_mntfromname utf8 alien>string >>device-name ]
+    } cleave ;
+
+M: macosx statvfs>file-system-info ( file-system-info byte-array -- file-system-info' )
+    {
+        [ statvfs-f_frsize >>preferred-block-size ]
+        [ statvfs-f_favail >>files-available ]
+        [ statvfs-f_namemax >>name-max ]
+    } cleave ;
+

basis/io/unix/files/netbsd/netbsd.factor

@@ -0,0 +1,49 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel unix.stat math unix
+combinators system io.backend accessors alien.c-types
+io.encodings.utf8 alien.strings unix.types unix.statfs 
+io.unix.files io.files unix.statvfs.netbsd ;
+IN: io.unix.files.netbsd
+
+TUPLE: netbsd-file-system-info < unix-file-system-info
+blocks-reserved files-reserved
+owner io-size
+sync-reads sync-writes
+async-reads async-writes
+idx mount-from spare ;
+
+M: netbsd new-file-system-info netbsd-file-system-info new ;
+
+M: netbsd file-system-statvfs
+    "statvfs" <c-object> tuck statvfs io-error ;
+
+M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' )
+    {
+        [ statvfs-f_flag >>flags ]
+        [ statvfs-f_bsize >>block-size ]
+        [ statvfs-f_frsize >>preferred-block-size ]
+        [ statvfs-f_iosize >>io-size ]
+        [ statvfs-f_blocks >>blocks ]
+        [ statvfs-f_bfree >>blocks-free ]
+        [ statvfs-f_bavail >>blocks-available ]
+        [ statvfs-f_bresvd >>blocks-reserved ]
+        [ statvfs-f_files >>files ]
+        [ statvfs-f_ffree >>files-free ]
+        [ statvfs-f_favail >>files-available ]
+        [ statvfs-f_fresvd >>files-reserved ]
+        [ statvfs-f_syncreads >>sync-reads ]
+        [ statvfs-f_syncwrites >>sync-writes ]
+        [ statvfs-f_asyncreads >>async-reads ]
+        [ statvfs-f_asyncwrites >>async-writes ]
+        [ statvfs-f_fsidx >>idx ]
+        [ statvfs-f_fsid >>id ]
+        [ statvfs-f_namemax >>name-max ]
+        [ statvfs-f_owner >>owner ]
+        [ statvfs-f_spare >>spare ]
+        [ statvfs-f_fstypename alien>native-string >>type ]
+        [ statvfs-f_mntonname alien>native-string >>mount-point ]
+        [ statvfs-f_mntfromname alien>native-string >>device-name ]
+    } cleave ;
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;

basis/io/unix/files/openbsd/openbsd.factor

@@ -0,0 +1,41 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax accessors combinators kernel
+unix.types math system io.backend alien.c-types unix
+io.files io.unix.files unix.statvfs.openbsd ;
+IN: io.unix.files.openbsd
+
+M: openbsd file-system-statfs
+    "statfs" <c-object> tuck statfs io-error ;
+
+M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info' )
+    {
+        [ statfs-f_flag >>flags ]
+        [ statfs-f_bsize >>block-size ]
+        [ statfs-f_iosize >>io-size ]
+        [ statfs-f_blocks >>blocks ]
+        [ statfs-f_bfree >>blocks-free ]
+        [ statfs-f_bavail >>blocks-available ]
+        [ statfs-f_files >>files ]
+        [ statfs-f_ffree >>files-free ]
+        [ statfs-f_favail >>files-available ]
+        [ statfs-f_syncwrites >>sync-writes ]
+        [ statfs-f_syncreads >>sync-reads ]
+        [ statfs-f_asyncwrites >>async-writes ]
+        [ statfs-f_asyncreads >>async-reads ]
+        [ statfs-f_fsid >>id ]
+        [ statfs-f_namemax >>name-max ]
+        [ statfs-f_owner >>owner ]
+        [ statfs-f_spare >>spare ]
+        [ statfs-f_fstypename alien>native-string >>type ]
+        [ statfs-f_mntonname alien>native-string >>mount-point ]
+        [ statfs-f_mntfromname alien>native-string >>device-name ]
+    } cleave ;
+
+M: openbsd file-system-statvfs ( normalized-path -- statvfs )
+    "statvfs" <c-object> tuck statvfs io-error ;
+
+M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' )
+    {
+        [ statvfs-f_frsize >>preferred-block-size ]
+    } cleave ;

basis/io/unix/linux/monitors/monitors.factor

@@ -36,9 +36,7 @@ TUPLE: linux-monitor < monitor wd inotify watches disposed ;
     inotify-fd -rot inotify_add_watch dup io-error dup check-existing ;
 
 : add-watch ( path mask mailbox -- monitor )
-    >r
+    [ [ (normalize-path) ] dip [ (add-watch) ] [ drop ] 2bi ] dip
-    >r (normalize-path) r>
-    [ (add-watch) ] [ drop ] 2bi r>
     <linux-monitor> [ ] [ ] [ wd>> ] tri watches get set-at ;
 
 : check-inotify ( -- )
@@ -103,12 +101,12 @@ M: linux-monitor dispose* ( monitor -- )
 : next-event ( i buffer -- i buffer )
     2dup inotify-event@
     inotify-event-len "inotify-event" heap-size +
-    swap >r + r> ;
+    swap [ + ] dip ;
 
 : parse-file-notifications ( i buffer -- )
     2dup events-exhausted? [ 2drop ] [
         2dup inotify-event@ dup inotify-event-wd wd>monitor
-        >r parse-file-notify r> queue-change
+        [ parse-file-notify ] dip queue-change
         next-event parse-file-notifications
     ] if ;
 

basis/io/unix/macosx/monitors/monitors.factor

@@ -2,15 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend io.monitors
 core-foundation.fsevents continuations kernel sequences
-namespaces arrays system locals accessors destructors ;
+namespaces arrays system locals accessors destructors fry ;
 IN: io.unix.macosx.monitors
 
 TUPLE: macosx-monitor < monitor handle ;
 
 : enqueue-notifications ( triples monitor -- )
-    [
+    '[ first { +modify-file+ } _ queue-change ] each ;
-        >r first { +modify-file+ } r> queue-change
-    ] curry each ;
 
 M:: macosx (monitor) ( path recursive? mailbox -- monitor )
     [let | path [ path normalize-path ] |

basis/io/unix/select/select.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types kernel io.ports io.unix.backend
 bit-arrays sequences assocs unix math namespaces
-accessors math.order locals unix.time ;
+accessors math.order locals unix.time fry ;
 IN: io.unix.select
 
 TUPLE: select-mx < mx read-fdset write-fdset ;
@@ -28,7 +28,7 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
     [ check-fd ] 3curry each ; inline
 
 : init-fdset ( fds fdset -- )
-    [ >r t swap munge r> set-nth ] curry each ;
+    '[ t swap munge _ set-nth ] each ;
 
 : read-fdset/tasks ( mx -- seq fdset )
     [ reads>> keys ] [ read-fdset>> ] bi ;

basis/io/unix/sockets/sockets.factor

@@ -16,18 +16,18 @@ IN: io.unix.sockets
     0 socket dup io-error <fd> init-fd |dispose ;
 
 : set-socket-option ( fd level opt -- )
-    >r >r handle-fd r> r> 1 <int> "int" heap-size setsockopt io-error ;
+    [ handle-fd ] 2dip 1 <int> "int" heap-size setsockopt io-error ;
 
 M: unix addrinfo-error ( n -- )
     dup zero? [ drop ] [ gai_strerror throw ] if ;
 
 ! Client sockets - TCP and Unix domain
 M: object (get-local-address) ( handle remote -- sockaddr )
-    >r handle-fd r> empty-sockaddr/size <int>
+    [ handle-fd ] dip empty-sockaddr/size <int>
     [ getsockname io-error ] 2keep drop ;
 
 M: object (get-remote-address) ( handle local -- sockaddr )
-    >r handle-fd r> empty-sockaddr/size <int>
+    [ handle-fd ] dip empty-sockaddr/size <int>
     [ getpeername io-error ] 2keep drop ;
 
 : init-client-socket ( fd -- )
@@ -60,7 +60,7 @@ M: object ((client)) ( addrspec -- fd )
     SOL_SOCKET SO_REUSEADDR set-socket-option ;
 
 : server-socket-fd ( addrspec type -- fd )
-    >r dup protocol-family r> socket-fd
+    [ dup protocol-family ] dip socket-fd
     dup init-server-socket
     dup handle-fd rot make-sockaddr/size bind io-error ;
 
@@ -77,7 +77,7 @@ M: object (server) ( addrspec -- handle )
 M: object (accept) ( server addrspec -- fd sockaddr )
     2dup do-accept
     {
-        { [ over 0 >= ] [ >r 2nip <fd> init-fd r> ] }
+        { [ over 0 >= ] [ [ 2nip <fd> init-fd ] dip ] }
         { [ err_no EINTR = ] [ 2drop (accept) ] }
         { [ err_no EAGAIN = ] [
             2drop

basis/io/unix/unix-tests.factor

@@ -46,7 +46,7 @@ yield
 
         "Receive 1" print
 
-        "d" get receive >r reverse r>
+        "d" get receive [ reverse ] dip
         
         "Send 1" print
         dup .
@@ -55,7 +55,7 @@ yield
 
         "Receive 2" print
 
-        "d" get receive >r " world" append r>
+        "d" get receive [ " world" append ] dip
         
         "Send 1" print
         dup .
@@ -86,7 +86,7 @@ datagram-client <local> <datagram>
 [ "olleh" t ] [
     "d" get receive
     datagram-server <local> =
-    >r >string r>
+    [ >string ] dip
 ] unit-test
 
 [ ] [
@@ -98,7 +98,7 @@ datagram-client <local> <datagram>
 [ "hello world" t ] [
     "d" get receive
     datagram-server <local> =
-    >r >string r>
+    [ >string ] dip
 ] unit-test
 
 [ ] [ "d" get dispose ] unit-test

basis/io/windows/files/files.factor

@@ -10,7 +10,7 @@ IN: io.windows.files
 
 : open-file ( path access-mode create-mode flags -- handle )
     [
-        >r >r share-mode default-security-attributes r> r>
+        [ share-mode default-security-attributes ] 2dip
         CreateFile-flags f CreateFile opened-file
     ] with-destructors ;
 
@@ -46,7 +46,7 @@ IN: io.windows.files
     GetLastError ERROR_ALREADY_EXISTS = not ;
 
 : set-file-pointer ( handle length method -- )
-    >r dupd d>w/w <uint> r> SetFilePointer
+    [ dupd d>w/w <uint> ] dip SetFilePointer
     INVALID_SET_FILE_POINTER = [
         CloseHandle "SetFilePointer failed" throw
     ] when drop ;
@@ -257,9 +257,6 @@ M: winnt link-info ( path -- info )
 
 HOOK: root-directory os ( string -- string' )
 
-TUPLE: winnt-file-system-info < file-system-info
-total-bytes total-free-bytes ;
-
 : file-system-type ( normalized-path -- str )
     MAX_PATH 1+ <byte-array>
     MAX_PATH 1+
@@ -269,21 +266,28 @@ total-bytes total-free-bytes ;
     [ GetVolumeInformation win32-error=0/f ] 2keep drop
     utf16n alien>string ;
 
-: file-system-space ( normalized-path -- free-space total-bytes total-free-bytes )
+: file-system-space ( normalized-path -- available-space total-space free-space )
     "ULARGE_INTEGER" <c-object>
     "ULARGE_INTEGER" <c-object>
     "ULARGE_INTEGER" <c-object>
     [ GetDiskFreeSpaceEx win32-error=0/f ] 3keep ;
 
+: calculate-file-system-info ( file-system-info -- file-system-info' )
+    {
+        [ dup [ total-space>> ] [ free-space>> ] bi - >>used-space drop ]
+        [ ]
+    } cleave ;
+
 M: winnt file-system-info ( path -- file-system-info )
     normalize-path root-directory
     dup [ file-system-type ] [ file-system-space ] bi
-    \ winnt-file-system-info new
+    \ file-system-info new
-        swap *ulonglong >>total-free-bytes
-        swap *ulonglong >>total-bytes
         swap *ulonglong >>free-space
+        swap *ulonglong >>total-space
+        swap *ulonglong >>available-space
         swap >>type
-        swap >>mount-point ;
+        swap >>mount-point
+    calculate-file-system-info ;
 
 : volume>paths ( string -- array )
     16384 "ushort" <c-array> tuck dup length
@@ -324,7 +328,7 @@ M: winnt file-systems ( -- array )
     find-volumes [ volume>paths ] map
     concat [
         [ file-system-info ]
-        [ drop winnt-file-system-info new swap >>mount-point ] recover
+        [ drop \ file-system-info new swap >>mount-point ] recover
     ] map ;
 
 : file-times ( path -- timestamp timestamp timestamp )
@@ -344,23 +348,23 @@ M: winnt file-systems ( -- array )
 : set-file-times ( path timestamp/f timestamp/f timestamp/f -- )
     #! timestamp order: creation access write
     [
-        >r >r >r
+        [
             normalize-path open-existing &dispose handle>>
-        r> r> r> (set-file-times)
+        ] 3dip (set-file-times)
     ] with-destructors ;
 
 : set-file-create-time ( path timestamp -- )
     f f set-file-times ;
 
 : set-file-access-time ( path timestamp -- )
-    >r f r> f set-file-times ;
+    [ f ] dip f set-file-times ;
 
 : set-file-write-time ( path timestamp -- )
-    >r f f r> set-file-times ;
+    [ f f ] dip set-file-times ;
 
 M: winnt touch-file ( path -- )
     [
         normalize-path
-        maybe-create-file >r &dispose r>
+        maybe-create-file [ &dispose ] dip
         [ drop ] [ handle>> f now dup (set-file-times) ] if
     ] with-destructors ;

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

@@ -18,8 +18,8 @@ C: <io-callback> io-callback
     "OVERLAPPED" malloc-object &free ;
 
 : make-overlapped ( port -- overlapped-ext )
-    >r (make-overlapped)
+    [ (make-overlapped) ] dip
-    r> handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
+    handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
 
 : <completion-port> ( handle existing -- handle )
      f 1 CreateIoCompletionPort dup win32-error=0/f ;
@@ -64,13 +64,9 @@ M: winnt add-completion ( win32-handle -- )
 : handle-overlapped ( us -- ? )
     wait-for-overlapped [
         dup [
-            >r drop GetLastError 1array r> resume-callback t
+            [ drop GetLastError 1array ] dip resume-callback t
-        ] [
+        ] [ 2drop f ] if
-            2drop f
+    ] [ resume-callback t ] if ;
-        ] if
-    ] [
-        resume-callback t
-    ] if ;
 
 M: win32-handle cancel-operation
     [ check-disposed ] [ handle>> CancelIo drop ] bi ;
@@ -94,7 +90,7 @@ M: winnt init-io ( -- )
 
 : wait-for-file ( FileArgs n port -- n )
     swap file-error?
-    [ 2drop 0 ] [ >r lpOverlapped>> r> twiddle-thumbs ] if ;
+    [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ;
 
 : update-file-ptr ( n port -- )
     handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ;

basis/io/windows/nt/files/files.factor

@@ -59,6 +59,6 @@ M: winnt FileArgs-overlapped ( port -- overlapped )
 
 M: winnt open-append
     [ dup file-info size>> ] [ drop 0 ] recover
-    >r (open-append) r> >>ptr ;
+    [ (open-append) ] dip >>ptr ;
 
 M: winnt home "USERPROFILE" os-env ;

basis/io/windows/nt/launcher/launcher.factor

@@ -52,7 +52,7 @@ IN: io.windows.nt.launcher
     CreateFile dup invalid-handle? <win32-file> &dispose handle>> ;
 
 : redirect-append ( path access-mode create-mode -- handle )
-    >r >r path>> r> r>
+    [ path>> ] 2dip
     drop OPEN_ALWAYS
     redirect-file
     dup 0 FILE_END set-file-pointer ;
@@ -61,7 +61,7 @@ IN: io.windows.nt.launcher
     2drop handle>> duplicate-handle ;
 
 : redirect-stream ( stream access-mode create-mode -- handle )
-    >r >r underlying-handle handle>> r> r> redirect-handle ;
+    [ underlying-handle handle>> ] 2dip redirect-handle ;
 
 : redirect ( obj access-mode create-mode -- handle )
     {

basis/io/windows/nt/privileges/privileges.factor

@@ -20,12 +20,12 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
 
 : with-process-token ( quot -- )
     #! quot: ( token-handle -- token-handle )
-    >r open-process-token r>
+    [ open-process-token ] dip
     [ keep ] curry
     [ CloseHandle drop ] [ ] cleanup ; inline
 
 : lookup-privilege ( string -- luid )
-    >r f r> "LUID" <c-object>
+    [ f ] dip "LUID" <c-object>
     [ LookupPrivilegeValue win32-error=0/f ] keep ;
 
 : make-token-privileges ( name ? -- obj )
@@ -39,10 +39,10 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
         set-LUID_AND_ATTRIBUTES-Attributes
     ] when
 
-    >r lookup-privilege r>
+    [ lookup-privilege ] dip
     [
         TOKEN_PRIVILEGES-Privileges
-        >r 0 r> LUID_AND_ATTRIBUTES-nth
+        [ 0 ] dip LUID_AND_ATTRIBUTES-nth
         set-LUID_AND_ATTRIBUTES-Luid
     ] keep ;
 

basis/io/windows/nt/sockets/sockets.factor

@@ -176,8 +176,8 @@ TUPLE: WSASendTo-args port
 
 : make-send-buffer ( packet -- WSABUF )
     "WSABUF" malloc-object &free
-    [ >r malloc-byte-array &free r> set-WSABUF-buf ]
+    [ [ malloc-byte-array &free ] dip set-WSABUF-buf ]
-    [ >r length r> set-WSABUF-len ]
+    [ [ length ] dip set-WSABUF-len ]
     [ nip ]
     2tri ; inline
 
@@ -186,8 +186,8 @@ TUPLE: WSASendTo-args port
         swap >>port
         dup port>> handle>> handle>> >>s
         swap make-sockaddr/size
-            >r malloc-byte-array &free
+            [ malloc-byte-array &free ] dip
-            r> [ >>lpTo ] [ >>iToLen ] bi*
+            [ >>lpTo ] [ >>iToLen ] bi*
         swap make-send-buffer >>lpBuffers
         1 >>dwBufferCount
         0 >>dwFlags

basis/io/windows/sockets/sockets.factor

@@ -20,21 +20,21 @@ M: win32-socket dispose ( stream -- )
     <win32-socket> |dispose dup add-completion ;
 
 : open-socket ( addrspec type -- win32-socket )
-    >r protocol-family r>
+    [ protocol-family ] dip
     0 f 0 WSASocket-flags WSASocket
     dup socket-error
     opened-socket ;
 
 M: object (get-local-address) ( socket addrspec -- sockaddr )
-    >r handle>> r> empty-sockaddr/size <int>
+    [ handle>> ] dip empty-sockaddr/size <int>
     [ getsockname socket-error ] 2keep drop ;
 
 M: object (get-remote-address) ( socket addrspec -- sockaddr )
-    >r handle>> r> empty-sockaddr/size <int>
+    [ handle>> ] dip empty-sockaddr/size <int>
     [ getpeername socket-error ] 2keep drop ;
 
 : bind-socket ( win32-socket sockaddr len -- )
-    >r >r handle>> r> r> bind socket-error ;
+    [ handle>> ] 2dip bind socket-error ;
 
 M: object ((client)) ( addrspec -- handle )
     [ SOCK_STREAM open-socket ] keep

basis/io/windows/windows.factor

@@ -8,7 +8,8 @@ splitting continuations math.bitwise system accessors ;
 IN: io.windows
 
 : set-inherit ( handle ? -- )
-    >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
+    [ HANDLE_FLAG_INHERIT ] dip
+    >BOOLEAN SetHandleInformation win32-error=0/f ;
 
 TUPLE: win32-handle handle disposed ;
 

basis/models/range/range.factor

@@ -6,7 +6,7 @@ IN: models.range
 
 TUPLE: range < compose ;
 
-: <range> ( value min max page -- range )
+: <range> ( value page min max -- range )
     4array [ <model> ] map range new-compose ;
 
 : range-model ( range -- model ) dependencies>> first ;

basis/qualified/qualified-docs.factor

@@ -4,14 +4,21 @@ IN: qualified
 HELP: QUALIFIED:
 { $syntax "QUALIFIED: vocab" }
 { $description "Similar to " { $link POSTPONE: USE: } " but loads vocabulary with prefix." }
-{ $examples { $code
+{ $examples { $example
-    "QUALIFIED: math\n1 2 math:+ ! ==> 3" } } ;
+    "USING: prettyprint qualified ;"
+    "QUALIFIED: math"
+    "1 2 math:+ ." "3"
+} } ;
 
 HELP: QUALIFIED-WITH:
 { $syntax "QUALIFIED-WITH: vocab word-prefix" }
 { $description "Works like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." }
 { $examples { $code
-    "QUALIFIED-WITH: math m\n1 2 m:+ ! ==> 3" } } ;
+    "USING: prettyprint qualified ;"
+    "QUALIFIED-WITH: math m"
+    "1 2 m:+ ."
+    "3"
+} } ;
 
 HELP: FROM:
 { $syntax "FROM: vocab => words ... ;" }
@@ -28,9 +35,12 @@ HELP: EXCLUDE:
 HELP: RENAME:
 { $syntax "RENAME: word vocab => newname " }
 { $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "newname" } "." }
-{ $examples { $code
+{ $examples { $example
+    "USING: prettyprint qualified ;"
     "RENAME: + math => -"
-    "2 3 - ! => 5" } } ;
+    "2 3 - ."
+    "5"
+} } ;
 
 ARTICLE: "qualified" "Qualified word lookup"
 "The " { $vocab-link "qualified" } " vocabulary provides a handful of parsing words which give more control over word lookup than is offered by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } "."

basis/tools/deploy/shaker/shaker.factor

@@ -23,10 +23,8 @@ IN: tools.deploy.shaker
 
 : strip-init-hooks ( -- )
     "Stripping startup hooks" show
-    "cpu.x86" init-hooks get delete-at
+    { "cpu.x86" "command-line" "libc" "system" "environment" }
-    "command-line" init-hooks get delete-at
+    [ init-hooks get delete-at ] each
-    "libc" init-hooks get delete-at
-    "system" init-hooks get delete-at
     deploy-threads? get [
         "threads" init-hooks get delete-at
     ] unless

basis/tools/scaffold/scaffold.factor

@@ -17,23 +17,17 @@ ERROR: no-vocab vocab ;
 
 <PRIVATE
 
-: root? ( string -- ? ) vocab-roots get member?  ;
+: root? ( string -- ? ) vocab-roots get member? ;
 
-: length-changes? ( seq quot -- ? )
+: contains-dot? ( string -- ? ) ".." swap subseq? ;
-    dupd call [ length ] bi@ = not ; inline
+
+: contains-separator? ( string -- ? ) [ path-separator? ] contains? ;
 
 : check-vocab-name ( string -- string )
-    dup [ [ CHAR: . = ] trim ] length-changes?
+    dup contains-dot? [ vocab-name-contains-dot ] when
-    [ vocab-name-contains-dot ] when
+    dup contains-separator? [ vocab-name-contains-separator ] when ;
-
-    ".." over subseq? [ vocab-name-contains-dot ] when
-
-    dup [ path-separator? ] contains?
-    [ vocab-name-contains-separator ] when ;
 
 : check-root ( string -- string )
-    check-vocab-name
-    dup "resource:" head? [ "resource:" prepend ] unless
     dup root? [ not-a-vocab-root ] unless ;
 
 : directory-exists ( path -- )

basis/ui/gadgets/editors/editors.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays documents io kernel math models
+USING: accessors arrays documents kernel math models
 namespaces locals fry make opengl opengl.gl sequences strings
 io.styles math.vectors sorting colors combinators assocs
 math.order fry calendar alarms ui.clipboards ui.commands
@@ -218,7 +218,7 @@ M: editor ungraft*
     ] with-editor-translation ;
 
 : selection-start/end ( editor -- start end )
-    dup editor-mark* swap editor-caret* sort-pair ;
+    [ editor-mark* ] [ editor-caret* ] bi sort-pair ;
 
 : (draw-selection) ( x1 x2 -- )
     over -
@@ -227,9 +227,8 @@ M: editor ungraft*
     swap [ gl-fill-rect ] with-translation ;
 
 : draw-selected-line ( start end n -- )
-    [ start/end-on-line ] keep tuck
+    [ start/end-on-line ] keep
-    [ editor get offset>x ] 2dip
+    tuck [ editor get offset>x ] 2bi@
-    editor get offset>x
     (draw-selection) ;
 
 : draw-selection ( -- )
@@ -237,9 +236,9 @@ M: editor ungraft*
     editor get selection-start/end
     over first [
         2dup [
-            [ 2dup ] dip draw-selected-line
+            draw-selected-line
             1 translate-lines
-        ] each-line 2drop
+        ] with with each-line
     ] with-editor-translation ;
 
 M: editor draw-gadget*

basis/ui/windows/windows.factor

@@ -284,13 +284,9 @@ SYMBOL: nc-buttons
     message>button nc-buttons get
     swap [ push ] [ delete ] if ;
 
-: >lo-hi ( WORD -- array ) [ lo-word ] keep hi-word 2array ;
+: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ;
-: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
 
-: mouse-absolute>relative ( lparam handle -- array )
+: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
-    [ >lo-hi ] dip
-    "RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep
-    get-RECT-top-left 2array v- ;
 
 : mouse-event>gesture ( uMsg -- button )
     key-modifiers swap message>button
@@ -340,9 +336,7 @@ SYMBOL: nc-buttons
     >lo-hi swap window move-hand fire-motion ;
 
 :: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
-    wParam mouse-wheel
+    wParam mouse-wheel hand-loc get hWnd window send-wheel ;
-    lParam hWnd mouse-absolute>relative
-    hWnd window send-wheel ;
 
 : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
     #! message sent if windows needs application to stop dragging

basis/ui/x11/x11.factor

@@ -117,7 +117,7 @@ M: world button-up-event
     } at ;
 
 M: world wheel-event
-    [ dup mouse-event>scroll-direction swap mouse-event-loc ] dip
+    [ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip
     send-wheel ;
 
 M: world enter-event motion-event ;
@@ -125,7 +125,7 @@ M: world enter-event motion-event ;
 M: world leave-event 2drop forget-rollover ;
 
 M: world motion-event
-    [ dup XMotionEvent-x swap XMotionEvent-y 2array ] dip
+    [ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip
     move-hand fire-motion ;
 
 M: world focus-in-event
@@ -146,10 +146,10 @@ M: world selection-notify-event
 
 : clipboard-for-atom ( atom -- clipboard )
     {
-        { [ dup XA_PRIMARY = ] [ drop selection get ] }
+        { XA_PRIMARY [ selection get ] }
-        { [ dup XA_CLIPBOARD = ] [ drop clipboard get ] }
+        { XA_CLIPBOARD [ clipboard get ] }
         [ drop <clipboard> ]
-    } cond ;
+    } case ;
 
 : encode-clipboard ( string type -- bytes )
     XSelectionRequestEvent-target

basis/unix/statfs/freebsd/freebsd.factor

@@ -1,53 +1,4 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel unix math accessors
+USING: alien.syntax ;
-combinators system io.backend alien.c-types unix.statfs 
-io.files ;
 IN: unix.statfs.freebsd
-
-: ST_RDONLY       1 ; inline
-: ST_NOSUID       2 ; inline
-
-C-STRUCT: statvfs               
-    { "fsblkcnt_t" "f_bavail" }
-    { "fsblkcnt_t" "f_bfree" }
-    { "fsblkcnt_t" "f_blocks" }
-    { "fsfilcnt_t" "f_favail" }
-    { "fsfilcnt_t" "f_ffree" }
-    { "fsfilcnt_t" "f_files" }
-    { "ulong" "f_bsize" }
-    { "ulong" "f_flag" }
-    { "ulong" "f_frsize" }
-    { "ulong" "f_fsid" }
-    { "ulong" "f_namemax" } ;
-
-FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
-
-TUPLE: freebsd-file-system-info < file-system-info
-bavail bfree blocks favail ffree files
-bsize flag frsize fsid namemax ;
-
-M: freebsd >file-system-info ( struct -- statfs )
-    [ \ freebsd-file-system-info new ] dip
-    {
-        [
-            [ statvfs-f_bsize ]
-            [ statvfs-f_bavail ] bi * >>free-space
-        ]
-        [ statvfs-f_bavail >>bavail ]
-        [ statvfs-f_bfree >>bfree ]
-        [ statvfs-f_blocks >>blocks ]
-        [ statvfs-f_favail >>favail ]
-        [ statvfs-f_ffree >>ffree ]
-        [ statvfs-f_files >>files ]
-        [ statvfs-f_bsize >>bsize ]
-        [ statvfs-f_flag >>flag ]
-        [ statvfs-f_frsize >>frsize ]
-        [ statvfs-f_fsid >>fsid ]
-        [ statvfs-f_namemax >>namemax ]
-    } cleave ;
-
-M: freebsd file-system-info ( path -- byte-array )
-    normalize-path
-    "statvfs" <c-object> tuck statvfs io-error
-    >file-system-info ;

basis/unix/statfs/linux/32/32.factor

@@ -1,46 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types combinators kernel unix.stat
-math accessors system unix io.backend layouts vocabs.loader
-alien.syntax unix.statfs io.files ;
-IN: unix.statfs.linux
-
-C-STRUCT: statfs
-    { "long"    "f_type" }
-    { "long"    "f_bsize" }
-    { "long"    "f_blocks" }
-    { "long"    "f_bfree" }
-    { "long"    "f_bavail" }
-    { "long"    "f_files" }
-    { "long"    "f_ffree" }
-    { "fsid_t"  "f_fsid" }
-    { "long"    "f_namelen" } ;
-
-FUNCTION: int statfs ( char* path, statfs* buf ) ;
-
-TUPLE: linux32-file-system-info < file-system-info
-bsize blocks bfree bavail files ffree fsid namelen
-frsize spare ;
-
-M: linux >file-system-info ( struct -- statfs )
-    [ \ linux32-file-system-info new ] dip
-    {
-        [
-            [ statfs-f_bsize ]
-            [ statfs-f_bavail ] bi * >>free-space
-        ]
-        [ statfs-f_type >>type ]
-        [ statfs-f_bsize >>bsize ]
-        [ statfs-f_blocks >>blocks ]
-        [ statfs-f_bfree >>bfree ]
-        [ statfs-f_bavail >>bavail ]
-        [ statfs-f_files >>files ]
-        [ statfs-f_ffree >>ffree ]
-        [ statfs-f_fsid >>fsid ]
-        [ statfs-f_namelen >>namelen ]
-    } cleave ;
-
-M: linux file-system-info ( path -- byte-array )
-    normalize-path
-    "statfs" <c-object> tuck statfs io-error
-    >file-system-info ;

basis/unix/statfs/linux/32/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/unix/statfs/linux/64/64.factor

@@ -1,50 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types combinators kernel unix.stat
-math accessors system unix io.backend layouts vocabs.loader
-alien.syntax unix.statfs io.files ;
-IN: unix.statfs.linux
-
-C-STRUCT: statfs64
-    { "__SWORD_TYPE" "f_type" }
-    { "__SWORD_TYPE" "f_bsize" }
-    { "__fsblkcnt64_t" "f_blocks" }
-    { "__fsblkcnt64_t" "f_bfree" }
-    { "__fsblkcnt64_t" "f_bavail" }
-    { "__fsfilcnt64_t" "f_files" }
-    { "__fsfilcnt64_t" "f_ffree" }
-    { "__fsid_t" "f_fsid" }
-    { "__SWORD_TYPE" "f_namelen" }
-    { "__SWORD_TYPE" "f_frsize" }
-    { { "__SWORD_TYPE" 5 } "f_spare" } ;
-
-FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
-
-TUPLE: linux64-file-system-info < file-system-info
-bsize blocks bfree bavail files ffree fsid namelen
-frsize spare ;
-
-M: linux >file-system-info ( struct -- statfs )
-    [ \ linux64-file-system-info new ] dip
-    {
-        [
-            [ statfs64-f_bsize ]
-            [ statfs64-f_bavail ] bi * >>free-space
-        ]
-        [ statfs64-f_type >>type ]
-        [ statfs64-f_bsize >>bsize ]
-        [ statfs64-f_blocks >>blocks ]
-        [ statfs64-f_bfree >>bfree ]
-        [ statfs64-f_bavail >>bavail ]
-        [ statfs64-f_files >>files ]
-        [ statfs64-f_ffree >>ffree ]
-        [ statfs64-f_fsid >>fsid ]
-        [ statfs64-f_namelen >>namelen ]
-        [ statfs64-f_frsize >>frsize ]
-        [ statfs64-f_spare >>spare ]
-    } cleave ;
-
-M: linux file-system-info ( path -- byte-array )
-    normalize-path
-    "statfs64" <c-object> tuck statfs64 io-error
-    >file-system-info ;

basis/unix/statfs/linux/64/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/unix/statfs/linux/linux.factor

@@ -1,43 +1,19 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types combinators kernel unix.stat
+USING: alien.syntax ;
-math accessors system unix io.backend layouts vocabs.loader
-sequences csv io.streams.string io.encodings.utf8 namespaces
-unix.statfs io.files ;
 IN: unix.statfs.linux
 
-cell-bits {
+C-STRUCT: statfs64
-    { 32 [ "unix.statfs.linux.32" require ] }
+    { "__SWORD_TYPE" "f_type" }
-    { 64 [ "unix.statfs.linux.64" require ] }
+    { "__SWORD_TYPE" "f_bsize" }
-} case
+    { "__fsblkcnt64_t" "f_blocks" }
+    { "__fsblkcnt64_t" "f_bfree" }
+    { "__fsblkcnt64_t" "f_bavail" }
+    { "__fsfilcnt64_t" "f_files" }
+    { "__fsfilcnt64_t" "f_ffree" }
+    { "__fsid_t" "f_fsid" }
+    { "__SWORD_TYPE" "f_namelen" }
+    { "__SWORD_TYPE" "f_frsize" }
+    { { "__SWORD_TYPE" 5 } "f_spare" } ;
 
-TUPLE: mtab-entry file-system-name mount-point type options
+FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
-frequency pass-number ;
-
-: mtab-csv>mtab-entry ( csv -- mtab-entry )
-    [ mtab-entry new ] dip
-    {
-        [ first >>file-system-name ]
-        [ second >>mount-point ]
-        [ third >>type ]
-        [ fourth <string-reader> csv first >>options ]
-        [ 4 swap nth >>frequency ]
-        [ 5 swap nth >>pass-number ]
-    } cleave ;
-
-: parse-mtab ( -- array )
-    [
-        "/etc/mtab" utf8 <file-reader>
-        CHAR: \s delimiter set csv
-    ] with-scope
-    [ mtab-csv>mtab-entry ] map ;
-
-M: linux file-systems
-    parse-mtab [
-        [ mount-point>> file-system-info ] keep
-        {
-            [ file-system-name>> >>device-name ]
-            [ mount-point>> >>mount-point ]
-            [ type>> >>type ]
-        } cleave
-    ] map ;

basis/unix/statfs/macosx/macosx.factor

@@ -3,7 +3,7 @@
 USING: alien.c-types io.encodings.utf8 io.encodings.string
 kernel sequences unix.stat accessors unix combinators math
 grouping system unix.statfs io.files io.backend alien.strings
-math.bitwise alien.syntax ;
+math.bitwise alien.syntax io.unix.files ;
 IN: unix.statfs.macosx
 
 : MNT_RDONLY  HEX: 00000001 ; inline
@@ -116,50 +116,3 @@ C-STRUCT: statfs64
 
 FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
 FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;
-
-
-TUPLE: macosx-file-system-info < file-system-info
-block-size io-size blocks blocks-free blocks-available files
-files-free file-system-id owner type-id flags filesystem-subtype ;
-
-M: macosx file-systems ( -- array )
-    f <void*> dup 0 getmntinfo64 dup io-error
-    [ *void* ] dip
-    "statfs64" heap-size [ * memory>byte-array ] keep group
-    [ >file-system-info ] map ;
-
-M: macosx >file-system-info ( byte-array -- file-system-info )
-    [ \ macosx-file-system-info new ] dip
-    {
-        [
-            [ statfs64-f_bavail ] [ statfs64-f_bsize ] bi *
-            >>free-space
-        ]
-        [ statfs64-f_mntonname utf8 alien>string >>mount-point ]
-        [ statfs64-f_bsize >>block-size ]
-
-        [ statfs64-f_iosize >>io-size ]
-        [ statfs64-f_blocks >>blocks ]
-        [ statfs64-f_bfree >>blocks-free ]
-        [ statfs64-f_bavail >>blocks-available ]
-        [ statfs64-f_files >>files ]
-        [ statfs64-f_ffree >>files-free ]
-        [ statfs64-f_fsid >>file-system-id ]
-        [ statfs64-f_owner >>owner ]
-        [ statfs64-f_type >>type-id ]
-        [ statfs64-f_flags >>flags ]
-        [ statfs64-f_fssubtype >>filesystem-subtype ]
-        [
-            statfs64-f_fstypename utf8 alien>string
-            >>type
-        ]
-        [
-            statfs64-f_mntfromname
-            utf8 alien>string >>device-name
-        ]
-    } cleave ;
-
-M: macosx file-system-info ( path -- file-system-info )
-    normalize-path
-    "statfs64" <c-object> tuck statfs64 io-error
-    >file-system-info ;

basis/unix/statfs/netbsd/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/unix/statfs/netbsd/netbsd.factor

@@ -1,78 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel unix.stat math unix
-combinators system io.backend accessors alien.c-types
-io.encodings.utf8 alien.strings unix.types unix.statfs io.files ;
-IN: unix.statfs.netbsd
-
-: _VFS_NAMELEN    32   ; inline
-: _VFS_MNAMELEN   1024 ; inline
-
-C-STRUCT: statvfs
-    { "ulong"   "f_flag" }   
-    { "ulong"   "f_bsize" }
-    { "ulong"   "f_frsize" }  
-    { "ulong"   "f_iosize" }  
-    { "fsblkcnt_t" "f_blocks" }       
-    { "fsblkcnt_t" "f_bfree" } 
-    { "fsblkcnt_t" "f_bavail" }       
-    { "fsblkcnt_t" "f_bresvd" }       
-    { "fsfilcnt_t" "f_files" }
-    { "fsfilcnt_t" "f_ffree" }
-    { "fsfilcnt_t" "f_favail" }       
-    { "fsfilcnt_t" "f_fresvd" }       
-    { "uint64_t"   "f_syncreads" }    
-    { "uint64_t"   "f_syncwrites" }   
-    { "uint64_t"   "f_asyncreads" }   
-    { "uint64_t"   "f_asyncwrites" }  
-    { "fsid_t"    "f_fsidx" }
-    { "ulong"   "f_fsid" }
-    { "ulong"   "f_namemax" }      
-    { "uid_t"   "f_owner" }
-    { { "uint32_t" 4 } "f_spare" }     
-    { { "char" _VFS_NAMELEN } "f_fstypename" }
-    { { "char" _VFS_MNAMELEN } "f_mntonname" }
-    { { "char" _VFS_MNAMELEN } "f_mntfromname" } ;
-
-FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
-
-TUPLE: netbsd-file-system-info < file-system-info
-flag bsize frsize io-size
-blocks blocks-free blocks-available blocks-reserved
-files ffree sync-reads sync-writes async-reads async-writes
-fsidx fsid namemax owner spare fstype mnotonname mntfromname
-file-system-type-name mount-from ;
-
-M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info )
-    [ \ netbsd-file-system-info new ] dip
-    {
-        [
-            [ statvfs-f_bsize ]
-            [ statvfs-f_bavail ] bi * >>free-space
-        ]
-        [ statvfs-f_flag >>flag ]
-        [ statvfs-f_bsize >>bsize ]
-        [ statvfs-f_frsize >>frsize ]
-        [ statvfs-f_iosize >>io-size ]
-        [ statvfs-f_blocks >>blocks ]
-        [ statvfs-f_bfree >>blocks-free ]
-        [ statvfs-f_favail >>blocks-available ]
-        [ statvfs-f_fresvd >>blocks-reserved ]
-        [ statvfs-f_files >>files ]
-        [ statvfs-f_ffree >>ffree ]
-        [ statvfs-f_syncreads >>sync-reads ]
-        [ statvfs-f_syncwrites >>sync-writes ]
-        [ statvfs-f_asyncreads >>async-reads ]
-        [ statvfs-f_asyncwrites >>async-writes ]
-        [ statvfs-f_fsidx >>fsidx ]
-        [ statvfs-f_namemax >>namemax ]
-        [ statvfs-f_owner >>owner ]
-        [ statvfs-f_spare >>spare ]
-        [ statvfs-f_fstypename utf8 alien>string >>file-system-type-name ]
-        [ statvfs-f_mntonname utf8 alien>string >>mount-point ]
-        [ statvfs-f_mntfromname utf8 alien>string >>mount-from ]
-    } cleave ;
-
-M: netbsd file-system-info
-    normalize-path "statvfs" <c-object> tuck statvfs io-error 
-    >file-system-info ;

basis/unix/statfs/openbsd/32/32.factor

@@ -1,26 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel unix ; 
-IN: unix.statfs.openbsd.32
-
-: MFSNAMELEN 16 ; inline
-: MNAMELEN 90 ; inline
-
-C-STRUCT: statfs
-    { "u_int32_t"  "f_flags" }
-    { "int32_t"    "f_bsize" }
-    { "u_int32_t"  "f_iosize" }
-    { "u_int32_t"  "f_blocks" }
-    { "u_int32_t"  "f_bfree" }
-    { "int32_t"    "f_bavail" }
-    { "u_int32_t"  "f_files" }
-    { "u_int32_t"  "f_ffree" }
-    { "fsid_t"     "f_fsid" }
-    { "uid_t"      "f_owner" }
-    { "u_int32_t"  "f_syncwrites" }
-    { "u_int32_t"  "f_asyncwrites" }
-    { "u_int32_t"  "f_ctime" }
-    { { "u_int32_t" 3 }  "f_spare" }
-    { { "char" MFSNAMELEN } "f_fstypename" }
-    { { "char" MNAMELEN }   "f_mntonname" }  
-    { { "char" MNAMELEN }   "f_mntfromname" } ;

basis/unix/statfs/openbsd/32/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/unix/statfs/openbsd/64/64.factor

@@ -1,32 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix ;
-IN: unix.statfs.openbsd.64
-
-: MFSNAMELEN 16 ; inline
-: MNAMELEN 90 ; inline
-
-C-STRUCT: statfss
-    { "u_int32_t"      "f_flags" }
-    { "u_int32_t"      "f_bsize" }
-    { "u_int32_t"      "f_iosize" }
-    { "u_int64_t"      "f_blocks" }
-    { "u_int64_t"      "f_bfree" }
-    { "int64_t"        "f_bavail" }
-    { "u_int64_t"      "f_files" }
-    { "u_int64_t"      "f_ffree" }
-    { "int64_t"        "f_favail" }
-    { "u_int64_t"      "f_syncwrites" }
-    { "u_int64_t"      "f_syncreads" }
-    { "u_int64_t"      "f_asyncwrites" }
-    { "u_int64_t"      "f_asyncreads" }
-    { "fsid_t"         "f_fsid" }
-    { "u_int32_t"      "f_namemax" }
-    { "uid_t"          "f_owner" }
-    { "u_int32_t"      "f_ctime" }
-    { { "u_int32_t" 3 } " f_spare" }
-    { { "char" MFSNAMELEN } "f_fstypename" }
-    { { "char" MNAMELEN } "f_mntonname" }
-    { { "char" MNAMELEN } "f_mntfromname" }
-    { { "char" 512 } "mount_info" } ;
-    ! { "mount_info" "mount_info" } ;                                        

basis/unix/statfs/openbsd/64/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/unix/statfs/openbsd/authors.txt

@@ -1 +0,0 @@
-Doug Coleman

basis/unix/statfs/openbsd/openbsd.factor

@@ -1,53 +1,33 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax accessors combinators kernel
+USING: alien.syntax ;
-unix.types math system io.backend alien.c-types unix
-unix.statfs io.files ;
 IN: unix.statfs.openbsd
 
-C-STRUCT: statvfs
+: MFSNAMELEN 16 ; inline
-    { "ulong" "f_bsize" }
+: MNAMELEN 90 ; inline
-    { "ulong" "f_frsize" }
-    { "fsblkcnt_t" "f_blocks" }
-    { "fsblkcnt_t" "f_bfree" }
-    { "fsblkcnt_t" "f_bavail" }
-    { "fsfilcnt_t" "f_files" }
-    { "fsfilcnt_t" "f_ffree" }
-    { "fsfilcnt_t" "f_favail" }
-    { "ulong" "f_fsid" }
-    { "ulong" "f_flag" }
-    { "ulong" "f_namemax" } ;
 
-: ST_RDONLY       1 ; inline
+C-STRUCT: statfs
-: ST_NOSUID       2 ; inline
+    { "u_int32_t"       "f_flags" }
+    { "u_int32_t"       "f_bsize" }
+    { "u_int32_t"       "f_iosize" }
+    { "u_int64_t"       "f_blocks" }
+    { "u_int64_t"       "f_bfree" }
+    { "int64_t"         "f_bavail" }
+    { "u_int64_t"       "f_files" }
+    { "u_int64_t"       "f_ffree" }
+    { "int64_t"         "f_favail" }
+    { "u_int64_t"       "f_syncwrites" }
+    { "u_int64_t"       "f_syncreads" }
+    { "u_int64_t"       "f_asyncwrites" }
+    { "u_int64_t"       "f_asyncreads" }
+    { "fsid_t"          "f_fsid" }
+    { "u_int32_t"       "f_namemax" }
+    { "uid_t"           "f_owner" }
+    { "u_int32_t"       "f_ctime" }
+    { { "u_int32_t" 3 } "f_spare" }
+    { { "char" MFSNAMELEN } "f_fstypename" }
+    { { "char" MNAMELEN } "f_mntonname" }
+    { { "char" MNAMELEN } "f_mntfromname" } ;
+    ! { "mount_info" "mount_info" } ;
 
-FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statfs ( char* path, statvfs* buf ) ;
-
-TUPLE: openbsd-file-system-info < file-system-info
-bsize frsize blocks bfree bavail files ffree favail
-fsid flag namemax ;
-
-M: openbsd >file-system-info ( struct -- statfs )
-    [ \ openbsd-file-system-info new ] dip
-    {
-        [
-            [ statvfs-f_bsize ]
-            [ statvfs-f_bavail ] bi * >>free-space
-        ]
-        [ statvfs-f_bsize >>bsize ]
-        [ statvfs-f_frsize >>frsize ]
-        [ statvfs-f_blocks >>blocks ]
-        [ statvfs-f_bfree >>bfree ]
-        [ statvfs-f_bavail >>bavail ]
-        [ statvfs-f_files >>files ]
-        [ statvfs-f_ffree >>ffree ]
-        [ statvfs-f_favail >>favail ]
-        [ statvfs-f_fsid >>fsid ]
-        [ statvfs-f_flag >>flag ]
-        [ statvfs-f_namemax >>namemax ]
-    } cleave ;
-
-M: openbsd file-system-info ( path -- byte-array )
-    normalize-path
-    "statvfs" <c-object> tuck statvfs io-error
-    >file-system-info ;

basis/unix/statfs/statfs.factor

@@ -4,12 +4,10 @@ USING: sequences system vocabs.loader combinators accessors
 kernel math.order sorting ;
 IN: unix.statfs
 
-HOOK: >file-system-info os ( struct -- statfs )
-
 os {
     { linux   [ "unix.statfs.linux"   require ] }
     { macosx  [ "unix.statfs.macosx"  require ] }
     { freebsd [ "unix.statfs.freebsd" require ] }
-    { netbsd  [ "unix.statfs.netbsd"  require ] }
     { openbsd [ "unix.statfs.openbsd" require ] }
+    { netbsd  [ ] }
 } case

basis/unix/statvfs/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statvfs/freebsd/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statvfs/freebsd/freebsd.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax ;
+IN: unix.statvfs.freebsd
+
+C-STRUCT: statvfs
+    { "fsblkcnt_t"  "f_bavail" }
+    { "fsblkcnt_t"  "f_bfree" }
+    { "fsblkcnt_t"  "f_blocks" }
+    { "fsfilcnt_t"  "f_favail" }
+    { "fsfilcnt_t"  "f_ffree" }
+    { "fsfilcnt_t"  "f_files" }
+    { "ulong"   "f_bsize" }
+    { "ulong"   "f_flag" }
+    { "ulong"   "f_frsize" }
+    { "ulong"   "f_fsid" }
+    { "ulong"   "f_namemax" } ;
+
+! Flags
+: ST_RDONLY   HEX: 1 ; inline ! Read-only file system
+: ST_NOSUID   HEX: 2 ; inline ! Does not honor setuid/setgid
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;

basis/unix/statvfs/freebsd/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/statvfs/linux/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statvfs/linux/linux.factor

@@ -0,0 +1,31 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax ;
+IN: unix.statvfs.linux
+
+C-STRUCT: statvfs64
+    { "ulong" "f_bsize" }
+    { "ulong" "f_frsize" }
+    { "__fsblkcnt64_t" "f_blocks" }
+    { "__fsblkcnt64_t" "f_bfree" }
+    { "__fsblkcnt64_t" "f_bavail" }
+    { "__fsfilcnt64_t" "f_files" }
+    { "__fsfilcnt64_t" "f_ffree" }
+    { "__fsfilcnt64_t" "f_favail" }
+    { "ulong" "f_fsid" }
+    { "ulong" "f_flag" }
+    { "ulong" "f_namemax" }
+    { { "int" 6 } "__f_spare" } ;
+
+FUNCTION: int statvfs64 ( char* path, statvfs64* buf ) ;
+
+: ST_RDONLY 1 ; inline        ! Mount read-only.
+: ST_NOSUID 2 ; inline        ! Ignore suid and sgid bits.
+: ST_NODEV 4 ; inline         ! Disallow access to device special files.
+: ST_NOEXEC 8 ; inline        ! Disallow program execution.
+: ST_SYNCHRONOUS 16 ; inline  ! Writes are synced at once.
+: ST_MANDLOCK 64 ; inline     ! Allow mandatory locks on an FS.
+: ST_WRITE 128 ; inline       ! Write on file/directory/symlink.
+: ST_APPEND 256 ; inline      ! Append-only file.
+: ST_IMMUTABLE 512 ; inline   ! Immutable file.
+: ST_NOATIME 1024 ; inline    ! Do not update access times.

basis/unix/statvfs/linux/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/statvfs/macosx/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statvfs/macosx/macosx.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax ;
+IN: unix.statvfs.macosx
+
+C-STRUCT: statvfs
+    { "ulong"   "f_bsize" }
+    { "ulong"   "f_frsize" }
+    { "fsblkcnt_t"  "f_blocks" }
+    { "fsblkcnt_t"  "f_bfree" }
+    { "fsblkcnt_t"  "f_bavail" }
+    { "fsfilcnt_t"  "f_files" }
+    { "fsfilcnt_t"  "f_ffree" }
+    { "fsfilcnt_t"  "f_favail" }
+    { "ulong"   "f_fsid" }
+    { "ulong"   "f_flag" }
+    { "ulong"   "f_namemax" } ;
+
+! Flags
+: ST_RDONLY   HEX: 1 ; inline ! Read-only file system
+: ST_NOSUID   HEX: 2 ; inline ! Does not honor setuid/setgid
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;

basis/unix/statvfs/macosx/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/statvfs/netbsd/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statvfs/netbsd/netbsd.factor

@@ -0,0 +1,35 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax ;
+IN: unix.statvfs.netbsd
+
+: _VFS_NAMELEN    32   ; inline
+: _VFS_MNAMELEN   1024 ; inline
+
+C-STRUCT: statvfs
+    { "ulong"   "f_flag" }   
+    { "ulong"   "f_bsize" }
+    { "ulong"   "f_frsize" }  
+    { "ulong"   "f_iosize" }  
+    { "fsblkcnt_t" "f_blocks" }       
+    { "fsblkcnt_t" "f_bfree" } 
+    { "fsblkcnt_t" "f_bavail" }       
+    { "fsblkcnt_t" "f_bresvd" }       
+    { "fsfilcnt_t" "f_files" }
+    { "fsfilcnt_t" "f_ffree" }
+    { "fsfilcnt_t" "f_favail" }       
+    { "fsfilcnt_t" "f_fresvd" }       
+    { "uint64_t"   "f_syncreads" }    
+    { "uint64_t"   "f_syncwrites" }   
+    { "uint64_t"   "f_asyncreads" }   
+    { "uint64_t"   "f_asyncwrites" }  
+    { "fsid_t"    "f_fsidx" }
+    { "ulong"   "f_fsid" }
+    { "ulong"   "f_namemax" }      
+    { "uid_t"   "f_owner" }
+    { { "uint32_t" 4 } "f_spare" }     
+    { { "char" _VFS_NAMELEN } "f_fstypename" }
+    { { "char" _VFS_MNAMELEN } "f_mntonname" }
+    { { "char" _VFS_MNAMELEN } "f_mntfromname" } ;
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;

basis/unix/statvfs/netbsd/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/statvfs/openbsd/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/unix/statvfs/openbsd/openbsd.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax ;
+IN: unix.statvfs.openbsd
+
+C-STRUCT: statvfs
+    { "ulong" "f_bsize" }
+    { "ulong" "f_frsize" }
+    { "fsblkcnt_t" "f_blocks" }
+    { "fsblkcnt_t" "f_bfree" }
+    { "fsblkcnt_t" "f_bavail" }
+    { "fsfilcnt_t" "f_files" }
+    { "fsfilcnt_t" "f_ffree" }
+    { "fsfilcnt_t" "f_favail" }
+    { "ulong" "f_fsid" }
+    { "ulong" "f_flag" }
+    { "ulong" "f_namemax" } ;
+
+: ST_RDONLY       1 ; inline
+: ST_NOSUID       2 ; inline
+
+FUNCTION: int statvfs ( char* path, statvfs* buf ) ;

basis/unix/statvfs/openbsd/tags.txt

@@ -0,0 +1 @@
+unportable

basis/unix/statvfs/statvfs.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators system vocabs.loader ;
+IN: unix.statvfs
+
+os {
+    { linux   [ "unix.statvfs.linux"   require ] }
+    { macosx  [ "unix.statvfs.macosx"  require ] }
+    { freebsd [ "unix.statvfs.freebsd" require ] }
+    { netbsd  [ "unix.statvfs.netbsd"  require ] }
+    { openbsd [ "unix.statvfs.openbsd" require ] }
+} case

basis/unix/statvfs/tags.txt

@@ -0,0 +1 @@
+unportable

basis/xmode/utilities/utilities.factor

@@ -1,30 +1,30 @@
 USING: accessors sequences assocs kernel quotations namespaces
-xml.data xml.utilities combinators macros parser lexer words ;
+xml.data xml.utilities combinators macros parser lexer words fry ;
 IN: xmode.utilities
 
-: implies >r not r> or ; inline
+: implies [ not ] dip or ; inline
 
 : child-tags ( tag -- seq ) children>> [ tag? ] filter ;
 
 : map-find ( seq quot -- result elt )
     f -rot
-    [ nip ] swap [ dup ] 3compose find
+    '[ nip @ dup ] find
-    >r [ drop f ] unless r> ; inline
+    [ [ drop f ] unless ] dip ; inline
 
 : tag-init-form ( spec -- quot )
     {
         { [ dup quotation? ] [ [ object get tag get ] prepose ] }
         { [ dup length 2 = ] [
-            first2 [
+            first2 '[
-                >r >r tag get children>string
+                tag get children>string
-                r> [ execute ] when* object get r> execute
+                _ [ execute ] when* object get _ execute
-            ] 2curry
+            ]
         ] }
         { [ dup length 3 = ] [
-            first3 [
+            first3 '[
-                >r >r tag get at
+                _ tag get at
-                r> [ execute ] when* object get r> execute
+                _ [ execute ] when* object get _ execute
-            ] 3curry
+            ]
         ] }
     } cond ;
 
@@ -36,7 +36,7 @@ MACRO: (init-from-tag) ( specs -- )
     [ with-tag-initializer ] curry ;
 
 : init-from-tag ( tag tuple specs -- tuple )
-    over >r (init-from-tag) r> ; inline
+    over [ (init-from-tag) ] dip ; inline
 
 SYMBOL: tag-handlers
 SYMBOL: tag-handler-word

core/io/files/files.factor

@@ -187,7 +187,8 @@ SYMBOL: +unknown+
 
 HOOK: file-systems os ( -- array )
 
-TUPLE: file-system-info device-name mount-point type free-space ;
+TUPLE: file-system-info device-name mount-point type
+available-space free-space used-space total-space ;
 
 HOOK: file-system-info os ( path -- file-system-info )
 

core/io/io.factor

@@ -65,7 +65,7 @@ SYMBOL: error-stream
 
 : with-streams ( input output quot -- )
     [ [ with-streams* ] 3curry ]
-    [ [ drop dispose dispose ] 3curry ] 3bi
+    [ drop [ [ dispose ] bi@ ] 2curry ] 3bi
     [ ] cleanup ; inline
 
 : tabular-output ( style quot -- )

core/kernel/kernel-docs.factor

@@ -578,18 +578,6 @@ HELP: prepose
 
 { compose prepose } related-words
 
-HELP: 3compose
-{ $values { "quot1" callable } { "quot2" callable } { "quot3" callable } { "compose" compose } }
-{ $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } ", " { $snippet "quot2" } " and then " { $snippet "quot3" } "." }
-{ $notes
-    "The following two lines are equivalent:"
-    { $code
-        "3compose call"
-        "3append call"
-    }
-    "However, " { $link 3compose } " runs in constant time, and the compiler is able to compile code which calls composed quotations."
-} ;
-
 HELP: dip
 { $values { "x" object } { "quot" quotation } }
 { $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." }
@@ -814,7 +802,6 @@ ARTICLE: "compositional-combinators" "Compositional combinators"
 { $subsection 3curry }
 { $subsection with }
 { $subsection compose }
-{ $subsection 3compose }
 { $subsection prepose }
 "Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ;
 

core/kernel/kernel.factor

@@ -179,9 +179,6 @@ GENERIC: boa ( ... class -- tuple )
 : prepose ( quot1 quot2 -- compose )
     swap compose ; inline
 
-: 3compose ( quot1 quot2 quot3 -- compose )
-    compose compose ; inline
-
 ! Booleans
 : not ( obj -- ? ) [ f ] [ t ] if ; inline
 

core/vocabs/loader/loader-docs.factor

@@ -66,7 +66,7 @@ HELP: vocab-roots
 { $var-description "A sequence of pathname strings to search for vocabularies." } ;
 
 HELP: add-vocab-root
-{ $values { "path" "a pathname string" } }
+{ $values { "root" "a pathname string" } }
 { $description "Adds a directory pathname to the list of vocabulary roots." }
 { $see-also "factor-roots" } ;
 

extra/benchmark/xml/xml.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.utf8 io.files kernel sequences xml ;
+IN: benchmark.xml
+
+: xml-benchmark ( -- )
+    "resource:basis/xmode/modes/" [
+        [ utf8 <file-reader> read-xml drop ] each
+    ] with-directory-files ;
+
+MAIN: xml-benchmark

extra/boids/boids.factor

@@ -25,7 +25,7 @@ USING: kernel
        ui.render
        multi-methods
        multi-method-syntax
-       combinators.short-circuit.smart       
+       combinators.short-circuit
        processing.shapes
        flatland ;
 
@@ -86,7 +86,7 @@ TUPLE: <separation> < <behaviour> { radius initial: 25 } ;
       [ BEHAVIOUR view-angle>> in-view?   ]
       [ eq? not                           ]
     }
-  && ;
+  2&& ;
 
 :: neighborhood ( SELF OTHERS BEHAVIOUR -- boids )
   OTHERS [| OTHER | SELF OTHER BEHAVIOUR within-neighborhood? ] filter ;
@@ -154,7 +154,7 @@ M:  <boids-gadget> ungraft*     ( <boids-gadget> --     ) t >>paused drop  ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-M:: <boids-gadget> draw-gadget* ( BOIDS-GADGET -- )
+:: iterate-system ( BOIDS-GADGET -- )
 
   [let | SKY        [ BOIDS-GADGET gadget->sky   ]
          BOIDS      [ BOIDS-GADGET boids>>       ]
@@ -183,11 +183,14 @@ M:: <boids-gadget> draw-gadget* ( BOIDS-GADGET -- )
       
     map
 
-    BOIDS-GADGET (>>boids)
+    BOIDS-GADGET (>>boids) ] ;
 
-    origin get
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      [ BOIDS-GADGET boids>> [ draw-boid ] each ]
+
-    with-translation ] ;
+M:: <boids-gadget> draw-gadget* ( BOIDS-GADGET -- )
+  origin get
+    [ BOIDS-GADGET boids>> [ draw-boid ] each ]
+  with-translation ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -197,7 +200,7 @@ M:: <boids-gadget> draw-gadget* ( BOIDS-GADGET -- )
     [
       GADGET paused>>
         [ f ]
-        [ GADGET relayout-1 25 milliseconds sleep t ]
+        [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ]
       if
     ]
     loop

extra/combinators/lib/lib.factor

@@ -142,7 +142,7 @@ MACRO: multikeep ( word out-indexes -- ... )
     [ tuck 2slip ] dip while ; inline
 
 : generate ( generator predicate -- obj )
-    [ dup ] swap [ dup [ nip ] unless not ] 3compose
+    '[ dup @ dup [ nip ] unless not ]
     swap [ ] do-while ;
 
 MACRO: predicates ( seq -- quot/f )

extra/inverse/inverse.factor

@@ -5,7 +5,8 @@ sequences assocs math arrays stack-checker effects generalizations
 continuations debugger classes.tuple namespaces make vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
 sequences.private combinators mirrors
-combinators.short-circuit ;
+combinators.short-circuit fry qualified ;
+RENAME: _ fry => __
 IN: inverse
 
 TUPLE: fail ;
@@ -46,7 +47,7 @@ M: no-inverse summary
     dup word? [ "Badly formed math inverse" throw ] when 1quotation ;
 
 : swap-inverse ( math-inverse revquot -- revquot* quot )
-    next assure-constant rot second [ swap ] swap 3compose ;
+    next assure-constant rot second '[ @ swap @ ] ;
 
 : pull-inverse ( math-inverse revquot const -- revquot* quot )
     assure-constant rot first compose ;
@@ -236,8 +237,7 @@ DEFER: _
     ] recover ; inline
 
 : true-out ( quot effect -- quot' )
-    out>> [ ndrop ] curry
+    out>> '[ @ __ ndrop t ] ;
-    [ t ] 3compose ;
 
 : false-recover ( effect -- quot )
     in>> [ ndrop f ] curry [ recover-fail ] curry ;

extra/irc/gitbot/gitbot.factor

@@ -0,0 +1,55 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: fry irc.client irc.client.private kernel namespaces
+sequences threads io.encodings.8-bit io.launcher io splitting
+make mason.common mason.updates calendar math alarms ;
+IN: irc.gitbot
+
+: bot-profile ( -- obj )
+    "irc.freenode.org" 6667 "jackass" f <irc-profile> ;
+
+: bot-channel ( -- seq ) "#concatenative" ;
+
+GENERIC: handle-message ( msg -- )
+
+M: object handle-message drop ;
+
+: bot-loop ( chat -- )
+    dup hear handle-message bot-loop ;
+
+: start-bot ( -- chat )
+    bot-profile <irc-client>
+    [ connect-irc ]
+    [
+        [ bot-channel <irc-channel-chat> dup ] dip
+        '[ _ [ _ attach-chat ] [ bot-loop ] bi ]
+        "GitBot" spawn drop
+    ] bi ;
+
+: git-log ( from to -- lines )
+    [
+        "git-log" ,
+        "--no-merges" ,
+        "--pretty=format:%h %an: %s" ,
+        ".." swap 3append ,
+    ] { } make
+    latin1 [ input-stream get lines ] with-process-reader ;
+
+: updates ( from to -- lines )
+    git-log reverse
+    dup length 4 > [ 4 head "... and more" suffix ] when ;
+
+: report-updates ( from to chat -- )
+    [ updates ] dip
+    [ 1 seconds sleep ] swap
+    '[ _ speak ] interleave ;
+
+: check-for-updates ( chat -- )
+    [ git-id git-pull-cmd short-running-process git-id ] dip
+    report-updates ;
+
+: bot ( -- )
+    start-bot
+    '[ _ check-for-updates ] 5 minutes every drop ;
+
+MAIN: bot

extra/line-art/authors.txt

@@ -1 +0,0 @@
-Joe Groff

extra/line-art/summary.txt

@@ -1 +0,0 @@
-Stanford Bunny rendered with cartoon-style lines instead of shading

extra/line-art/tags.txt

@@ -1,3 +0,0 @@
-demos
-opengl
-glsl

extra/math/blas/cblas/cblas.factor

@@ -5,6 +5,7 @@ IN: math.blas.cblas
     { [ os macosx? ] [ "libblas.dylib" "cdecl" add-library ] }
     { [ os windows? ] [ "blas.dll" "cdecl" add-library ] }
     { [ os openbsd? ] [ "libcblas.so" "cdecl" add-library ] }
+    { [ os freebsd? ] [ "libcblas.so" "cdecl" add-library ] }
     [ "libblas.so" "cdecl" add-library ]
 } cond >>
 

extra/sequences/lib/lib.factor

@@ -5,7 +5,7 @@ USING: combinators.lib kernel sequences math namespaces make
 assocs random sequences.private shuffle math.functions arrays
 math.parser math.private sorting strings ascii macros assocs.lib
 quotations hashtables math.order locals generalizations
-math.ranges random  ;
+math.ranges random fry ;
 IN: sequences.lib
 
 : each-withn ( seq quot n -- ) nwith each ; inline
@@ -90,12 +90,8 @@ ERROR: element-not-found ;
     dupd find over [ element-not-found ] unless
     >r cut rest r> swap ; inline
 
-: (map-until) ( quot pred -- quot )
-    [ dup ] swap 3compose
-    [ [ drop t ] [ , f ] if ] compose [ find 2drop ] curry ;
-
 : map-until ( seq quot pred -- newseq )
-    (map-until) { } make ;
+    '[ [ @ dup @ [ drop t ] [ , f ] if ] find 2drop ] { } make ;
 
 : take-while ( seq quot -- newseq )
     [ not ] compose

vm/os-unix.h

@@ -23,6 +23,7 @@ typedef char F_SYMBOL;
 #define STRNCMP strncmp
 #define STRDUP strdup
 
+#define FIXNUM_FORMAT "%ld"
 #define CELL_FORMAT "%lu"
 #define CELL_HEX_FORMAT "%lx"
 

vm/os-windows.h

@@ -20,13 +20,13 @@ typedef wchar_t F_CHAR;
 #define STRNCMP wcsncmp
 #define STRDUP _wcsdup
 
+#define FIXNUM_FORMAT "%Id"
+#define CELL_FORMAT "%lu"
+#define CELL_HEX_FORMAT "%Ix"
+
 #ifdef WIN64
-        #define CELL_FORMAT "%Iu"
-        #define CELL_HEX_FORMAT "%Ix"
 	#define CELL_HEX_PAD_FORMAT "%016Ix"
 #else
-        #define CELL_FORMAT "%lu"
-        #define CELL_HEX_FORMAT "%lx"
 	#define CELL_HEX_PAD_FORMAT "%08lx"
 #endif
 

vm/utilities.c

@@ -44,7 +44,7 @@ void print_cell_hex_pad(CELL x)
 
 void print_fixnum(F_FIXNUM x)
 {
-	printf(CELL_FORMAT,x);
+	printf(FIXNUM_FORMAT,x);
 }
 
 CELL read_cell_hex(void)