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

basis/alarms/alarms.factor

@@ -35,7 +35,7 @@ ERROR: bad-alarm-frequency frequency ;
     [ time>> ] dip before=? ;
 
 : reschedule-alarm ( alarm -- )
-    dup [ swap interval>> time+ ] change-time register-alarm ;
+    dup [ swap interval>> time+ now max ] change-time register-alarm ;
 
 : call-alarm ( alarm -- )
     [ entry>> box> drop ]

basis/bootstrap/help/help.factor

@@ -1,6 +1,6 @@
 USING: help help.topics help.syntax help.crossref
 help.definitions io io.files kernel namespaces vocabs sequences
-parser vocabs.loader ;
+parser vocabs.loader vocabs.loader.private accessors assocs ;
 IN: bootstrap.help
 
 : load-help ( -- )
@@ -10,8 +10,8 @@ IN: bootstrap.help
     t load-help? set-global
 
     [ drop ] load-vocab-hook [
-        vocabs
+        dictionary get values
-        [ vocab-docs-loaded? not ] filter
+        [ docs-loaded?>> not ] filter
         [ load-docs ] each
     ] with-variable ;
 

basis/bootstrap/image/image.factor

@@ -130,6 +130,12 @@ SYMBOL: jit-if-word
 SYMBOL: jit-if-jump
 SYMBOL: jit-dispatch-word
 SYMBOL: jit-dispatch
+SYMBOL: jit-dip-word
+SYMBOL: jit-dip
+SYMBOL: jit-2dip-word
+SYMBOL: jit-2dip
+SYMBOL: jit-3dip-word
+SYMBOL: jit-3dip
 SYMBOL: jit-epilog
 SYMBOL: jit-return
 SYMBOL: jit-profiling
@@ -139,8 +145,8 @@ SYMBOL: jit-save-stack
 ! Default definition for undefined words
 SYMBOL: undefined-quot
 
-: userenv-offset ( symbol -- n )
+: userenvs ( -- assoc )
-    {
+    H{
         { bootstrap-boot-quot 20 }
         { bootstrap-global 21 }
         { jit-code-format 22 }
@@ -160,8 +166,17 @@ SYMBOL: undefined-quot
         { jit-push-immediate 36 }
         { jit-declare-word 42 }
         { jit-save-stack 43 }
+        { jit-dip-word 44 }
+        { jit-dip 45 }
+        { jit-2dip-word 46 }
+        { jit-2dip 47 }
+        { jit-3dip-word 48 }
+        { jit-3dip 49 }
         { undefined-quot 60 }
-    } at header-size + ;
+    } ; inline
+
+: userenv-offset ( symbol -- n )
+    userenvs at header-size + ;
 
 : emit ( cell -- ) image get push ;
 
@@ -443,6 +458,9 @@ M: quotation '
     \ dispatch jit-dispatch-word set
     \ do-primitive jit-primitive-word set
     \ declare jit-declare-word set
+    \ dip jit-dip-word set
+    \ 2dip jit-2dip-word set
+    \ 3dip jit-3dip-word set
     [ undefined ] undefined-quot set
     {
         jit-code-format
@@ -457,6 +475,12 @@ M: quotation '
         jit-if-jump
         jit-dispatch-word
         jit-dispatch
+        jit-dip-word
+        jit-dip
+        jit-2dip-word
+        jit-2dip
+        jit-3dip-word
+        jit-3dip
         jit-epilog
         jit-return
         jit-profiling

basis/bootstrap/stage2.factor

@@ -32,8 +32,8 @@ SYMBOL: bootstrap-time
 : count-words ( pred -- )
     all-words swap count number>string write ;
 
-: print-time ( time -- )
+: print-time ( us -- )
-    1000 /i
+    1000000 /i
     60 /mod swap
     number>string write
     " minutes and " write number>string write " seconds." print ;
@@ -52,7 +52,7 @@ SYMBOL: bootstrap-time
 
 [
     ! We time bootstrap
-    millis
+    micros
 
     default-image-name "output-image" set-global
 
@@ -77,7 +77,7 @@ SYMBOL: bootstrap-time
     [
         load-components
 
-        millis over - core-bootstrap-time set-global
+        micros over - core-bootstrap-time set-global
 
         run-bootstrap-init
     ] with-compiler-errors
@@ -100,7 +100,7 @@ SYMBOL: bootstrap-time
             ] [ print-error 1 exit ] recover
         ] set-boot-quot
 
-        millis swap - bootstrap-time set-global
+        micros swap - bootstrap-time set-global
         print-report
 
         "output-image" get save-image-and-exit

basis/calendar/calendar-docs.factor

@@ -365,12 +365,12 @@ HELP: unix-1970
 { $values { "timestamp" timestamp } }
 { $description "Outputs the beginning of UNIX time, or midnight, January 1, 1970." } ;
 
-HELP: millis>timestamp
+HELP: micros>timestamp
 { $values { "x" number } { "timestamp" timestamp } }
-{ $description "Converts a number of milliseconds into a timestamp value in GMT time." }
+{ $description "Converts a number of microseconds into a timestamp value in GMT time." }
 { $examples
     { $example "USING: accessors calendar prettyprint ;"
-               "1000 millis>timestamp year>> ."
+               "1000 micros>timestamp year>> ."
                "1970"
     }
 } ;

basis/calendar/calendar-tests.factor

@@ -143,10 +143,10 @@ IN: calendar.tests
 [ +gt+ ] [ 2005 1 1 12 30 0 instant <timestamp>
         2004 1 1 13 30 0 instant <timestamp> <=> ] unit-test
 
