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

2008-11-29 18:35:46 -06:00 · 2008-11-29 18:35:46 -06:00 · 06821bcb07
parent 26d7c1cac0 0e91763333
commit 06821bcb07
52 changed files with 2920 additions and 1630 deletions
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@ -52,7 +52,7 @@ GENERIC: c-type ( name -- type ) foldable

 : parse-array-type ( name -- array )
    "[" split unclip
-    >r [ "]" ?tail drop string>number ] map r> prefix ;
+    [ [ "]" ?tail drop string>number ] map ] dip prefix ;

 M: string c-type ( name -- type )
    CHAR: ] over member? [
@ -215,13 +215,13 @@ M: byte-array byte-length length ;
    ] [ ] make define-inline ;

 : nth-word ( name vocab -- word )
-    >r "-nth" append r> create ;
+    [ "-nth" append ] dip create ;

 : define-nth ( name vocab -- )
    dupd nth-word swap dup c-getter (define-nth) ;

 : set-nth-word ( name vocab -- word )
-    >r "set-" swap "-nth" 3append r> create ;
+    [ "set-" swap "-nth" 3append ] dip create ;

 : define-set-nth ( name vocab -- )
    dupd set-nth-word swap dup c-setter (define-nth) ;
@ -229,7 +229,7 @@ M: byte-array byte-length length ;
 : typedef ( old new -- ) c-types get set-at ;

 : define-c-type ( type name vocab -- )
-    >r tuck typedef r> [ define-nth ] 2keep define-set-nth ;
+    [ tuck typedef ] dip [ define-nth ] 2keep define-set-nth ;

 TUPLE: long-long-type < c-type ;

@ -249,12 +249,12 @@ M: long-long-type box-return ( type -- )
    f swap box-parameter ;

 : define-deref ( name vocab -- )
-    >r dup CHAR: * prefix r> create
+    [ dup CHAR: * prefix ] dip create
    swap c-getter 0 prefix define-inline ;

 : define-out ( name vocab -- )
    over [ <c-object> tuck 0 ] over c-setter append swap
-    >r >r constructor-word r> r> prefix define-inline ;
+    [ constructor-word ] 2dip prefix define-inline ;

 : c-bool> ( int -- ? )
    zero? not ;
@ -267,7 +267,7 @@ M: long-long-type box-return ( type -- )
    dupd set-nth-word [ >c-array ] 2curry ;

 : to-array-word ( name vocab -- word )
-    >r ">c-" swap "-array" 3append r> create ;
+    [ ">c-" swap "-array" 3append ] dip create ;

 : define-to-array ( type vocab -- )
    [ to-array-word ] 2keep >c-array-quot
@ -281,7 +281,7 @@ M: long-long-type box-return ( type -- )
    ] [ ] make ;

 : from-array-word ( name vocab -- word )
-    >r "c-" swap "-array>" 3append r> create ;
+    [ "c-" swap "-array>" 3append ] dip create ;

 : define-from-array ( type vocab -- )
    [ from-array-word ] 2keep c-array>quot
@ -299,11 +299,13 @@ M: long-long-type box-return ( type -- )

 : expand-constants ( c-type -- c-type' )
    dup array? [
-        unclip >r [
-            dup word? [
-                def>> { } swap with-datastack first
-            ] when
-        ] map r> prefix
+        unclip [
+            [
+                dup word? [
+                    def>> { } swap with-datastack first
+                ] when
+            ] map
+        ] dip prefix
    ] when ;

 : malloc-file-contents ( path -- alien len )
--- a/basis/alien/strings/strings.factor
+++ b/basis/alien/strings/strings.factor
@ -9,7 +9,7 @@ IN: alien.strings
 GENERIC# alien>string 1 ( c-ptr encoding -- string/f )

 M: c-ptr alien>string
-    >r <memory-stream> r> <decoder>
+    [ <memory-stream> ] [ <decoder> ] bi*
    "\0" swap stream-read-until drop ;

 M: f alien>string
--- a/basis/alien/structs/fields/fields.factor
+++ b/basis/alien/structs/fields/fields.factor
@ -29,10 +29,10 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
    writer>> swap "writing" set-word-prop ;

 : reader-word ( class name vocab -- word )
-    >r >r "-" r> 3append r> create ;
+    [ "-" swap 3append ] dip create ;

 : writer-word ( class name vocab -- word )
-    >r [ swap "set-" % % "-" % % ] "" make r> create ;
+    [ [ swap "set-" % % "-" % % ] "" make ] dip create ;

 : <field-spec> ( struct-name vocab type field-name -- spec )
    field-spec new
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@ -39,7 +39,7 @@ M: struct-type stack-size
 : c-struct? ( type -- ? ) (c-type) struct-type? ;

 : (define-struct) ( name vocab size align fields -- )
-    >r [ align ] keep r>
+    [ [ align ] keep ] dip
    struct-type boa
    -rot define-c-type ;

@ -50,11 +50,11 @@ M: struct-type stack-size
    [ c-type-align ] map supremum ;

 : define-struct ( name vocab fields -- )
-    pick >r
-    [ struct-offsets ] keep
-    [ [ type>> ] map compute-struct-align ] keep
-    [ (define-struct) ] keep
-    r> [ swap define-field ] curry each ;
+    pick [
+        [ struct-offsets ] keep
+        [ [ type>> ] map compute-struct-align ] keep
+        [ (define-struct) ] keep
+    ] dip [ swap define-field ] curry each ;

 : define-union ( name vocab members -- )
    [ expand-constants ] map
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@ -17,22 +17,13 @@ IN: alien.syntax
    [ alien-invoke ] 2curry 2curry ;

 : define-function ( return library function parameters -- )
-    >r pick r> parse-arglist
+    [ pick ] dip parse-arglist
    pick create-in dup reset-generic
-    >r >r function-quot r> r> 
+    [ function-quot ] 2dip
    -rot define-declared ;

 PRIVATE>

-: indirect-quot ( function-ptr-quot return types abi -- quot )
-    [ alien-indirect ] 3curry compose ;
-
-: define-indirect ( abi return function-ptr-quot function-name parameters -- )
-    >r pick r> parse-arglist
-    rot create-in dup reset-generic
-    >r >r swapd roll indirect-quot r> r>
-    -rot define-declared ;
-
 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing

 : ALIEN: scan string>number <alien> parsed ; parsing
@ -55,7 +46,7 @@ PRIVATE>
 : C-STRUCT:
    scan in get
    parse-definition
-    >r 2dup r> define-struct-early
+    [ 2dup ] dip define-struct-early
    define-struct ; parsing

 : C-UNION:
@ -64,7 +55,7 @@ PRIVATE>
 : C-ENUM:
    ";" parse-tokens
    dup length
-    [ >r create-in r> 1quotation define ] 2each ;
+    [ [ create-in ] dip 1quotation define ] 2each ;
    parsing

 M: alien pprint*
--- a/basis/bit-vectors/bit-vectors-tests.factor
+++ b/basis/bit-vectors/bit-vectors-tests.factor
@ -4,7 +4,7 @@ USING: tools.test bit-vectors vectors sequences kernel math ;
 [ 0 ] [ 123 <bit-vector> length ] unit-test

 : do-it
-    1234 swap [ >r even? r> push ] curry each ;
+    1234 swap [ [ even? ] dip push ] curry each ;

 [ t ] [
    3 <bit-vector> dup do-it
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@ -72,7 +72,7 @@ SYMBOL: objects
 : put-object ( n obj -- ) (objects) set-at ;

 : cache-object ( obj quot -- value )
-    >r (objects) r> [ obj>> ] prepose cache ; inline
+    [ (objects) ] dip [ obj>> ] prepose cache ; inline

 ! Constants

@ -97,10 +97,10 @@ SYMBOL: sub-primitives
    { [ { } make ] [ ] [ ] [ ] } spread 4array ; inline

 : jit-define ( quot rc rt offset name -- )
-    >r make-jit r> set ; inline
+    [ make-jit ] dip set ; inline

 : define-sub-primitive ( quot rc rt offset word -- )
-    >r make-jit r> sub-primitives get set-at ;
+    [ make-jit ] dip sub-primitives get set-at ;

 ! The image being constructed; a vector of word-size integers
 SYMBOL: image
@ -205,7 +205,7 @@ SYMBOL: undefined-quot
 : emit-fixnum ( n -- ) tag-fixnum emit ;

 : emit-object ( header tag quot -- addr )
-    swap here-as >r swap tag-fixnum emit call align-here r> ;
+    swap here-as [ swap tag-fixnum emit call align-here ] dip ;
    inline

 ! Write an object to the image.
--- a/basis/boxes/boxes.factor
+++ b/basis/boxes/boxes.factor
@ -23,4 +23,4 @@ ERROR: box-empty box ;
    dup occupied>> [ box> t ] [ drop f f ] if ;

 : if-box? ( box quot -- )
-    >r ?box r> [ drop ] if ; inline
+    [ ?box ] dip [ drop ] if ; inline
--- a/basis/calendar/calendar-docs.factor
+++ b/basis/calendar/calendar-docs.factor
@ -99,6 +99,48 @@ HELP: seconds-per-year
 { $values { "integer" integer } }
 { $description "Returns the number of seconds in a year averaged over 400 years. Used internally for adding an arbitrary real number of seconds to a timestamp." } ;

+HELP: biweekly
+{ $values
+     { "x" number }
+     { "y" number }
+}
+{ $description "Divides a number by the number of two week periods in a year." } ;
+
+HELP: daily-360
+{ $values
+     { "x" number }
+     { "y" number }
+}
+{ $description "Divides a number by the number of days in a 360-day year." } ;
+
+HELP: daily-365
+{ $values
+     { "x" number }
+     { "y" number }
+}
+{ $description "Divides a number by the number of days in a 365-day year." } ;
+
+HELP: monthly
+{ $values
+     { "x" number }
+     { "y" number }
+}
+{ $description "Divides a number by the number of months in a year." } ;
+
+HELP: semimonthly
+{ $values
+     { "x" number }
+     { "y" number }
+}
+{ $description "Divides a number by the number of half-months in a year. Note that biweekly has two more periods than semimonthly." } ;
+
+HELP: weekly
+{ $values
+     { "x" number }
+     { "y" number }
+}
+{ $description "Divides a number by the number of weeks in a year." } ;
+
 HELP: julian-day-number
 { $values { "year" integer } { "month" integer } { "day" integer } { "n" integer } }
 { $description "Calculates the Julian day number from a year, month, and day.  The difference between two Julian day numbers is the number of days that have elapsed between the two corresponding dates." }
@ -540,6 +582,8 @@ ARTICLE: "calendar" "Calendar"
 { $subsection "years" }
 { $subsection "months" }
 { $subsection "days" }
+"Calculating amounts per period of time:"
+{ $subsection "time-period-calculations" }
 "Meta-data about the calendar:"
 { $subsection "calendar-facts" }
 ;
@ -626,6 +670,18 @@ ARTICLE: "calendar-facts" "Calendar facts"
 { $subsection day-of-week }
 ;

+ARTICLE: "time-period-calculations" "Calculations over periods of time"
+{ $subsection monthly }
+{ $subsection semimonthly }
+{ $subsection biweekly }
+{ $subsection weekly }
+{ $subsection daily-360 }
+{ $subsection daily-365 }
+{ $subsection biweekly }
+{ $subsection biweekly }
+{ $subsection biweekly }
+;
+
 ARTICLE: "years" "Year operations"
 "Leap year predicate:"
 { $subsection leap-year? }
--- a/basis/calendar/calendar-tests.factor
+++ b/basis/calendar/calendar-tests.factor
@ -167,3 +167,5 @@ IN: calendar.tests
 [ t ] [ now 50 milliseconds sleep now before? ] unit-test
 [ t ] [ now 50 milliseconds sleep now swap after? ] unit-test
 [ t ] [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test
+
+[ 4+1/6 ] [ 100 semimonthly ] unit-test
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@ -89,6 +89,13 @@ PRIVATE>
 : minutes-per-year ( -- ratio ) 5259492/10 ; inline
 : seconds-per-year ( -- integer ) 31556952 ; inline

+: monthly ( x -- y ) 12 / ; inline
+: semimonthly ( x -- y ) 24 / ; inline
+: biweekly ( x -- y ) 26 / ; inline
+: weekly ( x -- y ) 52 / ; inline
+: daily-360 ( x -- y ) 360 / ; inline
+: daily-365 ( x -- y ) 365 / ; inline
+
 :: julian-day-number ( year month day -- n )
    #! Returns a composite date number
    #! Not valid before year -4800
@ -173,7 +180,7 @@ M: real +year ( timestamp n -- timestamp )
    12 /rem dup zero? [ drop 1- 12 ] when swap ; inline

 M: integer +month ( timestamp n -- timestamp )
-    [ over month>> + months/years >r >>month r> +year ] unless-zero ;
+    [ over month>> + months/years [ >>month ] dip +year ] unless-zero ;

 M: real +month ( timestamp n -- timestamp )
    [ float>whole-part swapd average-month * +day swap +month ] unless-zero ;
@ -181,7 +188,7 @@ M: real +month ( timestamp n -- timestamp )
 M: integer +day ( timestamp n -- timestamp )
    [
        over >date< julian-day-number + julian-day-number>date
-        >r >r >>year r> >>month r> >>day
+        [ >>year ] [ >>month ] [ >>day ] tri*
    ] unless-zero ;

 M: real +day ( timestamp n -- timestamp )
@ -191,7 +198,7 @@ M: real +day ( timestamp n -- timestamp )
    24 /rem swap ;

 M: integer +hour ( timestamp n -- timestamp )
-    [ over hour>> + hours/days >r >>hour r> +day ] unless-zero ;
+    [ over hour>> + hours/days [ >>hour ] dip +day ] unless-zero ;

 M: real +hour ( timestamp n -- timestamp )
    float>whole-part swapd 60 * +minute swap +hour ;
@ -200,7 +207,7 @@ M: real +hour ( timestamp n -- timestamp )
    60 /rem swap ;

 M: integer +minute ( timestamp n -- timestamp )
-    [ over minute>> + minutes/hours >r >>minute r> +hour ] unless-zero ;
+    [ over minute>> + minutes/hours [ >>minute ] dip +hour ] unless-zero ;

 M: real +minute ( timestamp n -- timestamp )
    [ float>whole-part swapd 60 * +second swap +minute ] unless-zero ;
@ -209,7 +216,7 @@ M: real +minute ( timestamp n -- timestamp )
    60 /rem swap >integer ;

 M: number +second ( timestamp n -- timestamp )
-    [ over second>> + seconds/minutes >r >>second r> +minute ] unless-zero ;
+    [ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ;

 : (time+)
    [ second>> +second ] keep
@ -226,7 +233,7 @@ PRIVATE>
 GENERIC# time+ 1 ( time1 time2 -- time3 )

 M: timestamp time+
-    >r clone r> (time+) drop ;
+    [ clone ] dip (time+) drop ;

 M: duration time+
    dup timestamp? [
@ -284,7 +291,7 @@ M: timestamp <=> ( ts1 ts2 -- n )
 : (time-) ( timestamp timestamp -- n )
    [ >gmt ] bi@
    [ [ >date< julian-day-number ] bi@ - 86400 * ] 2keep
-    [ >time< >r >r 3600 * r> 60 * r> + + ] bi@ - + ;
+    [ >time< [ [ 3600 * ] [ 60 * ] bi* ] dip + + ] bi@ - + ;

 M: timestamp time-
    #! Exact calendar-time difference
@ -320,13 +327,13 @@ M: duration time-
    1970 1 1 0 0 0 instant <timestamp> ;

 : millis>timestamp ( x -- timestamp )
-    >r unix-1970 r> milliseconds time+ ;
+    [ unix-1970 ] dip milliseconds time+ ;

 : timestamp>millis ( timestamp -- n )
    unix-1970 (time-) 1000 * >integer ;

 : micros>timestamp ( x -- timestamp )
-    >r unix-1970 r> microseconds time+ ;
+    [ unix-1970 ] dip microseconds time+ ;

 : timestamp>micros ( timestamp -- n )
    unix-1970 (time-) 1000000 * >integer ;
@ -343,10 +350,11 @@ M: duration time-
    #! Zeller Congruence
    #! http://web.textfiles.com/computers/formulas.txt
    #! good for any date since October 15, 1582
-    >r dup 2 <= [ 12 + >r 1- r> ] when
-    >r dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + r>
-        [ 1+ 3 * 5 /i + ] keep 2 * + r>
-    1+ + 7 mod ;
+    [
+        dup 2 <= [ [ 1- ] [ 12 + ] bi* ] when
+        [ dup [ 4 /i + ] keep [ 100 /i - ] keep 400 /i + ] dip
+        [ 1+ 3 * 5 /i + ] keep 2 * +
+    ] dip 1+ + 7 mod ;

 GENERIC: days-in-year ( obj -- n )

--- a/basis/calendar/format/format.factor
+++ b/basis/calendar/format/format.factor
@ -138,11 +138,11 @@ M: timestamp year. ( timestamp -- )

 : read-rfc3339-gmt-offset ( ch -- dt )
    dup CHAR: Z = [ drop instant ] [
-        >r
-        read-00 hours
-        read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
-        time+
-        r> signed-gmt-offset
+        [
+            read-00 hours
+            read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
+            time+
+        ] dip signed-gmt-offset
    ] if ;

 : read-ymd ( -- y m d )
@ -152,8 +152,9 @@ M: timestamp year. ( timestamp -- )
    read-00 ":" expect read-00 ":" expect read-00 ;

 : read-rfc3339-seconds ( s -- s' ch )
-    "+-Z" read-until >r
-    [ string>number ] [ length 10 swap ^ ] bi / + r> ;
+    "+-Z" read-until [
+        [ string>number ] [ length 10 swap ^ ] bi / +
+    ] dip ;

 : (rfc3339>timestamp) ( -- timestamp )
    read-ymd
@ -181,9 +182,9 @@ ERROR: invalid-timestamp-format ;

 : parse-rfc822-gmt-offset ( string -- dt )
    dup "GMT" = [ drop instant ] [
-        unclip >r
-        2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
-        r> signed-gmt-offset
+        unclip [ 
+            2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
+        ] dip signed-gmt-offset
    ] if ;

 : (rfc822>timestamp) ( -- timestamp )
--- a/basis/channels/remote/remote.factor
+++ b/basis/channels/remote/remote.factor
@ -14,7 +14,7 @@ IN: channels.remote
 PRIVATE>

 : publish ( channel -- id )
-    256 random-bits dup >r remote-channels set-at r> ;
+    256 random-bits dup [ remote-channels set-at ] dip ;

 : get-channel ( id -- channel )
    remote-channels at ;
--- a/basis/checksums/openssl/openssl.factor
+++ b/basis/checksums/openssl/openssl.factor
@ -28,7 +28,7 @@ M: evp-md-context dispose
    handle>> EVP_MD_CTX_cleanup drop ;

 : with-evp-md-context ( quot -- )
-    maybe-init-ssl >r <evp-md-context> r> with-disposal ; inline
+    maybe-init-ssl [ <evp-md-context> ] dip with-disposal ; inline

 : digest-named ( name -- md )
    dup EVP_get_digestbyname
--- a/basis/checksums/sha1/sha1.factor
+++ b/basis/checksums/sha1/sha1.factor
@ -41,9 +41,9 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
 : sha1-f ( B C D t -- f_tbcd )
    20 /i
    {   
-        { 0 [ >r over bitnot r> bitand >r bitand r> bitor ] }
+        { 0 [ [ over bitnot ] dip bitand [ bitand ] dip bitor ] }
        { 1 [ bitxor bitxor ] }
-        { 2 [ 2dup bitand >r pick bitand >r bitand r> r> bitor bitor ] }
+        { 2 [ 2dup bitand [ pick bitand [ bitand ] dip ] dip bitor bitor ] }
        { 3 [ bitxor bitxor ] }
    } case ;

--- a/basis/checksums/sha2/sha2.factor
+++ b/basis/checksums/sha2/sha2.factor
@ -59,7 +59,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
    [ 15 - swap nth s0-256 ] 2keep
    [ 7 - swap nth ] 2keep
    [ 2 - swap nth s1-256 ] 2keep
-    >r >r + + w+ r> r> swap set-nth ; inline
+    [ + + w+ ] 2dip swap set-nth ; inline

 : prepare-message-schedule ( seq -- w-seq )
    word-size get group [ be> ] map block-size get 0 pad-right
@ -71,7 +71,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
    [ bitxor bitand ] keep bitxor ;

 : maj ( x y z -- x' )
-    >r [ bitand ] 2keep bitor r> bitand bitor ;
+    [ [ bitand ] 2keep bitor ] dip bitand bitor ;

 : S0-256 ( x -- x' )
    [ -2 bitroll-32 ] keep
@ -83,7 +83,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
    [ -11 bitroll-32 ] keep
    -25 bitroll-32 bitxor bitxor ; inline

-: slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ; inline
+: slice3 ( n seq -- a b c ) [ dup 3 + ] dip <slice> first3 ; inline

 : T1 ( W n -- T1 )
    [ swap nth ] keep
@ -105,7 +105,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
    d c pick exchange
    c b pick exchange
    b a pick exchange
-    >r w+ a r> set-nth ;
+    [ w+ a ] dip set-nth ;

 : process-chunk ( M -- )
    H get clone vars set
@ -118,7 +118,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;

 : preprocess-plaintext ( string big-endian? -- padded-string )
    #! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits
-    >r >sbuf r> over [
+    [ >sbuf ] dip over [
        HEX: 80 ,
        dup length HEX: 3f bitand
        calculate-pad-length 0 <string> %
--- a/basis/cocoa/application/application.factor
+++ b/basis/cocoa/application/application.factor
@ -40,12 +40,13 @@ FUNCTION: void NSBeep ( ) ;
    dup next-event [ -> sendEvent: t ] [ drop f ] if* ;

 : add-observer ( observer selector name object -- )
-    >r >r >r >r NSNotificationCenter -> defaultCenter
-    r> r> sel_registerName
-    r> r> -> addObserver:selector:name:object: ;
+    [
+        [ NSNotificationCenter -> defaultCenter ] 2dip
+        sel_registerName
+    ] 2dip -> addObserver:selector:name:object: ;

 : remove-observer ( observer -- )
-    >r NSNotificationCenter -> defaultCenter r>
+    [ NSNotificationCenter -> defaultCenter ] dip
    -> removeObserver: ;

 : finish-launching ( -- ) NSApp -> finishLaunching ;
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@ -5,7 +5,7 @@ combinators compiler compiler.alien kernel math namespaces make
 parser prettyprint prettyprint.sections quotations sequences
 strings words cocoa.runtime io macros memoize debugger
 io.encodings.ascii effects libc libc.private parser lexer init
-core-foundation fry ;
+core-foundation fry generalizations ;
 IN: cocoa.messages

 : make-sender ( method function -- quot )
@ -27,7 +27,7 @@ super-message-senders global [ H{ } assoc-like ] change-at

 : cache-stub ( method function hash -- )
    [
-        over get [ 2drop ] [ over >r sender-stub r> set ] if
+        over get [ 2drop ] [ over [ sender-stub ] dip set ] if
    ] bind ;

 : cache-stubs ( method -- )
@ -37,7 +37,7 @@ super-message-senders global [ H{ } assoc-like ] change-at

 : <super> ( receiver -- super )
    "objc-super" <c-object> [
-        >r dup object_getClass class_getSuperclass r>
+        [ dup object_getClass class_getSuperclass ] dip
        set-objc-super-class
    ] keep
    [ set-objc-super-receiver ] keep ;
@ -62,23 +62,18 @@ objc-methods global [ H{ } assoc-like ] change-at
    dup objc-methods get at
    [ ] [ "No such method: " prepend throw ] ?if ;

-: make-dip ( quot n -- quot' )
-    dup
-    \ >r <repetition> >quotation -rot
-    \ r> <repetition> >quotation 3append ;
-
 MEMO: make-prepare-send ( selector method super? -- quot )
    [
        [ \ <super> , ] when
        swap <selector> , \ selector ,
    ] [ ] make
-    swap second length 2 - make-dip ;
+    swap second length 2 - '[ _ _ ndip ] ;

 MACRO: (send) ( selector super? -- quot )
-    >r dup lookup-method r>
+    [ dup lookup-method ] dip
    [ make-prepare-send ] 2keep
    super-message-senders message-senders ? get at
-    [ slip execute ] 2curry ;
+    '[ _ call _ execute ] ;

 : send ( receiver args... selector -- return... ) f (send) ; inline

@ -172,7 +167,7 @@ assoc-union alien>objc-types set-global
    ] unless ;

 : (parse-objc-type) ( i string -- ctype )
-    2dup nth >r >r 1+ r> r> {
+    [ [ 1+ ] dip ] [ nth ] 2bi {
        { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
        { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
        { [ dup CHAR: { = ] [ drop objc-struct-type ] }
@ -223,22 +218,23 @@ assoc-union alien>objc-types set-global
 : class-exists? ( string -- class ) objc_getClass >boolean ;

 : unless-defined ( class quot -- )
-    >r class-exists? r> unless ; inline
+    [ class-exists? ] dip unless ; inline

 : define-objc-class-word ( name quot -- )
    [
        over , , \ unless-defined , dup , \ objc-class ,
-    ] [ ] make >r "cocoa.classes" create r>
+    ] [ ] make [ "cocoa.classes" create ] dip
    (( -- class )) define-declared ;

 : import-objc-class ( name quot -- )
    2dup unless-defined
    dupd define-objc-class-word
-    [
+    '[
+        _
        dup
        objc-class register-objc-methods
        objc-meta-class register-objc-methods
-    ] curry try ;
+    ] try ;

 : root-class ( class -- root )
    dup class_getSuperclass [ root-class ] [ ] ?if ;
--- a/basis/core-foundation/core-foundation.factor
+++ b/basis/core-foundation/core-foundation.factor
@ -90,14 +90,14 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
 : <CFArray> ( seq -- alien )
    [ f swap length f CFArrayCreateMutable ] keep
    [ length ] keep
-    [ >r dupd r> CFArraySetValueAtIndex ] 2each ;
+    [ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;

 : <CFString> ( string -- alien )
    f swap dup length CFStringCreateWithCharacters ;

 : CF>string ( alien -- string )
    dup CFStringGetLength 1+ "ushort" <c-array> [
-        >r 0 over CFStringGetLength r> CFStringGetCharacters
+        [ 0 over CFStringGetLength ] dip CFStringGetCharacters
    ] keep utf16n alien>string ;

 : CF>string-array ( alien -- seq )
@ -107,8 +107,8 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
    [ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ;

 : <CFFileSystemURL> ( string dir? -- url )
-    >r <CFString> f over kCFURLPOSIXPathStyle
-    r> CFURLCreateWithFileSystemPath swap CFRelease ;
+    [ <CFString> f over kCFURLPOSIXPathStyle ] dip
+    CFURLCreateWithFileSystemPath swap CFRelease ;

 : <CFURL> ( string -- url )
    <CFString>
--- a/basis/db/db.factor
+++ b/basis/db/db.factor
@ -48,7 +48,7 @@ GENERIC: more-rows? ( result-set -- ? )
 : new-result-set ( query handle class -- result-set )
    new
        swap >>handle
-        >r [ sql>> ] [ in-params>> ] [ out-params>> ] tri r>
+        [ [ sql>> ] [ in-params>> ] [ out-params>> ] tri ] dip
        swap >>out-params
        swap >>in-params
        swap >>sql ;
--- a/basis/db/postgresql/lib/lib.factor
+++ b/basis/db/postgresql/lib/lib.factor
@ -75,7 +75,7 @@ M: postgresql-result-null summary ( obj -- str )
 : param-values ( statement -- seq seq2 )
    [ bind-params>> ] [ in-params>> ] bi
    [
-        >r value>> r> type>> {
+        [ value>> ] [ type>> ] bi* {
            { FACTOR-BLOB [
                dup [ object>bytes malloc-byte-array/length ] [ 0 ] if
            ] }
@ -98,7 +98,7 @@ M: postgresql-result-null summary ( obj -- str )

 : do-postgresql-bound-statement ( statement -- res )
    [
-        >r db get handle>> r>
+        [ db get handle>> ] dip
        {
            [ sql>> ]
            [ bind-params>> length ]
@ -116,7 +116,7 @@ M: postgresql-result-null summary ( obj -- str )

 : pq-get-string ( handle row column -- obj )
    3dup PQgetvalue utf8 alien>string
-    dup empty? [ >r pq-get-is-null f r> ? ] [ 3nip ] if ;
+    dup empty? [ [ pq-get-is-null f ] dip ? ] [ 3nip ] if ;

 : pq-get-number ( handle row column -- obj )
    pq-get-string dup [ string>number ] when ;
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@ -95,7 +95,7 @@ M: random-id-generator eval-generator ( singleton -- obj )
        3drop
    ] [
        pick column-name>> 0%
-        >r first2 r> interval-comparison 0%
+        [ first2 ] dip interval-comparison 0%
        bind#
    ] if ;

@ -201,7 +201,7 @@ M: db <count-statement> ( query -- statement )

 : create-index ( index-name table-name columns -- )
    [
-        >r >r "create index " % % r> " on " % % r> "(" %
+        [ [ "create index " % % ] dip " on " % % ] dip "(" %
        "," join % ")" %
    ] "" make sql-command ;

--- a/basis/dlists/dlists.factor
+++ b/basis/dlists/dlists.factor
@ -57,11 +57,11 @@ M: dlist-node node-value obj>> ;
 : (dlist-find-node) ( dlist-node quot: ( node -- ? ) -- node/f ? )
    over [
        [ call ] 2keep rot
-        [ drop t ] [ >r next>> r> (dlist-find-node) ] if
+        [ drop t ] [ [ next>> ] dip (dlist-find-node) ] if
    ] [ 2drop f f ] if ; inline recursive

 : dlist-find-node ( dlist quot -- node/f ? )
-    >r front>> r> (dlist-find-node) ; inline
+    [ front>> ] dip (dlist-find-node) ; inline

 : dlist-each-node ( dlist quot -- )
    [ f ] compose dlist-find-node 2drop ; inline
--- a/basis/editors/editors.factor
+++ b/basis/editors/editors.factor
@ -26,8 +26,7 @@ SYMBOL: edit-hook
    require ;

 : edit-location ( file line -- )
-    >r (normalize-path) r>
-    edit-hook get-global
+    [ (normalize-path) ] dip edit-hook get-global
    [ call ] [ no-edit-hook edit-location ] if* ;

 : edit ( defspec -- )
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@ -167,7 +167,7 @@ stand-alone
    } cond ;

 : escape-link ( href text -- href-esc text-esc )
-    >r check-url escape-quoted-string r> escape-string ;
+    [ check-url escape-quoted-string ] dip escape-string ;

 : write-link ( href text -- )
    escape-link
@ -185,7 +185,7 @@ stand-alone
    ] if ;

 : render-code ( string mode -- string' )
-    >r string-lines r>
+    [ string-lines ] dip
    [
        <pre>
            htmlize-lines
--- a/basis/float-arrays/float-arrays.factor
+++ b/basis/float-arrays/float-arrays.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private alien.accessors sequences
 sequences.private math math.private byte-arrays accessors
-alien.c-types parser prettyprint.backend ;
+alien.c-types parser prettyprint.backend combinators ;
 IN: float-arrays

 TUPLE: float-array
@ -67,6 +67,8 @@ M: float-array pprint* pprint-object ;
 ! Specializer hints
 USING: hints math.vectors arrays ;

+HINTS: <float-array> { 2 } { 3 } ;
+
 HINTS: vneg { array } { float-array } ;
 HINTS: v*n { array object } { float-array float } ;
 HINTS: n*v { array object } { float float-array } ;
--- a/basis/grouping/grouping.factor
+++ b/basis/grouping/grouping.factor
@ -11,7 +11,7 @@ TUPLE: chunking-seq { seq read-only } { n read-only } ;
 : check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline

 : new-groups ( seq n class -- groups )
-    >r check-groups r> boa ; inline
+    [ check-groups ] dip boa ; inline

 GENERIC: group@ ( n groups -- from to seq )

--- a/basis/hash2/hash2.factor
+++ b/basis/hash2/hash2.factor
@ -14,25 +14,25 @@ IN: hash2
 : <hash2> ( size -- hash2 ) f <array> ;

 : 2= ( a b pair -- ? )
-    first2 swapd >r >r = r> r> = and ; inline
+    first2 swapd [ = ] 2bi@ and ; inline

 : (assoc2) ( a b alist -- {a,b,val} )
-    [ >r 2dup r> 2= ] find >r 3drop r> ; inline
+    [ 2= ] with with find nip ; inline

 : assoc2 ( a b alist -- value )
    (assoc2) dup [ third ] when ; inline

 : set-assoc2 ( value a b alist -- alist )
-    >r rot 3array r> ?push ; inline
+    [ rot 3array ] dip ?push ; inline

 : hash2@ ( a b hash2 -- a b bucket hash2 )
-    >r 2dup hashcode2 r> [ length mod ] keep ; inline
+    [ 2dup hashcode2 ] dip [ length mod ] keep ; inline

 : hash2 ( a b hash2 -- value/f )
-    hash2@ nth [ assoc2 ] [ 2drop f ] if* ;
+    hash2@ nth dup [ assoc2 ] [ 3drop f ] if ;

 : set-hash2 ( a b value hash2 -- )
-    >r -rot r> hash2@ [ set-assoc2 ] change-nth ;
+    [ -rot ] dip hash2@ [ set-assoc2 ] change-nth ;

 : alist>hash2 ( alist size -- hash2 )
-    <hash2> [ over >r first3 r> set-hash2 ] reduce ; inline
+    <hash2> [ over [ first3 ] dip set-hash2 ] reduce ; inline
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@ -18,7 +18,7 @@ GENERIC: heap-size ( heap -- n )
 TUPLE: heap data ;

 : <heap> ( class -- heap )
-    >r V{ } clone r> boa ; inline
+    [ V{ } clone ] dip boa ; inline

 TUPLE: entry value key heap index ;

@ -52,16 +52,16 @@ M: heap heap-size ( heap -- n )
    data>> nth-unsafe ; inline

 : up-value ( n heap -- entry )
-    >r up r> data-nth ; inline
+    [ up ] dip data-nth ; inline

 : left-value ( n heap -- entry )
-    >r left r> data-nth ; inline
+    [ left ] dip data-nth ; inline

 : right-value ( n heap -- entry )
-    >r right r> data-nth ; inline
+    [ right ] dip data-nth ; inline

 : data-set-nth ( entry n heap -- )
-    >r [ >>index drop ] 2keep r>
+    [ [ >>index drop ] 2keep ] dip
    data>> set-nth-unsafe ; inline

 : data-push ( entry heap -- n )
@ -82,8 +82,8 @@ M: heap heap-size ( heap -- n )
    data>> first ; inline

 : data-exchange ( m n heap -- )
-    [ tuck data-nth >r data-nth r> ] 3keep
-    tuck >r >r data-set-nth r> r> data-set-nth ; inline
+    [ tuck data-nth [ data-nth ] dip ] 3keep
+    tuck [ data-set-nth ] 2dip data-set-nth ; inline

 GENERIC: heap-compare ( pair1 pair2 heap -- ? )

@ -97,10 +97,10 @@ M: max-heap heap-compare (heap-compare) +lt+ eq? ;
    heap-size >= ; inline

 : left-bounds-check? ( m heap -- ? )
-    >r left r> heap-bounds-check? ; inline
+    [ left ] dip heap-bounds-check? ; inline

 : right-bounds-check? ( m heap -- ? )
-    >r right r> heap-bounds-check? ; inline
+    [ right ] dip heap-bounds-check? ; inline

 : continue? ( m up[m] heap -- ? )
    [ data-nth swap ] keep [ data-nth ] keep
@ -109,7 +109,7 @@ M: max-heap heap-compare (heap-compare) +lt+ eq? ;
 DEFER: up-heap

 : (up-heap) ( n heap -- )
-    >r dup up r>
+    [ dup up ] dip
    3dup continue? [
        [ data-exchange ] 2keep up-heap
    ] [
@ -121,7 +121,7 @@ DEFER: up-heap

 : (child) ( m heap -- n )
    2dup right-value
-    >r 2dup left-value r>
+    [ 2dup left-value ] dip
    rot heap-compare
    [ right ] [ left ] if ;

--- a/basis/help/lint/summary.txt
+++ b/basis/help/lint/summary.txt
@ -0,0 +1 @@
+Help lint tool
--- a/basis/hints/hints-docs.factor
+++ b/basis/hints/hints-docs.factor
@ -1,10 +1,10 @@
 IN: hints
-USING: help.markup help.syntax words quotations sequences ;
+USING: help.markup help.syntax words quotations sequences kernel ;

 ARTICLE: "hints" "Compiler specialization hints"
 "Specialization hints help the compiler generate efficient code."
 $nl
-"Specialization hints can help words which call a lot of generic words on the same object - perhaps in a loop - and in most cases, it is anticipated that this object is of a certain class. Using specialization hints, the compiler can be instructed to compile a branch at the beginning of the word; if the branch is taken, the input object has the assumed class, and inlining of generic methods can take place."
+"Specialization hints can help words which call a lot of generic words on the same object - perhaps in a loop - and in most cases, it is anticipated that this object is of a certain class, or even " { $link eq? } " to some literal. Using specialization hints, the compiler can be instructed to compile a branch at the beginning of the word; if the branch is taken, the input object has the assumed class or value, and inlining of generic methods can take place."
 $nl
 "Specialization hints are not declarations; if the inputs do not match what is specified, the word will still run, possibly slower if the compiled code cannot inline methods because of insufficient static type information."
 $nl
@ -20,10 +20,10 @@ HELP: specialized-def
 { $description "Outputs the definition of a word after it has been split into specialized branches. This is the definition which will actually be compiled by the compiler." } ;

 HELP: HINTS:
-{ $values { "defspec" "a definition specifier" } { "hints..." "a list of sequences of classes" } }
+{ $values { "defspec" "a definition specifier" } { "hints..." "a list of sequences of classes or literals" } }
 { $description "Defines specialization hints for a word or a method."
 $nl
-"Each sequence of classes in the list will cause a specialized version of the word to be compiled." }
+"Each sequence in the list will cause a specialized version of the word to be compiled. Classes are tested for using their predicate, and literals are tested using " { $link eq? } "." }
 { $examples "The " { $link append } " word has a specializer for the very common case where two strings or two arrays are appended:"
 { $code "HINTS: append { string string } { array array } ;" }
 "Specializers can also be defined on methods:"
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@ -3,25 +3,34 @@
 USING: parser words definitions kernel sequences assocs arrays
 kernel.private fry combinators accessors vectors strings sbufs
 byte-arrays byte-vectors io.binary io.streams.string splitting
-math generic generic.standard generic.standard.engines ;
+math generic generic.standard generic.standard.engines classes ;
 IN: hints

-: (make-specializer) ( class picker -- quot )
-    swap "predicate" word-prop append ;
+GENERIC: specializer-predicate ( spec -- quot )

-: make-specializer ( classes -- quot )
+M: class specializer-predicate "predicate" word-prop ;
+
+M: object specializer-predicate '[ _ eq? ] ;
+
+GENERIC: specializer-declaration ( spec -- class )
+
+M: class specializer-declaration ;
+
+M: object specializer-declaration class ;
+
+: make-specializer ( specs -- quot )
    dup length <reversed>
    [ (picker) 2array ] 2map
    [ drop object eq? not ] assoc-filter
    [ [ t ] ] [
-        [ (make-specializer) ] { } assoc>map
+        [ swap specializer-predicate append ] { } assoc>map
        unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
    ] if-empty ;

 : specializer-cases ( quot word -- default alist )
    dup [ array? ] all? [ 1array ] unless [
        [ make-specializer ] keep
-        '[ _ declare ] pick append
+        [ specializer-declaration ] map '[ _ declare ] pick append
    ] { } map>assoc ;

 : method-declaration ( method -- quot )
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@ -117,7 +117,9 @@ M: word integer-op-input-classes
    { fixnum bignum float }
    [ [ dup 3array ] [ swap method ] 2bi ] with { } map>assoc
    [ nip ] assoc-filter
-    [ def>> peek ] assoc-map % ;
+    [ def>> ] assoc-map
+    [ nip length 1 = ] assoc-filter
+    [ first ] assoc-map % ;

 SYMBOL: math-ops

--- a/basis/mime/multipart/multipart-tests.factor
+++ b/basis/mime/multipart/multipart-tests.factor
--- a/basis/mime/multipart/multipart.factor
+++ b/basis/mime/multipart/multipart.factor
@ -1,7 +1,9 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators io kernel locals math multiline
-sequences splitting prettyprint ;
+sequences splitting prettyprint namespaces http.parsers
+ascii assocs unicode.case io.files.unique io.files io.encodings.binary
+byte-arrays io.encodings make fry ;
 IN: mime.multipart

 TUPLE: multipart-stream stream n leftover separator ;
@ -27,37 +29,77 @@ TUPLE: multipart-stream stream n leftover separator ;
 : multipart-split ( bytes separator -- before after seq=? )
    2dup sequence= [ 2drop f f t ] [ split1 f ] if ;

-:: multipart-step-found ( bytes stream quot -- ? )
-    bytes [
-        quot unless-empty
-    ] [
-        stream (>>leftover)
-        quot unless-empty
-    ] if-empty f quot call f ;
+:: multipart-step-found ( bytes stream quot: ( bytes -- ) -- ? )
+    bytes [ quot unless-empty ]
+    [ stream (>>leftover) quot unless-empty ] if-empty f ; inline

-:: multipart-step-not-found ( stream end-stream? separator quot -- ? )
-    end-stream? [
+:: multipart-step-not-found ( bytes stream end-stream? separator quot: ( bytes -- ) -- ? )
+    bytes end-stream? [
        quot unless-empty f
    ] [
        separator length 1- ?cut* stream (>>leftover)
        quot unless-empty t
-    ] if ;
+    ] if ; inline

 :: multipart-step ( stream bytes end-stream? separator quot: ( bytes -- ) -- ? end-stream? )
    #! return t to loop again
    bytes separator multipart-split
-    [ 2drop f quot call f ]
+    [ 2drop f ]
    [
        [ stream quot multipart-step-found ]
        [ stream end-stream? separator quot multipart-step-not-found ] if*
-    ] if stream leftover>> end-stream? not or ;
+    ] if stream leftover>> end-stream? not or >boolean ;
+
+
+:: multipart-step-loop ( stream quot1: ( bytes -- ) -- ? )
+    stream dup [ read-n ] [ separator>> ] bi quot1 multipart-step
+    swap [ drop stream quot1 multipart-step-loop ] when ; inline recursive
+
+SYMBOL: header
+SYMBOL: parsed-header
+SYMBOL: magic-separator
+
+: trim-blanks ( str -- str' ) [ blank? ] trim ;
+
+: trim-quotes ( str -- str' )
+    [ [ CHAR: " = ] [ CHAR: ' = ] bi or ] trim ;
+
+: parse-content-disposition ( str -- content-disposition hash )
+    ";" split [ first ] [ rest-slice ] bi [ "=" split ] map
+    [ [ trim-blanks ] [ trim-quotes ] bi* ] H{ } assoc-map-as ;
+
+: parse-multipart-header ( string -- headers )
+    "\r\n" split harvest
+    [ parse-header-line first2 ] H{ } map>assoc ;
+
+ERROR: expected-file ;
+
+TUPLE: uploaded-file path filename name ;
+
+: (parse-multipart) ( stream -- ? )
+    "\r\n\r\n" >>separator
+    header off
+    dup [ header [ prepend ] change ] multipart-step-loop drop
+    header get dup magic-separator get [ length ] bi@ < [
+        2drop f
+    ] [
+        parse-multipart-header
+        parsed-header set
+        "\r\n" magic-separator get append >>separator
+        "factor-upload" "httpd" make-unique-file tuck
+        binary [ [ write ] multipart-step-loop ] with-file-writer swap
+        "content-disposition" parsed-header get at parse-content-disposition
+        nip [ "filename" swap at ] [ "name" swap at ] bi
+        uploaded-file boa ,
+    ] if ;

 PRIVATE>

-:: multipart-step-loop ( stream quot1: ( bytes -- ) quot2: ( -- ) -- ? )
-    stream dup [ read-n ] [ separator>> ] bi quot1 multipart-step
-    swap [ drop stream quot1 quot2 multipart-step-loop ] quot2 if ;
-
-: multipart-loop-all ( stream quot1: ( bytes -- ) quot2: ( -- ) -- )
-    3dup multipart-step-loop
-    [ multipart-loop-all ] [ 3drop ] if ;
+: parse-multipart ( stream -- array )
+    [
+        "\r\n" <multipart-stream>
+        magic-separator off
+        dup [ magic-separator [ prepend ] change ]
+            multipart-step-loop drop
+        '[ [ _ (parse-multipart) ] loop ] { } make
+    ] with-scope ;
--- a/basis/opengl/gl/extensions/extensions.factor
+++ b/basis/opengl/gl/extensions/extensions.factor
@ -1,6 +1,6 @@
-USING: alien alien.syntax combinators kernel parser sequences
-system words namespaces hashtables init math arrays assocs
-continuations lexer ;
+USING: alien alien.syntax alien.syntax.private combinators
+kernel parser sequences system words namespaces hashtables init
+math arrays assocs continuations lexer ;
 IN: opengl.gl.extensions

 ERROR: unknown-gl-platform ;
@ -36,6 +36,15 @@ reset-gl-function-number-counter
        +gl-function-pointers+ get-global set-at
    ] if* ;

+: indirect-quot ( function-ptr-quot return types abi -- quot )
+    [ alien-indirect ] 3curry compose ;
+
+: define-indirect ( abi return function-ptr-quot function-name parameters -- )
+    [ pick ] dip parse-arglist
+    rot create-in
+    [ swapd roll indirect-quot ] 2dip
+    -rot define-declared ;
+
 : GL-FUNCTION:
    gl-function-calling-convention
    scan
--- a/basis/stack-checker/backend/backend.factor
+++ b/basis/stack-checker/backend/backend.factor
@ -4,7 +4,7 @@ USING: fry arrays generic io io.streams.string kernel math
 namespaces parser prettyprint sequences strings vectors words
 quotations effects classes continuations debugger assocs
 combinators compiler.errors accessors math.order definitions
-sets generic.standard.engines.tuple stack-checker.state
+sets generic.standard.engines.tuple hints stack-checker.state
 stack-checker.visitor stack-checker.errors
 stack-checker.values stack-checker.recursive-state ;
 IN: stack-checker.backend
@ -125,7 +125,7 @@ M: object apply-object push-literal ;
    ] 2bi ; inline

 : infer-word-def ( word -- )
-    [ def>> ] [ add-recursive-state ] bi infer-quot ;
+    [ specialized-def ] [ add-recursive-state ] bi infer-quot ;

 : check->r ( -- )
    meta-r get empty? terminated? get or
--- a/basis/stack-checker/inlining/inlining.factor
+++ b/basis/stack-checker/inlining/inlining.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry namespaces assocs kernel sequences words accessors
 definitions math math.order effects classes arrays combinators
-vectors arrays
+vectors arrays hints
 stack-checker.state
 stack-checker.errors
 stack-checker.values
@ -17,7 +17,7 @@ IN: stack-checker.inlining
 ! having to handle recursive inline words.

 : infer-inline-word-def ( word label -- )
-    [ drop def>> ] [ add-inline-word ] 2bi infer-quot ;
+    [ drop specialized-def ] [ add-inline-word ] 2bi infer-quot ;

 TUPLE: inline-recursive < identity-tuple
 id
--- a/basis/tools/hexdump/summary.txt
+++ b/basis/tools/hexdump/summary.txt
@ -1 +1 @@
-Prints formatted hex dump of an arbitrary sequence
+Prints the formatted hex dump of a byte-array
--- a/core/math/floats/floats-tests.factor
+++ b/core/math/floats/floats-tests.factor
@ -60,3 +60,5 @@ unit-test
 [ 0 ] [ 1/0. >bignum ] unit-test

 [ t ] [ 64 [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
+
+[ 5 ] [ 10.5 1.9 /i ] unit-test
--- a/core/math/floats/floats.factor
+++ b/core/math/floats/floats.factor
@ -24,6 +24,7 @@ M: float - float- ;
 M: float * float* ;
 M: float / float/f ;
 M: float /f float/f ;
+M: float /i float/f >integer ;
 M: float mod float-mod ;

 M: real abs dup 0 < [ neg ] when ;
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@ -80,17 +80,17 @@ ERROR: no-word-error name ;
 : <no-word-error> ( name possibilities -- error restarts )
    [ drop \ no-word-error boa ] [ word-restarts ] 2bi ;

-SYMBOL: amended-use?
+SYMBOL: amended-use

 SYMBOL: auto-use?

 : no-word-restarted ( restart-value -- word )
    dup word? [
-        amended-use? on
        dup vocabulary>>
-        [ (use+) ] [
-            "Added ``" swap "'' vocabulary to search path" 3append note.
-        ] bi
+        [ (use+) ]
+        [ amended-use get dup [ push ] [ 2drop ] if ]
+        [ "Added ``" swap "'' vocabulary to search path" 3append note. ]
+        tri
    ] [ create-in ] if ;

 : no-word ( name -- newword )
@ -232,22 +232,16 @@ SYMBOL: interactive-vocabs
 SYMBOL: print-use-hook

 print-use-hook global [ [ ] or ] change-at
-
+!
 : parse-fresh ( lines -- quot )
    [
-        amended-use? off
+        V{ } clone amended-use set
        parse-lines
-        amended-use? get [
-            print-use-hook get call
-        ] when
+        amended-use get empty? [ print-use-hook get call ] unless
    ] with-file-vocabs ;

 : parsing-file ( file -- )
-    "quiet" get [
-        drop
-    ] [
-        "Loading " write print flush
-    ] if ;
+    "quiet" get [ drop ] [ "Loading " write print flush ] if ;

 : filter-moved ( assoc1 assoc2 -- seq )
    swap assoc-diff [
--- a/extra/asn1/asn1.factor
+++ b/extra/asn1/asn1.factor
@ -189,11 +189,11 @@ M: string >ber ( str -- byte-array )
    >byte-array append ;

 : >ber-application-string ( n str -- byte-array )
-    >r HEX: 40 + set-tag r> >ber ;
+    [ HEX: 40 + set-tag ] dip >ber ;

 GENERIC: >ber-contextspecific ( n obj -- byte-array )
 M: string >ber-contextspecific ( n str -- byte-array )
-    >r HEX: 80 + set-tag r> >ber ;
+    [ HEX: 80 + set-tag ] dip >ber ;

 ! =========================================================
 ! Array
--- a/extra/assocs/lib/lib.factor
+++ b/extra/assocs/lib/lib.factor
@ -10,10 +10,10 @@ IN: assocs.lib
    dupd at [ nip ] when* ;

 : replace-at ( assoc value key -- assoc )
-    >r >r dup r> 1vector r> rot set-at ;
+    [ dupd 1vector ] dip rot set-at ;

 : peek-at* ( assoc key -- obj ? )
-    swap at* dup [ >r peek r> ] when ;
+    swap at* dup [ [ peek ] dip ] when ;

 : peek-at ( assoc key -- obj )
    peek-at* drop ;
@ -27,7 +27,7 @@ IN: assocs.lib
 : insert ( value variable -- ) namespace push-at ;

 : generate-key ( assoc -- str )
-    >r 32 random-bits >hex r>
+    [ 32 random-bits >hex ] dip
    2dup key? [ nip generate-key ] [ drop ] if ;

 : set-at-unique ( value assoc -- key )
--- a/extra/benchmark/nbody/nbody.factor
+++ b/extra/benchmark/nbody/nbody.factor
@ -11,39 +11,37 @@ IN: benchmark.nbody
 TUPLE: body
 { location float-array }
 { velocity float-array }
-{ mass float } ;
+{ mass float read-only } ;

-: <body> ( -- body ) body new ; inline
+: <body> ( location velocity mass -- body )
+    [ days-per-year v*n ] [ solar-mass * ] bi* body boa ; inline

 : <jupiter> ( -- body )
-    <body>
-        F{ 4.84143144246472090e+00 -1.16032004402742839e+00 -1.03622044471123109e-01 } >>location
-        F{ 1.66007664274403694e-03 7.69901118419740425e-03 -6.90460016972063023e-05 } days-per-year v*n >>velocity
-        9.54791938424326609e-04 solar-mass * >>mass ;
+    F{ 4.84143144246472090e+00 -1.16032004402742839e+00 -1.03622044471123109e-01 }
+    F{ 1.66007664274403694e-03 7.69901118419740425e-03 -6.90460016972063023e-05 }
+    9.54791938424326609e-04
+    <body> ;

 : <saturn> ( -- body )
-    <body>
-        F{ 8.34336671824457987e+00 4.12479856412430479e+00 -4.03523417114321381e-01 } >>location
-        F{ -2.76742510726862411e-03 4.99852801234917238e-03 2.30417297573763929e-05 } days-per-year v*n >>velocity
-        2.85885980666130812e-04 solar-mass * >>mass ;
+    F{ 8.34336671824457987e+00 4.12479856412430479e+00 -4.03523417114321381e-01 }
+    F{ -2.76742510726862411e-03 4.99852801234917238e-03 2.30417297573763929e-05 }
+    2.85885980666130812e-04
+    <body> ;

 : <uranus> ( -- body )
-    <body>
-        F{ 1.28943695621391310e+01 -1.51111514016986312e+01 -2.23307578892655734e-01 } >>location
-        F{ 2.96460137564761618e-03 2.37847173959480950e-03 -2.96589568540237556e-05 } days-per-year v*n >>velocity
-        4.36624404335156298e-05 solar-mass * >>mass ;
+    F{ 1.28943695621391310e+01 -1.51111514016986312e+01 -2.23307578892655734e-01 }
+    F{ 2.96460137564761618e-03 2.37847173959480950e-03 -2.96589568540237556e-05 }
+    4.36624404335156298e-05
+    <body> ;

 : <neptune> ( -- body )
-    <body>
-        F{ 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 } >>location
-        F{ 2.68067772490389322e-03 1.62824170038242295e-03 -9.51592254519715870e-05 } days-per-year v*n >>velocity
-        5.15138902046611451e-05 solar-mass * >>mass ;
+    F{ 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 }
+    F{ 2.68067772490389322e-03 1.62824170038242295e-03 -9.51592254519715870e-05 }
+    5.15138902046611451e-05
+    <body> ;

 : <sun> ( -- body )
-    <body>
-        solar-mass >>mass
-        F{ 0 0 0 } >>location
-        F{ 0 0 0 } >>velocity ;
+    F{ 0 0 0 } F{ 0 0 0 } 1 <body> ;
    
 : offset-momentum ( body offset -- body )
    vneg solar-mass v/n >>velocity ; inline
--- a/extra/combinators/lib/lib.factor
+++ b/extra/combinators/lib/lib.factor
@ -31,7 +31,7 @@ IN: combinators.lib
 ! Generalized versions of core combinators
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-: quad ( x p q r s -- ) >r >r >r keep r> keep r> keep r> call ; inline
+: quad ( x p q r s -- ) [ keep ] 3dip [ keep ] 2dip [ keep ] dip call ; inline

 : 4slip ( quot a b c d -- a b c d ) 4 nslip ; inline

@ -123,10 +123,10 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
    >r pick >r with r> r> swapd with ;

 : or? ( obj quot1 quot2 -- ? )
-    >r keep r> rot [ 2nip ] [ call ] if* ; inline
+    [ keep ] dip rot [ 2nip ] [ call ] if* ; inline

 : and? ( obj quot1 quot2 -- ? )
-    >r keep r> rot [ call ] [ 2drop f ] if ; inline
+    [ keep ] dip rot [ call ] [ 2drop f ] if ; inline

 MACRO: multikeep ( word out-indexes -- ... )
    [
@ -139,7 +139,7 @@ MACRO: multikeep ( word out-indexes -- ... )
    [ drop ] rot compose attempt-all ; inline

 : do-while ( pred body tail -- )
-    >r tuck 2slip r> while ; inline
+    [ tuck 2slip ] dip while ; inline

 : generate ( generator predicate -- obj )
    [ dup ] swap [ dup [ nip ] unless not ] 3compose
@ -147,7 +147,7 @@ MACRO: multikeep ( word out-indexes -- ... )

 MACRO: predicates ( seq -- quot/f )
    dup [ 1quotation [ drop ] prepend ] map
-    >r [ [ dup ] prepend ] map r> zip [ drop f ] suffix
+    [ [ [ dup ] prepend ] map ] dip zip [ drop f ] suffix
    [ cond ] curry ;

 : %chance ( quot n -- ) 100 random > swap when ; inline
--- a/extra/html/parser/parser.factor
+++ b/extra/html/parser/parser.factor
@ -26,7 +26,7 @@ SYMBOL: tagstack
        swap >>name ;

 : make-tag ( string attribs -- tag )
-    >r [ closing-tag? ] keep "/" trim1 r> rot <tag> ;
+    [ [ closing-tag? ] keep "/" trim1 ] dip rot <tag> ;

 : make-text-tag ( string -- tag )
    tag new
--- a/extra/jamshred/tunnel/tunnel.factor
+++ b/extra/jamshred/tunnel/tunnel.factor
@ -1,7 +1,8 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors combinators float-arrays kernel jamshred.oint locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ;
-USE: tools.walker
+USING: accessors arrays colors combinators float-arrays kernel
+locals math math.constants math.matrices math.order math.ranges
+math.vectors math.quadratic random sequences vectors jamshred.oint ;
 IN: jamshred.tunnel

 : n-segments ( -- n ) 5000 ; inline
--- a/extra/money/money-tests.factor
+++ b/extra/money/money-tests.factor
@ -12,10 +12,14 @@ IN: money.tests
 [ 1/10 ] [ DECIMAL: .1 ] unit-test
 [ 1/10 ] [ DECIMAL: 0.1 ] unit-test
 [ 1/10 ] [ DECIMAL: 00.10 ] unit-test
-
-
+[ 23 ] [ DECIMAL: 23 ] unit-test
+[ -23 ] [ DECIMAL: -23 ] unit-test
+[ -23-1/100 ] [ DECIMAL: -23.01 ] unit-test

 [ "DECIMAL: ." eval ] must-fail
 [ "DECIMAL: f" eval ] must-fail
 [ "DECIMAL: 0.f" eval ] must-fail
 [ "DECIMAL: f.0" eval ] must-fail
+
+[ "$100.00" ] [ DECIMAL: 100.0 money>string ] unit-test
+[ "$0.00" ] [ DECIMAL: 0.0 money>string ] unit-test
--- a/extra/money/money.factor
+++ b/extra/money/money.factor
@ -3,28 +3,31 @@ namespaces make sequences splitting grouping combinators
 continuations ;
 IN: money

+SYMBOL: currency-token
+CHAR: $ \ currency-token set-global
+
 : dollars/cents ( dollars -- dollars cents )
    100 * 100 /mod round ;

+: (money>string) ( dollars cents -- string )
+    [ number>string ] bi@
+    [ <reversed> 3 group "," join <reversed> ]
+    [ 2 CHAR: 0 pad-left ] bi* "." swap 3append ;
+
 : money>string ( object -- string )
-    dollars/cents [
-        "$" %
-        swap number>string
-        <reversed> 3 group "," join <reversed> %
-        "." % number>string 2 CHAR: 0 pad-left %
-    ] "" make ;
+    dollars/cents (money>string) currency-token get prefix ;

-: money. ( object -- )
-    money>string print ;
+: money. ( object -- ) money>string print ;

-ERROR: not-a-decimal x ;
+ERROR: not-an-integer x ;

 : parse-decimal ( str -- ratio )
    "." split1
-    >r dup "-" head? [ drop t "0" ] [ f swap ] if r>
+    [ "-" ?head swap ] dip
    [ [ "0" ] when-empty ] bi@
-    dup length
-    >r [ dup string>number [ nip ] [ not-a-decimal ] if* ] bi@ r>
+    [
+        [ dup string>number [ nip ] [ not-an-integer ] if* ] bi@
+    ] keep length
    10 swap ^ / + swap [ neg ] when ;

 : DECIMAL:
--- a/extra/taxes/usa/usa-tests.factor
+++ b/extra/taxes/usa/usa-tests.factor
@ -1,6 +1,6 @@
 USING: kernel money tools.test
 taxes.usa taxes.usa.federal taxes.usa.mn
-taxes.utils taxes.usa.w4 usa-cities ;
+calendar taxes.usa.w4 usa-cities ;
 IN: taxes.usa.tests

 [
--- a/extra/taxes/utils/utils.factor
+++ b/extra/taxes/utils/utils.factor
@ -1,10 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: math ;
-IN: taxes.utils
-
-: monthly ( x -- y ) 12 / ;
-: semimonthly ( x -- y ) 24 / ;
-: biweekly ( x -- y ) 26 / ;
-: weekly ( x -- y ) 52 / ;
-: daily ( x -- y ) 360 / ;