-[ t ] [ now timestamp>millis millis - 1000 < ] unit-test
+[ t ] [ now timestamp>micros micros - 1000000 < ] unit-test
-[ t ] [ 0 millis>timestamp unix-1970 = ] unit-test
+[ t ] [ 0 micros>timestamp unix-1970 = ] unit-test
-[ t ] [ 123456789000 [ millis>timestamp timestamp>millis ] keep = ] unit-test
+[ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
-[ t ] [ 123456789123456 [ millis>timestamp timestamp>millis ] keep = ] unit-test
+[ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
 
 : checktime+ now dup clone [ rot time+ drop ] keep = ;
 

basis/calendar/calendar.factor

@@ -325,9 +325,15 @@ M: duration time-
 : timestamp>millis ( timestamp -- n )
     unix-1970 (time-) 1000 * >integer ;
 
+: micros>timestamp ( x -- timestamp )
+    >r unix-1970 r> microseconds time+ ;
+
+: timestamp>micros ( timestamp -- n )
+    unix-1970 (time-) 1000000 * >integer ;
+
 : gmt ( -- timestamp )
     #! GMT time, right now
-    unix-1970 millis milliseconds time+ ;
+    unix-1970 micros microseconds time+ ;
 
 : now ( -- timestamp ) gmt >local-time ;
 : hence ( duration -- timestamp ) now swap time+ ;
@@ -404,7 +410,7 @@ PRIVATE>
 : since-1970 ( duration -- timestamp )
     unix-1970 time+ >local-time ;
 
-M: timestamp sleep-until timestamp>millis sleep-until ;
+M: timestamp sleep-until timestamp>micros sleep-until ;
 
 M: duration sleep hence sleep-until ;
 

basis/calendar/model/model.factor

@@ -7,7 +7,7 @@ SYMBOL: time
 
 : (time-thread) ( -- )
     now time get set-model
-    1000 sleep (time-thread) ;
+    1 seconds sleep (time-thread) ;
 
 : time-thread ( -- )
     [

basis/compiler/compiler.factor

@@ -91,8 +91,8 @@ t compile-dependencies? set-global
     [
         dup crossref?
         [
-            dependencies get >alist
+            dependencies get
-            generic-dependencies get >alist
+            generic-dependencies get
             compiled-xref
         ] [ drop ] if
     ] tri ;

basis/compiler/tests/alien.factor

@@ -361,7 +361,7 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
 [ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
 
 : callback-7 ( -- callback )
-    "void" { } "cdecl" [ 1000 sleep ] alien-callback ;
+    "void" { } "cdecl" [ 1000000 sleep ] alien-callback ;
 
 [ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test
 

basis/compiler/tests/redefine13.factor

@@ -0,0 +1,14 @@
+USING: math fry macros eval tools.test ;
+IN: compiler.tests.redefine13
+
+: breakage-word ( a b -- c ) + ;
+
+MACRO: breakage-macro ( a -- ) '[ _ breakage-word ] ;
+
+GENERIC: breakage-caller ( a -- c )
+
+M: fixnum breakage-caller 2 breakage-macro ;
+
+: breakage ( -- obj ) 2 breakage-caller ;
+
+! [ ] [ "IN: compiler.tests.redefine13 : breakage-word ( a b -- c ) ;" eval ] unit-test

basis/compiler/tests/redefine14.factor

@@ -0,0 +1,8 @@
+USING: compiler.units definitions tools.test sequences ;
+IN: compiler.tests.redefine14
+
+! TUPLE: bad ;
+! 
+! M: bad length 1 2 3 ;
+! 
+! [ ] [ [ { bad length } forget ] with-compilation-unit ] unit-test

basis/concurrency/combinators/combinators-tests.factor

@@ -11,7 +11,7 @@ math.parser ;
 
 [ { 1 4 9 } ] [ { 1 2 3 } [ sq ] parallel-map ] unit-test
 
-[ { 1 4 9 } ] [ { 1 2 3 } [ 1000 random sleep sq ] parallel-map ] unit-test
+[ { 1 4 9 } ] [ { 1 2 3 } [ 1000000 random sleep sq ] parallel-map ] unit-test
 
 [ { 1 2 3 } [ dup 2 mod 0 = [ "Even" throw ] when ] parallel-map ]
 [ error>> "Even" = ] must-fail-with

basis/concurrency/flags/flags-tests.factor

@@ -1,6 +1,6 @@
 IN: concurrency.flags.tests
 USING: tools.test concurrency.flags concurrency.combinators
-kernel threads locals accessors ;
+kernel threads locals accessors calendar ;
 
 :: flag-test-1 ( -- )
     [let | f [ <flag> ] |
@@ -13,7 +13,7 @@ kernel threads locals accessors ;
 
 :: flag-test-2 ( -- )
     [let | f [ <flag> ] |
-        [ 1000 sleep f raise-flag ] "Flag test" spawn drop
+        [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
         f lower-flag
         f value>>
     ] ;
@@ -39,7 +39,7 @@ kernel threads locals accessors ;
 
 :: flag-test-5 ( -- )
     [let | f [ <flag> ] |
-        [ 1000 sleep f raise-flag ] "Flag test" spawn drop
+        [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
         f wait-for-flag
         f value>>
     ] ;
@@ -48,6 +48,6 @@ kernel threads locals accessors ;
 
 [ ] [
     { 1 2 } <flag>
-    [ [ 1000 sleep raise-flag ] curry "Flag test" spawn drop ]
+    [ [ 1 seconds sleep raise-flag ] curry "Flag test" spawn drop ]
     [ [ wait-for-flag drop ] curry parallel-each ] bi
 ] unit-test

basis/concurrency/futures/futures-docs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: concurrency.promises concurrency.messaging kernel arrays
-continuations help.markup help.syntax quotations ;
+continuations help.markup help.syntax quotations calendar ;
 IN: concurrency.futures
 
 HELP: future
@@ -11,8 +11,8 @@ $nl
 "The quotation begins with an empty data stack, an empty catch stack, and a name stack containing the global namespace only. This means that the only way to pass data to the quotation is to partially apply the data, for example using " { $link curry } " or " { $link compose } "." } ;
 
 HELP: ?future-timeout
-{ $values { "future" future } { "timeout" "a timeout in milliseconds or " { $link f } } { "value" object } }
+{ $values { "future" future } { "timeout" { $maybe duration } } { "value" object } }
-{ $description "Waits for a deferred computation to complete, blocking indefinitely if " { $snippet "timeout" } " is " { $link f } ", otherwise waiting up to " { $snippet "timeout" } " milliseconds." }
+{ $description "Waits for a deferred computation to complete, blocking indefinitely if " { $snippet "timeout" } " is " { $link f } ", otherwise waiting up to the " { $snippet "timeout" } " before throwing an error." }
 { $errors "Throws an error if the timeout expires before the computation completes. Also throws an error if the future quotation threw an error." } ;
 
 HELP: ?future

basis/concurrency/locks/locks-tests.factor

@@ -100,7 +100,7 @@ threads sequences calendar accessors ;
                c await
                l [
                    4 v push
-                   1000 sleep
+                   1 seconds sleep
                    5 v push
                ] with-write-lock
                c'' count-down
@@ -139,7 +139,7 @@ threads sequences calendar accessors ;
                l [
                    1 v push
                    c count-down
-                   1000 sleep
+                   1 seconds sleep
                    2 v push
                ] with-write-lock
                c' count-down

basis/concurrency/promises/promises-docs.factor

@@ -13,7 +13,7 @@ HELP: promise-fulfilled?
 
 HELP: ?promise-timeout
 { $values { "promise" promise } { "timeout" { $maybe duration } } { "result" object } }
-{ $description "Waits for another thread to fulfill a promise, returning immediately if the promise has already been fulfilled. A timeout of " { $link f } " indicates that the thread may block indefinitely, otherwise it will wait up to " { $snippet "timeout" } " milliseconds." }
+{ $description "Waits for another thread to fulfill a promise, returning immediately if the promise has already been fulfilled. A timeout of " { $link f } " indicates that the thread may block indefinitely, otherwise it will wait up to the " { $snippet "timeout" } " before throwing an error." }
 { $errors "Throws an error if the timeout expires before the promise has been fulfilled." } ;
 
 HELP: ?promise

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

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.syntax kernel threads init namespaces alien
-core-foundation ;
+core-foundation calendar ;
 IN: core-foundation.run-loop
 
 : kCFRunLoopRunFinished 1 ; inline
@@ -30,7 +30,7 @@ FUNCTION: SInt32 CFRunLoopRunInMode (
 
 : run-loop-thread ( -- )
     CFRunLoopDefaultMode 0 f CFRunLoopRunInMode
-    kCFRunLoopRunHandledSource = [ 1000 sleep ] unless
+    kCFRunLoopRunHandledSource = [ 1 seconds sleep ] unless
     run-loop-thread ;
 
 : start-run-loop-thread ( -- )

basis/cpu/ppc/bootstrap.factor

@@ -71,11 +71,16 @@ big-endian on
 
 [ 0 B ] rc-relative-ppc-3 rt-xt 0 jit-word-jump jit-define
 
-: jit-call-quot ( -- )
+: jit-jump-quot ( -- )
     4 3 quot-xt-offset LWZ
     4 MTCTR
     BCTR ;
 
+: jit-call-quot ( -- )
+    4 3 quot-xt-offset LWZ
+    4 MTLR
+    BLRL ;
+
 [
     0 3 LOAD32
     6 ds-reg 0 LWZ
@@ -84,7 +89,7 @@ big-endian on
     3 3 4 ADDI
     3 3 0 LWZ
     ds-reg dup 4 SUBI
-    jit-call-quot
+    jit-jump-quot
 ] rc-absolute-ppc-2/2 rt-literal 1 jit-if-jump jit-define
 
 [
@@ -95,9 +100,83 @@ big-endian on
     3 3 6 ADD
     3 3 array-start-offset LWZ
     ds-reg dup 4 SUBI
-    jit-call-quot
+    jit-jump-quot
 ] rc-absolute-ppc-2/2 rt-literal 1 jit-dispatch jit-define
 
+! These should not clobber r3 since we store a quotation in there
+! in jit-dip
+
+: jit->r ( -- )
+    4 ds-reg 0 LWZ
+    ds-reg dup 4 SUBI
+    4 rs-reg 4 STWU ;
+
+: jit-2>r ( -- )
+    4 ds-reg 0 LWZ
+    5 ds-reg -4 LWZ
+    ds-reg dup 8 SUBI
+    rs-reg dup 8 ADDI
+    4 rs-reg 0 STW
+    5 rs-reg -4 STW ;
+
+: jit-3>r ( -- )
+    4 ds-reg 0 LWZ
+    5 ds-reg -4 LWZ
+    6 ds-reg -8 LWZ
+    ds-reg dup 12 SUBI
+    rs-reg dup 12 ADDI
+    4 rs-reg 0 STW
+    5 rs-reg -4 STW
+    6 rs-reg -8 STW ;
+
+: jit-r> ( -- )
+    4 ds-reg 0 LWZ
+    ds-reg dup 4 SUBI
+    4 rs-reg 4 STWU ;
+
+: jit-2r> ( -- )
+    4 rs-reg 0 LWZ
+    5 rs-reg -4 LWZ
+    rs-reg dup 8 SUBI
+    ds-reg dup 8 ADDI
+    4 ds-reg 0 STW
+    5 ds-reg -4 STW ;
+
+: jit-3r> ( -- )
+    4 rs-reg 0 LWZ
+    5 rs-reg -4 LWZ
+    6 rs-reg -8 LWZ
+    rs-reg dup 12 SUBI
+    ds-reg dup 12 ADDI
+    4 ds-reg 0 STW
+    5 ds-reg -4 STW
+    6 ds-reg -8 STW ;
+
+: prepare-dip ( -- )
+    0 3 LOAD32
+    3 3 0 LWZ ;
+
+[
+    prepare-dip
+    jit->r
+    jit-call-quot
+    jit-r>
+] rc-absolute-ppc-2/2 rt-literal 1 jit-dip jit-define
+
+[
+    prepare-dip
+    jit-2>r
+    jit-call-quot
+    jit-2r>
+] rc-absolute-ppc-2/2 rt-literal 1 jit-2dip jit-define
+
+[
+    prepare-dip
+    jit-3>r
+    jit-call-quot
+    jit-3r>
+] rc-absolute-ppc-2/2 rt-literal 1 jit-3dip jit-define
+
 [
     0 1 lr-save stack-frame + LWZ
     1 1 stack-frame ADDI
@@ -112,7 +191,7 @@ big-endian on
 [
     3 ds-reg 0 LWZ
     ds-reg dup 4 SUBI
-    jit-call-quot
+    jit-jump-quot
 ] f f f \ (call) define-sub-primitive
 
 [
@@ -245,17 +324,9 @@ big-endian on
     4 ds-reg 0 STW
 ] f f f \ -rot define-sub-primitive
 
-[
+[ jit->r ] f f f \ >r define-sub-primitive
-    3 ds-reg 0 LWZ
-    ds-reg dup 4 SUBI
-    3 rs-reg 4 STWU
-] f f f \ >r define-sub-primitive
 
-[
+[ jit-r> ] f f f \ r> define-sub-primitive
-    3 rs-reg 0 LWZ
-    rs-reg dup 4 SUBI
-    3 ds-reg 4 STWU
-] f f f \ r> define-sub-primitive
 
 ! Comparisons
 : jit-compare ( insn -- )

basis/cpu/x86/32/bootstrap.factor

@@ -12,6 +12,7 @@ IN: bootstrap.x86
 : mod-arg ( -- reg ) EDX ;
 : arg0 ( -- reg ) EAX ;
 : arg1 ( -- reg ) EDX ;
+: arg2 ( -- reg ) ECX ;
 : temp-reg ( -- reg ) EBX ;
 : stack-reg ( -- reg ) ESP ;
 : ds-reg ( -- reg ) ESI ;

basis/cpu/x86/64/unix/bootstrap.factor

@@ -7,6 +7,7 @@ IN: bootstrap.x86
 : stack-frame-size ( -- n ) 4 bootstrap-cells ;
 : arg0 ( -- reg ) RDI ;
 : arg1 ( -- reg ) RSI ;
+: arg2 ( -- reg ) RDX ;
 
 << "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
 call

basis/cpu/x86/64/winnt/bootstrap.factor

@@ -7,6 +7,7 @@ IN: bootstrap.x86
 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
 : arg0 ( -- reg ) RCX ;
 : arg1 ( -- reg ) RDX ;
+: arg2 ( -- reg ) R8 ;
 
 << "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
 call

basis/cpu/x86/bootstrap.factor

@@ -73,6 +73,80 @@ big-endian off
     arg0 quot-xt-offset [+] JMP                ! execute branch
 ] rc-absolute-cell rt-literal 1 rex-length + jit-dispatch jit-define
 
+! The jit->r words cannot clobber arg0
+
+: jit->r ( -- )
+    rs-reg bootstrap-cell ADD
+    temp-reg ds-reg [] MOV
+    ds-reg bootstrap-cell SUB
+    rs-reg [] temp-reg MOV ;
+
+: jit-2>r ( -- )
+    rs-reg 2 bootstrap-cells ADD
+    temp-reg ds-reg [] MOV
+    arg1 ds-reg -1 bootstrap-cells [+] MOV
+    ds-reg 2 bootstrap-cells SUB
+    rs-reg [] temp-reg MOV
+    rs-reg -1 bootstrap-cells [+] arg1 MOV ;
+
+: jit-3>r ( -- )
+    rs-reg 3 bootstrap-cells ADD
+    temp-reg ds-reg [] MOV
+    arg1 ds-reg -1 bootstrap-cells [+] MOV
+    arg2 ds-reg -2 bootstrap-cells [+] MOV
+    ds-reg 3 bootstrap-cells SUB
+    rs-reg [] temp-reg MOV
+    rs-reg -1 bootstrap-cells [+] arg1 MOV
+    rs-reg -2 bootstrap-cells [+] arg2 MOV ;
+
+: jit-r> ( -- )
+    ds-reg bootstrap-cell ADD
+    temp-reg rs-reg [] MOV
+    rs-reg bootstrap-cell SUB
+    ds-reg [] temp-reg MOV ;
+
+: jit-2r> ( -- )
+    ds-reg 2 bootstrap-cells ADD
+    temp-reg rs-reg [] MOV
+    arg1 rs-reg -1 bootstrap-cells [+] MOV
+    rs-reg 2 bootstrap-cells SUB
+    ds-reg [] temp-reg MOV
+    ds-reg -1 bootstrap-cells [+] arg1 MOV ;
+
+: jit-3r> ( -- )
+    ds-reg 3 bootstrap-cells ADD
+    temp-reg rs-reg [] MOV
+    arg1 rs-reg -1 bootstrap-cells [+] MOV
+    arg2 rs-reg -2 bootstrap-cells [+] MOV
+    rs-reg 3 bootstrap-cells SUB
+    ds-reg [] temp-reg MOV
+    ds-reg -1 bootstrap-cells [+] arg1 MOV
+    ds-reg -2 bootstrap-cells [+] arg2 MOV ;
+
+[
+    arg0 0 MOV                                 ! load quotation addr
+    arg0 arg0 [] MOV                           ! load quotation
+    jit->r
+    arg0 quot-xt-offset [+] CALL               ! call quotation
+    jit-r>
+] rc-absolute-cell rt-literal 1 rex-length + jit-dip jit-define
+
+[
+    arg0 0 MOV                                 ! load quotation addr
+    arg0 arg0 [] MOV                           ! load quotation
+    jit-2>r
+    arg0 quot-xt-offset [+] CALL               ! call quotation
+    jit-2r>
+] rc-absolute-cell rt-literal 1 rex-length + jit-2dip jit-define
+
+[
+    arg0 0 MOV                                 ! load quotation addr
+    arg0 arg0 [] MOV                           ! load quotation
+    jit-3>r                                    
+    arg0 quot-xt-offset [+] CALL               ! call quotation
+    jit-3r>
+] rc-absolute-cell rt-literal 1 rex-length + jit-3dip jit-define
+
 [
     stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
 ] f f f jit-epilog jit-define
@@ -223,19 +297,9 @@ big-endian off
     ds-reg [] arg1 MOV
 ] f f f \ -rot define-sub-primitive
 
-[
+[ jit->r ] f f f \ >r define-sub-primitive
-    rs-reg bootstrap-cell ADD
-    arg0 ds-reg [] MOV
-    ds-reg bootstrap-cell SUB
-    rs-reg [] arg0 MOV
-] f f f \ >r define-sub-primitive
 
-[
+[ jit-r> ] f f f \ r> define-sub-primitive
-    ds-reg bootstrap-cell ADD
-    arg0 rs-reg [] MOV
-    rs-reg bootstrap-cell SUB
-    ds-reg [] arg0 MOV
-] f f f \ r> define-sub-primitive
 
 ! Comparisons
 : jit-compare ( insn -- )
@@ -305,7 +369,7 @@ big-endian off
     ds-reg [] arg1 MOV                         ! push to stack
 ] f f f \ fixnum-shift-fast define-sub-primitive
 
-: jit-fixnum-/mod
+: jit-fixnum-/mod ( -- )
     temp-reg ds-reg [] MOV                     ! load second parameter
     div-arg ds-reg bootstrap-cell neg [+] MOV  ! load first parameter
     mod-arg div-arg MOV                        ! make a copy

basis/help/html/html.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
-io.files html.streams html.elements html.components help kernel
+io.files html.streams html.elements help kernel
 assocs sequences make words accessors arrays help.topics vocabs
 tools.vocabs tools.vocabs.browser namespaces prettyprint io
 vocabs.loader serialize fry memoize unicode.case math.order
@@ -104,10 +104,6 @@ MEMO: load-index ( name -- index )
 
 TUPLE: result title href ;
 
-M: result link-title title>> ;
-
-M: result link-href href>> ;
-
 : offline-apropos ( string index -- results )
     load-index swap >lower
     '[ [ drop _ ] dip >lower subseq? ] assoc-filter

basis/io/launcher/launcher.factor

@@ -4,7 +4,8 @@ USING: system kernel namespaces strings hashtables sequences
 assocs combinators vocabs.loader init threads continuations
 math accessors concurrency.flags destructors environment
 io io.backend io.timeouts io.pipes io.pipes.private io.encodings
-io.streams.duplex io.ports debugger prettyprint summary ;
+io.streams.duplex io.ports debugger prettyprint summary
+calendar ;
 IN: io.launcher
 
 TUPLE: process < identity-tuple
@@ -65,7 +66,7 @@ SYMBOL: wait-flag
 : wait-loop ( -- )
     processes get assoc-empty?
     [ wait-flag get-global lower-flag ]
-    [ wait-for-processes [ 100 sleep ] when ] if ;
+    [ wait-for-processes [ 100 milliseconds sleep ] when ] if ;
 
 : start-wait-thread ( -- )
     <flag> wait-flag set-global

basis/io/sockets/secure/openssl/openssl.factor

@@ -0,0 +1,196 @@
+! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays kernel debugger sequences
+namespaces math math.order combinators init alien alien.c-types
+alien.strings libc continuations destructors debugger summary
+splitting assocs random math.parser locals unicode.case openssl
+openssl.libcrypto openssl.libssl io.backend io.ports io.files
+io.encodings.8-bit io.timeouts io.sockets.secure ;
+IN: io.sockets.secure.openssl
+
+GENERIC: ssl-method ( symbol -- method )
+
+M: SSLv2  ssl-method drop SSLv2_client_method ;
+M: SSLv23 ssl-method drop SSLv23_method ;
+M: SSLv3  ssl-method drop SSLv3_method ;
+M: TLSv1  ssl-method drop TLSv1_method ;
+
+TUPLE: openssl-context < secure-context aliens sessions ;
+
+: set-session-cache ( ctx -- )
+    handle>>
+    [ SSL_SESS_CACHE_BOTH SSL_CTX_set_session_cache_mode ssl-error ]
+    [ 32 random-bits >hex dup length SSL_CTX_set_session_id_context ssl-error ]
+    bi ;
+
+: load-certificate-chain ( ctx -- )
+    dup config>> key-file>> [
+        [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
+        SSL_CTX_use_certificate_chain_file
+        ssl-error
+    ] [ drop ] if ;
+
+: password-callback ( -- alien )
+    "int" { "void*" "int" "bool" "void*" } "cdecl"
+    [| buf size rwflag password! |
+        password [ B{ 0 } password! ] unless
+
+        [let | len [ password strlen ] |
+            buf password len 1+ size min memcpy
+            len
+        ]
+    ] alien-callback ;
+
+: default-pasword ( ctx -- alien )
+    [ config>> password>> latin1 malloc-string ] [ aliens>> ] bi
+    [ push ] [ drop ] 2bi ;
+
+: set-default-password ( ctx -- )
+    [ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
+    [
+        [ handle>> ] [ default-pasword ] bi
+        SSL_CTX_set_default_passwd_cb_userdata
+    ] bi ;
+
+: use-private-key-file ( ctx -- )
+    dup config>> key-file>> [
+        [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
+        SSL_FILETYPE_PEM SSL_CTX_use_PrivateKey_file
+        ssl-error
+    ] [ drop ] if ;
+
+: load-verify-locations ( ctx -- )
+    dup config>> [ ca-file>> ] [ ca-path>> ] bi or [
+        [ handle>> ]
+        [
+            config>>
+            [ ca-file>> dup [ (normalize-path) ] when ]
+            [ ca-path>> dup [ (normalize-path) ] when ] bi
+        ] bi
+        SSL_CTX_load_verify_locations
+    ] [ handle>> SSL_CTX_set_default_verify_paths ] if ssl-error ;
+
+: set-verify-depth ( ctx -- )
+    dup config>> verify-depth>> [
+        [ handle>> ] [ config>> verify-depth>> ] bi
+        SSL_CTX_set_verify_depth
+    ] [ drop ] if ;
+
+TUPLE: bio handle disposed ;
+
+: <bio> ( handle -- bio ) f bio boa ;
+
+M: bio dispose* handle>> BIO_free ssl-error ;
+
+: <file-bio> ( path -- bio )
+    normalize-path "r" BIO_new_file dup ssl-error <bio> ;
+
+: load-dh-params ( ctx -- )
+    dup config>> dh-file>> [
+        [ handle>> ] [ config>> dh-file>> ] bi <file-bio> &dispose
+        handle>> f f f PEM_read_bio_DHparams dup ssl-error
+        SSL_CTX_set_tmp_dh ssl-error
+    ] [ drop ] if ;
+
+TUPLE: rsa handle disposed ;
+
+: <rsa> ( handle -- rsa ) f rsa boa ;
+
+M: rsa dispose* handle>> RSA_free ;
+
+: generate-eph-rsa-key ( ctx -- )
+    [ handle>> ]
+    [
+        config>> ephemeral-key-bits>> RSA_F4 f f RSA_generate_key
+        dup ssl-error <rsa> &dispose handle>>
+    ] bi
+    SSL_CTX_set_tmp_rsa ssl-error ;
+
+: <openssl-context> ( config ctx -- context )
+    openssl-context new
+        swap >>handle
+        swap >>config
+        V{ } clone >>aliens
+        H{ } clone >>sessions ;
+
+M: openssl <secure-context> ( config -- context )
+    maybe-init-ssl
+    [
+        dup method>> ssl-method SSL_CTX_new
+        dup ssl-error <openssl-context> |dispose
+        {
+            [ set-session-cache ]
+            [ load-certificate-chain ]
+            [ set-default-password ]
+            [ use-private-key-file ]
+            [ load-verify-locations ]
+            [ set-verify-depth ]
+            [ load-dh-params ]
+            [ generate-eph-rsa-key ]
+            [ ]
+        } cleave
+    ] with-destructors ;
+
+M: openssl-context dispose*
+    [ aliens>> [ free ] each ]
+    [ sessions>> values [ SSL_SESSION_free ] each ]
+    [ handle>> SSL_CTX_free ]
+    tri ;
+
+TUPLE: ssl-handle file handle connected disposed ;
+
+SYMBOL: default-secure-context
+
+: context-expired? ( context -- ? )
+    dup [ handle>> expired? ] [ drop t ] if ;
+
+: current-secure-context ( -- ctx )
+    secure-context get [
+        default-secure-context get dup context-expired? [
+            drop
+            <secure-config> <secure-context> default-secure-context set-global
+            current-secure-context
+        ] when
+    ] unless* ;
+
+: <ssl-handle> ( fd -- ssl )
+    current-secure-context handle>> SSL_new dup ssl-error
+    f f ssl-handle boa ;
+
+M: ssl-handle dispose*
+    [ handle>> SSL_free ] [ file>> dispose ] bi ;
+
+: check-verify-result ( ssl-handle -- )
+    SSL_get_verify_result dup X509_V_OK =
+    [ drop ] [ verify-message certificate-verify-error ] if ;
+
+: common-name ( certificate -- host )
+    X509_get_subject_name
+    NID_commonName 256 <byte-array>
+    [ 256 X509_NAME_get_text_by_NID ] keep
+    swap -1 = [ drop f ] [ latin1 alien>string ] if ;
+
+: common-names-match? ( expected actual -- ? )
+    [ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ;
+
+: check-common-name ( host ssl-handle -- )
+    SSL_get_peer_certificate common-name
+    2dup common-names-match?
+    [ 2drop ] [ common-name-verify-error ] if ;
+
+M: openssl check-certificate ( host ssl -- )
+    current-secure-context config>> verify>> [
+        handle>>
+        [ nip check-verify-result ]
+        [ check-common-name ]
+        2bi
+    ] [ 2drop ] if ;
+
+: get-session ( addrspec -- session/f )
+    current-secure-context sessions>> at
+    dup expired? [ drop f ] when ;
+
+: save-session ( session addrspec -- )
+    current-secure-context sessions>> set-at ;
+
+openssl secure-socket-backend set-global

basis/io/unix/files/files.factor

@@ -303,7 +303,7 @@ M: string other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ;
     dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
 
 : timestamp>timeval ( timestamp -- timeval )
-    unix-1970 time- duration>milliseconds make-timeval ;
+    unix-1970 time- duration>microseconds make-timeval ;
 
 : timestamps>byte-array ( timestamps -- byte-array )
     [ dup [ timestamp>timeval ] when ] map make-timeval-array ;

basis/io/unix/kqueue/kqueue.factor

@@ -94,7 +94,7 @@ M: kqueue-mx unregister-io-task ( task mx -- )
 : handle-kevents ( mx n -- )
     [ over events>> kevent-nth handle-kevent ] with each ;
 
-M: kqueue-mx wait-for-events ( ms mx -- )
+M: kqueue-mx wait-for-events ( us mx -- )
     swap dup [ make-timespec ] when
     dupd wait-kevent handle-kevents ;
 

basis/io/unix/select/select.factor

@@ -48,9 +48,9 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
     [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri
     f ;
 
-M:: select-mx wait-for-events ( ms mx -- )
+M:: select-mx wait-for-events ( us mx -- )
     mx
-    [ init-fdsets ms dup [ make-timeval ] when select multiplexer-error ]
+    [ init-fdsets us dup [ make-timeval ] when select multiplexer-error ]
     [ [ read-fdset/tasks ] keep [ input-available ] check-fdset ]
     [ [ write-fdset/tasks ] keep [ output-available ] check-fdset ]
     tri ;

basis/io/unix/sockets/secure/secure.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors unix byte-arrays kernel debugger sequences namespaces math
+USING: accessors unix byte-arrays kernel debugger sequences
-math.order combinators init alien alien.c-types alien.strings libc
+namespaces math math.order combinators init alien alien.c-types
-continuations destructors
+alien.strings libc continuations destructors openssl
-openssl openssl.libcrypto openssl.libssl
+openssl.libcrypto openssl.libssl io.files io.ports
-io.files io.ports io.unix.backend io.unix.sockets
+io.unix.backend io.unix.sockets io.encodings.ascii io.buffers
-io.encodings.ascii io.buffers io.sockets io.sockets.secure
+io.sockets io.sockets.secure io.sockets.secure.openssl
 io.timeouts system summary ;
 IN: io.unix.sockets.secure
 

basis/io/windows/nt/pipes/pipes.factor

@@ -35,7 +35,7 @@ IN: io.windows.nt.pipes
         "-" %
         32 random-bits #
         "-" %
-        millis #
+        micros #
     ] "" make ;
 
 M: winnt (pipe) ( -- pipe )

basis/io/windows/windows.factor

@@ -1,11 +1,10 @@
 ! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays destructors io io.backend
-io.buffers io.files io.ports io.sockets io.binary
+io.buffers io.files io.ports io.binary io.timeouts
-io.sockets io.timeouts windows.errors strings
+windows.errors strings kernel math namespaces sequences windows
-kernel math namespaces sequences windows windows.kernel32
+windows.kernel32 windows.shell32 windows.types windows.winsock
-windows.shell32 windows.types windows.winsock splitting
+splitting continuations math.bitwise system accessors ;
-continuations math.bitwise system accessors ;
 IN: io.windows
 
 : set-inherit ( handle ? -- )

basis/logging/logging-docs.factor

@@ -117,7 +117,6 @@ ARTICLE: "logging" "Logging framework"
 { $subsection "logging.rotation" }
 { $subsection "logging.parser" }
 { $subsection "logging.analysis" }
-{ $subsection "logging.insomniac" }
 { $subsection "logging.server" } ;
 
 ABOUT: "logging"

basis/logging/logging.factor

@@ -123,4 +123,3 @@ USE: vocabs.loader
 
 "logging.parser" require
 "logging.analysis" require
-"logging.insomniac" require

basis/openssl/openssl.factor

@@ -1,25 +1,13 @@
 ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays kernel debugger sequences namespaces math
+USING: init kernel namespaces openssl.libcrypto openssl.libssl
-math.order combinators init alien alien.c-types alien.strings libc
+sequences ;
-continuations destructors debugger summary splitting assocs
-random math.parser locals unicode.case
-openssl.libcrypto openssl.libssl
-io.backend io.ports io.files io.encodings.8-bit io.sockets.secure
-io.timeouts ;
 IN: openssl
 
 ! This code is based on http://www.rtfm.com/openssl-examples/
 
 SINGLETON: openssl
 
-GENERIC: ssl-method ( symbol -- method )
-
-M: SSLv2  ssl-method drop SSLv2_client_method ;
-M: SSLv23 ssl-method drop SSLv23_method ;
-M: SSLv3  ssl-method drop SSLv3_method ;
-M: TLSv1  ssl-method drop TLSv1_method ;
-
 : (ssl-error-string) ( n -- string )
     ERR_clear_error f ERR_error_string ;
 
@@ -47,183 +35,3 @@ SYMBOL: ssl-initialized?
     ] unless ;
 
 [ f ssl-initialized? set-global ] "openssl" add-init-hook
-
-TUPLE: openssl-context < secure-context aliens sessions ;
-
-: set-session-cache ( ctx -- )
-    handle>>
-    [ SSL_SESS_CACHE_BOTH SSL_CTX_set_session_cache_mode ssl-error ]
-    [ 32 random-bits >hex dup length SSL_CTX_set_session_id_context ssl-error ]
-    bi ;
-
-: load-certificate-chain ( ctx -- )
-    dup config>> key-file>> [
-        [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
-        SSL_CTX_use_certificate_chain_file
-        ssl-error
-    ] [ drop ] if ;
-
-: password-callback ( -- alien )
-    "int" { "void*" "int" "bool" "void*" } "cdecl"
-    [| buf size rwflag password! |
-        password [ B{ 0 } password! ] unless
-
-        [let | len [ password strlen ] |
-            buf password len 1+ size min memcpy
-            len
-        ]
-    ] alien-callback ;
-
-: default-pasword ( ctx -- alien )
-    [ config>> password>> latin1 malloc-string ] [ aliens>> ] bi
-    [ push ] [ drop ] 2bi ;
-
-: set-default-password ( ctx -- )
-    [ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
-    [
-        [ handle>> ] [ default-pasword ] bi
-        SSL_CTX_set_default_passwd_cb_userdata
-    ] bi ;
-
-: use-private-key-file ( ctx -- )
-    dup config>> key-file>> [
-        [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
-        SSL_FILETYPE_PEM SSL_CTX_use_PrivateKey_file
-        ssl-error
-    ] [ drop ] if ;
-
-: load-verify-locations ( ctx -- )
-    dup config>> [ ca-file>> ] [ ca-path>> ] bi or [
-        [ handle>> ]
-        [
-            config>>
-            [ ca-file>> dup [ (normalize-path) ] when ]
-            [ ca-path>> dup [ (normalize-path) ] when ] bi
-        ] bi
-        SSL_CTX_load_verify_locations
-    ] [ handle>> SSL_CTX_set_default_verify_paths ] if ssl-error ;
-
-: set-verify-depth ( ctx -- )
-    dup config>> verify-depth>> [
-        [ handle>> ] [ config>> verify-depth>> ] bi
-        SSL_CTX_set_verify_depth
-    ] [ drop ] if ;
-
-TUPLE: bio handle disposed ;
-
-: <bio> ( handle -- bio ) f bio boa ;
-
-M: bio dispose* handle>> BIO_free ssl-error ;
-
-: <file-bio> ( path -- bio )
-    normalize-path "r" BIO_new_file dup ssl-error <bio> ;
-
-: load-dh-params ( ctx -- )
-    dup config>> dh-file>> [
-        [ handle>> ] [ config>> dh-file>> ] bi <file-bio> &dispose
-        handle>> f f f PEM_read_bio_DHparams dup ssl-error
-        SSL_CTX_set_tmp_dh ssl-error
-    ] [ drop ] if ;
-
-TUPLE: rsa handle disposed ;
-
-: <rsa> ( handle -- rsa ) f rsa boa ;
-
-M: rsa dispose* handle>> RSA_free ;
-
-: generate-eph-rsa-key ( ctx -- )
-    [ handle>> ]
-    [
-        config>> ephemeral-key-bits>> RSA_F4 f f RSA_generate_key
-        dup ssl-error <rsa> &dispose handle>>
-    ] bi
-    SSL_CTX_set_tmp_rsa ssl-error ;
-
-: <openssl-context> ( config ctx -- context )
-    openssl-context new
-        swap >>handle
-        swap >>config
-        V{ } clone >>aliens
-        H{ } clone >>sessions ;
-
-M: openssl <secure-context> ( config -- context )
-    maybe-init-ssl
-    [
-        dup method>> ssl-method SSL_CTX_new
-        dup ssl-error <openssl-context> |dispose
-        {
-            [ set-session-cache ]
-            [ load-certificate-chain ]
-            [ set-default-password ]
-            [ use-private-key-file ]
-            [ load-verify-locations ]
-            [ set-verify-depth ]
-            [ load-dh-params ]
-            [ generate-eph-rsa-key ]
-            [ ]
-        } cleave
-    ] with-destructors ;
-
-M: openssl-context dispose*
-    [ aliens>> [ free ] each ]
-    [ sessions>> values [ SSL_SESSION_free ] each ]
-    [ handle>> SSL_CTX_free ]
-    tri ;
-
-TUPLE: ssl-handle file handle connected disposed ;
-
-SYMBOL: default-secure-context
-
-: context-expired? ( context -- ? )
-    dup [ handle>> expired? ] [ drop t ] if ;
-
-: current-secure-context ( -- ctx )
-    secure-context get [
-        default-secure-context get dup context-expired? [
-            drop
-            <secure-config> <secure-context> default-secure-context set-global
-            current-secure-context
-        ] when
-    ] unless* ;
-
-: <ssl-handle> ( fd -- ssl )
-    current-secure-context handle>> SSL_new dup ssl-error
-    f f ssl-handle boa ;
-
-M: ssl-handle dispose*
-    [ handle>> SSL_free ] [ file>> dispose ] bi ;
-
-: check-verify-result ( ssl-handle -- )
-    SSL_get_verify_result dup X509_V_OK =
-    [ drop ] [ verify-message certificate-verify-error ] if ;
-
-: common-name ( certificate -- host )
-    X509_get_subject_name
-    NID_commonName 256 <byte-array>
-    [ 256 X509_NAME_get_text_by_NID ] keep
-    swap -1 = [ drop f ] [ latin1 alien>string ] if ;
-
-: common-names-match? ( expected actual -- ? )
-    [ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ;
-
-: check-common-name ( host ssl-handle -- )
-    SSL_get_peer_certificate common-name
-    2dup common-names-match?
-    [ 2drop ] [ common-name-verify-error ] if ;
-
-M: openssl check-certificate ( host ssl -- )
-    current-secure-context config>> verify>> [
-        handle>>
-        [ nip check-verify-result ]
-        [ check-common-name ]
-        2bi
-    ] [ 2drop ] if ;
-
-: get-session ( addrspec -- session/f )
-    current-secure-context sessions>> at
-    dup expired? [ drop f ] when ;
-
-: save-session ( session addrspec -- )
-    current-secure-context sessions>> set-at ;
-
-openssl secure-socket-backend set-global

basis/peg/parsers/parsers.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces make math assocs
-shuffle vectors arrays math.parser accessors unicode.categories
+vectors arrays math.parser accessors unicode.categories
 sequences.deep peg peg.private peg.search math.ranges words ;
 IN: peg.parsers
 

basis/peg/peg.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings fry namespaces make math assocs
-shuffle debugger io vectors arrays math.parser math.order
+debugger io vectors arrays math.parser math.order
 vectors combinators classes sets unicode.categories
 compiler.units parser words quotations effects memoize accessors
 locals effects splitting combinators.short-circuit

basis/smtp/smtp.factor

@@ -145,7 +145,7 @@ ERROR: invalid-header-string string ;
         "<" %
         64 random-bits #
         "-" %
-        millis #
+        micros #
         "@" %
         smtp-domain get [ host-name ] unless* %
         ">" %

basis/stack-checker/known-words/known-words.factor

@@ -87,6 +87,15 @@ M: composed infer-call*
 M: object infer-call*
     \ literal-expected inference-warning ;
 
+: infer-slip ( -- )
+    1 infer->r pop-d infer-call 1 infer-r> ;
+
+: infer-2slip ( -- )
+    2 infer->r pop-d infer-call 2 infer-r> ;
+
+: infer-3slip ( -- )
+    3 infer->r pop-d infer-call 3 infer-r> ;
+
 : infer-curry ( -- )
     2 consume-d
     dup first2 <curried> make-known
@@ -150,6 +159,9 @@ M: object infer-call*
         { \ declare [ infer-declare ] }
         { \ call [ pop-d infer-call ] }
         { \ (call) [ pop-d infer-call ] }
+        { \ slip [ infer-slip ] }
+        { \ 2slip [ infer-2slip ] }
+        { \ 3slip [ infer-3slip ] }
         { \ curry [ infer-curry ] }
         { \ compose [ infer-compose ] }
         { \ execute [ infer-execute ] }
@@ -175,9 +187,10 @@ M: object infer-call*
     (( value -- )) apply-word/effect ;
 
 {
-    >r r> declare call (call) curry compose execute (execute) if
+    >r r> declare call (call) slip 2slip 3slip curry compose
-dispatch <tuple-boa> (throw) load-locals get-local drop-locals
+    execute (execute) if dispatch <tuple-boa> (throw)
-do-primitive alien-invoke alien-indirect alien-callback
+    load-locals get-local drop-locals do-primitive alien-invoke
+    alien-indirect alien-callback
 } [ t "special" set-word-prop ] each
 
 { call execute dispatch load-locals get-local drop-locals }
@@ -423,8 +436,8 @@ do-primitive alien-invoke alien-indirect alien-callback
 \ code-room { } { integer integer integer integer } define-primitive
 \ code-room  make-flushable
 
-\ millis { } { integer } define-primitive
+\ micros { } { integer } define-primitive
-\ millis make-flushable
+\ micros make-flushable
 
 \ tag { object } { fixnum } define-primitive
 \ tag make-foldable

basis/stack-checker/stack-checker.factor

@@ -24,4 +24,7 @@ M: callable infer ( quot -- effect )
 
 : forget-effects ( -- )
     forget-errors
-    all-words [ f "inferred-effect" set-word-prop ] each ;
+    all-words [
+        dup subwords [ f "inferred-effect" set-word-prop ] each
+        f "inferred-effect" set-word-prop
+    ] each ;

basis/threads/threads-docs.factor

@@ -100,7 +100,7 @@ HELP: sleep-queue
 { $var-description "A " { $link min-heap } " storing the queue of sleeping threads." } ;
 
 HELP: sleep-time
-{ $values { "ms/f" "a non-negative integer or " { $link f } } }
+{ $values { "us/f" "a non-negative integer or " { $link f } } }
 { $description "Outputs the time until the next sleeping thread is scheduled to wake up, which could be zero if there are threads in the run queue, or threads which need to wake up right now. If there are no runnable or sleeping threads, outputs " { $link f } "." } ;
 
 HELP: stop

basis/threads/threads.factor

@@ -93,7 +93,7 @@ PRIVATE>
     {
         { [ run-queue deque-empty? not ] [ 0 ] }
         { [ sleep-queue heap-empty? ] [ f ] }
-        [ sleep-queue heap-peek nip millis [-] ]
+        [ sleep-queue heap-peek nip micros [-] ]
     } cond ;
 
 DEFER: stop
@@ -106,7 +106,7 @@ DEFER: stop
 
 : expire-sleep? ( heap -- ? )
     dup heap-empty?
-    [ drop f ] [ heap-peek nip millis <= ] if ;
+    [ drop f ] [ heap-peek nip micros <= ] if ;
 
 : expire-sleep ( thread -- )
     f >>sleep-entry resume ;
@@ -184,7 +184,7 @@ M: f sleep-until
 GENERIC: sleep ( dt -- )
 
 M: real sleep
-    millis + >integer sleep-until ;
+    micros + >integer sleep-until ;
 
 : interrupt ( thread -- )
     dup state>> [

basis/tools/deploy/test/1/1.factor

@@ -1,6 +1,6 @@
 IN: tools.deploy.test.1
 USING: threads ;
 
-: deploy-test-1 ( -- ) 1000 sleep ;
+: deploy-test-1 ( -- ) 1000000 sleep ;
 
 MAIN: deploy-test-1

basis/tools/profiler/profiler-tests.factor

@@ -11,7 +11,7 @@ words ;
 
 [ ] [ [ 10 [ gc ] times ] profile ] unit-test
 
-[ ] [ [ 1000 sleep ] profile ] unit-test 
+[ ] [ [ 1000000 sleep ] profile ] unit-test 
 
 [ ] [ profile. ] unit-test
 

basis/tools/test/test.factor

@@ -49,7 +49,7 @@ SYMBOL: this-test
     [ drop t ] must-fail-with ;
 
 : (run-test) ( vocab -- )
-    dup vocab-source-loaded? [
+    dup vocab source-loaded?>> [
         vocab-tests [ run-file ] each
     ] [ drop ] if ;
 

basis/tools/threads/threads.factor

@@ -14,8 +14,8 @@ IN: tools.threads
     ] with-cell
     [
         sleep-entry>> [
-            key>> millis [-] number>string write
+            key>> micros [-] number>string write
-            " ms" write
+            " us" write
         ] when*
     ] with-cell ;
 

basis/tools/time/time-docs.factor

@@ -7,7 +7,7 @@ ARTICLE: "timing" "Timing code"
 "A lower-level word puts timings on the stack, intead of printing:"
 { $subsection benchmark }
 "You can also read the system clock and garbage collection statistics directly:"
-{ $subsection millis } 
+{ $subsection micros } 
 { $subsection gc-stats }
 { $see-also "profiling" } ;
 
@@ -15,7 +15,7 @@ ABOUT: "timing"
 
 HELP: benchmark
 { $values { "quot" "a quotation" }
-          { "runtime" "an integer denoting milliseconds" } }
+          { "runtime" "the runtime in microseconds" } }
       { $description "Runs a quotation, measuring the total wall clock time." }
 { $notes "A nicer word for interactive use is " { $link time } "." } ;
 
@@ -23,4 +23,4 @@ HELP: time
 { $values { "quot" "a quotation" } }
 { $description "Runs a quotation and then prints the total run time and some garbage collection statistics." } ;
 
-{ benchmark millis time } related-words
+{ benchmark micros time } related-words

basis/tools/time/time.factor

@@ -5,20 +5,20 @@ namespaces system sequences splitting grouping assocs strings ;
 IN: tools.time
 
 : benchmark ( quot -- runtime )
-    millis >r call millis r> - ; inline
+    micros >r call micros r> - ; inline
 
 : time. ( data -- )
     unclip
-    "==== RUNNING TIME" print nl pprint " ms" print nl
+    "==== RUNNING TIME" print nl 1000000 /f pprint " seconds" print nl
     4 cut*
     "==== GARBAGE COLLECTION" print nl
     [
         6 group
         {
             "GC count:"
-            "Cumulative GC time (ms):"
+            "Cumulative GC time (us):"
-            "Longest GC pause (ms):"
+            "Longest GC pause (us):"
-            "Average GC pause (ms):"
+            "Average GC pause (us):"
             "Objects copied:"
             "Bytes copied:"
         } prefix
@@ -29,7 +29,7 @@ IN: tools.time
     [
         nl
         {
-            "Total GC time (ms):"
+            "Total GC time (us):"
             "Cards scanned:"
             "Decks scanned:"
             "Code heap literal scans:"
@@ -37,4 +37,4 @@ IN: tools.time
     ] bi* ;
 
 : time ( quot -- )
-    gc-reset millis >r call gc-stats millis r> - prefix time. ; inline
+    gc-reset micros >r call gc-stats micros r> - prefix time. ; inline

basis/tools/vocabs/vocabs.factor

@@ -134,12 +134,12 @@ SYMBOL: modified-docs
             [
                 [
                     [ modified-sources ]
-                    [ vocab-source-loaded? ]
+                    [ vocab source-loaded?>> ]
                     [ vocab-source-path ]
                     tri (to-refresh)
                 ] [
                     [ modified-docs ]
-                    [ vocab-docs-loaded? ]
+                    [ vocab docs-loaded?>> ]
                     [ vocab-docs-path ]
                     tri (to-refresh)
                 ] bi
@@ -154,8 +154,8 @@ SYMBOL: modified-docs
 : do-refresh ( modified-sources modified-docs unchanged -- )
     unchanged-vocabs
     [
-        [ [ f swap set-vocab-source-loaded? ] each ]
+        [ [ vocab f >>source-loaded? drop ] each ]
-        [ [ f swap set-vocab-docs-loaded? ] each ] bi*
+        [ [ vocab f >>docs-loaded? drop ] each ] bi*
     ]
     [
         append prune

basis/ui/gestures/gestures-docs.factor

@@ -143,7 +143,7 @@ HELP: hand-last-button
 { $var-description "Global variable. The mouse button most recently pressed." } ;
 
 HELP: hand-last-time
-{ $var-description "Global variable. The timestamp of the most recent mouse button click. This timestamp has the same format as the output value of " { $link millis } "." } ;
+{ $var-description "Global variable. The timestamp of the most recent mouse button click. This timestamp has the same format as the output value of " { $link micros } "." } ;
 
 HELP: hand-buttons
 { $var-description "Global variable. A vector of mouse buttons currently held down." } ;

basis/ui/gestures/gestures.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs kernel math models namespaces
+USING: accessors arrays assocs kernel math math.order models
-make sequences words strings system hashtables math.parser
+namespaces make sequences words strings system hashtables
-math.vectors classes.tuple classes  boxes calendar
+math.parser math.vectors classes.tuple classes boxes calendar
 alarms symbols combinators sets columns fry deques ui.gadgets ;
 IN: ui.gestures
 
@@ -109,7 +109,7 @@ SYMBOL: hand-click#
 SYMBOL: hand-last-button
 SYMBOL: hand-last-time
 0 hand-last-button set-global
-0 hand-last-time set-global
+<zero> hand-last-time set-global
 
 SYMBOL: hand-buttons
 V{ } clone hand-buttons set-global
@@ -118,7 +118,7 @@ SYMBOL: scroll-direction
 { 0 0 } scroll-direction set-global
 
 SYMBOL: double-click-timeout
-300 double-click-timeout set-global
+300 milliseconds double-click-timeout set-global
 
 : hand-moved? ( -- ? )
     hand-loc get hand-click-loc get = not ;
@@ -199,7 +199,7 @@ SYMBOL: drag-timer
     hand-click-loc get-global swap screen-loc v- ;
 
 : multi-click-timeout? ( -- ? )
-    millis hand-last-time get - double-click-timeout get <= ;
+    now hand-last-time get time- double-click-timeout get before=? ;
 
 : multi-click-button? ( button -- button ? )
     dup hand-last-button get = ;
@@ -224,7 +224,7 @@ SYMBOL: drag-timer
             1 hand-click# set
         ] if
         hand-last-button set
-        millis hand-last-time set
+        now hand-last-time set
     ] bind ;
 
 : update-clicked ( -- )

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

@@ -38,7 +38,7 @@ tools.test kernel calendar parser accessors calendar io ;
 
 [ ] [ [ "interactor" get stream-read-quot drop ] "B" spawn drop ] unit-test
 
-[ ] [ 1000 sleep ] unit-test
+[ ] [ 1 seconds sleep ] unit-test
 
 [ ] [ "interactor" get interactor-eof ] unit-test
 
@@ -57,11 +57,11 @@ tools.test kernel calendar parser accessors calendar io ;
     ] in-thread
 ] unit-test
 
-[ ] [ 100 sleep ] unit-test
+[ ] [ 100 milliseconds sleep ] unit-test
 
 [ ] [ "interactor" get evaluate-input ] unit-test
 
-[ ] [ 100 sleep ] unit-test
+[ ] [ 100 milliseconds sleep ] unit-test
     
 [ ] [ "interactor" get interactor-eof ] unit-test
 
@@ -80,7 +80,7 @@ tools.test kernel calendar parser accessors calendar io ;
     ] in-thread
 ] unit-test
 
-[ ] [ 100 sleep ] unit-test
+[ ] [ 100 milliseconds sleep ] unit-test
 
 [ ] [ "interactor" get evaluate-input ] unit-test
 

basis/ui/tools/listener/listener-tests.factor

@@ -2,7 +2,8 @@ USING: continuations documents ui.tools.interactor
 ui.tools.listener hashtables kernel namespaces parser sequences
 tools.test ui.commands ui.gadgets ui.gadgets.editors
 ui.gadgets.panes vocabs words tools.test.ui slots.private
-threads arrays generic threads accessors listener math ;
+threads arrays generic threads accessors listener math
+calendar ;
 IN: ui.tools.listener.tests
 
 [ f ] [ "word" source-editor command-map commands>> empty? ] unit-test
@@ -47,7 +48,7 @@ IN: ui.tools.listener.tests
 
     [ ] [ "listener" get restart-listener ] unit-test
 
-    [ ] [ 1000 sleep ] unit-test
+    [ ] [ 1 seconds sleep ] unit-test
 
     [ ] [ "listener" get com-end ] unit-test
 ] with-grafted-gadget

basis/ui/tools/search/search-tests.factor

@@ -1,7 +1,7 @@
 USING: assocs ui.tools.search help.topics io.files io.styles
 kernel namespaces sequences source-files threads
 tools.test ui.gadgets ui.gestures vocabs accessors
-vocabs.loader words tools.test.ui debugger ;
+vocabs.loader words tools.test.ui debugger calendar ;
 IN: ui.tools.search.tests
 
 [ f ] [
@@ -14,7 +14,7 @@ IN: ui.tools.search.tests
 
 : update-live-search ( search -- seq )
     dup [
-        300 sleep
+        300 milliseconds sleep
         list>> control-value
     ] with-grafted-gadget ;
 
@@ -30,7 +30,7 @@ IN: ui.tools.search.tests
     "" all-words t <definition-search>
     dup [
         { "set-word-prop" } over field>> set-control-value
-        300 sleep
+        300 milliseconds sleep
         search-value \ set-word-prop eq?
     ] with-grafted-gadget
 ] unit-test

basis/ui/ui.factor

@@ -4,7 +4,7 @@ USING: arrays assocs io kernel math models namespaces make
 prettyprint dlists deques sequences threads sequences words
 debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
 ui.gestures ui.backend ui.render continuations init combinators
-hashtables concurrency.flags sets accessors ;
+hashtables concurrency.flags sets accessors calendar ;
 IN: ui
 
 ! Assoc mapping aliens to gadgets
@@ -153,7 +153,7 @@ SYMBOL: ui-hook
     ] [ ui-error ] recover ;
 
 : ui-wait ( -- )
-    10 sleep ;
+    10 milliseconds sleep ;
 
 SYMBOL: ui-thread
 

basis/unix/time/time.factor

@@ -11,14 +11,14 @@ C-STRUCT: timespec
     { "time_t" "sec" }
     { "long" "nsec" } ;
 
-: make-timeval ( ms -- timeval )
+: make-timeval ( us -- timeval )
-    1000 /mod 1000 *
+    1000000 /mod
     "timeval" <c-object>
     [ set-timeval-usec ] keep
     [ set-timeval-sec ] keep ;
 
-: make-timespec ( ms -- timespec )
+: make-timespec ( us -- timespec )
-    1000 /mod 1000000 *
+    1000000 /mod 1000 *
     "timespec" <c-object>
     [ set-timespec-nsec ] keep
     [ set-timespec-sec ] keep ;

core/alien/alien-docs.factor

@@ -281,8 +281,8 @@ $nl
         "Gives all Factor threads a chance to run."
     } }
     { {
-        { $code "void factor_sleep(long ms)" }
+        { $code "void factor_sleep(long us)" }
-        "Gives all Factor threads a chance to run for " { $snippet "ms" } " milliseconds."
+        "Gives all Factor threads a chance to run for " { $snippet "us" } " microseconds."
     } }
 } ;
 

core/arrays/arrays.factor

@@ -6,8 +6,8 @@ IN: arrays
 
 M: array clone (clone) ;
 M: array length length>> ;
-M: array nth-unsafe >r >fixnum r> array-nth ;
+M: array nth-unsafe [ >fixnum ] dip array-nth ;
-M: array set-nth-unsafe >r >fixnum r> set-array-nth ;
+M: array set-nth-unsafe [ >fixnum ] dip set-array-nth ;
 M: array resize resize-array ;
 
 : >array ( seq -- array ) { } clone-like ;

core/assocs/assocs.factor

@@ -21,7 +21,7 @@ GENERIC: assoc-clone-like ( assoc exemplar -- newassoc )
 GENERIC: >alist ( assoc -- newassoc )
 
 : (assoc-each) ( assoc quot -- seq quot' )
-    >r >alist r> [ first2 ] prepose ; inline
+    [ >alist ] dip [ first2 ] prepose ; inline
 
 : assoc-find ( assoc quot -- key value ? )
     (assoc-each) find swap [ first2 t ] [ drop f f f ] if ; inline
@@ -32,23 +32,26 @@ GENERIC: >alist ( assoc -- newassoc )
     (assoc-each) each ; inline
 
 : assoc>map ( assoc quot exemplar -- seq )
-    >r accumulator >r assoc-each r> r> like ; inline
+    [ accumulator [ assoc-each ] dip ] dip like ; inline
 
 : assoc-map-as ( assoc quot exemplar -- newassoc )
-    >r [ 2array ] compose V{ } assoc>map r> assoc-like ; inline
+    [ [ 2array ] compose V{ } assoc>map ] dip assoc-like ; inline
 
 : assoc-map ( assoc quot -- newassoc )
     over assoc-map-as ; inline
 
 : assoc-push-if ( key value quot accum -- )
-    >r 2keep r> roll
+    [ 2keep rot ] dip swap
-    [ >r 2array r> push ] [ 3drop ] if ; inline
+    [ [ 2array ] dip push ] [ 3drop ] if ; inline
 
 : assoc-pusher ( quot -- quot' accum )
     V{ } clone [ [ assoc-push-if ] 2curry ] keep ; inline
 
+: assoc-filter-as ( assoc quot exemplar -- subassoc )
+    [ assoc-pusher [ assoc-each ] dip ] dip assoc-like ; inline
+
 : assoc-filter ( assoc quot -- subassoc )
-    over >r assoc-pusher >r assoc-each r> r> assoc-like ; inline
+    over assoc-filter-as ; inline
 
 : assoc-contains? ( assoc quot -- ? )
     assoc-find 2nip ; inline
@@ -83,7 +86,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
         3drop f
     ] [
         3dup nth-unsafe at*
-        [ >r 3drop r> ] [ drop >r 1- r> (assoc-stack) ] if
+        [ [ 3drop ] dip ] [ drop [ 1- ] dip (assoc-stack) ] if
     ] if ; inline recursive
 
 : assoc-stack ( key seq -- value )
@@ -97,7 +100,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
 
 : assoc-hashcode ( n assoc -- code )
     [
-        >r over r> hashcode* 2/ >r dupd hashcode* r> bitxor
+        [ over ] dip hashcode* 2/ [ dupd hashcode* ] dip bitxor
     ] { } assoc>map hashcode* ;
 
 : assoc-intersect ( assoc1 assoc2 -- intersection )
@@ -130,19 +133,19 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
 
 : cache ( key assoc quot -- value )
     2over at* [
-        >r 3drop r>
+        [ 3drop ] dip
     ] [
-        drop pick rot >r >r call dup r> r> set-at
+        drop pick rot [ call dup ] 2dip set-at
     ] if ; inline
 
 : change-at ( key assoc quot -- )
-    [ >r at r> call ] 3keep drop set-at ; inline
+    [ [ at ] dip call ] 3keep drop set-at ; inline
 
 : at+ ( n key assoc -- )
     [ 0 or + ] change-at ;
 
 : map>assoc ( seq quot exemplar -- assoc )
-    >r [ 2array ] compose { } map-as r> assoc-like ; inline
+    [ [ 2array ] compose { } map-as ] dip assoc-like ; inline
 
 : extract-keys ( seq assoc -- subassoc )
     [ [ dupd at ] curry ] keep map>assoc ;
@@ -173,7 +176,7 @@ M: sequence at*
 M: sequence set-at
     2dup search-alist
     [ 2nip set-second ]
-    [ drop >r swap 2array r> push ] if ;
+    [ drop [ swap 2array ] dip push ] if ;
 
 M: sequence new-assoc drop <vector> ;
 
@@ -186,10 +189,10 @@ M: sequence delete-at
 M: sequence assoc-size length ;
 
 M: sequence assoc-clone-like
-    >r >alist r> clone-like ;
+    [ >alist ] dip clone-like ;
 
 M: sequence assoc-like
-    >r >alist r> like ;
+    [ >alist ] dip like ;
 
 M: sequence >alist ;
 

core/bootstrap/primitives.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays byte-arrays generic hashtables
-hashtables.private io kernel math math.order namespaces make
+hashtables.private io kernel math math.private math.order
-parser sequences strings vectors words quotations assocs layouts
+namespaces make parser sequences strings vectors words
-classes classes.builtin classes.tuple classes.tuple.private
+quotations assocs layouts classes classes.builtin classes.tuple
-kernel.private vocabs vocabs.loader source-files definitions
+classes.tuple.private kernel.private vocabs vocabs.loader
-slots classes.union classes.intersection classes.predicate
+source-files definitions slots classes.union
-compiler.units bootstrap.image.private io.files accessors
+classes.intersection classes.predicate compiler.units
-combinators ;
+bootstrap.image.private io.files accessors combinators ;
 IN: bootstrap.primitives
 
 "Creating primitives and basic runtime structures..." print flush
@@ -129,8 +129,7 @@ bootstrapping? on
     [ "slots" set-word-prop ] [ define-accessors ] 2bi ;
 
 : define-builtin ( symbol slotspec -- )
-    >r [ define-builtin-predicate ] keep
+    [ [ define-builtin-predicate ] keep ] dip define-builtin-slots ;
-    r> define-builtin-slots ;
 
 "fixnum" "math" create register-builtin
 "bignum" "math" create register-builtin
@@ -186,7 +185,11 @@ define-union-class
 ! A predicate class used for declarations
 "array-capacity" "sequences.private" create
 "fixnum" "math" lookup
-0 bootstrap-max-array-capacity <fake-bignum> [ between? ] 2curry
+[
+    [ dup 0 fixnum>= ] %
+    bootstrap-max-array-capacity <fake-bignum> [ fixnum<= ] curry ,
+    [ [ drop f ] if ] %
+] [ ] make
 define-predicate-class
 
 ! Catch-all class for providing a default method.
@@ -327,9 +330,7 @@ tuple
     [ ]
     [
         [
-            \ >r ,
+            callable instance-check-quot [ dip ] curry %
-            callable instance-check-quot %
-            \ r> ,
             callable instance-check-quot %
             tuple-layout ,
             \ <tuple-boa> ,
@@ -389,7 +390,7 @@ tuple
 
 ! Primitive words
 : make-primitive ( word vocab n -- )
-    >r create dup reset-word r>
+    [ create dup reset-word ] dip
     [ do-primitive ] curry [ ] like define ;
 
 {
@@ -460,7 +461,7 @@ tuple
     { "exit" "system" }
     { "data-room" "memory" }
     { "code-room" "memory" }
-    { "millis" "system" }
+    { "micros" "system" }
     { "modify-code-heap" "compiler.units" }
     { "dlopen" "alien" }
     { "dlsym" "alien" }
@@ -533,7 +534,7 @@ tuple
     { "unimplemented" "kernel.private" }
     { "gc-reset" "memory" }
 }
-[ >r first2 r> make-primitive ] each-index
+[ [ first2 ] dip make-primitive ] each-index
 
 ! Bump build number
 "build" "kernel" create build 1+ 1quotation define

core/checksums/checksums.factor

@@ -12,14 +12,17 @@ GENERIC: checksum-stream ( stream checksum -- value )
 
 GENERIC: checksum-lines ( lines checksum -- value )
 
-M: checksum checksum-bytes >r binary <byte-reader> r> checksum-stream ;
+M: checksum checksum-bytes
+    [ binary <byte-reader> ] dip checksum-stream ;
 
-M: checksum checksum-stream >r contents r> checksum-bytes ;
+M: checksum checksum-stream
+    [ contents ] dip checksum-bytes ;
 
-M: checksum checksum-lines >r B{ CHAR: \n } join r> checksum-bytes ;
+M: checksum checksum-lines
+    [ B{ CHAR: \n } join ] dip checksum-bytes ;
 
 : checksum-file ( path checksum -- value )
-    >r binary <file-reader> r> checksum-stream ;
+    [ binary <file-reader> ] dip checksum-stream ;
 
 : hex-string ( seq -- str )
     [ >hex 2 CHAR: 0 pad-left ] { } map-as concat ;

core/checksums/crc32/crc32.factor

@@ -11,7 +11,7 @@ IN: checksums.crc32
 
 256 [
     8 [
-        dup even? >r 2/ r> [ crc32-polynomial bitxor ] unless
+        [ 2/ ] [ even? ] bi [ crc32-polynomial bitxor ] unless
     ] times >bignum
 ] map 0 crc32-table copy
 
@@ -24,7 +24,7 @@ SINGLETON: crc32
 
 INSTANCE: crc32 checksum
 
-: init-crc32 drop >r HEX: ffffffff dup r> ; inline
+: init-crc32 drop [ HEX: ffffffff dup ] dip ; inline
 
 : finish-crc32 bitxor 4 >be ; inline
 

core/classes/algebra/algebra-tests.factor

@@ -13,9 +13,9 @@ IN: classes.algebra.tests
 \ flatten-class must-infer
 \ flatten-builtin-class must-infer
 
-: class-and* ( cls1 cls2 cls3 -- ? ) >r class-and r> class= ;
+: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;
 
-: class-or* ( cls1 cls2 cls3 -- ? ) >r class-or r> class= ;
+: class-or* ( cls1 cls2 cls3 -- ? ) [ class-or ] dip class= ;
 
 [ t ] [ object  object  object class-and* ] unit-test
 [ t ] [ fixnum  object  fixnum class-and* ] unit-test
@@ -240,9 +240,9 @@ UNION: z1 b1 c1 ;
         20 [ random-boolean-op ] [ ] replicate-as dup .
         [ infer in>> [ random-boolean ] replicate dup . ] keep
         
-        [ >r [ ] each r> call ] 2keep
+        [ [ [ ] each ] dip call ] 2keep
         
-        >r [ boolean>class ] each r> [ boolean-op>class-op ] map call object class=
+        [ [ boolean>class ] each ] dip [ boolean-op>class-op ] map call object class=
         
         =
     ] unit-test

core/classes/algebra/algebra.factor

@@ -18,7 +18,7 @@ TUPLE: anonymous-complement class ;
 C: <anonymous-complement> anonymous-complement
 
 : 2cache ( key1 key2 assoc quot -- value )
-    >r >r 2array r> [ first2 ] r> compose cache ; inline
+    [ 2array ] 2dip [ first2 ] prepose cache ; inline
 
 GENERIC: valid-class? ( obj -- ? )
 
@@ -66,13 +66,13 @@ DEFER: (class-or)
     swap superclass dup [ swap class<= ] [ 2drop f ] if ;
 
 : left-anonymous-union<= ( first second -- ? )
-    >r members>> r> [ class<= ] curry all? ;
+    [ members>> ] dip [ class<= ] curry all? ;
 
 : right-anonymous-union<= ( first second -- ? )
     members>> [ class<= ] with contains? ;
 
 : left-anonymous-intersection<= ( first second -- ? )
-    >r participants>> r> [ class<= ] curry contains? ;
+    [ participants>> ] dip [ class<= ] curry contains? ;
 
 : right-anonymous-intersection<= ( first second -- ? )
     participants>> [ class<= ] with all? ;
@@ -95,7 +95,7 @@ DEFER: (class-or)
     } cond ;
 
 : left-anonymous-complement<= ( first second -- ? )
-    >r normalize-complement r> class<= ;
+    [ normalize-complement ] dip class<= ;
 
 PREDICATE: nontrivial-anonymous-complement < anonymous-complement
     class>> {
@@ -212,7 +212,7 @@ M: anonymous-complement (classes-intersect?)
 : sort-classes ( seq -- newseq )
     [ [ name>> ] compare ] sort >vector
     [ dup empty? not ]
-    [ dup largest-class >r over delete-nth r> ]
+    [ dup largest-class [ over delete-nth ] dip ]
     [ ] produce nip ;
 
 : min-class ( class seq -- class/f )

core/classes/tuple/tuple-tests.factor

@@ -485,7 +485,7 @@ must-fail-with
 [ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test
 
 : accessor-exists? ( class name -- ? )
-    >r "forget-accessors-test" "classes.tuple.tests" lookup r>
+    [ "forget-accessors-test" "classes.tuple.tests" lookup ] dip
     ">>" append "accessors" lookup method >boolean ;
 
 [ t ] [ "x" accessor-exists? ] unit-test

core/classes/tuple/tuple.factor

@@ -58,7 +58,7 @@ PRIVATE>
 
 : tuple>array ( tuple -- array )
     prepare-tuple>array
-    >r copy-tuple-slots r>
+    [ copy-tuple-slots ] dip
     first prefix ;
 
 : tuple-slots ( tuple -- seq )
@@ -178,9 +178,9 @@ ERROR: bad-superclass class ;
 
 : update-slot ( old-values n class initial -- value )
     pick [
-        >r >r swap nth dup r> instance? r> swap
+        [ [ swap nth dup ] dip instance? ] dip swap
         [ drop ] [ nip ] if
-    ] [ >r 3drop r> ] if ;
+    ] [ [ 3drop ] dip ] if ;
 
 : apply-slot-permutation ( old-values triples -- new-values )
     [ first3 update-slot ] with map ;
@@ -233,7 +233,7 @@ M: tuple-class update-class
     class-usages [ tuple-class? ] filter ;
 
 : each-subclass ( class quot -- )
-    >r subclasses r> each ; inline
+    [ subclasses ] dip each ; inline
 
 : redefine-tuple-class ( class superclass slots -- )
     [
@@ -320,7 +320,7 @@ M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ;
 M: tuple hashcode*
     [
         [ class hashcode ] [ tuple-size ] [ ] tri
-        >r rot r> [
+        [ rot ] dip [
             swapd array-nth hashcode* sequence-hashcode-step
         ] 2curry each
     ] recursive-hashcode ;

core/combinators/combinators-docs.factor

@@ -74,7 +74,7 @@ HELP: spread
     { $code
         "! Equivalent"
         "{ [ p ] [ q ] [ r ] [ s ] } spread"
-        ">r >r >r p r> q r> r r> s"
+        "[ [ [ p ] dip q ] dip r ] dip s"
     }
 } ;
 

core/combinators/combinators.factor

@@ -80,7 +80,7 @@ ERROR: no-case ;
         drop [ swap adjoin ] curry each
     ] [
         [
-            >r 2dup r> hashcode pick length rem rot nth adjoin
+            [ 2dup ] dip hashcode pick length rem rot nth adjoin
         ] each 2drop
     ] if ;
 
@@ -88,13 +88,13 @@ ERROR: no-case ;
     next-power-of-2 swap [ nip clone ] curry map ;
 
 : distribute-buckets ( alist initial quot -- buckets )
-    swapd [ >r dup first r> call 2array ] curry map
+    swapd [ [ dup first ] dip call 2array ] curry map
     [ length <buckets> dup ] keep
     [ first2 (distribute-buckets) ] with each ; inline
 
 : hash-case-table ( default assoc -- array )
     V{ } [ 1array ] distribute-buckets
-    [ [ >r literalize r> ] assoc-map linear-case-quot ] with map ;
+    [ [ [ literalize ] dip ] assoc-map linear-case-quot ] with map ;
 
 : hash-dispatch-quot ( table -- quot )
     [ length 1- [ fixnum-bitand ] curry ] keep
@@ -130,20 +130,20 @@ ERROR: no-case ;
         { [ dup [ length 4 <= ] [ [ word? ] contains? ] bi or ] [ drop linear-case-quot ] }
         { [ dup contiguous-range? ] [ drop dispatch-case-quot ] }
         { [ dup [ wrapper? ] contains? not ] [ drop hash-case-quot ] }
-        { [ dup [ wrapper? ] all? ] [ drop [ >r wrapped>> r> ] assoc-map hash-case-quot ] }
+        { [ dup [ wrapper? ] all? ] [ drop [ [ wrapped>> ] dip ] assoc-map hash-case-quot ] }
         [ drop linear-case-quot ]
     } cond ;
 
 ! assert-depth
 : trim-datastacks ( seq1 seq2 -- seq1' seq2' )
-    2dup [ length ] bi@ min tuck tail >r tail r> ;
+    2dup [ length ] bi@ min tuck [ tail ] 2bi@ ;
 
 ERROR: relative-underflow stack ;
 
 ERROR: relative-overflow stack ;
 
 : assert-depth ( quot -- )
-    >r datastack r> dip >r datastack r>
+    [ datastack ] dip dip [ datastack ] dip
     2dup [ length ] compare {
         { +lt+ [ trim-datastacks nip relative-underflow ] }
         { +eq+ [ 2drop ] }

core/compiler/errors/errors.factor

@@ -20,7 +20,7 @@ SYMBOL: with-compiler-errors?
 
 : errors-of-type ( type -- assoc )
     compiler-errors get-global
-    swap [ >r nip compiler-error-type r> eq? ] curry
+    swap [ [ nip compiler-error-type ] dip eq? ] curry
     assoc-filter ;
 
 : compiler-errors. ( type -- )

core/continuations/continuations.factor

@@ -65,7 +65,7 @@ C: <continuation> continuation
     #! ( value f r:capture r:restore )
     #! Execution begins right after the call to 'continuation'.
     #! The 'restore' branch is taken.
-    >r >r dummy-1 continuation r> r> [ dummy-2 ] prepose ?if ; inline
+    [ dummy-1 continuation ] 2dip [ dummy-2 ] prepose ?if ; inline
 
 : callcc0 ( quot -- ) [ drop ] ifcc ; inline
 
@@ -78,7 +78,7 @@ C: <continuation> continuation
     set-catchstack
     set-namestack
     set-retainstack
-    >r set-datastack r>
+    [ set-datastack ] dip
     set-callstack ;
 
 : (continue-with) ( obj continuation -- )
@@ -87,7 +87,7 @@ C: <continuation> continuation
     set-catchstack
     set-namestack
     set-retainstack
-    >r set-datastack drop 4 getenv f 4 setenv f r>
+    [ set-datastack drop 4 getenv f 4 setenv f ] dip
     set-callstack ;
 
 PRIVATE>
@@ -135,14 +135,13 @@ SYMBOL: thread-error-hook
     c> continue-with ;
 
 : recover ( try recovery -- )
-    >r [ swap >c call c> drop ] curry r> ifcc ; inline
+    [ [ swap >c call c> drop ] curry ] dip ifcc ; inline
 
 : ignore-errors ( quot -- )
     [ drop ] recover ; inline
 
 : cleanup ( try cleanup-always cleanup-error -- )
-    over >r compose [ dip rethrow ] curry
+    [ compose [ dip rethrow ] curry recover ] [ drop ] 2bi call ; inline
-    recover r> call ; inline
 
 ERROR: attempt-all-error ;
 

core/generic/math/math.factor

@@ -36,9 +36,10 @@ PREDICATE: math-class < class
 
 : math-upgrade ( class1 class2 -- quot )
     [ math-class-max ] 2keep
-    >r over r> (math-upgrade) >r (math-upgrade)
+    [ over ] dip (math-upgrade) [
+        (math-upgrade)
         dup empty? [ [ dip ] curry [ ] like ] unless
-    r> append ;
+    ] dip append ;
 
 ERROR: no-math-method left right generic ;
 
@@ -55,9 +56,9 @@ ERROR: no-math-method left right generic ;
 
 : math-method ( word class1 class2 -- quot )
     2dup and [
-        2dup math-upgrade >r
+        2dup math-upgrade
-        math-class-max over order min-class applicable-method
+        [ math-class-max over order min-class applicable-method ] dip
-        r> prepend
+        prepend
     ] [
         2drop object-method
     ] if ;
@@ -85,7 +86,7 @@ M: math-combination perform-combination
     dup
     \ over [
         dup math-class? [
-            \ dup [ >r 2dup r> math-method ] math-vtable
+            \ dup [ [ 2dup ] dip math-method ] math-vtable
         ] [
             over object-method
         ] if nip

core/generic/standard/engines/engines.factor

@@ -18,7 +18,7 @@ GENERIC: engine>quot ( engine -- quot )
     [ over assumed [ engine>quot ] with-variable ] assoc-map ;
 
 : if-small? ( assoc true false -- )
-    >r >r dup assoc-size 4 <= r> r> if ; inline
+    [ dup assoc-size 4 <= ] 2dip if ; inline
 
 : linear-dispatch-quot ( alist -- quot )
     default get [ drop ] prepend swap
@@ -45,7 +45,7 @@ GENERIC: engine>quot ( engine -- quot )
         { 0 [ [ dup ] ] }
         { 1 [ [ over ] ] }
         { 2 [ [ pick ] ] }
-        [ 1- (picker) [ >r ] swap [ r> swap ] 3append ]
+        [ 1- (picker) [ dip swap ] curry ]
     } case ;
 
 : picker ( -- quot ) \ (dispatch#) get (picker) ;

core/generic/standard/engines/predicate/predicate.factor

@@ -10,7 +10,7 @@ TUPLE: predicate-dispatch-engine methods ;
 C: <predicate-dispatch-engine> predicate-dispatch-engine
 
 : class-predicates ( assoc -- assoc )
-    [ >r "predicate" word-prop picker prepend r> ] assoc-map ;
+    [ [ "predicate" word-prop picker prepend ] dip ] assoc-map ;
 
 : keep-going? ( assoc -- ? )
     assumed get swap second first class<= ;

core/generic/standard/engines/tag/tag.factor

@@ -26,7 +26,7 @@ C: <lo-tag-dispatch-engine> lo-tag-dispatch-engine
 
 M: lo-tag-dispatch-engine engine>quot
     methods>> engines>quots*
-    [ >r lo-tag-number r> ] assoc-map
+    [ [ lo-tag-number ] dip ] assoc-map
     [
         picker % [ tag ] % [
             sort-tags linear-dispatch-quot
@@ -53,13 +53,13 @@ C: <hi-tag-dispatch-engine> hi-tag-dispatch-engine
 
 M: hi-tag-dispatch-engine engine>quot
     methods>> engines>quots*
-    [ >r hi-tag-number r> ] assoc-map
+    [ [ hi-tag-number ] dip ] assoc-map
     [
         picker % hi-tag-quot % [
             sort-tags linear-dispatch-quot
         ] [
             num-tags get , \ fixnum-fast ,
-            [ >r num-tags get - r> ] assoc-map
+            [ [ num-tags get - ] dip ] assoc-map
             num-hi-tags direct-dispatch-quot
         ] if-small? %
     ] [ ] make ;

core/generic/standard/standard.factor

@@ -33,8 +33,8 @@ ERROR: no-method object generic ;
     ] change-at ;
 
 : flatten-method ( class method assoc -- )
-    >r >r dup flatten-class keys swap r> r> [
+    [ dup flatten-class keys swap ] 2dip [
-        >r spin r> push-method
+        [ spin ] dip push-method
     ] 3curry each ;
 
 : flatten-methods ( assoc -- assoc' )
@@ -113,7 +113,7 @@ PREDICATE: simple-generic < standard-generic
     T{ standard-combination f 0 } define-generic ;
 
 : with-standard ( combination quot -- quot' )
-    >r #>> (dispatch#) r> with-variable ; inline
+    [ #>> (dispatch#) ] dip with-variable ; inline
 
 M: standard-generic extra-values drop 0 ;
 

core/growable/growable.factor

@@ -43,10 +43,10 @@ M: growable set-length ( n seq -- )
     growable-check
     2dup length >= [
         2dup capacity >= [ over new-size over expand ] when
-        >r >fixnum r>
+        [ >fixnum ] dip
         over 1 fixnum+fast over (>>length)
     ] [
-        >r >fixnum r>
+        [ >fixnum ] dip
     ] if ; inline
 
 M: growable set-nth ensure set-nth-unsafe ;

core/hashtables/hashtables-tests.factor

@@ -134,7 +134,7 @@ H{ } "x" set
 
 [ H{ { -1 4 } { -3 16 } { -5 36 } } ] [
     H{ { 1 2 } { 3 4 } { 5 6 } }
-    [ >r neg r> sq ] assoc-map
+    [ [ neg ] dip sq ] assoc-map
 ] unit-test
 
 ! Bug discovered by littledan

core/hashtables/hashtables.factor

@@ -15,7 +15,7 @@ TUPLE: hashtable
     length>> 1 fixnum-fast fixnum-bitand ; inline
 
 : hash@ ( key array -- i )
-    >r hashcode >fixnum dup fixnum+fast r> wrap ; inline
+    [ hashcode >fixnum dup fixnum+fast ] dip wrap ; inline
 
 : probe ( array i -- array i )
     2 fixnum+fast over wrap ; inline
@@ -105,7 +105,7 @@ M: hashtable clear-assoc ( hash -- )
 
 M: hashtable delete-at ( key hash -- )
     tuck key@ [
-        >r >r ((tombstone)) dup r> r> set-nth-pair
+        [ ((tombstone)) dup ] 2dip set-nth-pair
         hash-deleted+
     ] [
         3drop
@@ -115,9 +115,9 @@ M: hashtable assoc-size ( hash -- n )
     [ count>> ] [ deleted>> ] bi - ;
 
 : rehash ( hash -- )
-    dup >alist >r
+    dup >alist [
     dup clear-assoc
-    r> (rehash) ;
+    ] dip (rehash) ;
 
 M: hashtable set-at ( value key hash -- )
     dup ?grow-hash
@@ -133,7 +133,7 @@ M: hashtable set-at ( value key hash -- )
 : push-unsafe ( elt seq -- )
     [ length ] keep
     [ underlying>> set-array-nth ]
-    [ >r 1+ r> (>>length) ]
+    [ [ 1+ ] dip (>>length) ]
     2bi ; inline
 
 PRIVATE>
@@ -141,9 +141,10 @@ PRIVATE>
 M: hashtable >alist
     [ array>> [ length 2/ ] keep ] [ assoc-size <vector> ] bi [
         [
-            >r
+            [
-            >r 1 fixnum-shift-fast r>
+                [ 1 fixnum-shift-fast ] dip
-            [ array-nth ] [ >r 1 fixnum+fast r> array-nth ] 2bi r>
+                [ array-nth ] [ [ 1 fixnum+fast ] dip array-nth ] 2bi
+            ] dip
             pick tombstone? [ 3drop ] [ [ 2array ] dip push-unsafe ] if
         ] 2curry each
     ] keep { } like ;

core/io/backend/backend-docs.factor

@@ -2,8 +2,8 @@ USING: help.markup help.syntax io io.backend strings
 byte-arrays ;
 
 HELP: io-multiplex
-{ $values { "ms" "a non-negative integer" } }
+{ $values { "us" "a non-negative integer" } }
-{ $contract "Waits up to " { $snippet "ms" } " milliseconds for pending I/O requests to complete." } ;
+{ $contract "Waits up to " { $snippet "us" } " microseconds for pending I/O requests to complete." } ;
 
 HELP: init-io
 { $contract "Initializes the I/O system. Called on startup." } ;

core/io/encodings/encodings.factor

@@ -95,7 +95,7 @@ M: decoder stream-read-partial stream-read ;
 
 : ((read-until)) ( buf quot: ( -- char stop? ) -- string/f sep/f )
     dup call
-    [ >r drop "" like r> ]
+    [ [ drop "" like ] dip ]
     [ pick push ((read-until)) ] if ; inline recursive
 
 : (read-until) ( quot -- string/f sep/f )

core/io/files/files.factor

@@ -26,13 +26,13 @@ HOOK: (file-appender) io-backend ( path -- stream )
     <file-reader> lines ;
 
 : with-file-reader ( path encoding quot -- )
-    >r <file-reader> r> with-input-stream ; inline
+    [ <file-reader> ] dip with-input-stream ; inline
 
 : file-contents ( path encoding -- str )
     <file-reader> contents ;
 
 : with-file-writer ( path encoding quot -- )
-    >r <file-writer> r> with-output-stream ; inline
+    [ <file-writer> ] dip with-output-stream ; inline
 
 : set-file-lines ( seq path encoding -- )
     [ [ print ] each ] with-file-writer ;
@@ -41,7 +41,7 @@ HOOK: (file-appender) io-backend ( path -- stream )
     [ write ] with-file-writer ;
 
 : with-file-appender ( path encoding quot -- )
-    >r <file-appender> r> with-output-stream ; inline
+    [ <file-appender> ] dip with-output-stream ; inline
 
 ! Pathnames
 : path-separator? ( ch -- ? ) os windows? "/\\" "/" ? member? ;
@@ -127,13 +127,13 @@ PRIVATE>
         { [ dup head.? ] [ rest trim-left-separators append-path ] }
         { [ dup head..? ] [
             2 tail trim-left-separators
-            >r parent-directory r> append-path
+            [ parent-directory ] dip append-path
         ] }
         { [ over absolute-path? over first path-separator? and ] [
-            >r 2 head r> append
+            [ 2 head ] dip append
         ] }
         [
-            >r trim-right-separators "/" r>
+            [ trim-right-separators "/" ] dip
             trim-left-separators 3append
         ]
     } cond ;
@@ -166,7 +166,7 @@ HOOK: make-link io-backend ( target symlink -- )
 HOOK: read-link io-backend ( symlink -- path )
 
 : copy-link ( target symlink -- )
-    >r read-link r> make-link ;
+    [ read-link ] dip make-link ;
 
 SYMBOL: +regular-file+
 SYMBOL: +directory+
@@ -228,7 +228,7 @@ M: object normalize-path ( path -- path' )
     (normalize-path) current-directory set ;
 
 : with-directory ( path quot -- )
-    >r (normalize-path) current-directory r> with-variable ; inline
+    [ (normalize-path) current-directory ] dip with-variable ; inline
 
 ! Creating directories
 HOOK: make-directory io-backend ( path -- )

core/io/io.factor

@@ -69,7 +69,7 @@ SYMBOL: error-stream
     [ ] cleanup ; inline
 
 : tabular-output ( style quot -- )
-    swap >r { } make r> output-stream get stream-write-table ; inline
+    swap [ { } make ] dip output-stream get stream-write-table ; inline
 
 : with-row ( quot -- )
     { } make , ; inline
@@ -89,8 +89,8 @@ SYMBOL: error-stream
     ] if ; inline
 
 : with-nesting ( style quot -- )
-    >r output-stream get make-block-stream
+    [ output-stream get make-block-stream ] dip
-    r> with-output-stream ; inline
+    with-output-stream ; inline
 
 : print ( string -- ) output-stream get stream-print ;
 

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

@@ -6,11 +6,11 @@ IN: io.streams.byte-array
     512 <byte-vector> swap <encoder> ;
 
 : with-byte-writer ( encoding quot -- byte-array )
-    >r <byte-writer> r> [ output-stream get ] compose with-output-stream*
+    [ <byte-writer> ] dip [ output-stream get ] compose with-output-stream*
     dup encoder? [ stream>> ] when >byte-array ; inline
 
 : <byte-reader> ( byte-array encoding -- stream )
-    >r >byte-vector dup reverse-here r> <decoder> ;
+    [ >byte-vector dup reverse-here ] dip <decoder> ;
 
 : with-byte-reader ( byte-array encoding quot -- )
-    >r <byte-reader> r> with-input-stream* ; inline
+    [ <byte-reader> ] dip with-input-stream* ; inline

core/io/streams/c/c.factor

@@ -67,7 +67,7 @@ M: c-io-backend init-io ;
 
 M: c-io-backend (init-stdio) init-c-stdio ;
 
-M: c-io-backend io-multiplex 60 60 * 1000 * or (sleep) ;
+M: c-io-backend io-multiplex 60 60 * 1000 * 1000 * or (sleep) ;
 
 M: c-io-backend (file-reader)
     "rb" fopen <c-reader> ;

core/io/streams/nested/nested.factor

@@ -56,7 +56,7 @@ M: style-stream stream-write
     [ style>> ] [ stream>> ] bi stream-format ;
 
 M: style-stream stream-write1
-    >r 1string r> stream-write ;
+    [ 1string ] dip stream-write ;
 
 M: style-stream make-span-stream
     do-nested-style make-span-stream ;

core/io/streams/string/string.factor

@@ -24,7 +24,7 @@ M: null-encoding decode-char drop stream-read1 ;
     ] unless ;
 
 : map-last ( seq quot -- seq )
-    >r dup length <reversed> [ zero? ] r> compose 2map ; inline
+    [ dup length <reversed> ] dip [ 0 = ] prepose 2map ; inline
 
 PRIVATE>
 
@@ -75,7 +75,7 @@ M: growable stream-read-partial
     >sbuf dup reverse-here null-encoding <decoder> ;
 
 : with-string-reader ( str quot -- )
-    >r <string-reader> r> with-input-stream ; inline
+    [ <string-reader> ] dip with-input-stream ; inline
 
 INSTANCE: growable plain-writer
 

core/kernel/kernel-docs.factor

@@ -29,12 +29,6 @@ HELP: spin                           $shuffle ;
 HELP: roll                           $shuffle ;
 HELP: -roll                          $shuffle ;
 
-HELP: >r ( x -- )
-{ $values { "x" object } } { $description "Moves the top of the data stack to the retain stack." } ;
-
-HELP: r> ( -- x )
-{ $values { "x" object } } { $description "Moves the top of the retain stack to the data stack." } ;
-
 HELP: datastack ( -- ds )
 { $values { "ds" array } }
 { $description "Outputs an array containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the array." } ;
@@ -212,7 +206,10 @@ HELP: 3slip
 
 HELP: keep
 { $values { "quot" { $quotation "( x -- )" } } { "x" object } }
-{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." } ;
+{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." }
+{ $examples
+    { $example "USING: arrays kernel prettyprint ;" "2 \"greetings\" [ <array> ] keep 2array ." "{ { \"greetings\" \"greetings\" } \"greetings\" }" }
+} ;
 
 HELP: 2keep
 { $values { "quot" { $quotation "( x y -- )" } } { "x" object } { "y" object } }
@@ -347,7 +344,7 @@ HELP: bi*
     "The following two lines are equivalent:"
     { $code
         "[ p ] [ q ] bi*"
-        ">r p r> q"
+        "[ p ] dip q"
     }
 } ;
 
@@ -358,7 +355,7 @@ HELP: 2bi*
     "The following two lines are equivalent:"
     { $code
         "[ p ] [ q ] 2bi*"
-        ">r >r p r> r> q"
+        "[ p ] 2dip q"
     }
 } ;
 
@@ -369,7 +366,7 @@ HELP: tri*
     "The following two lines are equivalent:"
     { $code
         "[ p ] [ q ] [ r ] tri*"
-        ">r >r p r> q r> r"
+        "[ [ p ] dip q ] dip r"
     }
 } ;
 
@@ -380,7 +377,7 @@ HELP: bi@
     "The following two lines are equivalent:"
     { $code
         "[ p ] bi@"
-        ">r p r> p"
+        "[ p ] dip p"
     }
     "The following two lines are also equivalent:"
     { $code
@@ -396,7 +393,7 @@ HELP: 2bi@
     "The following two lines are equivalent:"
     { $code
         "[ p ] 2bi@"
-        ">r >r p r> r> p"
+        "[ p ] 2dip p"
     }
     "The following two lines are also equivalent:"
     { $code
@@ -412,7 +409,7 @@ HELP: tri@
     "The following two lines are equivalent:"
     { $code
         "[ p ] tri@"
-        ">r >r p r> p r> p"
+        "[ [ p ] dip p ] dip p"
     }
     "The following two lines are also equivalent:"
     { $code
@@ -565,11 +562,7 @@ HELP: compose
 { $values { "quot1" callable } { "quot2" callable } { "compose" compose } }
 { $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } " followed by " { $snippet "quot2" } "." }
 { $notes
-    "The two quotations must leave the retain stack in the same state on exit as it was on entry, so the following code is not allowed:"
+    "The following two lines are equivalent:"
-    { $code
-        "[ 3 >r ] [ r> . ] compose"
-    }
-    "Except for this restriction, the following two lines are equivalent:"
     { $code
         "compose call"
         "append call"
@@ -589,15 +582,7 @@ 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 three quotations must leave the retain stack in the same state on exit as it was on entry, so for example, the following code is not allowed:"
+    "The following two lines are equivalent:"
-    { $code
-        "[ >r ] swap [ r> ] 3compose"
-    }
-    "The correct way to achieve the effect of the above is the following:"
-    { $code
-        "[ dip ] curry"
-    }
-    "Excepting the retain stack restriction, the following two lines are equivalent:"
     { $code
         "3compose call"
         "3append call"
@@ -608,16 +593,15 @@ HELP: 3compose
 HELP: dip
 { $values { "x" object } { "quot" quotation } }
 { $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." }
-{ $notes "The following are equivalent:"
+{ $examples
-    { $code ">r foo bar r>" }
+    { $example "USING: arrays kernel math prettyprint ;" "10 20 30 [ / ] dip 2array ." "{ 1/2 30 }" }
-    { $code "[ foo bar ] dip" }
 } ;
 
 HELP: 2dip
 { $values { "x" object } { "y" object } { "quot" quotation } }
 { $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } " and " { $snippet "obj2" } " hidden on the retain stack." }
 { $notes "The following are equivalent:"
-    { $code ">r >r foo bar r> r>" }
+    { $code "[ [ foo bar ] dip ] dip" }
     { $code "[ foo bar ] 2dip" }
 } ;
 
@@ -625,7 +609,7 @@ HELP: 3dip
 { $values { "x" object } { "y" object } { "z" object } { "quot" quotation } }
 { $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } ", " { $snippet "obj2" } " and " { $snippet "obj3" } " hidden on the retain stack." }
 { $notes "The following are equivalent:"
-    { $code ">r >r >r foo bar r> r> r>" }
+    { $code "[ [ [ foo bar ] dip ] dip ] dip" }
     { $code "[ foo bar ] 3dip" }
 } ;
 
@@ -692,15 +676,7 @@ $nl
 { $subsection -rot }
 { $subsection spin }
 { $subsection roll }
-{ $subsection -roll }
+{ $subsection -roll } ;
-"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using the following two words:"
-{ $subsection >r }
-{ $subsection r> }
-"The top of the data stack is ``hidden'' between " { $link >r } " and " { $link r> } ":"
-{ $example "1 2 3 >r .s r>" "1\n2" }
-"Usages of " { $link >r } " and " { $link r> } " must be balanced within a single quotation; quotations are not permitted to pop retain stack elements they did not push, or leave elements on the retain stack after returning."
-$nl
-"The " { $link "inference" } " tool checks retain stack usage. The " { $link "slip-keep-combinators" } " combinators abstract out common retain stack usage patterns." ;
 
 ARTICLE: "cleave-shuffle-equivalence" "Expressing shuffle words with cleave combinators"
 "Cleave combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to cleave combinators are discussed in the documentation for " { $link bi } ", " { $link 2bi } ", " { $link 3bi } ", " { $link tri } ", " { $link 2tri } " and " { $link 3tri } "."
@@ -793,14 +769,10 @@ $nl
 { $subsection tri* }
 "Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:"
 { $code
-    "! First alternative; uses retain stack explicitly"
+    "! First alternative; uses dip"
-    ">r >r 1 +"
+    "[ [ 1 + ] dip 1 - dip ] 2 *"
-    "r> 1 -"
-    "r> 2 *"
     "! Second alternative: uses tri*"
-    "[ 1 + ]"
+    "[ 1 + ] [ 1 - ] [ 2 * ] tri*"
-    "[ 1 - ]"
-    "[ 2 * ] tri*"
 }
 
 $nl
@@ -819,7 +791,9 @@ $nl
 { $subsection both? }
 { $subsection either? } ;
 
-ARTICLE: "slip-keep-combinators" "The dip, slip and keep combinators"
+ARTICLE: "slip-keep-combinators" "Retain stack combinators"
+"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
+$nl
 "The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
 { $subsection dip }
 { $subsection 2dip }
@@ -851,7 +825,7 @@ ARTICLE: "implementing-combinators" "Implementing combinators"
 "These words are used to implement combinators. Note that combinator definitions must be followed by the " { $link POSTPONE: inline } " declaration in order to compile in the optimizing compiler; for example:"
 { $code
     ": keep ( x quot -- x )"
-    "    over >r call r> ; inline"
+    "    over [ call ] dip ; inline"
 }
 "Word inlining is documented in " { $link "declarations" } "." ;
 
@@ -935,10 +909,10 @@ ARTICLE: "dataflow" "Data and control flow"
 { $subsection "booleans" }
 { $subsection "shuffle-words" }
 "A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
+{ $subsection "slip-keep-combinators" }
 { $subsection "cleave-combinators" }
 { $subsection "spread-combinators" }
 { $subsection "apply-combinators" }
-{ $subsection "slip-keep-combinators" }
 { $subsection "conditionals" }
 { $subsection "compositional-combinators" }
 { $subsection "combinators" }

core/kernel/kernel-tests.factor

@@ -106,11 +106,11 @@ IN: kernel.tests
 
 ! Regression
 : (loop) ( a b c d -- )
-    >r pick r> swap >r pick r> swap
+    [ pick ] dip swap [ pick ] dip swap
-    < [ >r >r >r 1+ r> r> r> (loop) ] [ 2drop 2drop ] if ; inline
+    < [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline
 
 : loop ( obj obj -- )
-    H{ } values swap >r dup length swap r> 0 -roll (loop) ;
+    H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;
 
 [ loop ] must-fail
 

core/kernel/kernel.factor

@@ -3,12 +3,16 @@
 USING: kernel.private slots.private classes.tuple.private ;
 IN: kernel
 
+DEFER: dip
+DEFER: 2dip
+DEFER: 3dip
+
 ! Stack stuff
 : spin ( x y z -- z y x ) swap rot ; inline
 
-: roll ( x y z t -- y z t x ) >r rot r> swap ; inline
+: roll ( x y z t -- y z t x ) [ rot ] dip swap ; inline
 
-: -roll ( x y z t -- t x y z ) swap >r -rot r> ; inline
+: -roll ( x y z t -- t x y z ) swap [ -rot ] dip ; inline
 
 : 2over ( x y z -- x y z x y ) pick pick ; inline
 
@@ -49,56 +53,68 @@ DEFER: if
     pick [ roll 2drop call ] [ 2nip call ] if ; inline
 
 ! Slippers
-: slip ( quot x -- x ) >r call r> ; inline
+: slip ( quot x -- x )
+    #! 'slip' and 'dip' can be defined in terms of each other
+    #! because the JIT special-cases a 'dip' preceeded by
+    #! a literal quotation.
+    [ call ] dip ;
 
-: 2slip ( quot x y -- x y ) >r >r call r> r> ; inline
+: 2slip ( quot x y -- x y )
+    #! '2slip' and '2dip' can be defined in terms of each other
+    #! because the JIT special-cases a '2dip' preceeded by
+    #! a literal quotation.
+    [ call ] 2dip ;
 
-: 3slip ( quot x y z -- x y z ) >r >r >r call r> r> r> ; inline
+: 3slip ( quot x y z -- x y z )
+    #! '3slip' and '3dip' can be defined in terms of each other
+    #! because the JIT special-cases a '3dip' preceeded by
+    #! a literal quotation.
+    [ call ] 3dip ;
 
 : dip ( x quot -- x ) swap slip ; inline
 
-: 2dip ( x y quot -- x y ) swap >r dip r> ; inline
+: 2dip ( x y quot -- x y ) -rot 2slip ; inline
 
-: 3dip ( x y z quot -- x y z ) swap >r 2dip r> ; inline
+: 3dip ( x y z quot -- x y z ) -roll 3slip ; inline
 
 ! Keepers
-: keep ( x quot -- x ) dupd dip ; inline
+: keep ( x quot -- x ) over slip ; inline
 
-: 2keep ( x y quot -- x y ) >r 2dup r> 2dip ; inline
+: 2keep ( x y quot -- x y ) [ 2dup ] dip 2dip ; inline
 
-: 3keep ( x y z quot -- x y z ) >r 3dup r> 3dip ; inline
+: 3keep ( x y z quot -- x y z ) [ 3dup ] dip 3dip ; inline
 
 ! Cleavers
 : bi ( x p q -- )
-    >r keep r> call ; inline
+    [ keep ] dip call ; inline
 
 : tri ( x p q r -- )
-    >r >r keep r> keep r> call ; inline
+    [ [ keep ] dip keep ] dip call ; inline
 
 ! Double cleavers
 : 2bi ( x y p q -- )
-    >r 2keep r> call ; inline
+    [ 2keep ] dip call ; inline
 
 : 2tri ( x y p q r -- )
-    >r >r 2keep r> 2keep r> call ; inline
+    [ [ 2keep ] dip 2keep ] dip call ; inline
 
 ! Triple cleavers
 : 3bi ( x y z p q -- )
-    >r 3keep r> call ; inline
+    [ 3keep ] dip call ; inline
 
 : 3tri ( x y z p q r -- )
-    >r >r 3keep r> 3keep r> call ; inline
+    [ [ 3keep ] dip 3keep ] dip call ; inline
 
 ! Spreaders
 : bi* ( x y p q -- )
-    >r dip r> call ; inline
+    [ dip ] dip call ; inline
 
 : tri* ( x y z p q r -- )
-    >r >r 2dip r> dip r> call ; inline
+    [ [ 2dip ] dip dip ] dip call ; inline
 
 ! Double spreaders
 : 2bi* ( w x y z p q -- )
-    >r 2dip r> call ; inline
+    [ 2dip ] dip call ; inline
 
 ! Appliers
 : bi@ ( x y quot -- )
@@ -115,8 +131,8 @@ DEFER: if
     dup slip swap [ loop ] [ drop ] if ; inline recursive
 
 : while ( pred: ( -- ? ) body: ( -- ) tail: ( -- ) -- )
-    >r >r dup slip r> r> roll
+    [ dup slip ] 2dip roll
-    [ >r tuck 2slip r> while ]
+    [ [ tuck 2slip ] dip while ]
     [ 2nip call ] if ; inline recursive
 
 ! Object protocol
@@ -182,7 +198,7 @@ GENERIC: boa ( ... class -- tuple )
 : either? ( x y quot -- ? ) bi@ or ; inline
 
 : most ( x y quot -- z )
-    >r 2dup r> call [ drop ] [ nip ] if ; inline
+    [ 2dup ] dip call [ drop ] [ nip ] if ; inline
 
 ! Error handling -- defined early so that other files can
 ! throw errors before continuations are loaded

core/lexer/lexer.factor

@@ -23,7 +23,7 @@ TUPLE: lexer text line line-text line-length column ;
     lexer new-lexer ;
 
 : skip ( i seq ? -- n )
-    >r tuck r>
+    [ tuck ] dip
     [ swap CHAR: \s eq? xor ] curry find-from drop
     [ ] [ length ] ?if ;
 

core/math/integers/integers.factor

@@ -25,7 +25,7 @@ M: fixnum + fixnum+ ;
 M: fixnum - fixnum- ;
 M: fixnum * fixnum* ;
 M: fixnum /i fixnum/i ;
-M: fixnum /f >r >float r> >float float/f ;
+M: fixnum /f [ >float ] dip >float float/f ;
 
 M: fixnum mod fixnum-mod ;
 
@@ -41,7 +41,7 @@ M: fixnum bitnot fixnum-bitnot ;
 M: fixnum bit? neg shift 1 bitand 0 > ;
 
 : (fixnum-log2) ( accum n -- accum )
-    dup 1 number= [ drop ] [ >r 1+ r> 2/ (fixnum-log2) ] if ;
+    dup 1 number= [ drop ] [ [ 1+ ] [ 2/ ] bi* (fixnum-log2) ] if ;
     inline recursive
 
 M: fixnum (log2) 0 swap (fixnum-log2) ;
@@ -94,7 +94,7 @@ M: bignum (log2) bignum-log2 ;
 
 : pre-scale ( num den -- scale shifted-num scaled-den )
     2dup [ log2 ] bi@ -
-    tuck [ neg 54 + shift ] [ >r scale-denonimator r> + ] 2bi*
+    tuck [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] 2bi*
     -rot ; inline
 
 ! Second step: loop
@@ -103,7 +103,7 @@ M: bignum (log2) bignum-log2 ;
 
 : /f-loop ( scale mantissa den -- scale' fraction-and-guard rem )
     [ 2dup /i log2 53 > ]
-    [ >r shift-mantissa r> ]
+    [ [ shift-mantissa ] dip ]
     [ ] while /mod ; inline
 
 ! Third step: post-scaling
@@ -111,7 +111,7 @@ M: bignum (log2) bignum-log2 ;
     52 2^ 1- bitand 1022 52 shift bitor bits>double ; inline
 
 : scale-float ( scale mantissa -- float' )
-    >r dup 0 < [ neg 2^ recip ] [ 2^ ] if r> * ; inline
+    [ dup 0 < [ neg 2^ recip ] [ 2^ ] if ] dip * ; inline
 
 : post-scale ( scale mantissa -- n )
     2/ dup log2 52 > [ shift-mantissa ] when

core/math/math.factor

@@ -107,7 +107,7 @@ M: float fp-infinity? ( float -- ? )
     2dup >= [
         drop
     ] [
-        >r 1 shift r> (next-power-of-2)
+        [ 1 shift ] dip (next-power-of-2)
     ] if ;
 
 : next-power-of-2 ( m -- n ) 2 swap (next-power-of-2) ; foldable
@@ -122,13 +122,13 @@ M: float fp-infinity? ( float -- ? )
 
 : iterate-prep 0 -rot ; inline
 
-: if-iterate? >r >r 2over < r> r> if ; inline
+: if-iterate? [ 2over < ] 2dip if ; inline
 
 : iterate-step ( i n quot -- i n quot )
     #! Apply quot to i, keep i and quot, hide n.
-    swap >r 2dup 2slip r> swap ; inline
+    swap [ 2dup 2slip ] dip swap ; inline
 
-: iterate-next >r >r 1+ r> r> ; inline
+: iterate-next [ 1+ ] 2dip ; inline
 
 PRIVATE>
 
@@ -167,6 +167,6 @@ PRIVATE>
         2dup 2slip rot [
             drop
         ] [
-            >r 1- r> find-last-integer
+            [ 1- ] dip find-last-integer
         ] if
     ] if ; inline recursive

core/math/parser/parser.factor

@@ -51,12 +51,12 @@ SYMBOL: negative?
 : (base>) ( str -- n ) radix get base> ;
 
 : whole-part ( str -- m n )
-    sign split1 >r (base>) r>
+    sign split1 [ (base>) ] dip
     dup [ (base>) ] [ drop 0 swap ] if ;
 
 : string>ratio ( str -- a/b )
     "-" ?head dup negative? set swap
-    "/" split1 (base>) >r whole-part r>
+    "/" split1 (base>) [ whole-part ] dip
     3dup and and [ / + swap [ neg ] when ] [ 2drop 2drop f ] if ;
 
 : valid-digits? ( seq -- ? )
@@ -137,7 +137,7 @@ M: ratio >base
     {
         {
             [ CHAR: e over member? ]
-            [ "e" split1 >r fix-float "e" r> 3append ]
+            [ "e" split1 [ fix-float "e" ] dip 3append ]
         } {
             [ CHAR: . over member? ]
             [ ]

core/namespaces/namespaces.factor

@@ -23,7 +23,7 @@ PRIVATE>
 : off ( variable -- ) f swap set ; inline
 : get-global ( variable -- value ) global at ;
 : set-global ( value variable -- ) global set-at ;
-: change ( variable quot -- ) >r dup get r> rot slip set ; inline
+: change ( variable quot -- ) [ [ get ] keep ] dip dip set ; inline
 : +@ ( n variable -- ) [ 0 or + ] change ;
 : inc ( variable -- ) 1 swap +@ ; inline
 : dec ( variable -- ) -1 swap +@ ; inline
@@ -37,4 +37,4 @@ PRIVATE>
     H{ } clone >n call ndrop ; inline
 
 : with-variable ( value key quot -- )
-    >r associate >n r> call ndrop ; inline
+    [ associate >n ] dip call ndrop ; inline

core/parser/parser-tests.factor

@@ -498,3 +498,5 @@ DEFER: blah
 [ error>> error>> def>> \ blah eq? ] must-fail-with
 
 [ ] [ f lexer set f file set "Hello world" note. ] unit-test
+
+[ "CHAR: \\u9999999999999" eval ] must-fail

core/parser/parser.factor

@@ -10,7 +10,7 @@ IN: parser
 
 : location ( -- loc )
     file get lexer get line>> 2dup and
-    [ >r path>> r> 2array ] [ 2drop f ] if ;
+    [ [ path>> ] dip 2array ] [ 2drop f ] if ;
 
 : save-location ( definition -- )
     location remember-definition ;
@@ -140,7 +140,7 @@ ERROR: staging-violation word ;
     } cond ;
 
 : (parse-until) ( accum end -- accum )
-    dup >r parse-step [ r> (parse-until) ] [ r> drop ] if ;
+    [ parse-step ] keep swap [ (parse-until) ] [ drop ] if ;
 
 : parse-until ( end -- vec )
     100 <vector> swap (parse-until) ;
@@ -156,7 +156,7 @@ ERROR: staging-violation word ;
     lexer-factory get call (parse-lines) ;
 
 : parse-literal ( accum end quot -- accum )
-    >r parse-until r> call parsed ; inline
+    [ parse-until ] dip call parsed ; inline
 
 : parse-definition ( -- quot )
     \ ; parse-until >quotation ;

core/quotations/quotations.factor

@@ -49,7 +49,10 @@ M: wrapper literalize <wrapper> ;
 M: curry length quot>> length 1+ ;
 
 M: curry nth
-    over zero? [ nip obj>> literalize ] [ >r 1- r> quot>> nth ] if ;
+    over 0 =
+    [ nip obj>> literalize ]
+    [ [ 1- ] dip quot>> nth ]
+    if ;
 
 INSTANCE: curry immutable-sequence
 

core/sequences/sequences.factor

@@ -16,7 +16,7 @@ GENERIC: like ( seq exemplar -- newseq ) flushable
 GENERIC: clone-like ( seq exemplar -- newseq ) flushable
 
 : new-like ( len exemplar quot -- seq )
-    over >r >r new-sequence r> call r> like ; inline
+    over [ [ new-sequence ] dip call ] dip like ; inline
 
 M: sequence like drop ;
 
@@ -111,14 +111,14 @@ INSTANCE: integer immutable-sequence
     [ first3-unsafe 3 ] [ nth-unsafe ] bi ; inline
 
 : exchange-unsafe ( m n seq -- )
-    [ tuck nth-unsafe >r nth-unsafe r> ] 3keep tuck
+    [ tuck [ nth-unsafe ] 2bi@ ]
-    >r >r set-nth-unsafe r> r> set-nth-unsafe ; inline
+    [ tuck [ set-nth-unsafe ] 2bi@ ] 3bi ; inline
 
 : (head) ( seq n -- from to seq ) 0 spin ; inline
 
 : (tail) ( seq n -- from to seq ) over length rot ; inline
 
-: from-end >r dup length r> - ; inline
+: from-end [ dup length ] dip - ; inline
 
 : (2sequence)
     tuck 1 swap set-nth-unsafe
@@ -188,7 +188,7 @@ TUPLE: slice
 { seq read-only } ;
 
 : collapse-slice ( m n slice -- m' n' seq )
-    [ from>> ] [ seq>> ] bi >r tuck + >r + r> r> ; inline
+    [ from>> ] [ seq>> ] bi [ tuck [ + ] 2bi@ ] dip ; inline
 
 ERROR: slice-error from to seq reason ;
 
@@ -253,12 +253,12 @@ INSTANCE: repetition immutable-sequence
 
 : prepare-subseq ( from to seq -- dst i src j n )
     #! The check-length call forces partial dispatch
-    [ >r swap - r> new-sequence dup 0 ] 3keep
+    [ [ swap - ] dip new-sequence dup 0 ] 3keep
     -rot drop roll length check-length ; inline
 
 : check-copy ( src n dst -- )
     over 0 < [ bounds-error ] when
-    >r swap length + r> lengthen ; inline
+    [ swap length + ] dip lengthen ; inline
 
 PRIVATE>
 
@@ -279,11 +279,11 @@ PRIVATE>
 
 : copy ( src i dst -- )
     #! The check-length call forces partial dispatch
-    pick length check-length >r 3dup check-copy spin 0 r>
+    pick length check-length [ 3dup check-copy spin 0 ] dip
     (copy) drop ; inline
 
 M: sequence clone-like
-    >r dup length r> new-sequence [ 0 swap copy ] keep ;
+    [ dup length ] dip new-sequence [ 0 swap copy ] keep ;
 
 M: immutable-sequence clone-like like ;
 
@@ -291,31 +291,31 @@ M: immutable-sequence clone-like like ;
 
 <PRIVATE
 
-: ((append)) ( seq1 seq2 accum -- accum )
+: (append) ( seq1 seq2 accum -- accum )
-    [ >r over length r> copy ]
+    [ [ over length ] dip copy ]
     [ 0 swap copy ]
     [ ] tri ; inline
 
-: (append) ( seq1 seq2 exemplar -- newseq )
-    >r over length over length + r>
-    [ ((append)) ] new-like ; inline
-
-: (3append) ( seq1 seq2 seq3 exemplar -- newseq )
-    >r pick length pick length pick length + + r> [
-        [ >r pick length pick length + r> copy ]
-        [ ((append)) ] bi
-    ] new-like ; inline
-
 PRIVATE>
 
-: append ( seq1 seq2 -- newseq ) over (append) ;
+: append-as ( seq1 seq2 exemplar -- newseq )
+    [ over length over length + ] dip
+    [ (append) ] new-like ; inline
+
+: 3append-as ( seq1 seq2 seq3 exemplar -- newseq )
+    [ pick length pick length pick length + + ] dip [
+        [ [ pick length pick length + ] dip copy ]
+        [ (append) ] bi
+    ] new-like ; inline
+
+: append ( seq1 seq2 -- newseq ) over append-as ;
 
 : prepend ( seq1 seq2 -- newseq ) swap append ; inline
 
-: 3append ( seq1 seq2 seq3 -- newseq ) pick (3append) ;
+: 3append ( seq1 seq2 seq3 -- newseq ) pick 3append-as ;
 
 : change-nth ( i seq quot -- )
-    [ >r nth r> call ] 3keep drop set-nth ; inline
+    [ [ nth ] dip call ] 3keep drop set-nth ; inline
 
 : min-length ( seq1 seq2 -- n ) [ length ] bi@ min ; inline
 
@@ -324,32 +324,32 @@ PRIVATE>
 <PRIVATE
 
 : (each) ( seq quot -- n quot' )
-    >r dup length swap [ nth-unsafe ] curry r> compose ; inline
+    [ dup length swap [ nth-unsafe ] curry ] dip compose ; inline
 
 : (collect) ( quot into -- quot' )
-    [ >r keep r> set-nth-unsafe ] 2curry ; inline
+    [ [ keep ] dip set-nth-unsafe ] 2curry ; inline
 
 : collect ( n quot into -- )
     (collect) each-integer ; inline
 
 : map-into ( seq quot into -- )
-    >r (each) r> collect ; inline
+    [ (each) ] dip collect ; inline
 
 : 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 )
-    >r over r> nth-unsafe >r nth-unsafe r> ; inline
+    [ over ] dip nth-unsafe [ nth-unsafe ] dip ; inline
 
 : (2each) ( seq1 seq2 quot -- n quot' )
-    >r [ min-length ] 2keep r>
+    [ [ min-length ] 2keep ] dip
-    [ >r 2nth-unsafe r> call ] 3curry ; inline
+    [ [ 2nth-unsafe ] dip call ] 3curry ; inline
 
 : 2map-into ( seq1 seq2 quot into -- newseq )
-    >r (2each) r> collect ; inline
+    [ (2each) ] dip collect ; inline
 
 : finish-find ( i seq -- i elt )
     over [ dupd nth-unsafe ] [ drop f ] if ; inline
 
 : (find) ( seq quot quot' -- i elt )
-    pick >r >r (each) r> call r> finish-find ; inline
+    pick [ [ (each) ] dip call ] dip finish-find ; inline
 
 : (find-from) ( n seq quot quot' -- i elt )
     [ 2dup bounds-check? ] 2dip
@@ -373,7 +373,7 @@ PRIVATE>
     swapd each ; inline
 
 : map-as ( seq quot exemplar -- newseq )
-    >r over length r> [ [ map-into ] keep ] new-like ; inline
+    [ over length ] dip [ [ map-into ] keep ] new-like ; inline
 
 : map ( seq quot -- newseq )
     over map-as ; inline
@@ -382,7 +382,7 @@ PRIVATE>
     [ drop ] prepose map ; inline
 
 : replicate-as ( seq quot exemplar -- newseq )
-    >r [ drop ] prepose r> map-as ; inline
+    [ [ drop ] prepose ] dip map-as ; inline
 
 : change-each ( seq quot -- )
     over map-into ; inline
@@ -394,13 +394,13 @@ PRIVATE>
     (2each) each-integer ; inline
 
 : 2reverse-each ( seq1 seq2 quot -- )
-    >r [ <reversed> ] bi@ r> 2each ; inline
+    [ [ <reversed> ] bi@ ] dip 2each ; inline
 
 : 2reduce ( seq1 seq2 identity quot -- result )
-    >r -rot r> 2each ; inline
+    [ -rot ] dip 2each ; inline
 
 : 2map-as ( seq1 seq2 quot exemplar -- newseq )
-    >r 2over min-length r>
+    [ 2over min-length ] dip
     [ [ 2map-into ] keep ] new-like ; inline
 
 : 2map ( seq1 seq2 quot -- newseq )
@@ -422,49 +422,49 @@ PRIVATE>
     [ nip find-last-integer ] (find-from) ; inline
 
 : find-last ( seq quot -- i elt )
-    [ >r 1- r> find-last-integer ] (find) ; inline
+    [ [ 1- ] dip find-last-integer ] (find) ; inline
 
 : all? ( seq quot -- ? )
     (each) all-integers? ; inline
 
 : push-if ( elt quot accum -- )
-    >r keep r> rot [ push ] [ 2drop ] if  ; inline
+    [ keep ] dip rot [ push ] [ 2drop ] if ; inline
 
 : pusher ( quot -- quot accum )
     V{ } clone [ [ push-if ] 2curry ] keep ; inline
 
 : filter ( seq quot -- subseq )
-    over >r pusher >r each r> r> like ; inline
+    over [ pusher [ each ] dip ] dip like ; inline
 
 : push-either ( elt quot accum1 accum2 -- )
-    >r >r keep swap r> r> ? push ; inline
+    [ keep swap ] 2dip ? push ; inline
 
 : 2pusher ( quot -- quot accum1 accum2 )
     V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
 
 : partition ( seq quot -- trueseq falseseq )
-    over >r 2pusher >r >r each r> r> r> tuck [ like ] 2bi@ ; inline
+    over [ 2pusher [ each ] 2dip ] dip tuck [ like ] 2bi@ ; inline
 
 : monotonic? ( seq quot -- ? )
-    >r dup length 1- swap r> (monotonic) all? ; inline
+    [ dup length 1- swap ] dip (monotonic) all? ; inline
 
 : interleave ( seq between quot -- )
-    [ (interleave) ] 2curry >r dup length swap r> 2each ; inline
+    [ (interleave) ] 2curry [ dup length swap ] dip 2each ; inline
 
 : accumulator ( quot -- quot' vec )
     V{ } clone [ [ push ] curry compose ] keep ; inline
 
 : produce-as ( pred quot tail exemplar -- seq )
-    >r swap accumulator >r swap while r> r> like ; inline
+    [ swap accumulator [ swap while ] dip ] dip like ; inline
 
 : produce ( pred quot tail -- seq )
     { } produce-as ; inline
 
 : follow ( obj quot -- seq )
-    >r [ dup ] r> [ keep ] curry [ ] produce nip ; inline
+    [ dup ] swap [ keep ] curry [ ] produce nip ; inline
 
 : prepare-index ( seq quot -- seq n quot )
-    >r dup length r> ; inline
+    [ dup length ] dip ; inline
 
 : each-index ( seq quot -- )
     prepare-index 2each ; inline
@@ -518,9 +518,9 @@ PRIVATE>
 
 : cache-nth ( i seq quot -- elt )
     2over ?nth dup [
-        >r 3drop r>
+        [ 3drop ] dip
     ] [
-        drop swap >r over >r call dup r> r> set-nth
+        drop swap [ over [ call dup ] dip ] dip set-nth
     ] if ; inline
 
 : mismatch ( seq1 seq2 -- i )
@@ -575,14 +575,14 @@ PRIVATE>
     [ eq? not ] with filter-here ;
 
 : prefix ( seq elt -- newseq )
-    over >r over length 1+ r> [
+    over [ over length 1+ ] dip [
         [ 0 swap set-nth-unsafe ] keep
         [ 1 swap copy ] keep
     ] new-like ;
 
 : suffix ( seq elt -- newseq )
-    over >r over length 1+ r> [
+    over [ over length 1+ ] dip [
-        [ >r over length r> set-nth-unsafe ] keep
+        [ [ over length ] dip set-nth-unsafe ] keep
         [ 0 swap copy ] keep
     ] new-like ;
 
@@ -596,7 +596,7 @@ PRIVATE>
     2over = [
         2drop 2drop
     ] [
-        [ >r 2over + pick r> move >r 1+ r> ] keep
+        [ [ 2over + pick ] dip move [ 1+ ] dip ] keep
         move-backward
     ] if ;
 
@@ -604,15 +604,15 @@ PRIVATE>
     2over = [
         2drop 2drop
     ] [
-        [ >r pick >r dup dup r> + swap r> move 1- ] keep
+        [ [ pick [ dup dup ] dip + swap ] dip move 1- ] keep
         move-forward
     ] if ;
 
 : (open-slice) ( shift from to seq ? -- )
     [
-        >r [ 1- ] bi@ r> move-forward
+        [ [ 1- ] bi@ ] dip move-forward
     ] [
-        >r >r over - r> r> move-backward
+        [ over - ] 2dip move-backward
     ] if ;
 
 PRIVATE>
@@ -621,19 +621,19 @@ PRIVATE>
     pick 0 = [
         3drop
     ] [
-        pick over length + over >r >r
+        pick over length + over
-        pick 0 > >r [ length ] keep r> (open-slice)
+        [ pick 0 > [ [ length ] keep ] dip (open-slice) ] 2dip
-        r> r> set-length
+        set-length
     ] if ;
 
 : delete-slice ( from to seq -- )
-    check-slice >r over >r - r> r> open-slice ;
+    check-slice [ over [ - ] dip ] dip open-slice ;
 
 : delete-nth ( n seq -- )
-    >r dup 1+ r> delete-slice ;
+    [ dup 1+ ] dip delete-slice ;
 
 : replace-slice ( new from to seq -- )
-    [ >r >r dup pick length + r> - over r> open-slice ] keep
+    [ [ [ dup pick length + ] dip - over ] dip open-slice ] keep
     copy ;
 
 : remove-nth ( n seq -- seq' )
@@ -652,7 +652,7 @@ PRIVATE>
 
 : reverse-here ( seq -- )
     dup length dup 2/ [
-        >r 2dup r>
+        [ 2dup ] dip
         tuck - 1- rot exchange-unsafe
     ] each 2drop ;
 
@@ -679,7 +679,7 @@ PRIVATE>
 <PRIVATE
 
 : joined-length ( seq glue -- n )
-    >r dup sum-lengths swap length 1 [-] r> length * + ;
+    [ dup sum-lengths swap length 1 [-] ] dip length * + ;
 
 PRIVATE>
 
@@ -696,7 +696,7 @@ PRIVATE>
     ] dip compose if ; inline
 
 : pad-left ( seq n elt -- padded )
-    [ swap dup (append) ] padding ;
+    [ swap dup append-as ] padding ;
 
 : pad-right ( seq n elt -- padded )
     [ append ] padding ;
@@ -735,12 +735,12 @@ PRIVATE>
         >fixnum {
             [ drop nip ]
             [ 2drop first ]
-            [ >r drop first2 r> call ]
+            [ [ drop first2 ] dip call ]
-            [ >r drop first3 r> bi@ ]
+            [ [ drop first3 ] dip bi@ ]
         } dispatch
     ] [
         drop
-        >r >r halves r> r>
+        [ halves ] 2dip
         [ [ binary-reduce ] 2curry bi@ ] keep
         call
     ] if ; inline recursive
@@ -755,7 +755,7 @@ PRIVATE>
 
 : (start) ( subseq seq n -- subseq seq ? )
     pick length [
-        >r 3dup r> [ + swap nth-unsafe ] keep rot nth-unsafe =
+        [ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe =
     ] all? nip ; inline
 
 PRIVATE>
@@ -763,7 +763,7 @@ PRIVATE>
 : start* ( subseq seq n -- i )
     pick length pick length swap - 1+
     [ (start) ] find-from
-    swap >r 3drop r> ;
+    swap [ 3drop ] dip ;
 
 : start ( subseq seq -- i ) 0 start* ; inline
 
@@ -771,7 +771,7 @@ PRIVATE>
 
 : drop-prefix ( seq1 seq2 -- slice1 slice2 )
     2dup mismatch [ 2dup min-length ] unless*
-    tuck tail-slice >r tail-slice r> ;
+    tuck [ tail-slice ] 2bi@ ;
 
 : unclip ( seq -- rest first )
     [ rest ] [ first ] bi ;
@@ -801,14 +801,14 @@ PRIVATE>
     inline
 
 : trim-left-slice ( seq quot -- slice )
-    over >r [ not ] compose find drop r> swap
+    over [ [ not ] compose find drop ] dip swap
     [ tail-slice ] [ dup length tail-slice ] if* ; inline
     
 : trim-left ( seq quot -- newseq )
     over [ trim-left-slice ] dip like ; inline
 
 : trim-right-slice ( seq quot -- slice )
-    over >r [ not ] compose find-last drop r> swap
+    over [ [ not ] compose find-last drop ] dip swap
     [ 1+ head-slice ] [ 0 head-slice ] if* ; inline
 
 : trim-right ( seq quot -- newseq )

core/slots/slots.factor

@@ -3,7 +3,7 @@
 USING: arrays byte-arrays kernel kernel.private math namespaces
 make sequences strings words effects generic generic.standard
 classes classes.algebra slots.private combinators accessors
-words sequences.private assocs alien ;
+words sequences.private assocs alien quotations ;
 IN: slots
 
 TUPLE: slot-spec name offset class initial read-only ;
@@ -23,7 +23,7 @@ PREDICATE: writer < word "writer" word-prop ;
     3bi ;
 
 : create-accessor ( name effect -- word )
-    >r "accessors" create dup r>
+    [ "accessors" create dup ] dip
     "declared-effect" set-word-prop ;
 
 : reader-quot ( slot-spec -- quot )
@@ -59,7 +59,7 @@ ERROR: bad-slot-value value class ;
     offset>> , \ set-slot , ;
 
 : writer-quot/coerce ( slot-spec -- )
-    [ \ >r , class>> "coercer" word-prop % \ r> , ]
+    [ class>> "coercer" word-prop [ dip ] curry % ]
     [ offset>> , \ set-slot , ]
     bi ;
 
@@ -75,7 +75,7 @@ ERROR: bad-slot-value value class ;
     bi ;
 
 : writer-quot/fixnum ( slot-spec -- )
-    [ >r >fixnum r> ] % writer-quot/check ;
+    [ [ >fixnum ] dip ] % writer-quot/check ;
 
 : writer-quot ( slot-spec -- quot )
     [
@@ -108,9 +108,9 @@ ERROR: bad-slot-value value class ;
 : define-changer ( name -- )
     dup changer-word dup deferred? [
         [
-            [ over >r >r ] %
+            \ over ,
-            over reader-word ,
+            over reader-word 1quotation
-            [ r> call r> swap ] %
+            [ dip call ] curry [ dip swap ] curry %
             swap setter-word ,
         ] [ ] make define-inline
     ] [ 2drop ] if ;

core/sorting/sorting.factor

@@ -25,20 +25,20 @@ TUPLE: merge
 
 : dump ( from to seq accum -- )
     #! Optimize common case where to - from = 1, 2, or 3.
-    >r >r 2dup swap - r> r> pick 1 = 
+    [ 2dup swap - ] 2dip pick 1 = 
-    [ >r >r 2drop r> nth-unsafe r> push ] [
+    [ [ [ 2drop ] dip nth-unsafe ] dip push ] [
         pick 2 = [
-            >r >r 2drop dup 1+
+            [
-            r> [ nth-unsafe ] curry bi@
+                [ 2drop dup 1+ ] dip
-            r> [ push ] curry bi@
+                [ nth-unsafe ] curry bi@
+            ] dip [ push ] curry bi@
         ] [
             pick 3 = [
-                >r >r 2drop dup 1+ dup 1+
+                [
-                r> [ nth-unsafe ] curry tri@
+                    [ 2drop dup 1+ dup 1+ ] dip
-                r> [ push ] curry tri@
+                    [ nth-unsafe ] curry tri@
-            ] [
+                ] dip [ push ] curry tri@
-                >r nip subseq r> push-all
+            ] [ [ nip subseq ] dip push-all ] if
-            ] if
         ] if
     ] if ; inline