diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index 94472e8261..727492edb1 100644
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -8,6 +8,8 @@ UNION: value-type array struct-type ;
 
 M: array c-type ;
 
+M: array c-type-class drop object ;
+
 M: array heap-size unclip heap-size [ * ] reduce ;
 
 M: array c-type-align first c-type-align ;
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 543af8dee8..46d63c3375 100644
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -13,13 +13,15 @@ DEFER: *char
 : little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
 
 TUPLE: c-type
+class
 boxer boxer-quot unboxer unboxer-quot
 getter setter
 reg-class size align stack-align? ;
 
 : new-c-type ( class -- type )
     new
-        int-regs >>reg-class ;
+        int-regs >>reg-class
+        object >>class ;
 
 : <c-type> ( -- type )
     \ c-type new-c-type ;
@@ -63,6 +65,12 @@ M: string c-type ( name -- type )
         ] ?if
     ] if ;
 
+GENERIC: c-type-class ( name -- class )
+
+M: c-type c-type-class class>> ;
+
+M: string c-type-class c-type c-type-class ;
+
 GENERIC: c-type-boxer ( name -- boxer )
 
 M: c-type c-type-boxer boxer>> ;
@@ -306,6 +314,7 @@ M: long-long-type box-return ( type -- )
 
 [
     <c-type>
+        c-ptr >>class
         [ alien-cell ] >>getter
         [ set-alien-cell ] >>setter
         bootstrap-cell >>size
@@ -315,6 +324,7 @@ M: long-long-type box-return ( type -- )
     "void*" define-primitive-type
 
     <long-long-type>
+        integer >>class
         [ alien-signed-8 ] >>getter
         [ set-alien-signed-8 ] >>setter
         8 >>size
@@ -324,6 +334,7 @@ M: long-long-type box-return ( type -- )
     "longlong" define-primitive-type
 
     <long-long-type>
+        integer >>class
         [ alien-unsigned-8 ] >>getter
         [ set-alien-unsigned-8 ] >>setter
         8 >>size
@@ -333,6 +344,7 @@ M: long-long-type box-return ( type -- )
     "ulonglong" define-primitive-type
 
     <c-type>
+        integer >>class
         [ alien-signed-cell ] >>getter
         [ set-alien-signed-cell ] >>setter
         bootstrap-cell >>size
@@ -342,6 +354,7 @@ M: long-long-type box-return ( type -- )
     "long" define-primitive-type
 
     <c-type>
+        integer >>class
         [ alien-unsigned-cell ] >>getter
         [ set-alien-unsigned-cell ] >>setter
         bootstrap-cell >>size
@@ -351,6 +364,7 @@ M: long-long-type box-return ( type -- )
     "ulong" define-primitive-type
 
     <c-type>
+        integer >>class
         [ alien-signed-4 ] >>getter
         [ set-alien-signed-4 ] >>setter
         4 >>size
@@ -360,6 +374,7 @@ M: long-long-type box-return ( type -- )
     "int" define-primitive-type
 
     <c-type>
+        integer >>class
         [ alien-unsigned-4 ] >>getter
         [ set-alien-unsigned-4 ] >>setter
         4 >>size
@@ -369,6 +384,7 @@ M: long-long-type box-return ( type -- )
     "uint" define-primitive-type
 
     <c-type>
+        fixnum >>class
         [ alien-signed-2 ] >>getter
         [ set-alien-signed-2 ] >>setter
         2 >>size
@@ -378,6 +394,7 @@ M: long-long-type box-return ( type -- )
     "short" define-primitive-type
 
     <c-type>
+        fixnum >>class
         [ alien-unsigned-2 ] >>getter
         [ set-alien-unsigned-2 ] >>setter
         2 >>size
@@ -387,6 +404,7 @@ M: long-long-type box-return ( type -- )
     "ushort" define-primitive-type
 
     <c-type>
+        fixnum >>class
         [ alien-signed-1 ] >>getter
         [ set-alien-signed-1 ] >>setter
         1 >>size
@@ -396,6 +414,7 @@ M: long-long-type box-return ( type -- )
     "char" define-primitive-type
 
     <c-type>
+        fixnum >>class
         [ alien-unsigned-1 ] >>getter
         [ set-alien-unsigned-1 ] >>setter
         1 >>size
@@ -414,6 +433,7 @@ M: long-long-type box-return ( type -- )
     "bool" define-primitive-type
 
     <c-type>
+        float >>class
         [ alien-float ] >>getter
         [ [ >float ] 2dip set-alien-float ] >>setter
         4 >>size
@@ -425,6 +445,7 @@ M: long-long-type box-return ( type -- )
     "float" define-primitive-type
 
     <c-type>
+        float >>class
         [ alien-double ] >>getter
         [ [ >float ] 2dip set-alien-double ] >>setter
         8 >>size
diff --git a/basis/alien/strings/strings.factor b/basis/alien/strings/strings.factor
index 70bbe773ee..b0faadb7fc 100644
--- a/basis/alien/strings/strings.factor
+++ b/basis/alien/strings/strings.factor
@@ -40,6 +40,9 @@ PREDICATE: string-type < pair
 
 M: string-type c-type ;
 
+M: string-type c-type-class
+    drop object ;
+
 M: string-type heap-size
     drop "void*" heap-size ;
 
diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index adb25aa977..1131b1eecd 100644
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -9,6 +9,8 @@ TUPLE: struct-type size align fields ;
 
 M: struct-type heap-size size>> ;
 
+M: struct-type c-type-class drop object ;
+
 M: struct-type c-type-align align>> ;
 
 M: struct-type c-type-stack-align? drop f ;
diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index 7bad44f7a6..9ffe4a6aa0 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -21,8 +21,6 @@ IN: compiler.cfg.builder
 
 ! Convert tree SSA IR to CFG SSA IR.
 
-: stop-iterating ( -- next ) end-basic-block f ;
-
 SYMBOL: procedures
 SYMBOL: current-word
 SYMBOL: current-label
@@ -211,7 +209,7 @@ M: #dispatch emit-node
 ! #call
 M: #call emit-node
     dup word>> dup "intrinsic" word-prop
-    [ emit-intrinsic iterate-next ] [ nip emit-call ] if ;
+    [ emit-intrinsic ] [ nip emit-call ] if ;
 
 ! #call-recursive
 M: #call-recursive emit-node label>> id>> emit-call ;
@@ -262,7 +260,7 @@ M: #terminate emit-node drop stop-iterating ;
 
 : emit-alien-node ( node quot -- next )
     [ params>> ] dip [ drop alien-stack-frame ] [ call ] 2bi
-    begin-basic-block iterate-next ; inline
+    ##branch begin-basic-block iterate-next ; inline
 
 M: #alien-invoke emit-node
     [ ##alien-invoke ] emit-alien-node ;
diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index 7584931cf7..7e97961eb3 100644
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -34,6 +34,7 @@ M: ##compare-imm-branch uses-vregs src1>> 1array ;
 M: ##dispatch uses-vregs src>> 1array ;
 M: ##alien-getter uses-vregs src>> 1array ;
 M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ;
+M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: _compare-imm-branch uses-vregs src1>> 1array ;
 M: insn uses-vregs drop f ;
@@ -43,6 +44,7 @@ UNION: vreg-insn
 ##write-barrier
 ##dispatch
 ##effect
+##fixnum-overflow
 ##conditional-branch
 ##compare-imm-branch
 _conditional-branch
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index ce1f6b7e85..9e82851c12 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -92,6 +92,15 @@ INSN: ##shr-imm < ##binary-imm ;
 INSN: ##sar-imm < ##binary-imm ;
 INSN: ##not < ##unary ;
 
+! Overflowing arithmetic
+TUPLE: ##fixnum-overflow < insn src1 src2 ;
+INSN: ##fixnum-add < ##fixnum-overflow ;
+INSN: ##fixnum-add-tail < ##fixnum-overflow ;
+INSN: ##fixnum-sub < ##fixnum-overflow ;
+INSN: ##fixnum-sub-tail < ##fixnum-overflow ;
+INSN: ##fixnum-mul < ##fixnum-overflow ;
+INSN: ##fixnum-mul-tail < ##fixnum-overflow ;
+
 : ##tag-fixnum ( dst src -- ) tag-bits get ##shl-imm ; inline
 : ##untag-fixnum ( dst src -- ) tag-bits get ##sar-imm ; inline
 
diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index 04c9097725..68ee7489f8 100644
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -3,10 +3,22 @@
 USING: sequences accessors layouts kernel math namespaces
 combinators fry locals
 compiler.tree.propagation.info
-compiler.cfg.stacks compiler.cfg.hats compiler.cfg.instructions
-compiler.cfg.utilities ;
+compiler.cfg.hats
+compiler.cfg.stacks
+compiler.cfg.iterator
+compiler.cfg.instructions
+compiler.cfg.utilities
+compiler.cfg.registers ;
 IN: compiler.cfg.intrinsics.fixnum
 
+: emit-both-fixnums? ( -- )
+    D 0 ^^peek
+    D 1 ^^peek
+    ^^or
+    tag-mask get ^^and-imm
+    0 cc= ^^compare-imm
+    ds-push ;
+
 : (emit-fixnum-imm-op) ( infos insn -- dst )
     ds-drop
     [ ds-pop ]
@@ -64,3 +76,16 @@ IN: compiler.cfg.intrinsics.fixnum
 
 : emit-fixnum>bignum ( -- )
     ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
+
+: emit-fixnum-overflow-op ( quot quot-tail -- next )
+    [ 2inputs 1 ##inc-d ] 2dip
+    tail-call? [
+        ##epilogue
+        nip call
+        stop-iterating
+    ] [
+        drop call
+        ##branch
+        begin-basic-block
+        iterate-next
+    ] if ; inline
diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor
index ef1cde337a..6c6c2955c9 100644
--- a/basis/compiler/cfg/intrinsics/intrinsics.factor
+++ b/basis/compiler/cfg/intrinsics/intrinsics.factor
@@ -8,7 +8,8 @@ compiler.cfg.intrinsics.alien
 compiler.cfg.intrinsics.allot
 compiler.cfg.intrinsics.fixnum
 compiler.cfg.intrinsics.float
-compiler.cfg.intrinsics.slots ;
+compiler.cfg.intrinsics.slots
+compiler.cfg.iterator ;
 QUALIFIED: kernel
 QUALIFIED: arrays
 QUALIFIED: byte-arrays
@@ -22,6 +23,9 @@ IN: compiler.cfg.intrinsics
 
 {
     kernel.private:tag
+    math.private:both-fixnums?
+    math.private:fixnum+
+    math.private:fixnum-
     math.private:fixnum+fast
     math.private:fixnum-fast
     math.private:fixnum-bitand
@@ -85,60 +89,67 @@ IN: compiler.cfg.intrinsics
         alien.accessors:set-alien-double
     } [ t "intrinsic" set-word-prop ] each ;
 
-: emit-intrinsic ( node word -- )
+: enable-fixnum*-intrinsic ( -- )
+    \ math.private:fixnum* t "intrinsic" set-word-prop ;
+
+: emit-intrinsic ( node word -- node/f )
     {
-        { \ kernel.private:tag [ drop emit-tag ] }
-        { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op ] }
-        { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op ] }
-        { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op ] }
-        { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op ] }
-        { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op ] }
-        { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
-        { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
-        { \ math.private:fixnum*fast [ emit-fixnum*fast ] }
-        { \ math.private:fixnum< [ cc< emit-fixnum-comparison ] }
-        { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison ] }
-        { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison ] }
-        { \ math.private:fixnum> [ cc> emit-fixnum-comparison ] }
-        { \ kernel:eq? [ cc= emit-fixnum-comparison ] }
-        { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] }
-        { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] }
-        { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
-        { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
-        { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
-        { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
-        { \ math.private:float< [ drop cc< emit-float-comparison ] }
-        { \ math.private:float<= [ drop cc<= emit-float-comparison ] }
-        { \ math.private:float>= [ drop cc>= emit-float-comparison ] }
-        { \ math.private:float> [ drop cc> emit-float-comparison ] }
-        { \ math.private:float= [ drop cc= emit-float-comparison ] }
-        { \ math.private:float>fixnum [ drop emit-float>fixnum ] }
-        { \ math.private:fixnum>float [ drop emit-fixnum>float ] }
-        { \ slots.private:slot [ emit-slot ] }
-        { \ slots.private:set-slot [ emit-set-slot ] }
-        { \ strings.private:string-nth [ drop emit-string-nth ] }
-        { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
-        { \ arrays:<array> [ emit-<array> ] }
-        { \ byte-arrays:<byte-array> [ emit-<byte-array> ] }
-        { \ math.private:<complex> [ emit-simple-allot ] }
-        { \ math.private:<ratio> [ emit-simple-allot ] }
-        { \ kernel:<wrapper> [ emit-simple-allot ] }
-        { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
-        { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
-        { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
-        { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
-        { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
-        { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
-        { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-cell [ emit-alien-cell-getter ] }
-        { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
-        { \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter ] }
-        { \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter ] }
-        { \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter ] }
-        { \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter ] }
+        { \ kernel.private:tag [ drop emit-tag iterate-next ] }
+        { \ math.private:both-fixnums? [ drop emit-both-fixnums? iterate-next ] }
+        { \ math.private:fixnum+ [ drop [ ##fixnum-add ] [ ##fixnum-add-tail ] emit-fixnum-overflow-op ] }
+        { \ math.private:fixnum- [ drop [ ##fixnum-sub ] [ ##fixnum-sub-tail ] emit-fixnum-overflow-op ] }
+        { \ math.private:fixnum* [ drop [ ##fixnum-mul ] [ ##fixnum-mul-tail ] emit-fixnum-overflow-op ] }
+        { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op iterate-next ] }
+        { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op iterate-next ] }
+        { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op iterate-next ] }
+        { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op iterate-next ] }
+        { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op iterate-next ] }
+        { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast iterate-next ] }
+        { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot iterate-next ] }
+        { \ math.private:fixnum*fast [ emit-fixnum*fast iterate-next ] }
+        { \ math.private:fixnum< [ cc< emit-fixnum-comparison iterate-next ] }
+        { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison iterate-next ] }
+        { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison iterate-next ] }
+        { \ math.private:fixnum> [ cc> emit-fixnum-comparison iterate-next ] }
+        { \ kernel:eq? [ cc= emit-fixnum-comparison iterate-next ] }
+        { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum iterate-next ] }
+        { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum iterate-next ] }
+        { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op iterate-next ] }
+        { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op iterate-next ] }
+        { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op iterate-next ] }
+        { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op iterate-next ] }
+        { \ math.private:float< [ drop cc< emit-float-comparison iterate-next ] }
+        { \ math.private:float<= [ drop cc<= emit-float-comparison iterate-next ] }
+        { \ math.private:float>= [ drop cc>= emit-float-comparison iterate-next ] }
+        { \ math.private:float> [ drop cc> emit-float-comparison iterate-next ] }
+        { \ math.private:float= [ drop cc= emit-float-comparison iterate-next ] }
+        { \ math.private:float>fixnum [ drop emit-float>fixnum iterate-next ] }
+        { \ math.private:fixnum>float [ drop emit-fixnum>float iterate-next ] }
+        { \ slots.private:slot [ emit-slot iterate-next ] }
+        { \ slots.private:set-slot [ emit-set-slot iterate-next ] }
+        { \ strings.private:string-nth [ drop emit-string-nth iterate-next ] }
+        { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> iterate-next ] }
+        { \ arrays:<array> [ emit-<array> iterate-next ] }
+        { \ byte-arrays:<byte-array> [ emit-<byte-array> iterate-next ] }
+        { \ math.private:<complex> [ emit-simple-allot iterate-next ] }
+        { \ math.private:<ratio> [ emit-simple-allot iterate-next ] }
+        { \ kernel:<wrapper> [ emit-simple-allot iterate-next ] }
+        { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter iterate-next ] }
+        { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter iterate-next ] }
+        { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter iterate-next ] }
+        { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter iterate-next ] }
+        { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter iterate-next ] }
+        { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter iterate-next ] }
+        { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter iterate-next ] }
+        { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter iterate-next ] }
+        { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter iterate-next ] }
+        { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter iterate-next ] }
+        { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter iterate-next ] }
+        { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter iterate-next ] }
+        { \ alien.accessors:alien-cell [ emit-alien-cell-getter iterate-next ] }
+        { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter iterate-next ] }
+        { \ alien.accessors:alien-float [ single-float-regs emit-alien-float-getter iterate-next ] }
+        { \ alien.accessors:set-alien-float [ single-float-regs emit-alien-float-setter iterate-next ] }
+        { \ alien.accessors:alien-double [ double-float-regs emit-alien-float-getter iterate-next ] }
+        { \ alien.accessors:set-alien-double [ double-float-regs emit-alien-float-setter iterate-next ] }
     } case ;
diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index ec9ffaba49..d545b6d15c 100644
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -34,6 +34,12 @@ M: insn compute-stack-frame*
 
 \ _gc t frame-required? set-word-prop
 \ _spill t frame-required? set-word-prop
+\ ##fixnum-add t frame-required? set-word-prop
+\ ##fixnum-sub t frame-required? set-word-prop
+\ ##fixnum-mul t frame-required? set-word-prop
+\ ##fixnum-add-tail f frame-required? set-word-prop
+\ ##fixnum-sub-tail f frame-required? set-word-prop
+\ ##fixnum-mul-tail f frame-required? set-word-prop
 
 : compute-stack-frame ( insns -- )
     frame-required? off
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index cef14d06e4..99a138a763 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -33,5 +33,7 @@ IN: compiler.cfg.utilities
     building off
     basic-block off ;
 
+: stop-iterating ( -- next ) end-basic-block f ;
+
 : emit-primitive ( node -- )
     word>> ##call ##branch begin-basic-block ;
diff --git a/basis/compiler/cfg/value-numbering/propagate/propagate.factor b/basis/compiler/cfg/value-numbering/propagate/propagate.factor
index a3c9725838..d5c9830c0b 100644
--- a/basis/compiler/cfg/value-numbering/propagate/propagate.factor
+++ b/basis/compiler/cfg/value-numbering/propagate/propagate.factor
@@ -62,4 +62,8 @@ M: ##compare-imm-branch propagate
 M: ##dispatch propagate
     [ resolve ] change-src ;
 
+M: ##fixnum-overflow propagate
+    [ resolve ] change-src1
+    [ resolve ] change-src2 ;
+
 M: insn propagate ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index bfb47ba330..b66b6a11c7 100644
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -156,6 +156,16 @@ M: ##shr-imm generate-insn dst/src1/src2 %shr-imm ;
 M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ;
 M: ##not     generate-insn dst/src       %not     ;
 
+: src1/src2 ( insn -- src1 src2 )
+    [ src1>> register ] [ src2>> register ] bi ; inline
+
+M: ##fixnum-add generate-insn src1/src2 %fixnum-add ;
+M: ##fixnum-add-tail generate-insn src1/src2 %fixnum-add-tail ;
+M: ##fixnum-sub generate-insn src1/src2 %fixnum-sub ;
+M: ##fixnum-sub-tail generate-insn src1/src2 %fixnum-sub-tail ;
+M: ##fixnum-mul generate-insn src1/src2 %fixnum-mul ;
+M: ##fixnum-mul-tail generate-insn src1/src2 %fixnum-mul-tail ;
+
 : dst/src/temp ( insn -- dst src temp )
     [ dst/src ] [ temp>> register ] bi ; inline
 
diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index dd6f99ead1..59434b6dc5 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -254,3 +254,25 @@ TUPLE: id obj ;
     { 1 2 3 4 }
     [ { array } declare 2 <groups> length ] compile-call
 ] unit-test
+
+! Oops with new intrinsics
+: fixnum-overflow-control-flow-test ( a b -- c )
+    [ 1 fixnum- ] [ 2 fixnum- ] if 3 fixnum+fast ;
+
+[ 3 ] [ 1 t fixnum-overflow-control-flow-test ] unit-test
+[ 2 ] [ 1 f fixnum-overflow-control-flow-test ] unit-test
+
+! LOL
+: blah ( a -- b )
+    { float } declare dup 0 =
+    [ drop 1 ] [
+        dup 0 >=
+        [ 2 "double" "libm" "pow" { "double" "double" } alien-invoke ]
+        [ -0.5 "double" "libm" "pow" { "double" "double" } alien-invoke ]
+        if
+    ] if ;
+
+[ 4.0 ] [ 2.0 blah ] unit-test
+
+[ 4 ] [ 2 [ dup fixnum* ] compile-call ] unit-test
+[ 7 ] [ 2 [ dup fixnum* 3 fixnum+fast ] compile-call ] unit-test
diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index a1d8773484..e9bf77b188 100644
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -93,7 +93,7 @@ M: #shuffle node>quot
         [ drop "COMPLEX SHUFFLE" , ]
     } cond ;
 
-M: #push node>quot literal>> , ;
+M: #push node>quot literal>> literalize , ;
 
 M: #call node>quot word>> , ;
 
diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index f6e2bc0940..163b17094a 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -37,31 +37,6 @@ most-negative-fixnum most-positive-fixnum [a,b]
 
 \ bitnot { integer } "input-classes" set-word-prop
 
-{
-    fcosh
-    flog
-    fsinh
-    fexp
-    fasin
-    facosh
-    fasinh
-    ftanh
-    fatanh
-    facos
-    fpow
-    fatan
-    fatan2
-    fcos
-    ftan
-    fsin
-    fsqrt
-} [
-    dup stack-effect
-    [ in>> length real <repetition> "input-classes" set-word-prop ]
-    [ out>> length float <repetition> "default-output-classes" set-word-prop ]
-    2bi
-] each
-
 : ?change-interval ( info quot -- quot' )
     over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline
 
@@ -222,8 +197,15 @@ generic-comparison-ops [
 
 {
     { >fixnum fixnum }
+    { bignum>fixnum fixnum }
+
     { >bignum bignum }
+    { fixnum>bignum bignum }
+    { float>bignum bignum }
+
     { >float float }
+    { fixnum>float float }
+    { bignum>float float }
 } [
     '[
         _
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 760ff167aa..5a7b096039 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -8,7 +8,7 @@ math.functions math.private strings layouts
 compiler.tree.propagation.info compiler.tree.def-use
 compiler.tree.debugger compiler.tree.checker
 slots.private words hashtables classes assocs locals
-float-arrays system sorting ;
+float-arrays system sorting math.libm ;
 IN: compiler.tree.propagation.tests
 
 \ propagate must-infer
@@ -594,6 +594,10 @@ MIXIN: empty-mixin
 
 [ V{ array } ] [ [ [ <=> ] sort [ <=> ] sort ] final-classes ] unit-test
 
+[ V{ float } ] [ [ fsqrt ] final-classes ] unit-test
+
+[ V{ t } ] [ [ { fixnum } declare 10 mod >float -20 > ] final-literals ] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test
diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor
index d586ff398f..9937c6b9c4 100644
--- a/basis/compiler/tree/propagation/simple/simple.factor
+++ b/basis/compiler/tree/propagation/simple/simple.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors kernel sequences sequences.private assocs words
 namespaces classes.algebra combinators classes classes.tuple
-classes.tuple.private continuations arrays
+classes.tuple.private continuations arrays alien.c-types
 math math.private slots generic definitions
 stack-checker.state
 compiler.tree
@@ -137,11 +137,12 @@ M: #call propagate-after
     dup word>> "input-classes" word-prop dup
     [ propagate-input-classes ] [ 2drop ] if ;
 
-M: #alien-invoke propagate-before
-    out-d>> [ object-info swap set-value-info ] each ;
+: propagate-alien-invoke ( node -- )
+    [ out-d>> ] [ params>> return>> ] bi
+    [ drop ] [ c-type-class <class-info> swap first set-value-info ] if-void ;
 
-M: #alien-indirect propagate-before
-    out-d>> [ object-info swap set-value-info ] each ;
+M: #alien-invoke propagate-before propagate-alien-invoke ;
 
-M: #return annotate-node
-    dup in-d>> (annotate-node) ;
+M: #alien-indirect propagate-before propagate-alien-invoke ;
+
+M: #return annotate-node dup in-d>> (annotate-node) ;
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 3d6195d9eb..2fdad0132a 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -77,6 +77,13 @@ HOOK: %shr-imm cpu ( dst src1 src2 -- )
 HOOK: %sar-imm cpu ( dst src1 src2 -- )
 HOOK: %not     cpu ( dst src -- )
 
+HOOK: %fixnum-add cpu ( src1 src2 -- )
+HOOK: %fixnum-add-tail cpu ( src1 src2 -- )
+HOOK: %fixnum-sub cpu ( src1 src2 -- )
+HOOK: %fixnum-sub-tail cpu ( src1 src2 -- )
+HOOK: %fixnum-mul cpu ( src1 src2 -- )
+HOOK: %fixnum-mul-tail cpu ( src1 src2 -- )
+
 HOOK: %integer>bignum cpu ( dst src temp -- )
 HOOK: %bignum>integer cpu ( dst src temp -- )
 
diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor
index 047d27c5f4..d22ff4d615 100644
--- a/basis/cpu/ppc/bootstrap.factor
+++ b/basis/cpu/ppc/bootstrap.factor
@@ -327,6 +327,18 @@ big-endian on
 \ BLT \ fixnum< define-jit-compare
 
 ! Math
+[
+    3 ds-reg 0 LWZ
+    4 ds-reg -4 LWZ
+    3 3 4 OR
+    3 3 tag-mask get ANDI
+    \ f tag-number 4 LI
+    0 3 0 CMPI
+    2 BNE
+    1 tag-fixnum 4 LI
+    4 ds-reg 4 STWU
+] f f f \ both-fixnums? define-sub-primitive
+
 : jit-math ( insn -- )
     3 ds-reg 0 LWZ
     4 ds-reg -4 LWZU
@@ -406,9 +418,7 @@ big-endian on
 [
     3 ds-reg 0 LWZ
     3 3 1 SRAWI
-    4 4 LI
-    4 3 4 SUBF
-    rs-reg 3 4 LWZX
+    rs-reg 3 3 LWZX
     3 ds-reg 0 STW
 ] f f f \ get-local define-sub-primitive
 
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 6a42ffdf77..8632d236cc 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -17,6 +17,7 @@ IN: cpu.ppc
 ! f30, f31: float scratch
 
 enable-float-intrinsics
+enable-fixnum*-intrinsic
 
 << \ ##integer>float t frame-required? set-word-prop
 \ ##float>integer t frame-required? set-word-prop >>
@@ -37,6 +38,9 @@ M: ppc %load-immediate ( reg n -- ) swap LOAD ;
 M: ppc %load-indirect ( reg obj -- )
     [ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-immediate ] bi* ;
 
+: %load-dlsym ( symbol dll register -- )
+    0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
+
 : ds-reg 29 ; inline
 : rs-reg 30 ; inline
 
@@ -164,6 +168,91 @@ M: ppc %shr-imm swapd SRWI ;
 M: ppc %sar-imm SRAWI ;
 M: ppc %not     NOT ;
 
+: %alien-invoke-tail ( func dll -- )
+    scratch-reg %load-dlsym scratch-reg MTCTR BCTR ;
+
+:: exchange-regs ( r1 r2 -- )
+    scratch-reg r1 MR
+    r1 r2 MR
+    r2 scratch-reg MR ;
+
+: ?MR ( r1 r2 -- ) 2dup = [ 2drop ] [ MR ] if ;
+
+:: move>args ( src1 src2 -- )
+    {
+        { [ src1 4 = ] [ 3 src2 ?MR 3 4 exchange-regs ] }
+        { [ src1 3 = ] [ 4 src2 ?MR ] }
+        { [ src2 3 = ] [ 4 src1 ?MR 3 4 exchange-regs ] }
+        { [ src2 4 = ] [ 3 src1 ?MR ] }
+        [ 3 src1 MR 4 src2 MR ]
+    } cond ;
+
+:: overflow-template ( src1 src2 insn func -- )
+    "no-overflow" define-label
+    0 0 LI
+    0 MTXER
+    scratch-reg src2 src1 insn call
+    scratch-reg ds-reg 0 STW
+    "no-overflow" get BNO
+    src2 src1 move>args
+    %prepare-alien-invoke
+    func f %alien-invoke
+    "no-overflow" resolve-label ; inline
+
+:: overflow-template-tail ( src1 src2 insn func -- )
+    "overflow" define-label
+    0 0 LI
+    0 MTXER
+    scratch-reg src2 src1 insn call
+    "overflow" get BO
+    scratch-reg ds-reg 0 STW
+    BLR
+    "overflow" resolve-label
+    src2 src1 move>args
+    %prepare-alien-invoke
+    func f %alien-invoke-tail ;
+
+M: ppc %fixnum-add ( src1 src2 -- )
+    [ ADDO. ] "overflow_fixnum_add" overflow-template ;
+
+M: ppc %fixnum-add-tail ( src1 src2 -- )
+    [ ADDO. ] "overflow_fixnum_add" overflow-template-tail ;
+
+M: ppc %fixnum-sub ( src1 src2 -- )
+    [ SUBFO. ] "overflow_fixnum_subtract" overflow-template ;
+
+M: ppc %fixnum-sub-tail ( src1 src2 -- )
+    [ SUBFO. ] "overflow_fixnum_subtract" overflow-template-tail ;
+
+M:: ppc %fixnum-mul ( src1 src2 -- )
+    "no-overflow" define-label
+    0 0 LI
+    0 MTXER
+    scratch-reg src1 tag-bits get SRAWI
+    scratch-reg scratch-reg src2 MULLWO.
+    scratch-reg ds-reg 0 STW
+    "no-overflow" get BNO
+    src2 src2 tag-bits get SRAWI
+    scratch-reg src2 move>args
+    %prepare-alien-invoke
+    "overflow_fixnum_multiply" f %alien-invoke
+    "no-overflow" resolve-label ;
+
+M:: ppc %fixnum-mul-tail ( src1 src2 -- )
+    "overflow" define-label
+    0 0 LI
+    0 MTXER
+    scratch-reg src1 tag-bits get SRAWI
+    scratch-reg scratch-reg src2 MULLWO.
+    "overflow" get BO
+    scratch-reg ds-reg 0 STW
+    BLR
+    "overflow" resolve-label
+    src2 src2 tag-bits get SRAWI
+    scratch-reg src2 move>args
+    %prepare-alien-invoke
+    "overflow_fixnum_multiply" f %alien-invoke-tail ;
+
 : bignum@ ( n -- offset ) cells bignum tag-number - ; inline
 
 M:: ppc %integer>bignum ( dst src temp -- )
@@ -318,9 +407,6 @@ M: ppc %set-alien-cell swap 0 STW ;
 M: ppc %set-alien-float swap 0 STFS ;
 M: ppc %set-alien-double swap 0 STFD ;
 
-: %load-dlsym ( symbol dll register -- )
-    0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
-
 : load-zone-ptr ( reg -- )
     [ "nursery" f ] dip %load-dlsym ;
 
@@ -538,11 +624,11 @@ M: ppc %prepare-alien-invoke
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    "stack_chain" f 11 %load-dlsym
-    11 11 0 LWZ
-    1 11 0 STW
-    ds-reg 11 8 STW
-    rs-reg 11 12 STW ;
+    "stack_chain" f scratch-reg %load-dlsym
+    scratch-reg scratch-reg 0 LWZ
+    1 scratch-reg 0 STW
+    ds-reg scratch-reg 8 STW
+    rs-reg scratch-reg 12 STW ;
 
 M: ppc %alien-invoke ( symbol dll -- )
     11 %load-dlsym 11 MTLR BLRL ;
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
old mode 100644
new mode 100755
index 217047e4b6..9fd1330757
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -23,8 +23,8 @@ M: x86.32 machine-registers
 M: x86.32 ds-reg ESI ;
 M: x86.32 rs-reg EDI ;
 M: x86.32 stack-reg ESP ;
-M: x86.32 temp-reg-1 EAX ;
-M: x86.32 temp-reg-2 ECX ;
+M: x86.32 temp-reg-1 ECX ;
+M: x86.32 temp-reg-2 EDX ;
 
 M:: x86.32 %dispatch ( src temp offset -- )
     ! Load jump table base.
@@ -38,12 +38,18 @@ M:: x86.32 %dispatch ( src temp offset -- )
     [ align-code ]
     bi ;
 
+! Registers for fastcall
+M: x86.32 param-reg-1 EAX ;
+M: x86.32 param-reg-2 EDX ;
+
 M: x86.32 reserved-area-size 0 ;
 
 M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
 
 M: x86.32 %alien-invoke (CALL) rel-dlsym ;
 
+M: x86.32 %alien-invoke-tail (JMP) rel-dlsym ;
+
 M: x86.32 struct-small-enough? ( size -- ? )
     heap-size { 1 2 4 8 } member?
     os { linux netbsd solaris } member? not and ;
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 9ddad23004..b6c76a78fd 100644
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -21,8 +21,8 @@ M: x86.64 machine-registers
 M: x86.64 ds-reg R14 ;
 M: x86.64 rs-reg R15 ;
 M: x86.64 stack-reg RSP ;
-M: x86.64 temp-reg-1 RAX ;
-M: x86.64 temp-reg-2 RCX ;
+M: x86.64 temp-reg-1 R8 ;
+M: x86.64 temp-reg-2 R9 ;
 
 M:: x86.64 %dispatch ( src temp offset -- )
     ! Load jump table base.
@@ -37,8 +37,8 @@ M:: x86.64 %dispatch ( src temp offset -- )
     [ align-code ]
     bi ;
 
-: param-reg-1 int-regs param-regs first ; inline
-: param-reg-2 int-regs param-regs second ; inline
+M: x86.64 param-reg-1 int-regs param-regs first ;
+M: x86.64 param-reg-2 int-regs param-regs second ;
 : param-reg-3 int-regs param-regs third ; inline
 
 M: int-regs return-reg drop RAX ;
@@ -168,6 +168,11 @@ M: x86.64 %alien-invoke
     rc-absolute-cell rel-dlsym
     R11 CALL ;
 
+M: x86.64 %alien-invoke-tail
+    R11 0 MOV
+    rc-absolute-cell rel-dlsym
+    R11 JMP ;
+
 M: x86.64 %prepare-alien-indirect ( -- )
     "unbox_alien" f %alien-invoke
     RBP RAX MOV ;
diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index d5fc64de00..42df1c8437 100644
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -379,12 +379,21 @@ big-endian off
     ds-reg bootstrap-cell neg [+] div-arg MOV
 ] f f f \ fixnum/mod-fast define-sub-primitive
 
+[
+    arg0 ds-reg [] MOV
+    arg0 ds-reg bootstrap-cell neg [+] OR
+    ds-reg bootstrap-cell ADD
+    arg0 tag-mask get AND
+    arg0 \ f tag-number MOV
+    arg1 1 tag-fixnum MOV
+    arg0 arg1 CMOVE
+    ds-reg [] arg0 MOV
+] f f f \ both-fixnums? define-sub-primitive
+
 [
     arg0 ds-reg [] MOV                         ! load local number
     fixnum>slot@                               ! turn local number into offset
-    arg1 bootstrap-cell MOV                    ! load base
-    arg1 arg0 SUB                              ! turn it into a stack offset
-    arg0 rs-reg arg1 [+] MOV                   ! load local value
+    arg0 rs-reg arg0 [+] MOV                   ! load local value
     ds-reg [] arg0 MOV                         ! push to stack
 ] f f f \ get-local define-sub-primitive
 
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index f0f156a57d..104a1f155b 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -14,6 +14,9 @@ M: x86 two-operand? t ;
 HOOK: temp-reg-1 cpu ( -- reg )
 HOOK: temp-reg-2 cpu ( -- reg )
 
+HOOK: param-reg-1 cpu ( -- reg )
+HOOK: param-reg-2 cpu ( -- reg )
+
 M: x86 %load-immediate MOV ;
 
 M: x86 %load-indirect swap 0 MOV rc-absolute-cell rel-immediate ;
@@ -90,6 +93,58 @@ M: x86 %shr-imm nip SHR ;
 M: x86 %sar-imm nip SAR ;
 M: x86 %not     drop NOT ;
 
+: ?MOV ( dst src -- )
+    2dup = [ 2drop ] [ MOV ] if ; inline
+
+:: move>args ( src1 src2 -- )
+    {
+        { [ src1 param-reg-2 = ] [ param-reg-1 src2 ?MOV param-reg-1 param-reg-2 XCHG ] }
+        { [ src1 param-reg-1 = ] [ param-reg-2 src2 ?MOV ] }
+        { [ src2 param-reg-1 = ] [ param-reg-2 src1 ?MOV param-reg-1 param-reg-2 XCHG ] }
+        { [ src2 param-reg-2 = ] [ param-reg-1 src1 ?MOV ] }
+        [
+            param-reg-1 src1 MOV
+            param-reg-2 src2 MOV
+        ]
+    } cond ;
+
+HOOK: %alien-invoke-tail cpu ( func dll -- )
+
+:: overflow-template ( src1 src2 insn inverse func -- )
+    <label> "no-overflow" set
+    src1 src2 insn call
+    ds-reg [] src1 MOV
+    "no-overflow" get JNO
+    src1 src2 inverse call
+    src1 src2 move>args
+    %prepare-alien-invoke
+    func f %alien-invoke
+    "no-overflow" resolve-label ; inline
+
+:: overflow-template-tail ( src1 src2 insn inverse func -- )
+    <label> "no-overflow" set
+    src1 src2 insn call
+    "no-overflow" get JNO
+    src1 src2 inverse call
+    src1 src2 move>args
+    %prepare-alien-invoke
+    func f %alien-invoke-tail
+    "no-overflow" resolve-label
+    ds-reg [] src1 MOV
+    0 RET ; inline
+
+M: x86 %fixnum-add ( src1 src2 -- )
+    [ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template ;
+
+M: x86 %fixnum-add-tail ( src1 src2 -- )
+    [ ADD ] [ SUB ] "overflow_fixnum_add" overflow-template-tail ;
+
+M: x86 %fixnum-sub ( src1 src2 -- )
+    [ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template ;
+
+M: x86 %fixnum-sub-tail ( src1 src2 -- )
+    [ SUB ] [ ADD ] "overflow_fixnum_subtract" overflow-template-tail ;
+
 : bignum@ ( reg n -- op )
     cells bignum tag-number - [+] ; inline
 
@@ -158,9 +213,6 @@ M: x86 %div-float nip DIVSD ;
 M: x86 %integer>float CVTSI2SD ;
 M: x86 %float>integer CVTTSD2SI ;
 
-: ?MOV ( dst src -- )
-    2dup = [ 2drop ] [ MOV ] if ; inline
-
 M: x86 %copy ( dst src -- ) ?MOV ;
 
 M: x86 %copy-float ( dst src -- )
diff --git a/basis/editors/emacs/emacs-docs.factor b/basis/editors/emacs/emacs-docs.factor
index 2ef1ced5ec..f55068e143 100644
--- a/basis/editors/emacs/emacs-docs.factor
+++ b/basis/editors/emacs/emacs-docs.factor
@@ -1,13 +1,11 @@
 USING: help help.syntax help.markup ;
+IN: editors.emacs
 
-ARTICLE: { "emacs" "emacs" } "Integration with Emacs"
-
-"Put this in your .emacs file:"
-
+ARTICLE: "editors.emacs" "Integration with Emacs"
+"Put this in your " { $snippet ".emacs" } " file:"
 { $code "(server-start)" }
-
-"If you would like a new window to open when you ask Factor to edit an object, put this in your .emacs file:"
-
+"If you would like a new window to open when you ask Factor to edit an object, put this in your " { $snippet ".emacs" } " file:"
 { $code "(setq server-window 'switch-to-buffer-other-frame)" }
-
 { $see-also "editor" } ;
+
+ABOUT: "editors.emacs"
\ No newline at end of file
diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor
index b5d1b8d8d2..a982ecdd7d 100644
--- a/basis/fry/fry-docs.factor
+++ b/basis/fry/fry-docs.factor
@@ -75,12 +75,6 @@ ARTICLE: "fry.philosophy" "Fried quotation philosophy"
     "[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]"
 } ;
 
-ARTICLE: "fry.limitations" "Fried quotation limitations"
-"As with " { $vocab-link "locals" } ", fried quotations cannot contain " { $link >r } " and " { $link r> } ". This is not a real limitation in practice, since " { $link dip } " can be used instead."
-$nl
-"An error thrown if a fried quotation contains calls to " { $link >r } " and " { $link r> } ":"
-{ $subsection >r/r>-in-fry-error } ;
-
 ARTICLE: "fry" "Fried quotations"
 "The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with ``holes'' (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack."
 $nl
@@ -92,7 +86,6 @@ $nl
 "The holes are filled in with the top of stack going in the rightmost hole, the second item on the stack going in the second hole from the right, and so on."
 { $subsection "fry.examples" }
 { $subsection "fry.philosophy" }
-{ $subsection "fry.limitations" }
 "Fry is implemented as a parsing word which reads a quotation and scans for occurrences of " { $link _ } " and " { $link @ } "; these words are not actually executed, and doing so raises an error (this can happen if they're accidentally used outside of a fry)."
 $nl
 "Fried quotations can also be constructed without using a parsing word; this is useful when meta-programming:"
diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor
index ac036f58ad..f84ad233cd 100644
--- a/basis/fry/fry.factor
+++ b/basis/fry/fry.factor
@@ -28,11 +28,6 @@ M: >r/r>-in-fry-error summary
     dup { >r r> load-locals get-local drop-locals } intersect
     empty? [ >r/r>-in-fry-error ] unless ;
 
-: shallow-fry ( quot -- quot' )
-    check-fry
-    [ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
-    { _ } split [ length 1- [ncurry] ] [ spread>quot ] bi prefix ;
-
 PREDICATE: fry-specifier < word { _ @ } memq? ;
 
 GENERIC: count-inputs ( quot -- n )
@@ -41,15 +36,21 @@ M: callable count-inputs [ count-inputs ] sigma ;
 M: fry-specifier count-inputs drop 1 ;
 M: object count-inputs drop 0 ;
 
+GENERIC: deep-fry ( obj -- )
+
+: shallow-fry ( quot -- quot' curry# )
+    check-fry
+    [ [ deep-fry ] each ] [ ] make
+    [ dup \ @ = [ drop [ _ call ] ] [ 1array ] if ] map concat
+    { _ } split [ spread>quot ] [ length 1- ] bi ;
+
 PRIVATE>
 
-: fry ( quot -- quot' )
-    [
-        [
-            dup callable? [
-                [ count-inputs \ _ <repetition> % ] [ fry % ] bi
-            ] [ , ] if
-        ] each
-    ] [ ] make shallow-fry ;
+: fry ( quot -- quot' ) shallow-fry [ncurry] swap prefix ;
+
+M: callable deep-fry
+    [ count-inputs \ _ <repetition> % ] [ fry % ] bi ;
+
+M: object deep-fry , ;
 
 : '[ \ ] parse-until fry over push-all ; parsing
diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor
index ba53e6c591..2380f5614d 100644
--- a/basis/generalizations/generalizations-docs.factor
+++ b/basis/generalizations/generalizations-docs.factor
@@ -17,6 +17,15 @@ HELP: narray
 { $description "A generalization of " { $link 1array } ", "
 { $link 2array } ", " { $link 3array } " and " { $link 4array } " "
 "that constructs an array from the top " { $snippet "n" } " elements of the stack."
+}
+{ $examples
+    "Some core words expressed in terms of " { $link narray } ":"
+    { $table
+        { { $link 1array } { $snippet "1 narray" } }
+        { { $link 2array } { $snippet "2 narray" } }
+        { { $link 3array } { $snippet "3 narray" } }
+        { { $link 4array } { $snippet "4 narray" } }
+    }
 } ;
 
 { nsequence narray } related-words
@@ -26,6 +35,15 @@ HELP: firstn
 { $description "A generalization of " { $link first } ", "
 { $link first2 } ", " { $link first3 } " and " { $link first4 } " "
 "that pushes the first " { $snippet "n" } " elements of a sequence on the stack."
+}
+{ $examples
+    "Some core words expressed in terms of " { $link firstn } ":"
+    { $table
+        { { $link first } { $snippet "1 firstn" } }
+        { { $link first2 } { $snippet "2 firstn" } }
+        { { $link first3 } { $snippet "3 firstn" } }
+        { { $link first4 } { $snippet "4 firstn" } }
+    }
 } ;
 
 HELP: npick
@@ -37,8 +55,13 @@ HELP: npick
 }
 { $examples
   { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" }
-}
-{ $see-also dup over pick } ;
+  "Some core words expressed in terms of " { $link npick } ":"
+    { $table
+        { { $link dup } { $snippet "1 npick" } }
+        { { $link over } { $snippet "2 npick" } }
+        { { $link pick } { $snippet "3 npick" } }
+    }
+} ;
 
 HELP: ndup
 { $values { "n" integer } }
@@ -49,8 +72,13 @@ HELP: ndup
 }
 { $examples
   { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" }
-}
-{ $see-also dup 2dup 3dup } ;
+  "Some core words expressed in terms of " { $link ndup } ":"
+    { $table
+        { { $link dup } { $snippet "1 ndup" } }
+        { { $link 2dup } { $snippet "2 ndup" } }
+        { { $link 3dup } { $snippet "3 ndup" } }
+    }
+} ;
 
 HELP: nnip
 { $values { "n" integer } }
@@ -60,8 +88,12 @@ HELP: nnip
 }
 { $examples
   { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 nnip .s" "4" }
-}
-{ $see-also nip 2nip } ;
+  "Some core words expressed in terms of " { $link nnip } ":"
+    { $table
+        { { $link nip } { $snippet "1 nnip" } }
+        { { $link 2nip } { $snippet "2 nnip" } }
+    }
+} ;
 
 HELP: ndrop
 { $values { "n" integer } }
@@ -71,8 +103,13 @@ HELP: ndrop
 }
 { $examples
   { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 ndrop .s" "1" }
-}
-{ $see-also drop 2drop 3drop } ;
+  "Some core words expressed in terms of " { $link ndrop } ":"
+    { $table
+        { { $link drop } { $snippet "1 ndrop" } }
+        { { $link 2drop } { $snippet "2 ndrop" } }
+        { { $link 3drop } { $snippet "3 ndrop" } }
+    }
+} ;
 
 HELP: nrot
 { $values { "n" integer } }
@@ -81,8 +118,12 @@ HELP: nrot
 }
 { $examples
   { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" }
-}
-{ $see-also rot -nrot } ;
+  "Some core words expressed in terms of " { $link nrot } ":"
+    { $table
+        { { $link swap } { $snippet "1 nrot" } }
+        { { $link rot } { $snippet "2 nrot" } }
+    }
+} ;
 
 HELP: -nrot
 { $values { "n" integer } }
@@ -91,8 +132,12 @@ HELP: -nrot
 }
 { $examples
   { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" }
-}
-{ $see-also rot nrot } ;
+  "Some core words expressed in terms of " { $link -nrot } ":"
+    { $table
+        { { $link swap } { $snippet "1 -nrot" } }
+        { { $link -rot } { $snippet "2 -nrot" } }
+    }
+} ;
 
 HELP: nrev
 { $values { "n" integer } }
@@ -100,11 +145,11 @@ HELP: nrev
 }
 { $examples
   { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrev .s" "4\n3\n2\n1" }
-}
-{ $see-also rot nrot } ;
+  "The " { $link spin } " word is equivalent to " { $snippet "3 nrev" } "."
+} ;
 
 HELP: ndip
-{ $values { "quot" quotation } { "n" number } }
+{ $values { "quot" quotation } { "n" integer } }
 { $description "A generalization of " { $link dip } " that can work " 
 "for any stack depth. The quotation will be called with a stack that "
 "has 'n' items removed first. The 'n' items are then put back on the "
@@ -113,30 +158,93 @@ HELP: ndip
 { $examples
   { $example "USING: generalizations kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" }
   { $example "USING: generalizations kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" }
-}
-{ $see-also dip 2dip } ;
+  "Some core words expressed in terms of " { $link ndip } ":"
+    { $table
+        { { $link dip } { $snippet "1 ndip" } }
+        { { $link 2dip } { $snippet "2 ndip" } }
+        { { $link 3dip } { $snippet "3 ndip" } }
+    }
+} ;
 
 HELP: nslip
-{ $values { "n" number } }
+{ $values { "n" integer } }
 { $description "A generalization of " { $link slip } " that can work " 
 "for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
 "removed from the stack, the quotation called, and the items restored."
 } 
 { $examples
   { $example "USING: generalizations prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" }
-}
-{ $see-also slip nkeep } ;
+  "Some core words expressed in terms of " { $link nslip } ":"
+    { $table
+        { { $link slip } { $snippet "1 nslip" } }
+        { { $link 2slip } { $snippet "2 nslip" } }
+        { { $link 3slip } { $snippet "3 nslip" } }
+    }
+} ;
 
 HELP: nkeep
-{ $values { "quot" quotation } { "n" number } }
+{ $values { "quot" quotation } { "n" integer } }
 { $description "A generalization of " { $link keep } " that can work " 
 "for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
 "saved, the quotation called, and the items restored."
 } 
 { $examples
   { $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" }
-}
-{ $see-also keep nslip } ;
+  "Some core words expressed in terms of " { $link nkeep } ":"
+    { $table
+        { { $link keep } { $snippet "1 nkeep" } }
+        { { $link 2keep } { $snippet "2 nkeep" } }
+        { { $link 3keep } { $snippet "3 nkeep" } }
+    }
+} ;
+
+HELP: ncurry
+{ $values { "quot" quotation } { "n" integer } }
+{ $description "A generalization of " { $link curry } " that can work for any stack depth."
+} 
+{ $examples
+  "Some core words expressed in terms of " { $link ncurry } ":"
+    { $table
+        { { $link curry } { $snippet "1 ncurry" } }
+        { { $link 2curry } { $snippet "2 ncurry" } }
+        { { $link 3curry } { $snippet "3 ncurry" } }
+    }
+} ;
+
+HELP: nwith
+{ $values { "quot" quotation } { "n" integer } }
+{ $description "A generalization of " { $link with } " that can work for any stack depth."
+} 
+{ $examples
+  "Some core words expressed in terms of " { $link nwith } ":"
+    { $table
+        { { $link with } { $snippet "1 nwith" } }
+    }
+} ;
+
+HELP: napply
+{ $values { "quot" quotation } { "n" integer } }
+{ $description "A generalization of " { $link bi@ } " and " { $link tri@ } " that can work for any stack depth."
+} 
+{ $examples
+  "Some core words expressed in terms of " { $link napply } ":"
+    { $table
+        { { $link bi@ } { $snippet "1 napply" } }
+        { { $link tri@ } { $snippet "2 napply" } }
+    }
+} ;
+
+HELP: mnswap
+{ $values { "m" integer } { "n" integer } }
+{ $description "Swaps the top " { $snippet "m" } " stack elements with the " { $snippet "n" } " elements directly underneath." }
+{ $examples
+  "Some core words expressed in terms of " { $link mnswap } ":"
+    { $table
+        { { $link swap } { $snippet "1 1 mnswap" } }
+        { { $link rot } { $snippet "2 1 mnswap" } }
+        { { $link -rot } { $snippet "1 2 mnswap" } }
+    }
+} ;
 
 ARTICLE: "generalizations" "Generalized shuffle words and combinators"
 "The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
@@ -155,12 +263,14 @@ $nl
 { $subsection nnip }
 { $subsection ndrop }
 { $subsection nrev }
+{ $subsection mnswap }
 "Generalized combinators:"
 { $subsection ndip }
 { $subsection nslip }
 { $subsection nkeep }
+{ $subsection napply }
+"Generalized quotation construction:"
 { $subsection ncurry } 
-{ $subsection nwith } 
-{ $subsection napply } ;
+{ $subsection nwith } ;
 
 ABOUT: "generalizations"
diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor
index 1ebe528f35..1291012700 100644
--- a/basis/generalizations/generalizations-tests.factor
+++ b/basis/generalizations/generalizations-tests.factor
@@ -38,3 +38,7 @@ IN: generalizations.tests
 [ "a" ] [ { "a" } 1 firstn ] unit-test
 
 [ [ 1 2 ] ] [ 1 2 2 [ ] nsequence ] unit-test
+
+[ 4 5 1 2 3 ] [ 1 2 3 4 5 2 3 mnswap ] unit-test
+
+[ 1 2 3 4 5 6 ] [ 1 2 3 4 5 6 2 4 mnswap 4 2 mnswap ] unit-test
diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor
index 490fa77204..3c24d20c8a 100644
--- a/basis/generalizations/generalizations.factor
+++ b/basis/generalizations/generalizations.factor
@@ -13,14 +13,14 @@ IN: generalizations
 
 >>
 
-MACRO: nsequence ( n seq -- quot )
+MACRO: nsequence ( n seq -- )
     [
         [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi
         [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce
     ] keep
     '[ @ _ like ] ;
 
-MACRO: narray ( n -- quot )
+MACRO: narray ( n -- )
     '[ _ { } nsequence ] ;
 
 MACRO: firstn ( n -- )
@@ -30,7 +30,7 @@ MACRO: firstn ( n -- )
         bi prefix '[ _ cleave ]
     ] if ;
 
-MACRO: npick ( n -- quot )
+MACRO: npick ( n -- )
     1- [ dup ] [ '[ _ dip swap ] ] repeat ;
 
 MACRO: ndup ( n -- )
@@ -51,7 +51,7 @@ MACRO: nnip ( n -- )
 MACRO: ntuck ( n -- )
     2 + '[ dup _ -nrot ] ;
 
-MACRO: nrev ( n -- quot )
+MACRO: nrev ( n -- )
     1 [a,b] [ ] [ '[ @ _ -nrot ] ] reduce ;
 
 MACRO: ndip ( quot n -- )
@@ -73,3 +73,6 @@ MACRO: napply ( n -- )
     2 [a,b]
     [ [ 1- ] [ ] bi '[ _ ntuck _ nslip ] ]
     map concat >quotation [ call ] append ;
+
+MACRO: mnswap ( m n -- )
+    1+ '[ _ -nrot ] <repetition> spread>quot ;
diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor
index 6e27bd9256..711712a4bc 100644
--- a/basis/help/cookbook/cookbook.factor
+++ b/basis/help/cookbook/cookbook.factor
@@ -325,6 +325,15 @@ ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid"
     { "If " { $link run-file } " throws a stack depth assertion, it means that the top-level form in the file left behind values on the stack. The stack depth is compared before and after loading a source file, since this type of situation is almost always an error. If you have a legitimate need to load a source file which returns data in some manner, define a word in the source file which produces this data on the stack and call the word after loading the file." }
 } ;
 
+ARTICLE: "cookbook-images" "Image file cookbook"
+"Factor has the ability to save the entire state of the system into an " { $emphasis "image file" } "."
+$nl
+"You can save a custom image if you find yourself loading the same libraries in every Factor session; some libraries take a little while to compile, so saving an image with those libraries loaded can save you a lot of time."
+$nl
+"For example, to save an image with the web framework loaded,"
+{ $code "USE: furnace" "save" }
+"See " { $link "images" } " for details." ;
+
 ARTICLE: "cookbook-next" "Next steps"
 "Once you have read through " { $link "first-program" } " and " { $link "cookbook" } ", the best way to keep learning Factor is to start looking at some simple example programs. Here are a few particularly nice vocabularies which should keep you busy for a little while:"
 { $list
@@ -349,6 +358,7 @@ ARTICLE: "cookbook" "Factor cookbook"
 { $subsection "cookbook-application" }
 { $subsection "cookbook-scripts" }
 { $subsection "cookbook-compiler" }
+{ $subsection "cookbook-images" }
 { $subsection "cookbook-philosophy" }
 { $subsection "cookbook-pitfalls" }
 { $subsection "cookbook-next" } ;
diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor
index 899cad2404..318169c0a0 100644
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@@ -285,15 +285,16 @@ M: f ($instance)
 
 : $see ( element -- ) first [ see ] ($see) ;
 
-: $see-methods ( element -- ) first [ see-methods ] ($see) ;
-
 : $synopsis ( element -- ) first [ synopsis write ] ($see) ;
 
 : $definition ( element -- )
     "Definition" $heading $see ;
 
 : $methods ( element -- )
-    "Methods" $heading $see-methods ;
+    first methods [
+        "Methods" $heading
+        [ see-all ] ($see)
+    ] unless-empty ;
 
 : $value ( object -- )
     "Variable value" $heading
diff --git a/basis/locals/backend/backend-tests.factor b/basis/locals/backend/backend-tests.factor
index 9352714509..ee714f7ef7 100644
--- a/basis/locals/backend/backend-tests.factor
+++ b/basis/locals/backend/backend-tests.factor
@@ -1,39 +1,14 @@
 IN: locals.backend.tests
 USING: tools.test locals.backend kernel arrays ;
 
-[ 3 ] [ 3 >r 1 get-local r> drop ] unit-test
-
-[ 4 ] [ 3 4 >r >r 2 get-local 2 drop-locals ] unit-test
-
-: get-local-test-1 ( -- x ) 3 >r 1 get-local r> drop ;
+: get-local-test-1 ( -- x ) 3 1 load-locals 0 get-local 1 drop-locals ;
 
 \ get-local-test-1 must-infer
 
 [ 3 ] [ get-local-test-1 ] unit-test
 
-: get-local-test-2 ( -- x ) 3 4 >r >r 2 get-local 2 drop-locals ;
+: get-local-test-2 ( -- x ) 3 4 2 load-locals -1 get-local 2 drop-locals ;
 
 \ get-local-test-2 must-infer
 
-[ 4 ] [ get-local-test-2 ] unit-test
-
-: get-local-test-3 ( -- a b ) 3 4 >r >r 2 get-local r> r> 2array ;
-
-\ get-local-test-3 must-infer
-
-[ 4 { 3 4 } ] [ get-local-test-3 ] unit-test
-
-: get-local-test-4 ( -- a b )
-    3 4 >r >r r> r> dup swap >r swap >r r> r> 2array ;
-
-\ get-local-test-4 must-infer
-
-[ 4 { 3 4 } ] [ get-local-test-4 ] unit-test
-
-[ 1 2 ] [ 1 2 2 load-locals r> r> ] unit-test
-
-: load-locals-test-1 ( -- a b ) 1 2 2 load-locals r> r> ;
-
-\ load-locals-test-1 must-infer
-
-[ 1 2 ] [ load-locals-test-1 ] unit-test
+[ 3 ] [ get-local-test-2 ] unit-test
diff --git a/basis/locals/backend/backend.factor b/basis/locals/backend/backend.factor
index 0d9ee6a64e..ece5c1d200 100644
--- a/basis/locals/backend/backend.factor
+++ b/basis/locals/backend/backend.factor
@@ -1,11 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math.private kernel slots.private sequences effects words ;
+USING: slots.private ;
 IN: locals.backend
 
-: load-locals ( n -- )
-    dup 0 eq? [ drop ] [ swap >r 1 fixnum-fast load-locals ] if ;
-
 : local-value 2 slot ; inline
 
 : set-local-value 2 set-slot ; inline
diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor
index 18488ed1dd..89314aadc5 100644
--- a/basis/locals/locals-docs.factor
+++ b/basis/locals/locals-docs.factor
@@ -1,5 +1,5 @@
 USING: help.syntax help.markup kernel macros prettyprint
-memoize combinators arrays ;
+memoize combinators arrays generalizations ;
 IN: locals
 
 HELP: [|
@@ -131,10 +131,40 @@ $nl
 $nl
 "Unlike some languages such as Python and Java, writing to mutable locals in outer scopes is fully supported and has the expected semantics." ;
 
+ARTICLE: "locals-fry" "Locals and fry"
+"Locals integrate with " { $link "fry" } " so that mixing locals with fried quotations gives intuitive results."
+$nl
+"Recall that the following two code snippets are equivalent:"
+{ $code "'[ sq _ + ]" }
+{ $code "[ [ sq ] dip + ] curry" }
+"The semantics of " { $link dip } " and " { $link curry } " are such that the first example behaves as if the top of the stack as ``inserted'' in the ``hole'' in the quotation's second element."
+$nl
+"Conceptually, " { $link curry } " is defined so that the following two code snippets are equivalent:"
+{ $code "3 [ - ] curry" }
+{ $code "[ 3 - ]" }
+"With lambdas, " { $link curry } " behaves differently. Rather than prepending an element, it fills in named parameters from right to left. The following two snippets are equivalent:"
+{ $code "3 [| a b | a b - ] curry" }
+{ $code "[| a | a 3 - ]" }
+"Because of this, the behavior of fry changes when applied to a lambda, to ensure that conceptually, fry behaves as with quotations. So the following snippets are no longer equivalent:"
+{ $code "'[ [| a | _ a - ] ]" }
+{ $code "'[ [| a | a - ] curry ] call" }
+"Instead, the first line above expands into something like the following:"
+{ $code "[ [ swap [| a | a - ] ] curry call ]" }
+"This ensures that the fried value appears ``underneath'' the local variable " { $snippet "a" } " when the quotation calls."
+$nl
+"The precise behavior is the following. When frying a lambda, a stack shuffle (" { $link mnswap } ") is prepended to the lambda so that the " { $snippet "m" } " curried values, which start off at the top of the stack, are transposed with the " { $snippet "n" } " inputs to the lambda." ;
+
 ARTICLE: "locals-limitations" "Limitations of locals"
-"The first limitation is also shared by " { $vocab-link "fry" } ": the " { $link >r } " and " { $link r> } " words may not be used together with locals. Instead, use the " { $link dip } " combinator. An error is thrown at parse time if an attempt is made to use " { $link >r } " and " { $link r> } " inside a lambda body:"
-{ $subsection >r/r>-in-lambda-error }
-"Another limitation concerns combinators implemented as macros. Locals can only be used with such combinators if the input array immediately precedes the combinator call. For example, the following will work:"
+"There are two main limitations of the current locals implementation, and both concern macros."
+{ $heading "Macro expansions with free variables" }
+"The expansion of a macro cannot reference local variables bound in the outer scope. For example, the following macro is invalid:"
+{ $code "MACRO:: twice ( quot -- ) [ quot call quot call ] ;" }
+"The following is fine, though:"
+{ $code "MACRO:: twice ( quot -- ) quot quot '[ @ @ ] ;" }
+{ $heading "Static stack effect inference and macros" }
+"Recall that a macro will only expand at compile-time, and the word containing it will only get a static stack effect, if all inputs to the macro are literal. When locals are used, there is an additional restriction; the literals must immediately precede the macro call, lexically."
+$nl
+"For example, all of the following three examples are equivalent semantically, but only the first will have a static stack effect and compile with the optimizing compiler:"
 { $code
     ":: good-cond-usage ( a -- ... )"
     "    {"
@@ -143,7 +173,7 @@ ARTICLE: "locals-limitations" "Limitations of locals"
     "        { [ a 0 = ] [ ... ] }"
     "    } cond ;"
 }
-"But not the following:"
+"The following two will not, and will run slower as a result:"
 { $code
     ": my-cond ( alist -- ) cond ; inline"
     ""
@@ -154,6 +184,14 @@ ARTICLE: "locals-limitations" "Limitations of locals"
     "        { [ a 0 = ] [ ... ] }"
     "    } my-cond ;"
 }
+{ $code
+    ":: bad-cond-usage ( a -- ... )"
+    "    {"
+    "        { [ a 0 < ] [ ... ] }"
+    "        { [ a 0 > ] [ ... ] }"
+    "        { [ a 0 = ] [ ... ] }"
+    "    } swap swap cond ;"
+}
 "The reason is that locals are rewritten into stack code at parse time, whereas macro expansion is performed later during compile time. To circumvent this problem, the " { $vocab-link "macros.expander" } " vocabulary is used to rewrite simple macro usages prior to local transformation, however "{ $vocab-link "macros.expander" } " does not deal with more complicated cases where the literal inputs to the macro do not immediately precede the macro call in the source." ;
 
 ARTICLE: "locals" "Local variables and lexical closures"
@@ -174,6 +212,7 @@ $nl
 "Additional topics:"
 { $subsection "locals-literals" }
 { $subsection "locals-mutable" }
+{ $subsection "locals-fry" }
 { $subsection "locals-limitations" }
 "Locals complement dynamically scoped variables implemented in the " { $vocab-link "namespaces" } " vocabulary." ;
 
diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index 8796721b1b..f13c1d57fa 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -398,7 +398,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ ] [ [ { integer lambda-method-forget-test } forget ] with-compilation-unit ] unit-test
 
-[ { [ 10 ] } ] [ 10 [| A | { [ A ] } ] call ] unit-test
+[ 10 ] [ 10 [| A | { [ A ] } ] call first call ] unit-test
 
 [
     "USING: locals fry math ; [ 0 '[ [let | A [ 10 ] | A _ + ] ] ]" eval
@@ -431,14 +431,53 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ 3 ] [ 3 [| a | \ a ] call ] unit-test
 
-! :: wlet-&&-test ( a -- ? )
-!     [wlet | is-integer? [ a integer? ]
-!             is-even? [ a even? ]
-!             >10? [ a 10 > ] |
-!         { [ is-integer? ] [ is-even? ] [ >10? ] } &&
-!     ] ;
+[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval ] must-fail
 
-! [ f ] [ 1.5 wlet-&&-test ] unit-test
-! [ f ] [ 3 wlet-&&-test ] unit-test
-! [ f ] [ 8 wlet-&&-test ] unit-test
-! [ t ] [ 12 wlet-&&-test ] unit-test
\ No newline at end of file
+[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" eval ] must-fail
+
+[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" eval ] must-fail
+
+[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" eval ] must-fail
+
+[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail
+
+:: wlet-&&-test ( a -- ? )
+    [wlet | is-integer? [ a integer? ]
+            is-even? [ a even? ]
+            >10? [ a 10 > ] |
+        { [ is-integer? ] [ is-even? ] [ >10? ] } &&
+    ] ;
+
+\ wlet-&&-test must-infer
+[ f ] [ 1.5 wlet-&&-test ] unit-test
+[ f ] [ 3 wlet-&&-test ] unit-test
+[ f ] [ 8 wlet-&&-test ] unit-test
+[ t ] [ 12 wlet-&&-test ] unit-test
+
+: fry-locals-test-1 ( -- n )
+    [let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
+
+\ fry-locals-test-1 must-infer
+[ 10 ] [ fry-locals-test-1 ] unit-test
+
+:: fry-locals-test-2 ( -- n )
+    [let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
+
+\ fry-locals-test-2 must-infer
+[ 10 ] [ fry-locals-test-2 ] unit-test
+
+[ 1 ] [ 3 4 [| | '[ [ _ swap - ] call ] call ] call ] unit-test
+[ -1 ] [ 3 4 [| | [| a | a - ] call ] call ] unit-test
+[ -1 ] [ 3 4 [| | [| a | a - ] curry call ] call ] unit-test
+[ -1 ] [ 3 4 [| a | a - ] curry call ] unit-test
+[ 1 ] [ 3 4 [| | '[ [| a | _ a - ] call ] call ] call ] unit-test
+[ -1 ] [ 3 4 [| | '[ [| a | a _ - ] call ] call ] call ] unit-test
+
+[ { 1 2 3 4 } ] [
+    1 3 2 4
+    [| | '[ [| a b | a _ b _ 4array ] call ] call ] call
+] unit-test
+
+[ 10 ] [
+    [| | 0 '[ [let | A [ 10 ] | A _ + ] ] call ] call
+] unit-test
\ No newline at end of file
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index df713a50e7..d2b057953c 100644
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -6,18 +6,36 @@ quotations debugger macros arrays macros splitting combinators
 prettyprint.backend definitions prettyprint hashtables
 prettyprint.sections sets sequences.private effects
 effects.parser generic generic.parser compiler.units accessors
-locals.backend memoize macros.expander lexer classes summary ;
+locals.backend memoize macros.expander lexer classes summary fry
+fry.private ;
 IN: locals
 
-! Inspired by
-! http://cat-language.googlecode.com/svn/trunk/CatPointFreeForm.cs
-
 ERROR: >r/r>-in-lambda-error ;
 
 M: >r/r>-in-lambda-error summary
     drop
     "Explicit retain stack manipulation is not permitted in lambda bodies" ;
 
+ERROR: binding-form-in-literal-error ;
+
+M: binding-form-in-literal-error summary
+    drop "[let, [let* and [wlet not permitted inside literals" ;
+
+ERROR: local-writer-in-literal-error ;
+
+M: local-writer-in-literal-error summary
+    drop "Local writer words not permitted inside literals" ;
+
+ERROR: local-word-in-literal-error ;
+
+M: local-word-in-literal-error summary
+    drop "Local words not permitted inside literals" ;
+
+ERROR: bad-lambda-rewrite output ;
+
+M: bad-lambda-rewrite summary
+    drop "You have found a bug in locals. Please report." ;
+
 <PRIVATE
 
 TUPLE: lambda vars body ;
@@ -85,60 +103,53 @@ C: <quote> quote
     [ dup quote? [ local>> ] when eq? ] with find drop ;
 
 : read-local-quot ( obj args -- quot )
-    local-index 1+ [ get-local ] curry ;
+    local-index neg [ get-local ] curry ;
 
-: localize-writer ( obj args -- quot )
-    >r "local-reader" word-prop r>
+GENERIC# localize 1 ( obj args -- quot )
+
+M: local localize read-local-quot ;
+
+M: quote localize [ local>> ] dip read-local-quot ;
+
+M: local-word localize read-local-quot [ call ] append ;
+
+M: local-reader localize read-local-quot [ local-value ] append ;
+
+M: local-writer localize
+    [ "local-reader" word-prop ] dip
     read-local-quot [ set-local-value ] append ;
 
-: localize ( obj args -- quot )
-    {
-        { [ over local? ]        [ read-local-quot ] }
-        { [ over quote? ]        [ >r local>> r> read-local-quot ] }
-        { [ over local-word? ]   [ read-local-quot [ call ] append ] }
-        { [ over local-reader? ] [ read-local-quot [ local-value ] append ] }
-        { [ over local-writer? ] [ localize-writer ] }
-        { [ over \ lambda eq? ]  [ 2drop [ ] ] }
-        { [ t ]                  [ drop 1quotation ] }
-    } cond ;
+M: object localize drop 1quotation ;
 
 UNION: special local quote local-word local-reader local-writer ;
 
 : load-locals-quot ( args -- quot )
-    [
-        [ ]
-    ] [
+    [ [ ] ] [
         dup [ local-reader? ] contains? [
-            <reversed> [
-                local-reader? [ 1array >r ] [ >r ] ?
-            ] map concat
-        ] [
-            length [ load-locals ] curry >quotation
-        ] if
+            dup [ local-reader? [ 1array ] [ ] ? ] map spread>quot
+        ] [ [ ] ] if swap length [ load-locals ] curry append
     ] if-empty ;
 
 : drop-locals-quot ( args -- quot )
     [ [ ] ] [ length [ drop-locals ] curry ] if-empty ;
 
 : point-free-body ( quot args -- newquot )
-    >r but-last-slice r> [ localize ] curry map concat ;
+    [ but-last-slice ] dip '[ _ localize ] map concat ;
 
 : point-free-end ( quot args -- newquot )
     over peek special?
-    [ dup drop-locals-quot >r >r peek r> localize r> append ]
-    [ dup drop-locals-quot nip swap peek suffix ]
+    [ dup drop-locals-quot [ [ peek ] dip localize ] dip append ]
+    [ drop-locals-quot swap peek suffix ]
     if ;
 
 : (point-free) ( quot args -- newquot )
     [ nip load-locals-quot ]
-    [ point-free-body ]
-    [ point-free-end ]
-    2tri 3append >quotation ;
+    [ reverse point-free-body ]
+    [ reverse point-free-end ]
+    2tri [ ] 3append-as ;
 
 : point-free ( quot args -- newquot )
-    over empty?
-    [ nip length \ drop <repetition> >quotation ]
-    [ (point-free) ] if ;
+    over empty? [ nip length '[ _ ndrop ] ] [ (point-free) ] if ;
 
 UNION: lexical local local-reader local-writer local-word ;
 
@@ -227,9 +238,6 @@ GENERIC: rewrite-element ( obj -- )
 M: array rewrite-element
     dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
 
-M: quotation rewrite-element
-    dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
-
 M: vector rewrite-element rewrite-sequence ;
 
 M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
@@ -237,12 +245,22 @@ M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
 M: tuple rewrite-element
     [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
 
+M: quotation rewrite-element local-rewrite* ;
+
 M: lambda rewrite-element local-rewrite* ;
 
+M: binding-form rewrite-element binding-form-in-literal-error ;
+
 M: local rewrite-element , ;
 
 M: local-reader rewrite-element , ;
 
+M: local-writer rewrite-element
+    local-writer-in-literal-error ;
+
+M: local-word rewrite-element
+    local-word-in-literal-error ;
+
 M: word rewrite-element literalize , ;
 
 M: wrapper rewrite-element
@@ -278,8 +296,9 @@ M: object local-rewrite* , ;
 : make-locals ( seq -- words assoc )
     [ [ make-local ] map ] H{ } make-assoc ;
 
-: make-local-word ( name -- word )
-    <local-word> dup dup name>> set ;
+: make-local-word ( name def -- word )
+    [ <local-word> [ dup name>> set ] [ ] [ ] tri ] dip
+    "local-word-def" set-word-prop ;
 
 : push-locals ( assoc -- )
     use get push ;
@@ -328,7 +347,7 @@ SYMBOL: in-lambda?
 
 : (parse-wbindings) ( -- )
     parse-binding [
-        first2 >r make-local-word r> 2array ,
+        first2 [ make-local-word ] keep 2array ,
         (parse-wbindings)
     ] when* ;
 
@@ -340,7 +359,7 @@ SYMBOL: in-lambda?
 
 : let-rewrite ( body bindings -- )
     <reversed> [
-        >r 1array r> spin <lambda> [ call ] curry compose
+        [ 1array ] dip spin <lambda> '[ @ @ ]
     ] assoc-each local-rewrite* \ call , ;
 
 M: let local-rewrite*
@@ -351,7 +370,7 @@ M: let* local-rewrite*
 
 M: wlet local-rewrite*
     [ body>> ] [ bindings>> ] bi
-    [ [ ] curry ] assoc-map
+    [ '[ _ ] ] assoc-map
     let-rewrite ;
 
 : parse-locals ( -- vars assoc )
@@ -359,11 +378,6 @@ M: wlet local-rewrite*
     word [ over "declared-effect" set-word-prop ] when*
     in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
 
-ERROR: bad-lambda-rewrite output ;
-
-M: bad-lambda-rewrite summary
-    drop "You have found a bug in locals. Please report." ;
-
 : parse-locals-definition ( word -- word quot )
     "(" expect parse-locals \ ; (parse-lambda) <lambda>
     2dup "lambda" set-word-prop
@@ -431,7 +445,7 @@ M: lambda pprint*
     \ | pprint-word
     t <inset
     <block
-    [ <block >r pprint-var r> pprint* block> ] assoc-each
+    [ <block [ pprint-var ] dip pprint* block> ] assoc-each
     block>
     \ | pprint-word
     <block pprint-elements block>
@@ -497,3 +511,15 @@ M: lambda-method synopsis*
     method-stack-effect effect>string comment. ;
 
 PRIVATE>
+
+! Locals and fry
+M: binding-form count-inputs body>> count-inputs ;
+
+M: lambda count-inputs body>> count-inputs ;
+
+M: lambda deep-fry
+    clone [ shallow-fry swap ] change-body
+    [ [ vars>> length ] keep '[ _ _ mnswap @ ] , ] [ drop [ncurry] % ] 2bi ;
+
+M: binding-form deep-fry
+    clone [ fry '[ @ call ] ] change-body , ;
diff --git a/basis/math/bitwise/bitwise-docs.factor b/basis/math/bitwise/bitwise-docs.factor
index 9ed164330b..18ae8e1497 100644
--- a/basis/math/bitwise/bitwise-docs.factor
+++ b/basis/math/bitwise/bitwise-docs.factor
@@ -204,8 +204,25 @@ HELP: on-bits
         "64 on-bits .h"
         "ffffffffffffffff"
     }
+} ;
+
+HELP: toggle-bit
+{ $values
+     { "m" integer }
+     { "n" integer }
+     { "m'" integer }
 }
-;
+{ $description "Toggles the nth bit of an integer." }
+{ $examples
+    { $example "USING: math.bitwise kernel prettyprint ;"
+        "0 3 toggle-bit .b"
+        "1000"
+    }
+    { $example "USING: math.bitwise kernel prettyprint ;"
+        "BIN: 1000 3 toggle-bit .b"
+        "0"
+    }
+} ;
 
 HELP: set-bit
 { $values
diff --git a/basis/math/bitwise/bitwise-tests.factor b/basis/math/bitwise/bitwise-tests.factor
index 4422992956..979c62dcfb 100644
--- a/basis/math/bitwise/bitwise-tests.factor
+++ b/basis/math/bitwise/bitwise-tests.factor
@@ -29,3 +29,6 @@ IN: math.bitwise.tests
 \ foo must-infer
 
 [ 1 ] [ { 1 } flags ] unit-test
+
+[ 8 ] [ 0 3 toggle-bit ] unit-test
+[ 0 ] [ 8 3 toggle-bit ] unit-test
diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor
index 71ada945cd..89a21b65ab 100644
--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@@ -17,6 +17,7 @@ IN: math.bitwise
 : bits ( m n -- m' ) 2^ wrap ; inline
 : mask-bit ( m n -- m' ) 2^ mask ; inline
 : on-bits ( n -- m ) 2^ 1- ; inline
+: toggle-bit ( m n -- m' ) 2^ bitxor ; inline
 
 : shift-mod ( n s w -- n )
     [ shift ] dip 2^ wrap ; inline
diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index c582c560a9..1cea0a74dd 100644
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -100,7 +100,7 @@ PRIVATE>
         { [ dup integer? ] [ integer^ ] }
         { [ 2dup real^? ] [ fpow ] }
         [ ^complex ]
-    } cond ;
+    } cond ; inline
 
 : (^mod) ( n x y -- z )
     1 swap [
@@ -174,47 +174,61 @@ M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ;
 
 M: complex log >polar swap flog swap rect> ;
 
-: cos ( x -- y )
-    dup complex? [
-        >float-rect 2dup
-        fcosh swap fcos * -rot
-        fsinh swap fsin neg * rect>
-    ] [ fcos ] if ; foldable
+GENERIC: cos ( x -- y ) foldable
+
+M: complex cos
+    >float-rect 2dup
+    fcosh swap fcos * -rot
+    fsinh swap fsin neg * rect> ;
+
+M: real cos fcos ;
 
 : sec ( x -- y ) cos recip ; inline
 
-: cosh ( x -- y )
-    dup complex? [
-        >float-rect 2dup
-        fcos swap fcosh * -rot
-        fsin swap fsinh * rect>
-    ] [ fcosh ] if ; foldable
+GENERIC: cosh ( x -- y ) foldable
+
+M: complex cosh
+    >float-rect 2dup
+    fcos swap fcosh * -rot
+    fsin swap fsinh * rect> ;
+
+M: real cosh fcosh ;
 
 : sech ( x -- y ) cosh recip ; inline
 
-: sin ( x -- y )
-    dup complex? [
-        >float-rect 2dup
-        fcosh swap fsin * -rot
-        fsinh swap fcos * rect>
-    ] [ fsin ] if ; foldable
+GENERIC: sin ( x -- y ) foldable
+
+M: complex sin
+    >float-rect 2dup
+    fcosh swap fsin * -rot
+    fsinh swap fcos * rect> ;
+
+M: real sin fsin ;
 
 : cosec ( x -- y ) sin recip ; inline
 
-: sinh ( x -- y )
-    dup complex? [
-        >float-rect 2dup
-        fcos swap fsinh * -rot
-        fsin swap fcosh * rect>
-    ] [ fsinh ] if ; foldable
+GENERIC: sinh ( x -- y ) foldable
+
+M: complex sinh 
+    >float-rect 2dup
+    fcos swap fsinh * -rot
+    fsin swap fcosh * rect> ;
+
+M: real sinh fsinh ;
 
 : cosech ( x -- y ) sinh recip ; inline
 
-: tan ( x -- y )
-    dup complex? [ dup sin swap cos / ] [ ftan ] if ; inline
+GENERIC: tan ( x -- y ) foldable
 
-: tanh ( x -- y )
-    dup complex? [ dup sinh swap cosh / ] [ ftanh ] if ; inline
+M: complex tan [ sin ] [ cos ] bi / ;
+
+M: real tan ftan ;
+
+GENERIC: tanh ( x -- y ) foldable
+
+M: complex tanh [ sinh ] [ cosh ] bi / ;
+
+M: real tanh ftanh ;
 
 : cot ( x -- y ) tan recip ; inline
 
@@ -231,7 +245,7 @@ M: complex log >polar swap flog swap rect> ;
 : acosech ( x -- y ) recip asinh ; inline
 
 : atanh ( x -- y )
-    dup 1+ swap 1- neg / log 2 / ; inline
+    [ 1+ ] [ 1- neg ] bi / log 2 / ; inline
 
 : acoth ( x -- y ) recip atanh ; inline
 
@@ -246,8 +260,11 @@ M: complex log >polar swap flog swap rect> ;
     dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ;
     inline
 
-: atan ( x -- y )
-    dup complex? [ i* atanh i* ] [ fatan ] if ; inline
+GENERIC: atan ( x -- y ) foldable
+
+M: complex atan i* atanh i* ;
+
+M: real atan fatan ;
 
 : asec ( x -- y ) recip acos ; inline
 
diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor
index 8bda6a6dd0..96f5f134cc 100644
--- a/basis/math/libm/libm.factor
+++ b/basis/math/libm/libm.factor
@@ -5,69 +5,69 @@ IN: math.libm
 
 : facos ( x -- y )
     "double" "libm" "acos" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fasin ( x -- y )
     "double" "libm" "asin" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fatan ( x -- y )
     "double" "libm" "atan" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fatan2 ( x y -- z )
     "double" "libm" "atan2" { "double" "double" } alien-invoke ;
-    foldable
+    inline
 
 : fcos ( x -- y )
     "double" "libm" "cos" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fsin ( x -- y )
     "double" "libm" "sin" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : ftan ( x -- y )
     "double" "libm" "tan" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fcosh ( x -- y )
     "double" "libm" "cosh" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fsinh ( x -- y )
     "double" "libm" "sinh" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : ftanh ( x -- y )
     "double" "libm" "tanh" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fexp ( x -- y )
     "double" "libm" "exp" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : flog ( x -- y )
     "double" "libm" "log" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fpow ( x y -- z )
     "double" "libm" "pow" { "double" "double" } alien-invoke ;
-    foldable
+    inline
 
 : fsqrt ( x -- y )
     "double" "libm" "sqrt" { "double" } alien-invoke ;
-    foldable
+    inline
     
 ! Windows doesn't have these...
 : facosh ( x -- y )
     "double" "libm" "acosh" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fasinh ( x -- y )
     "double" "libm" "asinh" { "double" } alien-invoke ;
-    foldable
+    inline
 
 : fatanh ( x -- y )
     "double" "libm" "atanh" { "double" } alien-invoke ;
-    foldable
+    inline
diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor
index 41fd28e441..388d117959 100644
--- a/basis/math/ranges/ranges.factor
+++ b/basis/math/ranges/ranges.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 USING: kernel layouts math math.order namespaces sequences
 sequences.private accessors ;
 IN: math.ranges
@@ -8,9 +10,7 @@ TUPLE: range
 { step read-only } ;
 
 : <range> ( a b step -- range )
-    [ over - ] dip
-    [ / 1+ 0 max >integer ] keep
-    range boa ; inline
+    [ over - ] dip [ /i 1+ 0 max ] keep range boa ; inline
 
 M: range length ( seq -- n )
     length>> ;
diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index 3b807bf8b6..d9a9b9bf40 100644
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@@ -42,10 +42,10 @@ IN: opengl
     [ glDisableClientState ] each ; inline
 
 MACRO: all-enabled ( seq quot -- )
-    >r words>values r> [ (all-enabled) ] 2curry ;
+    [ words>values ] dip [ (all-enabled) ] 2curry ;
 
 MACRO: all-enabled-client-state ( seq quot -- )
-    >r words>values r> [ (all-enabled-client-state) ] 2curry ;
+    [ words>values ] dip [ (all-enabled-client-state) ] 2curry ;
 
 : do-matrix ( mode quot -- )
     swap [ glMatrixMode glPushMatrix call ] keep
@@ -136,7 +136,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
     circle-points concat >c-float-array ;
 
 : (gen-gl-object) ( quot -- id )
-    >r 1 0 <uint> r> keep *uint ; inline
+    [ 1 0 <uint> ] dip keep *uint ; inline
 
 : gen-texture ( -- id )
     [ glGenTextures ] (gen-gl-object) ;
@@ -145,7 +145,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
     [ glGenBuffers ] (gen-gl-object) ;
 
 : (delete-gl-object) ( id quot -- )
-    >r 1 swap <uint> r> call ; inline
+    [ 1 swap <uint> ] dip call ; inline
 
 : delete-texture ( id -- )
     [ glDeleteTextures ] (delete-gl-object) ;
@@ -164,7 +164,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
 
 : <gl-buffer> ( target data hint -- id )
     pick gen-gl-buffer [ [
-        >r dup byte-length swap r> glBufferData
+        [ dup byte-length swap ] dip glBufferData
     ] with-gl-buffer ] keep ;
 
 : buffer-offset ( int -- alien )
@@ -198,9 +198,11 @@ TUPLE: sprite loc dim dim2 dlist texture ;
     gen-texture [
         GL_TEXTURE_BIT [
             GL_TEXTURE_2D swap glBindTexture
-            >r >r GL_TEXTURE_2D 0 GL_RGBA r>
-            sprite-size2 0 GL_LUMINANCE_ALPHA
-            GL_UNSIGNED_BYTE r> glTexImage2D
+            [
+                [ GL_TEXTURE_2D 0 GL_RGBA ] dip
+                sprite-size2 0 GL_LUMINANCE_ALPHA
+                GL_UNSIGNED_BYTE
+            ] dip glTexImage2D
         ] do-attribs
     ] keep ;
     
@@ -252,7 +254,7 @@ MEMO: (rect-texture-coords) ( -- seq )
     [ nip [ free-sprite ] when* ] assoc-each ;
 
 : with-translation ( loc quot -- )
-    GL_MODELVIEW [ >r gl-translate r> call ] do-matrix ; inline
+    GL_MODELVIEW [ [ gl-translate ] dip call ] do-matrix ; inline
 
 : fix-coordinates ( point1 point2 -- x1 y2 x2 y2 )
     [ first2 [ >fixnum ] bi@ ] bi@ ;
diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor
index 6dd7175db8..82acef9b72 100644
--- a/basis/prettyprint/prettyprint.factor
+++ b/basis/prettyprint/prettyprint.factor
@@ -370,9 +370,12 @@ M: word see
 : (see-methods) ( generic -- seq )
     "methods" word-prop values natural-sort ;
 
-: see-methods ( word -- )
+: methods ( word -- seq )
     [
         dup class? [ dup (see-implementors) % ] when
         dup generic? [ dup (see-methods) % ] when
         drop
-    ] { } make prune see-all ;
+    ] { } make prune ;
+
+: see-methods ( word -- )
+    methods see-all ;
diff --git a/basis/regexp/backend/backend.factor b/basis/regexp/backend/backend.factor
index 4c82876650..5eff0579c8 100644
--- a/basis/regexp/backend/backend.factor
+++ b/basis/regexp/backend/backend.factor
@@ -5,12 +5,13 @@ IN: regexp.backend
 
 TUPLE: regexp
     raw
-    { stack vector }
-    parse-tree
     { options hashtable }
+    stack
+    parse-tree
     nfa-table
     dfa-table
     minimized-table
+    matchers
     { nfa-traversal-flags hashtable }
     { dfa-traversal-flags hashtable }
     { state integer }
diff --git a/basis/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor
index f143bebdf7..eec0d309b1 100644
--- a/basis/regexp/classes/classes.factor
+++ b/basis/regexp/classes/classes.factor
@@ -1,12 +1,25 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math math.order symbols regexp.parser
+USING: accessors kernel math math.order symbols 
 words regexp.utils unicode.categories combinators.short-circuit ;
 IN: regexp.classes
 
+SINGLETONS: any-char any-char-no-nl
+letter-class LETTER-class Letter-class digit-class
+alpha-class non-newline-blank-class
+ascii-class punctuation-class java-printable-class blank-class
+control-character-class hex-digit-class java-blank-class c-identifier-class
+unmatchable-class terminator-class word-boundary-class ;
+
+SINGLETONS: beginning-of-input beginning-of-line
+end-of-input end-of-line ;
+
+MIXIN: node
+TUPLE: character-class-range from to ; INSTANCE: character-class-range node
+
 GENERIC: class-member? ( obj class -- ? )
 
-M: word class-member? ( obj class -- ? ) 2drop f ;
+M: t class-member? ( obj class -- ? ) 2drop f ;
 
 M: integer class-member? ( obj class -- ? ) 2drop f ;
 
@@ -18,7 +31,7 @@ M: any-char class-member? ( obj class -- ? )
 
 M: any-char-no-nl class-member? ( obj class -- ? )
     drop CHAR: \n = not ;
-    
+
 M: letter-class class-member? ( obj class -- ? )
     drop letter? ;
             
@@ -70,3 +83,9 @@ M: terminator-class class-member? ( obj class -- ? )
         [ CHAR: \u002028 = ]
         [ CHAR: \u002029 = ]
     } 1|| ;
+
+M: beginning-of-line class-member? ( obj class -- ? )
+    2drop f ;
+
+M: end-of-line class-member? ( obj class -- ? )
+    2drop f ;
diff --git a/basis/regexp/nfa/nfa.factor b/basis/regexp/nfa/nfa.factor
index 99d94b4bcb..7620652948 100644
--- a/basis/regexp/nfa/nfa.factor
+++ b/basis/regexp/nfa/nfa.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs grouping kernel regexp.backend
 locals math namespaces regexp.parser sequences fry quotations
 math.order math.ranges vectors unicode.categories regexp.utils
-regexp.transition-tables words sets ;
+regexp.transition-tables words sets regexp.classes unicode.case ;
 IN: regexp.nfa
 
 SYMBOL: negation-mode
@@ -22,8 +22,13 @@ SINGLETON: front-anchor INSTANCE: front-anchor traversal-flag
 SINGLETON: back-anchor INSTANCE: back-anchor traversal-flag
 SINGLETON: word-boundary INSTANCE: word-boundary traversal-flag
 
-: add-global-flag ( flag -- )
-    current-regexp get nfa-table>> flags>> conjoin ;
+: options ( -- obj ) current-regexp get options>> ;
+
+: option? ( obj -- ? ) options key? ;
+
+: option-on ( obj -- ) options conjoin ;
+
+: option-off ( obj -- ) options delete-at ;
 
 : next-state ( regexp -- state )
     [ state>> ] [ [ 1+ ] change-state drop ] bi ;
@@ -106,6 +111,7 @@ M: kleene-star nfa-node ( node -- )
 
 M: concatenation nfa-node ( node -- )
     seq>>
+    reversed-regexp option? [ <reversed> ] when
     [ [ nfa-node ] each ]
     [ length 1- [ concatenate-nodes ] times ] bi ;
 
@@ -115,16 +121,59 @@ M: alternation nfa-node ( node -- )
     [ length 1- [ alternate-nodes ] times ] bi ;
 
 M: constant nfa-node ( node -- )
-    char>> literal-transition add-simple-entry ;
+    case-insensitive option? [
+        dup char>> [ ch>lower ] [ ch>upper ] bi
+        2dup = [
+            2drop
+            char>> literal-transition add-simple-entry
+        ] [
+            [ literal-transition add-simple-entry ] bi@
+            alternate-nodes drop
+        ] if
+    ] [
+        char>> literal-transition add-simple-entry
+    ] if ;
 
 M: epsilon nfa-node ( node -- )
     drop eps literal-transition add-simple-entry ;
 
-M: word nfa-node ( node -- )
+M: word nfa-node ( node -- ) class-transition add-simple-entry ;
+
+M: any-char nfa-node ( node -- )
+    [ dotall option? ] dip any-char-no-nl ?
     class-transition add-simple-entry ;
 
+! M: beginning-of-text nfa-node ( node -- ) ;
+
+M: beginning-of-line nfa-node ( node -- ) class-transition add-simple-entry ;
+
+M: end-of-line nfa-node ( node -- ) class-transition add-simple-entry ;
+
+: choose-letter-class ( node -- node' )
+    case-insensitive option? Letter-class rot ? ;
+
+M: letter-class nfa-node ( node -- )
+    choose-letter-class class-transition add-simple-entry ;
+
+M: LETTER-class nfa-node ( node -- )
+    choose-letter-class class-transition add-simple-entry ;
+
 M: character-class-range nfa-node ( node -- )
-    class-transition add-simple-entry ;
+    case-insensitive option? [
+        dup [ from>> ] [ to>> ] bi
+        2dup [ Letter? ] bi@ and [
+            rot drop
+            [ [ ch>lower ] bi@ character-class-range boa ]
+            [ [ ch>upper ] bi@ character-class-range boa ] 2bi 
+            [ class-transition add-simple-entry ] bi@
+            alternate-nodes
+        ] [
+            2drop
+            class-transition add-simple-entry
+        ] if
+    ] [
+        class-transition add-simple-entry
+    ] if ;
 
 M: capture-group nfa-node ( node -- )
     eps literal-transition add-simple-entry
@@ -141,26 +190,6 @@ M: non-capture-group nfa-node ( node -- )
 M: reluctant-kleene-star nfa-node ( node -- )
     term>> <kleene-star> nfa-node ;
 
-M: beginning-of-line nfa-node ( node -- )
-    drop 
-    eps literal-transition add-simple-entry
-    beginning-of-line add-global-flag ;
-
-M: end-of-line nfa-node ( node -- )
-    drop
-    eps literal-transition add-simple-entry
-    end-of-line add-global-flag ;
-
-M: beginning-of-input nfa-node ( node -- )
-    drop
-    eps literal-transition add-simple-entry
-    beginning-of-input add-global-flag ;
-
-M: end-of-input nfa-node ( node -- )
-    drop
-    eps literal-transition add-simple-entry
-    end-of-input add-global-flag ;
-
 M: negation nfa-node ( node -- )
     negation-mode inc
     term>> nfa-node 
@@ -182,6 +211,10 @@ M: lookbehind nfa-node ( node -- )
     lookbehind-off add-traversal-flag
     2 [ concatenate-nodes ] times ;
 
+M: option nfa-node ( node -- )
+    [ option>> ] [ on?>> ] bi [ option-on ] [ option-off ] if
+    eps literal-transition add-simple-entry ;
+
 : construct-nfa ( regexp -- )
     [
         reset-regexp
diff --git a/basis/regexp/parser/parser-tests.factor b/basis/regexp/parser/parser-tests.factor
index 0f25b2e3bf..fe4d2f1d1a 100644
--- a/basis/regexp/parser/parser-tests.factor
+++ b/basis/regexp/parser/parser-tests.factor
@@ -19,8 +19,8 @@ IN: regexp.parser
 [ ] [ "(?:a)" test-regexp ] unit-test
 [ ] [ "(?i:a)" test-regexp ] unit-test
 [ ] [ "(?-i:a)" test-regexp ] unit-test
-[ "(?z:a)" test-regexp ] [ bad-option? ] must-fail-with
-[ "(?-z:a)" test-regexp ] [ bad-option? ] must-fail-with
+[ "(?z:a)" test-regexp ] [ unknown-regexp-option? ] must-fail-with
+[ "(?-z:a)" test-regexp ] [ unknown-regexp-option? ] must-fail-with
 
 [ ] [ "(?=a)" test-regexp ] unit-test
 
diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor
index 71a3e067f3..4d8f3ddfbc 100644
--- a/basis/regexp/parser/parser.factor
+++ b/basis/regexp/parser/parser.factor
@@ -4,12 +4,11 @@ USING: accessors arrays assocs combinators io io.streams.string
 kernel math math.parser namespaces qualified sets
 quotations sequences splitting symbols vectors math.order
 unicode.categories strings regexp.backend regexp.utils
-unicode.case words locals ;
+unicode.case words locals regexp.classes ;
 IN: regexp.parser
 
 FROM: math.ranges => [a,b] ;
 
-MIXIN: node
 TUPLE: concatenation seq ; INSTANCE: concatenation node
 TUPLE: alternation seq ; INSTANCE: alternation node
 TUPLE: kleene-star term ; INSTANCE: kleene-star node
@@ -40,38 +39,31 @@ INSTANCE: independent-group parentheses-group
 TUPLE: comment-group term ; INSTANCE: comment-group node
 INSTANCE: comment-group parentheses-group
 
-TUPLE: character-class-range from to ; INSTANCE: character-class-range node
 SINGLETON: epsilon INSTANCE: epsilon node
-SINGLETON: any-char INSTANCE: any-char node
-SINGLETON: any-char-no-nl INSTANCE: any-char-no-nl node
-SINGLETON: beginning-of-input INSTANCE: beginning-of-input node
-SINGLETON: end-of-input INSTANCE: end-of-input node
-SINGLETON: beginning-of-line INSTANCE: beginning-of-line node
-SINGLETON: end-of-line INSTANCE: end-of-line node
 
-TUPLE: option-on option ; INSTANCE: option-on node
-TUPLE: option-off option ; INSTANCE: option-off node
+TUPLE: option option on? ; INSTANCE: option node
+
 SINGLETONS: unix-lines dotall multiline comments case-insensitive
 unicode-case reversed-regexp ;
 
-SINGLETONS: letter-class LETTER-class Letter-class digit-class
-alpha-class non-newline-blank-class
-ascii-class punctuation-class java-printable-class blank-class
-control-character-class hex-digit-class java-blank-class c-identifier-class
-unmatchable-class terminator-class word-boundary-class ;
-
-SINGLETONS: beginning-of-group end-of-group
-beginning-of-character-class end-of-character-class
+SINGLETONS: beginning-of-character-class end-of-character-class
 left-parenthesis pipe caret dash ;
 
-: get-option ( option -- ? ) current-regexp get options>> at ;
-: get-unix-lines ( -- ? ) unix-lines get-option ;
-: get-dotall ( -- ? ) dotall get-option ;
-: get-multiline ( -- ? ) multiline get-option ;
-: get-comments ( -- ? ) comments get-option ;
-: get-case-insensitive ( -- ? ) case-insensitive get-option ;
-: get-unicode-case ( -- ? ) unicode-case get-option ;
-: get-reversed-regexp ( -- ? ) reversed-regexp get-option ;
+: push1 ( obj -- ) input-stream get stream>> push ;
+: peek1 ( -- obj ) input-stream get stream>> [ f ] [ peek ] if-empty ;
+: pop3 ( seq -- obj1 obj2 obj3 ) [ pop ] [ pop ] [ pop ] tri spin ;
+: drop1 ( -- ) read1 drop ;
+
+: stack ( -- obj ) current-regexp get stack>> ;
+: change-whole-stack ( quot -- )
+    current-regexp get
+    [ stack>> swap call ] keep (>>stack) ; inline
+: push-stack ( obj -- ) stack push ;
+: pop-stack ( -- obj ) stack pop ;
+: cut-out ( vector n -- vector' vector ) cut rest ;
+ERROR: cut-stack-error ;
+: cut-stack ( obj vector -- vector' vector )
+    tuck last-index [ cut-stack-error ] unless* cut-out swap ;
 
 : <possessive-kleene-star> ( obj -- kleene ) possessive-kleene-star boa ;
 : <reluctant-kleene-star> ( obj -- kleene ) reluctant-kleene-star boa ;
@@ -80,18 +72,11 @@ left-parenthesis pipe caret dash ;
 
 : <negation> ( obj -- negation ) negation boa ;
 : <concatenation> ( seq -- concatenation )
-    >vector get-reversed-regexp [ reverse ] when
-    [ epsilon ] [ concatenation boa ] if-empty ;
+    >vector [ epsilon ] [ concatenation boa ] if-empty ;
 : <alternation> ( seq -- alternation ) >vector alternation boa ;
 : <capture-group> ( obj -- capture-group ) capture-group boa ;
 : <kleene-star> ( obj -- kleene-star ) kleene-star boa ;
-: <constant> ( obj -- constant )
-    dup Letter? get-case-insensitive and [
-        [ ch>lower ] [ ch>upper ] bi
-        [ constant boa ] bi@ 2array <alternation>
-    ] [
-        constant boa
-    ] if ;
+: <constant> ( obj -- constant ) constant boa ;
 
 : first|concatenation ( seq -- first/concatenation )
     dup length 1 = [ first ] [ <concatenation> ] if ;
@@ -100,21 +85,14 @@ left-parenthesis pipe caret dash ;
     dup length 1 = [ first ] [ <alternation> ] if ;
 
 : <character-class-range> ( from to -- obj )
-    2dup [ Letter? ] bi@ or get-case-insensitive and [
-        [ [ ch>lower ] bi@ character-class-range boa ]
-        [ [ ch>upper ] bi@ character-class-range boa ] 2bi
-        2array [ [ from>> ] [ to>> ] bi < ] filter
-        [ unmatchable-class ] [ first|alternation ] if-empty
-    ] [
-        2dup <
-        [ character-class-range boa ] [ 2drop unmatchable-class ] if
-    ] if ;
+    2dup <
+    [ character-class-range boa ] [ 2drop unmatchable-class ] if ;
 
 ERROR: unmatched-parentheses ;
 
-ERROR: bad-option ch ;
+ERROR: unknown-regexp-option option ;
 
-: option ( ch -- singleton )
+: ch>option ( ch -- singleton )
     {
         { CHAR: i [ case-insensitive ] }
         { CHAR: d [ unix-lines ] }
@@ -124,13 +102,21 @@ ERROR: bad-option ch ;
         { CHAR: s [ dotall ] }
         { CHAR: u [ unicode-case ] }
         { CHAR: x [ comments ] }
-        [ bad-option ]
+        [ unknown-regexp-option ]
     } case ;
 
-: option-on ( option -- ) current-regexp get options>> conjoin ;
-: option-off ( option -- ) current-regexp get options>> delete-at ;
+: option>ch ( option -- string )
+    {
+        { case-insensitive [ CHAR: i ] }
+        { multiline [ CHAR: m ] }
+        { reversed-regexp [ CHAR: r ] }
+        { dotall [ CHAR: s ] }
+        [ unknown-regexp-option ]
+    } case ;
+
+: toggle-option ( ch ? -- ) 
+    [ ch>option ] dip option boa push-stack ;
 
-: toggle-option ( ch ? -- ) [ option ] dip [ option-on ] [ option-off ] if ;
 : (parse-options) ( string ? -- ) [ toggle-option ] curry each ;
 
 : parse-options ( string -- )
@@ -176,7 +162,7 @@ DEFER: (parse-regexp)
     [ drop1 (parse-special-group) ]
     [ capture-group f nested-parse-regexp ] if ;
 
-: handle-dot ( -- ) get-dotall any-char any-char-no-nl ? push-stack ;
+: handle-dot ( -- ) any-char push-stack ;
 : handle-pipe ( -- ) pipe push-stack ;
 : (handle-star) ( obj -- kleene-star )
     peek1 {
@@ -234,11 +220,8 @@ ERROR: invalid-range a b ;
         [ [ nip at-most-n ] [ at-least-n ] if* ] if
     ] [ drop 0 max exactly-n ] if ;
 
-: handle-front-anchor ( -- )
-    get-multiline beginning-of-line beginning-of-input ? push-stack ;
-
-: handle-back-anchor ( -- )
-    get-multiline end-of-line end-of-input ? push-stack ;
+: handle-front-anchor ( -- ) beginning-of-line push-stack ;
+: handle-back-anchor ( -- ) end-of-line push-stack ;
 
 ERROR: bad-character-class obj ;
 ERROR: expected-posix-class ;
@@ -247,8 +230,8 @@ ERROR: expected-posix-class ;
     read1 CHAR: { = [ expected-posix-class ] unless
     "}" read-until [ bad-character-class ] unless
     {
-        { "Lower" [ get-case-insensitive Letter-class letter-class ? ] }
-        { "Upper" [ get-case-insensitive Letter-class LETTER-class ? ] }
+        { "Lower" [ letter-class ] }
+        { "Upper" [ LETTER-class ] }
         { "Alpha" [ Letter-class ] }
         { "ASCII" [ ascii-class ] }
         { "Digit" [ digit-class ] }
@@ -412,7 +395,8 @@ DEFER: handle-left-bracket
     [ first|concatenation ] map first|alternation ;
 
 : handle-right-parenthesis ( -- )
-    stack dup [ parentheses-group "members" word-prop member? ] find-last -rot cut rest
+    stack dup [ parentheses-group "members" word-prop member? ] find-last
+    -rot cut rest
     [ [ push ] keep current-regexp get (>>stack) ]
     [ finish-regexp-parse push-stack ] bi* ;
 
@@ -429,12 +413,9 @@ DEFER: handle-left-bracket
         { CHAR: [ [ handle-left-bracket t ] }
         { CHAR: \ [ handle-escape t ] }
         [
-            dup CHAR: $ = peek1 f = and [
-                drop
-                handle-back-anchor f
-            ] [
-                push-constant t
-            ] if
+            dup CHAR: $ = peek1 f = and
+            [ drop handle-back-anchor f ]
+            [ push-constant t ] if
         ]
     } case ;
 
@@ -451,7 +432,6 @@ DEFER: handle-left-bracket
                 parse-regexp-beginning (parse-regexp)
             ] with-input-stream
         ] unless-empty
-        current-regexp get
-        stack finish-regexp-parse
-            >>parse-tree drop
+        current-regexp get [ finish-regexp-parse ] change-stack
+        dup stack>> >>parse-tree drop
     ] with-variable ;
diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
index e4bab990a4..27936eea1c 100644
--- a/basis/regexp/regexp-tests.factor
+++ b/basis/regexp/regexp-tests.factor
@@ -238,7 +238,7 @@ IN: regexp-tests
 
 [ t ] [ "abc" <reversed> R/ abc/r matches? ] unit-test
 [ t ] [ "abc" <reversed> R/ a[bB][cC]/r matches? ] unit-test
-[ t ] [ "adcbe" R/ a(?r)(bcd)(?-r)e/r matches? ] unit-test
+[ t ] [ "adcbe" R/ a(?r)(bcd)(?-r)e/ matches? ] unit-test
 
 [ t ] [ "s@f" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
 [ f ] [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
@@ -307,17 +307,30 @@ IN: regexp-tests
 ! Bug in parsing word
 [ t ] [ "a" R' a' matches?  ] unit-test
 
+! Convert to lowercase until E
+[ f ] [ "AA" R/ \LAA\E/ matches? ] unit-test
+[ t ] [ "aa" R/ \LAA\E/ matches? ] unit-test
+
+! Convert to uppercase until E
+[ t ] [ "AA" R/ \Uaa\E/ matches? ] unit-test
+[ f ] [ "aa" R/ \Uaa\E/ matches? ] unit-test
+
 ! [ "{Lower}" <regexp> ] [ invalid-range? ] must-fail-with
 
-[ t ] [ "a" R/ ^a/ matches? ] unit-test
-[ f ] [ "\na" R/ ^a/ matches? ] unit-test
-[ f ] [ "\r\na" R/ ^a/ matches? ] unit-test
-[ f ] [ "\ra" R/ ^a/ matches? ] unit-test
+! [ t ] [ "a" R/ ^a/ matches? ] unit-test
+! [ f ] [ "\na" R/ ^a/ matches? ] unit-test
+! [ f ] [ "\r\na" R/ ^a/ matches? ] unit-test
+! [ f ] [ "\ra" R/ ^a/ matches? ] unit-test
 
-[ t ] [ "a" R/ a$/ matches? ] unit-test
-[ f ] [ "a\n" R/ a$/ matches? ] unit-test
-[ f ] [ "a\r" R/ a$/ matches? ] unit-test
-[ f ] [ "a\r\n" R/ a$/ matches? ] unit-test
+! [ t ] [ "a" R/ a$/ matches? ] unit-test
+! [ f ] [ "a\n" R/ a$/ matches? ] unit-test
+! [ f ] [ "a\r" R/ a$/ matches? ] unit-test
+! [ f ] [ "a\r\n" R/ a$/ matches? ] unit-test
+
+! [ t ] [ "a" R/ a$|b$/ matches? ] unit-test
+! [ t ] [ "b" R/ a$|b$/ matches? ] unit-test
+! [ t ] [ "ab" R/ a$|b$/ matches? ] unit-test
+! [ t ] [ "ba" R/ ba$|b$/ matches? ] unit-test
 
 ! [ t ] [ "a" R/ \Aa/ matches? ] unit-test
 ! [ f ] [ "\na" R/ \Aaa/ matches? ] unit-test
@@ -347,14 +360,6 @@ IN: regexp-tests
 ! [ t ] [ "\r\na" R/ ^a/m matches? ] unit-test
 ! [ t ] [ "\ra" R/ ^a/m matches? ] unit-test
 
-! Convert to lowercase until E
-[ f ] [ "AA" R/ \LAA\E/ matches? ] unit-test
-[ t ] [ "aa" R/ \LAA\E/ matches? ] unit-test
-
-! Convert to uppercase until E
-[ t ] [ "AA" R/ \Uaa\E/ matches? ] unit-test
-[ f ] [ "aa" R/ \Uaa\E/ matches? ] unit-test
-
 ! [ t ] [ "a" "a$" R/ a$/m matches? ] unit-test
 ! [ t ] [ "a\n" "a$" R/ a$/m matches? ] unit-test
 ! [ t ] [ "a\r" "a$" R/ a$/m matches? ] unit-test
diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index e61d5692f4..b41e4d271e 100644
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -16,6 +16,7 @@ IN: regexp
         H{ } clone >>nfa-traversal-flags
         H{ } clone >>dfa-traversal-flags
         H{ } clone >>options
+        H{ } clone >>matchers
         reset-regexp ;
 
 : construct-regexp ( regexp -- regexp' )
@@ -93,26 +94,6 @@ IN: regexp
         { "R| "  "|"  }
     } swap [ subseq? not nip ] curry assoc-find drop ;
 
-ERROR: unknown-regexp-option option ;
-
-: option>ch ( option -- string )
-    {
-        { case-insensitive [ CHAR: i ] }
-        { multiline [ CHAR: m ] }
-        { reversed-regexp [ CHAR: r ] }
-        { dotall [ CHAR: s ] }
-        [ unknown-regexp-option ]
-    } case ;
-
-: ch>option ( ch -- option )
-    {
-        { CHAR: i [ case-insensitive ] }
-        { CHAR: m [ multiline ] }
-        { CHAR: r [ reversed-regexp ] }
-        { CHAR: s [ dotall ] }
-        [ unknown-regexp-option ]
-    } case ;
-
 : string>options ( string -- options )
     [ ch>option dup ] H{ } map>assoc ;
 
diff --git a/basis/regexp/transition-tables/transition-tables.factor b/basis/regexp/transition-tables/transition-tables.factor
index 80317a1b66..5375d813e1 100644
--- a/basis/regexp/transition-tables/transition-tables.factor
+++ b/basis/regexp/transition-tables/transition-tables.factor
@@ -20,18 +20,19 @@ TUPLE: default ;
 
 : <literal-transition> ( from to obj -- transition )
     literal-transition make-transition ;
+
 : <class-transition> ( from to obj -- transition )
     class-transition make-transition ;
+
 : <default-transition> ( from to -- transition )
     t default-transition make-transition ;
 
-TUPLE: transition-table transitions start-state final-states flags ;
+TUPLE: transition-table transitions start-state final-states ;
 
 : <transition-table> ( -- transition-table )
     transition-table new
         H{ } clone >>transitions
-        H{ } clone >>final-states
-        H{ } clone >>flags ;
+        H{ } clone >>final-states ;
 
 : maybe-initialize-key ( key hashtable -- )
     2dup key? [ 2drop ] [ H{ } clone -rot set-at ] if ;
diff --git a/basis/regexp/utils/utils.factor b/basis/regexp/utils/utils.factor
index 5116dd2b7e..af1b2fa1fb 100644
--- a/basis/regexp/utils/utils.factor
+++ b/basis/regexp/utils/utils.factor
@@ -26,23 +26,6 @@ IN: regexp.utils
 : ?insert-at ( value key hash/f -- hash )
     [ H{ } clone ] unless* [ insert-at ] keep ;
 
-: last-state ( regexp -- range ) stack>> peek first2 [a,b] ;
-: push1 ( obj -- ) input-stream get stream>> push ;
-: peek1 ( -- obj ) input-stream get stream>> [ f ] [ peek ] if-empty ;
-: pop3 ( seq -- obj1 obj2 obj3 ) [ pop ] [ pop ] [ pop ] tri spin ;
-: drop1 ( -- ) read1 drop ;
-
-: stack ( -- obj ) current-regexp get stack>> ;
-: change-whole-stack ( quot -- )
-    current-regexp get
-    [ stack>> swap call ] keep (>>stack) ; inline
-: push-stack ( obj -- ) stack push ;
-: pop-stack ( -- obj ) stack pop ;
-: cut-out ( vector n -- vector' vector ) cut rest ;
-ERROR: cut-stack-error ;
-: cut-stack ( obj vector -- vector' vector )
-    tuck last-index [ cut-stack-error ] unless* cut-out swap ;
-
 ERROR: bad-octal number ;
 ERROR: bad-hex number ;
 : check-octal ( octal -- octal ) dup 255 > [ bad-octal ] when ;
diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 6585698b23..12eb637964 100644
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -134,11 +134,11 @@ M: object infer-call*
 
 : infer-load-locals ( -- )
     pop-literal nip
-    consume-d dup reverse copy-values dup output-r
-    [ [ f f ] dip ] [ reverse swap zip ] 2bi #shuffle, ;
+    consume-d dup copy-values dup output-r
+    [ [ f f ] dip ] [ swap zip ] 2bi #shuffle, ;
 
 : infer-get-local ( -- )
-    [let* | n [ pop-literal nip ]
+    [let* | n [ pop-literal nip 1 swap - ]
             in-r [ n consume-r ]
             out-d [ in-r first copy-value 1array ]
             out-r [ in-r copy-values ] |
@@ -186,6 +186,9 @@ M: object infer-call*
 : infer-local-writer ( word -- )
     (( value -- )) apply-word/effect ;
 
+: infer-local-word ( word -- )
+    "local-word-def" word-prop infer-quot-here ;
+
 {
     >r r> declare call (call) slip 2slip 3slip curry compose
     execute (execute) if dispatch <tuple-boa> (throw)
@@ -209,6 +212,7 @@ M: object infer-call*
         { [ dup local? ] [ infer-local-reader ] }
         { [ dup local-reader? ] [ infer-local-reader ] }
         { [ dup local-writer? ] [ infer-local-writer ] }
+        { [ dup local-word? ] [ infer-local-word ] }
         { [ dup recursive-word? ] [ call-recursive-word ] }
         [ dup infer-word apply-word/effect ]
     } cond ;
@@ -277,6 +281,8 @@ M: object infer-call*
 \ <complex> { real real } { complex } define-primitive
 \ <complex> make-foldable
 
+\ both-fixnums? { object object } { object object object } define-primitive
+
 \ fixnum+ { fixnum fixnum } { integer } define-primitive
 \ fixnum+ make-foldable
 
diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor
index 6e11eb1189..7eec29f94b 100644
--- a/basis/stack-checker/transforms/transforms.factor
+++ b/basis/stack-checker/transforms/transforms.factor
@@ -94,7 +94,10 @@ IN: stack-checker.transforms
         [ "method-class" word-prop ]
         [ "method-generic" word-prop ] bi
         [ inlined-dependency depends-on ] bi@
-    ] [ next-method-quot ] bi
+    ] [
+        [ next-method-quot ]
+        [ '[ _ no-next-method ] ] bi or
+    ] bi
 ] 1 define-transform
 
 ! Constructors
diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor
index c836bfc2b6..9847b16bc2 100644
--- a/basis/tools/annotations/annotations.factor
+++ b/basis/tools/annotations/annotations.factor
@@ -26,12 +26,12 @@ M: word reset
     ] when
     [
         over dup def>> "unannotated-def" set-word-prop
-        >r dup def>> r> call define
+        [ dup def>> ] dip call define
     ] with-compilation-unit ; inline
 
 : word-inputs ( word -- seq )
     stack-effect [
-        >r datastack r> in>> length tail*
+        [ datastack ] dip in>> length tail*
     ] [
         datastack
     ] if* ;
@@ -41,34 +41,38 @@ M: word reset
     word-inputs stack.
     "\\--" print flush ;
 
+: word-outputs ( word -- seq )
+    stack-effect [
+        [ datastack ] dip out>> length tail*
+    ] [
+        datastack
+    ] if* ;
+
 : leaving ( str -- )
     "/-- Leaving: " write dup .
-    stack-effect [
-        >r datastack r> out>> length tail* stack.
-    ] [
-        .s
-    ] if* "\\--" print flush ;
+    word-outputs stack.
+     "\\--" print flush ;
 
-: (watch) ( word def -- def ) over '[ _ entering @ _ leaving ] ;
+: (watch) ( word def -- def )
+    over '[ _ entering @ _ leaving ] ;
 
 : watch ( word -- )
     dup [ (watch) ] annotate ;
 
-: (watch-vars) ( quot word vars -- newquot )
-    rot
+: (watch-vars) ( word vars quot -- newquot )
    '[
-        "--- Entering: "       write _ .
+        "--- Entering: " write _ .
         "--- Variable values:" print _ [ dup get ] H{ } map>assoc describe
         @
     ] ;
 
 : watch-vars ( word vars -- )
-    dupd [ (watch-vars) ] 2curry annotate ;
+    dupd '[ [ _ _ ] dip (watch-vars) ] annotate ;
 
 GENERIC# annotate-methods 1 ( word quot -- )
 
 M: generic annotate-methods
-    >r "methods" word-prop values r> [ annotate ] curry each ;
+    [ "methods" word-prop values ] dip [ annotate ] curry each ;
 
 M: word annotate-methods
     annotate ;
@@ -77,4 +81,4 @@ M: word annotate-methods
     [ add-breakpoint ] annotate-methods ;
 
 : breakpoint-if ( word quot -- )
-    [ [ [ break ] when ] rot 3append ] curry annotate-methods ;
+    '[ [ _ [ [ break ] when ] ] dip 3append ] annotate-methods ;
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index a537d37d11..00cee32ddb 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -343,6 +343,9 @@ IN: tools.deploy.shaker
 : compress-strings ( -- )
     [ string? ] [ ] "strings" compress ;
 
+: compress-wrappers ( -- )
+    [ wrapper? ] [ ] "wrappers" compress ;
+
 : finish-deploy ( final-image -- )
     "Finishing up" show
     >r { } set-datastack r>
@@ -391,7 +394,8 @@ SYMBOL: deploy-vocab
     r> strip-words
     compress-byte-arrays
     compress-quotations
-    compress-strings ;
+    compress-strings
+    compress-wrappers ;
 
 : (deploy) ( final-image vocab config -- )
     #! Does the actual work of a deployment in the slave
diff --git a/basis/tools/hexdump/hexdump-docs.factor b/basis/tools/hexdump/hexdump-docs.factor
index 9579fb7f81..612195d997 100644
--- a/basis/tools/hexdump/hexdump-docs.factor
+++ b/basis/tools/hexdump/hexdump-docs.factor
@@ -1,14 +1,15 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel sequences strings ;
+USING: help.markup help.syntax kernel sequences byte-arrays
+strings ;
 IN: tools.hexdump
 
 HELP: hexdump.
-{ $values { "seq" sequence } }
+{ $values { "byte-array" byte-array } }
 { $description "Converts a sequence to its hexadecimal and ASCII representation sixteen characters at a time and writes it to standard out." } ;
 
 HELP: hexdump
-{ $values { "seq" sequence } { "str" string } }
+{ $values { "byte-array" byte-array } { "str" string } }
 { $description "Converts a sequence to its hexadecimal and ASCII representation sixteen characters at a time.  Lines are separated by a newline character." }
 { $see-also hexdump. } ;
 
diff --git a/basis/tools/hexdump/hexdump-tests.factor b/basis/tools/hexdump/hexdump-tests.factor
index 7202e4402c..1a8ed35510 100644
--- a/basis/tools/hexdump/hexdump-tests.factor
+++ b/basis/tools/hexdump/hexdump-tests.factor
@@ -1,10 +1,10 @@
-USING: tools.hexdump kernel sequences tools.test ;
+USING: tools.hexdump kernel sequences tools.test byte-arrays ;
 IN: tools.hexdump.tests
 
-[ t ] [ "" hexdump "Length: 0, 0h\n" = ] unit-test
-[ t ] [ "abcdefghijklmnopqrstuvwxyz" hexdump "Length: 26, 1ah\n00000000h: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop\n00000010h: 71 72 73 74 75 76 77 78 79 7a                   qrstuvwxyz\n" = ] unit-test
+[ t ] [ B{ } hexdump "Length: 0, 0h\n" = ] unit-test
+[ t ] [ "abcdefghijklmnopqrstuvwxyz" >byte-array hexdump "Length: 26, 1ah\n00000000h: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop\n00000010h: 71 72 73 74 75 76 77 78 79 7a                   qrstuvwxyz\n" = ] unit-test
 
-[ t ] [ 256 [ ] map hexdump "Length: 256, 100h\n00000000h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ................\n00000010h: 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f ................\n00000020h: 20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f  !\"#$%&'()*+,-./\n00000030h: 30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f 0123456789:;<=>?\n00000040h: 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f @ABCDEFGHIJKLMNO\n00000050h: 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_\n00000060h: 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno\n00000070h: 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~.\n00000080h: 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................\n00000090h: 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................\n000000a0h: a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................\n000000b0h: b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................\n000000c0h: c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................\n000000d0h: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................\n000000e0h: e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................\n000000f0h: f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................\n" = ] unit-test
+[ t ] [ 256 [ ] B{ } map-as hexdump "Length: 256, 100h\n00000000h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ................\n00000010h: 10 11 12 13 14 15 16 17 18 19 1a 1b 1c 1d 1e 1f ................\n00000020h: 20 21 22 23 24 25 26 27 28 29 2a 2b 2c 2d 2e 2f  !\"#$%&'()*+,-./\n00000030h: 30 31 32 33 34 35 36 37 38 39 3a 3b 3c 3d 3e 3f 0123456789:;<=>?\n00000040h: 40 41 42 43 44 45 46 47 48 49 4a 4b 4c 4d 4e 4f @ABCDEFGHIJKLMNO\n00000050h: 50 51 52 53 54 55 56 57 58 59 5a 5b 5c 5d 5e 5f PQRSTUVWXYZ[\\]^_\n00000060h: 60 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f `abcdefghijklmno\n00000070h: 70 71 72 73 74 75 76 77 78 79 7a 7b 7c 7d 7e 7f pqrstuvwxyz{|}~.\n00000080h: 80 81 82 83 84 85 86 87 88 89 8a 8b 8c 8d 8e 8f ................\n00000090h: 90 91 92 93 94 95 96 97 98 99 9a 9b 9c 9d 9e 9f ................\n000000a0h: a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 aa ab ac ad ae af ................\n000000b0h: b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf ................\n000000c0h: c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 ca cb cc cd ce cf ................\n000000d0h: d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 da db dc dd de df ................\n000000e0h: e0 e1 e2 e3 e4 e5 e6 e7 e8 e9 ea eb ec ed ee ef ................\n000000f0h: f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb fc fd fe ff ................\n" = ] unit-test
 
 
 [
diff --git a/basis/tools/hexdump/hexdump.factor b/basis/tools/hexdump/hexdump.factor
index c8b9f4accc..d16d6b2595 100644
--- a/basis/tools/hexdump/hexdump.factor
+++ b/basis/tools/hexdump/hexdump.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays io io.streams.string kernel math math.parser
-namespaces sequences splitting grouping strings ascii ;
+namespaces sequences splitting grouping strings ascii byte-arrays ;
 IN: tools.hexdump
 
 <PRIVATE
@@ -28,9 +28,11 @@ IN: tools.hexdump
 
 PRIVATE>
 
-: hexdump. ( seq -- )
+GENERIC: hexdump. ( byte-array -- )
+
+M: byte-array hexdump.
     [ length write-header ]
     [ 16 <sliced-groups> [ write-hex-line ] each-index ] bi ;
 
-: hexdump ( seq -- str )
+: hexdump ( byte-array -- str )
     [ hexdump. ] with-string-writer ;
diff --git a/basis/tools/vocabs/browser/browser-docs.factor b/basis/tools/vocabs/browser/browser-docs.factor
index 6c5fb596e8..508b4a3493 100644
--- a/basis/tools/vocabs/browser/browser-docs.factor
+++ b/basis/tools/vocabs/browser/browser-docs.factor
@@ -11,3 +11,7 @@ ARTICLE: "vocab-index" "Vocabulary index"
 { $subsection "vocab-tags" }
 { $subsection "vocab-authors" }
 { $describe-vocab "" } ;
+
+HELP: words.
+{ $values { "vocab" "a vocabulary name" } }
+{ $description "Printings a listing of all the words in a vocabulary, categorized by type." } ;
diff --git a/basis/ui/clipboards/clipboards.factor b/basis/ui/clipboards/clipboards.factor
index e1b591dfb9..42c3f6ddef 100644
--- a/basis/ui/clipboards/clipboards.factor
+++ b/basis/ui/clipboards/clipboards.factor
@@ -33,7 +33,7 @@ SYMBOL: selection
 
 : gadget-copy ( gadget clipboard -- )
     over gadget-selection?
-        [ >r [ gadget-selection ] keep r> copy-clipboard ]
+        [ [ [ gadget-selection ] keep ] dip copy-clipboard ]
         [ 2drop ]
     if ;
 
diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor
index 9ff3a59f71..5d3b8db19d 100644
--- a/basis/ui/cocoa/cocoa.factor
+++ b/basis/ui/cocoa/cocoa.factor
@@ -5,7 +5,7 @@ command-line kernel memory namespaces cocoa.messages
 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
 cocoa.windows cocoa.classes cocoa.application sequences system
 ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.cocoa.views core-foundation threads math.geometry.rect ;
+ui.cocoa.views core-foundation threads math.geometry.rect fry ;
 IN: ui.cocoa
 
 TUPLE: handle view window ;
@@ -15,7 +15,7 @@ C: <handle> handle
 SINGLETON: cocoa-ui-backend
 
 M: cocoa-ui-backend do-events ( -- )
-    [ NSApp [ do-event ] curry loop ui-wait ] with-autorelease-pool ;
+    [ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
 
 TUPLE: pasteboard handle ;
 
diff --git a/basis/ui/cocoa/tools/tools.factor b/basis/ui/cocoa/tools/tools.factor
index 876e9e5df1..a8ade05a86 100644
--- a/basis/ui/cocoa/tools/tools.factor
+++ b/basis/ui/cocoa/tools/tools.factor
@@ -25,7 +25,7 @@ CLASS: {
 }
 
 { "application:openFiles:" "void" { "id" "SEL" "id" "id" }
-    [ >r 3drop r> finder-run-files ]
+    [ [ 3drop ] dip finder-run-files ]
 }
 
 { "newFactorWorkspace:" "id" { "id" "SEL" "id" }
diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor
index 82a31ad0d9..1e35fcf4b2 100644
--- a/basis/ui/cocoa/views/views.factor
+++ b/basis/ui/cocoa/views/views.factor
@@ -8,7 +8,7 @@ core-foundation threads combinators math.geometry.rect ;
 IN: ui.cocoa.views
 
 : send-mouse-moved ( view event -- )
-    over >r mouse-location r> window move-hand fire-motion ;
+    [ mouse-location ] [ drop window ] 2bi move-hand fire-motion ;
 
 : button ( event -- n )
     #! Cocoa -> Factor UI button mapping
@@ -85,18 +85,19 @@ IN: ui.cocoa.views
     mouse-location rot window send-button-up ;
 
 : send-wheel$ ( view event -- )
-    over >r
-    dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
-    mouse-location
-    r> window send-wheel ;
+    [
+        dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
+        mouse-location
+    ] [ drop window ] 2bi send-wheel ;
 
 : send-action$ ( view event gesture -- junk )
-    >r drop window r> send-action f ;
+    [ drop window ] dip send-action f ;
 
 : add-resize-observer ( observer object -- )
-    >r "updateFactorGadgetSize:"
-    "NSViewFrameDidChangeNotification" <NSString>
-    r> add-observer ;
+    [
+        "updateFactorGadgetSize:"
+        "NSViewFrameDidChangeNotification" <NSString>
+    ] dip add-observer ;
 
 : string-or-nil? ( NSString -- ? )
     [ CF>string NSStringPboardType = ] [ t ] if* ;
@@ -109,7 +110,7 @@ IN: ui.cocoa.views
     ] if ;
 
 : NSRect>rect ( NSRect world -- rect )
-    >r dup NSRect-x over NSRect-y r>
+    [ dup NSRect-x over NSRect-y ] dip
     rect-dim second swap - 2array
     over NSRect-w rot NSRect-h 2array
     <rect> ;
@@ -256,7 +257,7 @@ CLASS: {
 { "validRequestorForSendType:returnType:" "id" { "id" "SEL" "id" "id" }
     [
         ! We return either self or nil
-        >r >r over window-focus r> r>
+        [ over window-focus ] 2dip
         valid-service? [ drop ] [ 2drop f ] if
     ]
 }
@@ -278,7 +279,7 @@ CLASS: {
 { "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" }
     [
         pasteboard-string dup [
-            >r drop window-focus r> swap user-input 1
+            [ drop window-focus ] dip swap user-input 1
         ] [
             3drop 0
         ] if
diff --git a/basis/ui/commands/commands.factor b/basis/ui/commands/commands.factor
index b45e2e4004..5f8c3381b7 100644
--- a/basis/ui/commands/commands.factor
+++ b/basis/ui/commands/commands.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel sequences strings
 math assocs words generic namespaces make assocs quotations
-splitting ui.gestures unicode.case unicode.categories tr ;
+splitting ui.gestures unicode.case unicode.categories tr fry ;
 IN: ui.commands
 
 SYMBOL: +nullary+
@@ -37,7 +37,7 @@ GENERIC: command-word ( command -- word )
         [
             commands>>
             [ drop ] assoc-filter
-            [ [ invoke-command ] curry swap set ] assoc-each
+            [ '[ _ invoke-command ] swap set ] assoc-each
         ] each
     ] H{ } make-assoc ;
 
diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor
index d2dfe56ed4..41d000af26 100644
--- a/basis/ui/freetype/freetype.factor
+++ b/basis/ui/freetype/freetype.factor
@@ -111,7 +111,7 @@ M: freetype-renderer open-font ( font -- open-font )
     freetype drop open-fonts get [ <font> ] cache ;
 
 : load-glyph ( font char -- glyph )
-    >r handle>> dup r> 0 FT_Load_Char
+    [ handle>> dup ] dip 0 FT_Load_Char
     freetype-error face-glyph ;
 
 : char-width ( open-font char -- w )
@@ -174,7 +174,7 @@ M: freetype-renderer string-height ( open-font string -- h )
     bi 2array ;
 
 : <char-sprite> ( open-font char -- sprite )
-    over >r render-glyph dup r> glyph-texture-loc
+    over [ render-glyph dup ] dip glyph-texture-loc
     over glyph-size pick glyph-texture-size <sprite>
     [ bitmap>texture ] keep [ init-sprite ] keep ;
 
@@ -206,7 +206,7 @@ M: freetype-renderer string-height ( open-font string -- h )
     fonts>> [ open-font H{ } clone 2array ] cache first2 ;
 
 M: freetype-renderer draw-string ( font string loc -- )
-    >r >r world get font-sprites r> r> (draw-string) ;
+    [ world get font-sprites ] 2dip (draw-string) ;
 
 : run-char-widths ( open-font string -- widths )
     char-widths [ scan-sums ] [ 2 v/n ] bi v+ ;
diff --git a/basis/ui/gadgets/books/books.factor b/basis/ui/gadgets/books/books.factor
index da0ff35728..4ef90d87b9 100644
--- a/basis/ui/gadgets/books/books.factor
+++ b/basis/ui/gadgets/books/books.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences models ui.gadgets math.geometry.rect ;
+USING: accessors kernel sequences models ui.gadgets
+math.geometry.rect fry ;
 IN: ui.gadgets.books
 
 TUPLE: book < gadget ;
@@ -25,6 +26,6 @@ M: book model-changed ( model book -- )
 M: book pref-dim* ( book -- dim ) children>> pref-dims max-dim ;
 
 M: book layout* ( book -- )
-    [ children>> ] [ dim>> ] bi [ >>dim drop ] curry each ;
+    [ children>> ] [ dim>> ] bi '[ _ >>dim drop ] each ;
 
 M: book focusable-child* ( book -- child/t ) current-page ;
diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor
index 01d695c281..c3a7216910 100644
--- a/basis/ui/gadgets/gadgets-tests.factor
+++ b/basis/ui/gadgets/gadgets-tests.factor
@@ -152,6 +152,13 @@ M: mock-gadget ungraft*
     { { f f } { f t } { t f } { t t } } [ notify-combo ] assoc-each
 ] with-string-writer print
 
+[ { { 10 30 } } ] [
+    <gadget> { 0 1 } >>orientation
+    { { 10 20 } }
+    { { 100 30 } }
+    orient
+] unit-test
+
 \ <gadget> must-infer
 \ unparent must-infer
 \ add-gadget must-infer
diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index 7d33ec21fd..51c8f07225 100644
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays hashtables kernel models math namespaces
 make sequences quotations math.vectors combinators sorting
 binary-search vectors dlists deques models threads
-concurrency.flags math.order math.geometry.rect ;
+concurrency.flags math.order math.geometry.rect fry ;
 IN: ui.gadgets
 
 SYMBOL: ui-notify-flag
@@ -56,9 +56,7 @@ M: gadget model-changed 2drop ;
     2dup eq? [
         2drop { 0 0 }
     ] [
-        over rect-loc >r
-        >r parent>> r> relative-loc
-        r> v+
+        over rect-loc [ [ parent>> ] dip relative-loc ] dip v+
     ] if ;
 
 GENERIC: user-input* ( str gadget -- ? )
@@ -73,7 +71,7 @@ M: gadget children-on nip children>> ;
     [ swap loc>> v- ] dip v. 0 <=> ;
 
 : (fast-children-on) ( dim axis children -- i )
-    -rot [ ((fast-children-on)) ] 2curry search drop ;
+    -rot '[ _ _ ((fast-children-on)) ] search drop ;
 
 : fast-children-on ( rect axis children -- from to )
     [ [ rect-loc ] 2dip (fast-children-on) 0 or ]
@@ -95,10 +93,10 @@ M: gadget children-on nip children>> ;
 : dim-sum ( seq -- dim ) { 0 0 } [ v+ ] reduce ;
 
 : orient ( gadget seq1 seq2 -- seq )
-    >r >r orientation>> r> r> [ pick set-axis ] 2map nip ;
+    rot orientation>> '[ _ set-axis ] 2map ;
 
 : each-child ( gadget quot -- )
-    >r children>> r> each ; inline
+    [ children>> ] dip each ; inline
 
 ! Selection protocol
 GENERIC: gadget-selection? ( gadget -- ? )
@@ -310,18 +308,18 @@ SYMBOL: in-layout?
     [ parent>> ] follow ;
 
 : each-parent ( gadget quot -- ? )
-    >r parents r> all? ; inline
+    [ parents ] dip all? ; inline
 
 : find-parent ( gadget quot -- parent )
-    >r parents r> find nip ; inline
+    [ parents ] dip find nip ; inline
 
 : screen-loc ( gadget -- loc )
     parents { 0 0 } [ rect-loc v+ ] reduce ;
 
 : (screen-rect) ( gadget -- loc ext )
     dup parent>> [
-        >r rect-extent r> (screen-rect)
-        >r tuck v+ r> vmin >r v+ r>
+        [ rect-extent ] dip (screen-rect)
+        [ tuck v+ ] dip vmin [ v+ ] dip
     ] [
         rect-extent
     ] if* ;
diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor
index feca8f7c63..8d79c9e07c 100755
--- a/basis/ui/gadgets/grid-lines/grid-lines.factor
+++ b/basis/ui/gadgets/grid-lines/grid-lines.factor
@@ -1,7 +1,8 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors math namespaces opengl opengl.gl sequences
-math.vectors ui.gadgets ui.gadgets.grids ui.render math.geometry.rect ;
+USING: kernel accessors math namespaces opengl opengl.gl
+sequences math.vectors ui.gadgets ui.gadgets.grids ui.render
+math.geometry.rect fry ;
 IN: ui.gadgets.grid-lines
 
 TUPLE: grid-lines color ;
@@ -19,8 +20,8 @@ SYMBOL: grid-dim
 
 : draw-grid-lines ( gaps orientation -- )
     [ grid get swap grid-positions grid get rect-dim suffix ] dip
-    [ [ v- ] curry map ] keep
-    [ swap grid-line-from/to gl-line ] curry each ;
+    [ '[ _ v- ] map ] keep
+    '[ _ swap grid-line-from/to gl-line ] each ;
 
 M: grid-lines draw-boundary
     color>> gl-color [
diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor
index 3e91e0ceb6..386457551f 100644
--- a/basis/ui/gadgets/grids/grids.factor
+++ b/basis/ui/gadgets/grids/grids.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math namespaces make sequences words io
 io.streams.string math.vectors ui.gadgets columns accessors
-math.geometry.rect locals ;
+math.geometry.rect locals fry ;
 IN: ui.gadgets.grids
 
 TUPLE: grid < gadget
@@ -48,21 +48,18 @@ grid
     dupd add-gaps dim-sum v+ ;
 
 M: grid pref-dim*
-    dup gap>> swap compute-grid >r over r>
-    gap-sum >r gap-sum r> (pair-up) ;
+    dup gap>> swap compute-grid [ over ] dip
+    [ gap-sum ] 2bi@ (pair-up) ;
 
 : do-grid ( dims grid quot -- )
-    -rot grid>>
-    [ [ pick call ] 2each ] 2each
-    drop ; inline
+    [ grid>> ] dip '[ _ 2each ] 2each ; inline
 
 : grid-positions ( grid dims -- locs )
-    >r gap>> dup r> add-gaps swap [ v+ ] accumulate nip ;
+    [ gap>> dup ] dip add-gaps swap [ v+ ] accumulate nip ;
 
 : position-grid ( grid horiz vert -- )
-    pick >r
-    >r over r> grid-positions >r grid-positions r>
-    pair-up r> [ (>>loc) ] do-grid ;
+    pick [ [ over ] dip [ grid-positions ] 2bi@ pair-up ] dip
+    [ (>>loc) ] do-grid ;
 
 : resize-grid ( grid horiz vert -- )
     pick fill?>> [
diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor
index 79a485b711..e4343e6280 100644
--- a/basis/ui/gadgets/labelled/labelled.factor
+++ b/basis/ui/gadgets/labelled/labelled.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays ui.gadgets.buttons ui.gadgets.borders
 ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
@@ -19,10 +19,10 @@ TUPLE: labelled-gadget < track content ;
 M: labelled-gadget focusable-child* content>> ;
 
 : <labelled-scroller> ( gadget title -- gadget )
-    >r <scroller> r> <labelled-gadget> ;
+    [ <scroller> ] dip <labelled-gadget> ;
 
 : <labelled-pane> ( model quot scrolls? title -- gadget )
-    >r >r <pane-control> r> >>scrolls? r>
+    [ [ <pane-control> ] dip >>scrolls? ] dip
     <labelled-scroller> ;
 
 : <close-box> ( quot -- button/f )
diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor
index 6e56b48c8b..5706f47639 100644
--- a/basis/ui/gadgets/labels/labels.factor
+++ b/basis/ui/gadgets/labels/labels.factor
@@ -13,7 +13,7 @@ TUPLE: label < gadget text font color ;
 
 : set-label-string ( string label -- )
     CHAR: \n pick memq? [
-        >r string-lines r> (>>text)
+        [ string-lines ] dip (>>text)
     ] [
         (>>text)
     ] if ; inline
diff --git a/basis/ui/gadgets/lists/lists.factor b/basis/ui/gadgets/lists/lists.factor
index ec46638c91..0113e1959d 100644
--- a/basis/ui/gadgets/lists/lists.factor
+++ b/basis/ui/gadgets/lists/lists.factor
@@ -33,7 +33,7 @@ TUPLE: list < pack index presenter color hook ;
     hook>> [ [ list? ] find-parent ] prepend ;
 
 : <list-presentation> ( hook elt presenter -- gadget )
-    keep >r >label text-theme r>
+    keep [ >label text-theme ] dip
     <presentation>
     swap >>hook ; inline
 
@@ -42,7 +42,7 @@ TUPLE: list < pack index presenter color hook ;
     [ presenter>> ]
     [ control-value ]
     tri [
-        >r 2dup r> swap <list-presentation>
+        [ 2dup ] dip swap <list-presentation>
     ] map 2nip ;
 
 M: list model-changed
@@ -113,8 +113,8 @@ M: list focusable-child* drop t ;
     select-gadget ;
 
 : list-page ( list vec -- )
-    >r dup selected-rect rect-bounds 2 v/n v+
-    over visible-dim r> v* v+ swap select-at ;
+    [ dup selected-rect rect-bounds 2 v/n v+ over visible-dim ] dip
+    v* v+ swap select-at ;
 
 : list-page-up ( list -- ) { 0 -1 } list-page ;
 
diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor
index e973dd07dc..cbcfdb14d8 100644
--- a/basis/ui/gadgets/menus/menus.factor
+++ b/basis/ui/gadgets/menus/menus.factor
@@ -8,13 +8,13 @@ math.geometry.rect ;
 IN: ui.gadgets.menus
 
 : menu-loc ( world menu -- loc )
-    >r rect-dim r> pref-dim [v-] hand-loc get-global vmin ;
+    [ rect-dim ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
 
 TUPLE: menu-glass < gadget ;
 
 : <menu-glass> ( menu world -- glass )
     menu-glass new-gadget
-    >r over menu-loc >>loc r>
+    [ over menu-loc >>loc ] dip
     swap add-gadget ;
 
 M: menu-glass layout* gadget-child prefer ;
diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor
index 32a60374eb..5965e8b568 100644
--- a/basis/ui/gadgets/packs/packs.factor
+++ b/basis/ui/gadgets/packs/packs.factor
@@ -19,10 +19,10 @@ TUPLE: pack < gadget
     { 0 0 } [ v+ over v+ ] accumulate 2nip ;
 
 : aligned-locs ( gadget sizes -- seq )
-    [ >r dup align>> swap rect-dim r> v- n*v ] with map ;
+    [ [ dup align>> swap rect-dim ] dip v- n*v ] with map ;
 
 : packed-locs ( gadget sizes -- seq )
-    over gap>> over gap-locs >r dupd aligned-locs r> orient ;
+    over gap>> over gap-locs [ dupd aligned-locs ] dip orient ;
 
 : round-dims ( seq -- newseq )
     { 0 0 } swap
@@ -31,8 +31,9 @@ TUPLE: pack < gadget
 
 : pack-layout ( pack sizes -- )
     round-dims over children>>
-    >r dupd packed-dims r> 2dup [ (>>dim) ] 2each
-    >r packed-locs r> [ (>>loc) ] 2each ;
+    [ dupd packed-dims ] dip
+    [ [ (>>dim) ] 2each ]
+    [ [ packed-locs ] dip [ (>>loc) ] 2each ] 2bi ;
 
 : <pack> ( orientation -- pack )
     pack new-gadget
@@ -48,7 +49,7 @@ TUPLE: pack < gadget
     [ dim-sum ] keep length 1 [-] rot n*v v+ ;
 
 : pack-pref-dim ( gadget sizes -- dim )
-    over gap>> over gap-dims >r max-dim r>
+    over gap>> over gap-dims [ max-dim ] dip
     rot orientation>> set-axis ;
 
 M: pack pref-dim*
diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index c612cbef0a..9a30cee777 100644
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -9,7 +9,7 @@ opengl combinators math.vectors sorting splitting
 io.streams.nested assocs ui.gadgets.presentations
 ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
 classes.tuple models continuations destructors accessors
-math.geometry.rect ;
+math.geometry.rect fry ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < pack
@@ -59,7 +59,7 @@ M: pane gadget-selection ( pane -- string/f )
 GENERIC: draw-selection ( loc obj -- )
 
 : if-fits ( rect quot -- )
-    >r clip get over intersects? r> [ drop ] if ; inline
+    [ clip get over intersects? ] dip [ drop ] if ; inline
 
 M: gadget draw-selection ( loc gadget -- )
     swap offset-rect [
@@ -135,8 +135,8 @@ M: style-stream write-gadget
 
 : with-pane ( pane quot -- )
     over scroll>top
-    over pane-clear >r <pane-stream> r>
-    over >r with-output-stream* r> ?nl ; inline
+    over pane-clear [ <pane-stream> ] dip
+    over [ with-output-stream* ] dip ?nl ; inline
 
 : make-pane ( quot -- gadget )
     <pane> [ swap with-pane ] keep smash-pane ; inline
@@ -154,7 +154,7 @@ M: pane-control model-changed ( model pane-control -- )
         swap >>model ;
 
 : do-pane-stream ( pane-stream quot -- )
-    >r pane>> r> keep scroll-pane ; inline
+    [ pane>> ] dip keep scroll-pane ; inline
 
 M: pane-stream stream-nl
     [ pane-nl drop ] do-pane-stream ;
@@ -178,7 +178,7 @@ M: pane-stream make-span-stream
 ! Character styles
 
 : apply-style ( style gadget key quot -- style gadget )
-    >r pick at r> when* ; inline
+    [ pick at ] dip when* ; inline
 
 : apply-foreground-style ( style gadget -- style gadget )
     foreground [ >>color ] apply-style ;
@@ -228,7 +228,7 @@ M: pane-stream make-span-stream
     border-width [ <border> ] apply-style ;
 
 : apply-printer-style ( style gadget -- style gadget )
-    presented-printer [ [ make-pane ] curry >>printer ] apply-style ;
+    presented-printer [ '[ _ make-pane ] >>printer ] apply-style ;
 
 : style-pane ( style pane -- pane )
     apply-border-width-style
@@ -284,10 +284,10 @@ M: pane-stream make-cell-stream
     pane-cell-stream new-nested-pane-stream ;
 
 M: pane-stream stream-write-table
-    >r
-    swap [ [ pane>> smash-pane ] map ] map
-    styled-grid
-    r> print-gadget ;
+    [
+        swap [ [ pane>> smash-pane ] map ] map
+        styled-grid
+    ] dip print-gadget ;
 
 ! Stream utilities
 M: pack dispose drop ;
@@ -309,7 +309,7 @@ M: paragraph stream-write
     drop ;
 
 : gadget-write1 ( char gadget -- )
-    >r 1string r> stream-write ;
+    [ 1string ] dip stream-write ;
 
 M: pack stream-write1 gadget-write1 ;
 
diff --git a/basis/ui/gadgets/presentations/presentations.factor b/basis/ui/gadgets/presentations/presentations.factor
index c5f078e82e..e39069ed7b 100644
--- a/basis/ui/gadgets/presentations/presentations.factor
+++ b/basis/ui/gadgets/presentations/presentations.factor
@@ -12,7 +12,7 @@ TUPLE: presentation < button object hook ;
 
 : invoke-presentation ( presentation command -- )
     over dup hook>> call
-    >r object>> r> invoke-command ;
+    [ object>> ] dip invoke-command ;
 
 : invoke-primary ( presentation -- )
     dup object>> primary-operation
diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index f42d65f738..968972a869 100644
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -4,7 +4,7 @@ USING: accessors arrays ui.gestures ui.gadgets ui.gadgets.buttons
 ui.gadgets.frames ui.gadgets.grids math.order
 ui.gadgets.theme ui.render kernel math namespaces sequences
 vectors models models.range math.vectors math.functions
-quotations colors math.geometry.rect ;
+quotations colors math.geometry.rect fry ;
 IN: ui.gadgets.sliders
 
 TUPLE: elevator < gadget direction ;
@@ -104,13 +104,14 @@ elevator H{
 
 : layout-thumb-loc ( slider -- )
     dup thumb-loc (layout-thumb)
-    >r [ floor ] map r> (>>loc) ;
+    [ [ floor ] map ] dip (>>loc) ;
 
 : layout-thumb-dim ( slider -- )
-    dup dup thumb-dim (layout-thumb) >r
-    >r dup rect-dim r>
-    rot orientation>> set-axis [ ceiling ] map
-    r> (>>dim) ;
+    dup dup thumb-dim (layout-thumb)
+    [
+        [ dup rect-dim ] dip
+        rot orientation>> set-axis [ ceiling ] map
+    ] dip (>>dim) ;
 
 : layout-thumb ( slider -- )
     dup layout-thumb-loc layout-thumb-dim ;
@@ -121,13 +122,13 @@ M: elevator layout*
 : slide-by-line ( amount slider -- ) [ line>> * ] keep slide-by ;
 
 : <slide-button> ( vector polygon amount -- button )
-    >r gray swap <polygon-gadget> r>
-    [ swap find-slider slide-by-line ] curry <repeat-button>
+    [ gray swap <polygon-gadget> ] dip
+    '[ _ swap find-slider slide-by-line ] <repeat-button>
     swap >>orientation ;
 
 : elevator, ( gadget orientation -- gadget )
     tuck <elevator> >>elevator
-    swap <thumb>    >>thumb
+    swap <thumb> >>thumb
     dup elevator>> over thumb>> add-gadget
     @center grid-add ;
 
diff --git a/basis/ui/gadgets/status-bar/status-bar.factor b/basis/ui/gadgets/status-bar/status-bar.factor
index 431804f4ca..32abcd5466 100644
--- a/basis/ui/gadgets/status-bar/status-bar.factor
+++ b/basis/ui/gadgets/status-bar/status-bar.factor
@@ -16,4 +16,4 @@ IN: ui.gadgets.status-bar
     open-world-window ;
 
 : show-summary ( object gadget -- )
-    >r [ summary ] [ "" ] if* r> show-status ;
+    [ [ summary ] [ "" ] if* ] dip show-status ;
diff --git a/basis/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor
index 9dd152885e..35781fa568 100644
--- a/basis/ui/gadgets/worlds/worlds-docs.factor
+++ b/basis/ui/gadgets/worlds/worlds-docs.factor
@@ -53,3 +53,20 @@ HELP: draw-world
 { $values { "world" world } }
 { $description "Redraws a world." }
 { $notes "This word should only be called by the UI backend. To force a gadget to redraw from user code, call " { $link relayout-1 } "." } ;
+
+HELP: find-gl-context
+{ $values { "gadget" gadget } }
+{ $description "Makes the OpenGL context of the gadget's containing native window the current OpenGL context." }
+{ $notes "This word should be called from " { $link graft* } " and " { $link ungraft* } " methods which need to allocate and deallocate OpenGL resources, such as textures, display lists, and so on." } ;
+
+ARTICLE: "ui-paint-custom" "Implementing custom drawing logic"
+"The UI uses OpenGL to render gadgets. Custom rendering logic can be plugged in with the " { $link "ui-pen-protocol" } ", or by implementing a generic word:"
+{ $subsection draw-gadget* }
+"Custom drawing code has access to the full OpenGL API in the " { $vocab-link "opengl" } " vocabulary."
+$nl
+"Gadgets which need to allocate and deallocate OpenGL resources such as textures, display lists, and so on, should perform the allocation in the " { $link graft* } " method, and the deallocation in the " { $link ungraft* } " method. Since those words are not necessarily called with the gadget's OpenGL context active, a utility word can be used to find and make the correct OpenGL context current:"
+{ $subsection find-gl-context }
+"OpenGL state must not be altered as a result of drawing a gadget, so any flags which were enabled should be disabled, and vice versa."
+{ $subsection "ui-paint-coord" }
+{ $subsection "gl-utilities" }
+{ $subsection "text-rendering" } ;
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 904a2a5bac..98c3258911 100644
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -52,7 +52,7 @@ M: world request-focus-on ( child gadget -- )
 M: world layout*
     dup call-next-method
     dup glass>> [
-        >r dup rect-dim r> (>>dim)
+        [ dup rect-dim ] dip (>>dim)
     ] when* drop ;
 
 M: world focusable-child* gadget-child ;
diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor
index 1e472e921f..602d3fd425 100644
--- a/basis/ui/gestures/gestures-docs.factor
+++ b/basis/ui/gestures/gestures-docs.factor
@@ -191,6 +191,43 @@ HELP: gesture>string
     { $example "USING: io ui.gestures ;" "T{ key-down f { C+ } \"x\" } gesture>string print" "C+x" }
 } ;
 
+HELP: left-action
+{ $class-description "Gesture sent when the user performs a multi-touch three-finger swipe left." } ;
+
+HELP: right-action
+{ $class-description "Gesture sent when the user performs a multi-touch three-finger swipe right." } ;
+
+HELP: up-action
+{ $class-description "Gesture sent when the user performs a multi-touch three-finger swipe up." } ;
+
+HELP: down-action
+{ $class-description "Gesture sent when the user performs a multi-touch three-finger swipe down." } ;
+
+HELP: zoom-in-action
+{ $class-description "Gesture sent when the user performs a multi-touch two-finger pinch in." } ;
+
+HELP: zoom-out-action
+{ $class-description "Gesture sent when the user performs a multi-touch two-finger pinch out." } ;
+
+ARTICLE: "gesture-differences" "Gesture handling differences between platforms"
+"On Mac OS X, the modifier keys map as follows:"
+{ $table
+    { { $link S+ } "Shift" }
+    { { $link A+ } "Command (Apple)" }
+    { { $link C+ } "Control" }
+    { { $link M+ } "Option" }
+}
+"On Windows and X11:"
+{ $table
+    { { $link S+ } "Shift" }
+    { { $link A+ } "Alt" }
+    { { $link C+ } "Control" }
+    { { $link M+ } "Windows key" }
+}
+"On Windows, " { $link key-up } " gestures are not reported for all keyboard events."
+$nl
+{ $link "multitouch-gestures" } " are only supported on Mac OS X." ;
+
 ARTICLE: "ui-gestures" "UI gestures"
 "User actions such as keyboard input and mouse button clicks deliver " { $emphasis "gestures" } " to gadgets. If the direct receiver of the gesture does not handle it, the gesture is passed on to the receiver's parent, and this way it travels up the gadget hierarchy. Gestures which are not handled at some point are ignored."
 $nl
@@ -207,6 +244,9 @@ $nl
 { $subsection "ui-user-input" }
 "Mouse input:"
 { $subsection "mouse-gestures" }
+{ $subsection "multitouch-gestures" }
+"Guidelines for cross-platform applications:"
+{ $subsection "gesture-differences" }
 "Abstractions built on top of gestures:"
 { $subsection "ui-commands" }
 { $subsection "ui-operations" } ;
@@ -301,6 +341,18 @@ $nl
 "Global variable set when a mouse scroll wheel gesture is sent:"
 { $subsection scroll-direction } ;
 
+ARTICLE: "multitouch-gestures" "Multi-touch gestures"
+"Multi-touch gestures are only supported on Mac OS X with newer MacBook and MacBook Pro models."
+$nl
+"Three-finger swipe:"
+{ $subsection left-action }
+{ $subsection right-action }
+{ $subsection up-action }
+{ $subsection down-action }
+"Two-finger pinch:"
+{ $subsection zoom-in-action }
+{ $subsection zoom-out-action } ;
+
 ARTICLE: "action-gestures" "Action gestures"
 "Action gestures exist to keep keyboard shortcuts for common clipboard operations consistent."
 { $subsection cut-action }
diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor
index 8e83f69edb..660ae1f43d 100644
--- a/basis/ui/operations/operations.factor
+++ b/basis/ui/operations/operations.factor
@@ -38,7 +38,7 @@ SYMBOL: operations
     operations get [ predicate>> call ] with filter ;
 
 : find-operation ( obj quot -- command )
-    >r object-operations r> find-last nip ; inline
+    [ object-operations ] dip find-last nip ; inline
 
 : primary-operation ( obj -- operation )
     [ command>> +primary+ word-prop ] find-operation ;
diff --git a/basis/ui/render/render-docs.factor b/basis/ui/render/render-docs.factor
index 294ee1c63d..7f88a904ec 100644
--- a/basis/ui/render/render-docs.factor
+++ b/basis/ui/render/render-docs.factor
@@ -1,5 +1,6 @@
 USING: ui.gadgets ui.gestures help.markup help.syntax
-kernel classes strings opengl.gl models math.geometry.rect ;
+kernel classes strings opengl opengl.gl models
+math.geometry.rect ;
 IN: ui.render
 
 HELP: gadget
@@ -128,21 +129,11 @@ $nl
 { $subsection draw-string }
 { $subsection draw-text } ;
 
-ARTICLE: "ui-paint-custom" "Implementing custom drawing logic"
-"The UI uses OpenGL to render gadgets. Custom rendering logic can be plugged in with the " { $link "ui-pen-protocol" } ", or by implementing a generic word:"
-{ $subsection draw-gadget* }
-"Custom drawing code has access to the full OpenGL API in the " { $vocab-link "opengl" } " vocabulary."
-$nl
+ARTICLE: "ui-paint-coord" "The UI co-ordinate system"
 "The UI uses a co-ordinate system where the y axis is oriented down. The OpenGL " { $link GL_MODELVIEW } " matrix is not saved or restored when rendering a gadget. Instead, the origin of the gadget relative to the OpenGL context is stored in a variable:"
 { $subsection origin }
-"Custom drawing implementations can translate co-ordinates manually, or save and restore the " { $link GL_MODELVIEW } " matrix."
+"Custom drawing implementations can translate co-ordinates manually, or save and restore the " { $link GL_MODELVIEW } " matrix using a word such as " { $link with-translation } "."
 $nl
-"OpenGL state must not be altered as a result of drawing a gadget, so any flags which were enabled should be disabled, and vice versa."
-$nl
-"Gadgets must not draw outside of their bounding box, however clipping is not enforced by default, for performance reasons. This can be changed by setting the " { $snippet "clipped?" } " slot to " { $link t } " in the gadget's constructor."
-$nl
-"Saving the " { $link GL_MODELVIEW } " matrix and enabling/disabling flags can be done in a clean way using the combinators documented in the following section."
-{ $subsection "gl-utilities" }
-{ $subsection "text-rendering" } ;
+"Gadgets must not draw outside of their bounding box, however clipping is not enforced by default, for performance reasons. This can be changed by setting the " { $slot "clipped?" } " slot to " { $link t } " in the gadget's constructor." ;
 
 ABOUT: "ui-paint-custom"
diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index 36c0d5f256..55b8a82ac1 100755
--- a/basis/ui/render/render.factor
+++ b/basis/ui/render/render.factor
@@ -12,7 +12,7 @@ SYMBOL: viewport-translation
 
 : flip-rect ( rect -- loc dim )
     rect-bounds [
-        >r { 1 -1 } v* r> { 0 -1 } v* v+
+        [ { 1 -1 } v* ] dip { 0 -1 } v* v+
         viewport-translation get v+
     ] keep ;
 
@@ -79,9 +79,7 @@ DEFER: draw-gadget
     >absolute clip [ rect-intersect ] change ;
 
 : with-clipping ( gadget quot -- )
-    clip get >r
-    over change-clip do-clip call
-    r> clip set do-clip ; inline
+    clip get [ over change-clip do-clip call ] dip clip set do-clip ; inline
 
 : draw-gadget ( gadget -- )
     {
@@ -200,7 +198,7 @@ M: polygon draw-interior
 
 : <polygon-gadget> ( color points -- gadget )
     dup max-dim
-    >r <polygon> <gadget> r> >>dim
+    [ <polygon> <gadget> ] dip >>dim
     swap >>interior ;
 
 ! Font rendering
@@ -242,7 +240,7 @@ HOOK: free-fonts font-renderer ( world -- )
         [
             [
                 2dup { 0 0 } draw-string
-                >r open-font r> string-height
+                [ open-font ] dip string-height
                 0.0 swap 0.0 glTranslated
             ] with each
         ] with-translation
diff --git a/basis/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor
index f310f72780..5a99d1174b 100644
--- a/basis/ui/tools/deploy/deploy.factor
+++ b/basis/ui/tools/deploy/deploy.factor
@@ -1,12 +1,11 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ui.gadgets colors kernel ui.render namespaces
-       models models.mapping sequences ui.gadgets.buttons
-       ui.gadgets.packs ui.gadgets.labels tools.deploy.config
-       namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
-       ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
-       tools.deploy vocabs ui.tools.workspace system accessors ;
-
+USING: ui.gadgets colors kernel ui.render namespaces models
+models.mapping sequences ui.gadgets.buttons ui.gadgets.packs
+ui.gadgets.labels tools.deploy.config namespaces
+ui.gadgets.editors ui.gadgets.borders ui.gestures ui.commands
+assocs ui.gadgets.tracks ui ui.tools.listener tools.deploy
+vocabs ui.tools.workspace system accessors fry ;
 IN: ui.tools.deploy
 
 TUPLE: deploy-gadget < pack vocab settings ;
@@ -83,7 +82,7 @@ TUPLE: deploy-gadget < pack vocab settings ;
 
 : com-deploy ( gadget -- )
     dup com-save
-    dup find-deploy-vocab [ deploy ] curry call-listener
+    dup find-deploy-vocab '[ _ deploy ] call-listener
     close-window ;
 
 : com-help ( -- )
diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor
index 5739a469ea..0676619b07 100644
--- a/basis/ui/tools/interactor/interactor.factor
+++ b/basis/ui/tools/interactor/interactor.factor
@@ -7,7 +7,7 @@ quotations sequences strings threads listener classes.tuple
 ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.status-bar
 ui.gadgets.presentations ui.gadgets.worlds ui.gestures
 definitions calendar concurrency.flags concurrency.mailboxes
-ui.tools.workspace accessors sets destructors ;
+ui.tools.workspace accessors sets destructors fry ;
 IN: ui.tools.interactor
 
 ! If waiting is t, we're waiting for user input, and invoking
@@ -88,7 +88,7 @@ M: interactor model-changed
     [ editor-string ] keep
     [ interactor-input. ] 2keep
     [ add-interactor-history ] keep
-    [ clear-input ] curry "Clearing input" spawn drop ;
+    '[ _ clear-input ] "Clearing input" spawn drop ;
 
 : interactor-eof ( interactor -- )
     dup interactor-busy? [
@@ -126,7 +126,7 @@ M: interactor stream-read
     swap dup zero? [
         2drop ""
     ] [
-        >r interactor-read dup [ "\n" join ] when r> short head
+        [ interactor-read dup [ "\n" join ] when ] dip short head
     ] if ;
 
 M: interactor stream-read-partial
diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index de0ce43f20..7ffbfd2738 100644
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -28,7 +28,7 @@ M: listener-gadget focusable-child*
     input>> ;
 
 M: listener-gadget call-tool* ( input listener -- )
-    >r string>> r> input>> set-editor-string ;
+    [ string>> ] dip input>> set-editor-string ;
 
 M: listener-gadget tool-scroller
     output>> find-scroller ;
@@ -95,13 +95,13 @@ M: engine-word word-completion-string
 : use-if-necessary ( word seq -- )
     over vocabulary>> over and [
         2dup [ assoc-stack ] keep = [ 2drop ] [
-            >r vocabulary>> vocab-words r> push
+            [ vocabulary>> vocab-words ] dip push
         ] if
     ] [ 2drop ] if ;
 
 : insert-word ( word -- )
     get-workspace listener>> input>>
-    [ >r word-completion-string r> user-input* drop ]
+    [ [ word-completion-string ] dip user-input* drop ]
     [ interactor-use use-if-necessary ]
     2bi ;
 
diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor
index 05d1ccdb82..7280efe885 100644
--- a/basis/ui/tools/profiler/profiler.factor
+++ b/basis/ui/tools/profiler/profiler.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: ui.tools.workspace kernel quotations tools.profiler
 ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
-ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors ;
+ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors fry ;
 IN: ui.tools.profiler
 
 TUPLE: profiler-gadget < track pane ;
@@ -14,7 +14,7 @@ TUPLE: profiler-gadget < track pane ;
         dup pane>> <scroller> 1 track-add ;
 
 : with-profiler-pane ( gadget quot -- )
-    >r pane>> r> with-pane ;
+    [ pane>> ] dip with-pane ;
 
 : com-full-profile ( gadget -- )
     [ profile. ] with-profiler-pane ;
@@ -39,10 +39,10 @@ profiler-gadget "toolbar" f {
 GENERIC: profiler-presentation ( obj -- quot )
 
 M: usage-profile profiler-presentation
-    word>> [ usage-profile. ] curry ;
+    word>> '[ _ usage-profile. ] ;
 
 M: vocab-profile profiler-presentation
-    vocab>> [ vocab-profile. ] curry ;
+    vocab>> '[ _ vocab-profile. ] ;
 
 M: f profiler-presentation
     drop [ vocabs-profile. ] ;
diff --git a/basis/ui/tools/search/search-tests.factor b/basis/ui/tools/search/search-tests.factor
index c8c7c6c219..39a6442308 100644
--- a/basis/ui/tools/search/search-tests.factor
+++ b/basis/ui/tools/search/search-tests.factor
@@ -19,7 +19,7 @@ IN: ui.tools.search.tests
     ] with-grafted-gadget ;
 
 : test-live-search ( gadget quot -- ? )
-    >r update-live-search dup assert-non-empty r> all? ;
+    [ update-live-search dup assert-non-empty ] dip all? ;
 
 [ t ] [
     "swp" all-words f <definition-search>
diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor
index 6368737460..8e1cc8d8f0 100644
--- a/basis/ui/tools/tools-docs.factor
+++ b/basis/ui/tools/tools-docs.factor
@@ -76,17 +76,6 @@ $nl
 
 ;
 
-ARTICLE: "ui-tool-tutorial" "UI tool tutorial"
-"The following is an example of a typical session with the UI which should give you a taste of its power:"
-{ $list
-    { "You decide to refactor some code, and move a few words from a source file you have already loaded, into a new source file." }
-    { "You press " { $operation edit } " in the listener, which displays a gadget where you can type part of a loaded file's name, and then press " { $snippet "RET" } " when the correct completion is highlighted. This opens the file in your editor." } 
-    { "You refactor your words, move them to a new source file, and load the new file using " { $link run-file } "." }
-    { "Interactively testing the new code reveals a problem with one particular code snippet, so you enter it in the listener's input area, and press " { $operation walk } " to invoke the single stepper." }
-    { "Single stepping through the code makes the problem obvious, so you right-click on a presentation of the broken word in the stepper, and choose " { $strong "Edit" } " from the menu." }
-    { "After fixing the problem in the source editor, you right click on the word in the stepper and invoke " { $strong "Reload" } " from the menu." }
-} ;
-
 ARTICLE: "ui-completion-words" "Word completion popup"
 "Clicking a word in the word completion popup displays the word definition in the " { $link "ui-browser" } ". Pressing " { $snippet "RET" } " with a word selected inserts the word name in the listener, along with a " { $link POSTPONE: USE: } " declaration (if necessary)."
 { $operations \ $operations } ;
@@ -110,18 +99,16 @@ $nl
 { $subsection "ui-completion-sources" } ;
 
 ARTICLE: "ui-workspace-keys" "UI keyboard shortcuts"
+"See " { $link "gesture-differences" } " to find out how your platform's modifier keys map to modifiers in the Factor UI."
 { $command-map workspace "tool-switching" }
 { $command-map workspace "scrolling" }
 { $command-map workspace "workflow" }
-{ $command-map workspace "multi-touch" }
-{ $heading "Implementation" }
-"Workspaces are instances of " { $link workspace } "." ;
+{ $command-map workspace "multi-touch" } ;
 
 ARTICLE: "ui-tools" "UI developer tools"
 "The Factor development environment can seem rather different from what you are used to, because it is very simple and powerful.."
 $nl
 "To take full advantage of the UI, you should be using a supported text editor. See " { $link "editor" } "."
-{ $subsection "ui-tool-tutorial" }
 { $subsection "ui-workspace-keys" }
 { $subsection "ui-presentations" }
 { $subsection "ui-completion" }
diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor
index 3310a3e0a5..9927f9e5ae 100644
--- a/basis/ui/tools/tools.factor
+++ b/basis/ui/tools/tools.factor
@@ -9,7 +9,7 @@ ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
 ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
 ui.gadgets.presentations ui.gestures words vocabs.loader
 tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
-mirrors ;
+mirrors fry ;
 IN: ui.tools
 
 : <workspace-tabs> ( workspace -- tabs )
@@ -93,7 +93,7 @@ workspace "workflow" f {
 ] workspace-window-hook set-global
 
 : inspect-continuation ( traceback -- )
-    control-value [ inspect ] curry call-listener ;
+    control-value '[ _ inspect ] call-listener ;
 
 traceback-gadget "toolbar" f {
     { T{ key-down f f "v" } variables }
diff --git a/basis/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor
index 9c825d4920..e6643698c7 100644
--- a/basis/ui/tools/walker/walker.factor
+++ b/basis/ui/tools/walker/walker.factor
@@ -5,7 +5,7 @@ ui.tools.listener ui.tools.traceback ui.gadgets.buttons
 ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets
 models models.filter ui.tools.workspace ui.gestures
 ui.gadgets.labels ui threads namespaces make tools.walker assocs
-combinators ;
+combinators fry ;
 IN: ui.tools.walker
 
 TUPLE: walker-gadget < track
@@ -53,7 +53,7 @@ M: walker-gadget focusable-child*
     ] "" make ;
 
 : <thread-status> ( model thread -- gadget )
-    [ walker-state-string ] curry <filter> <label-control> ;
+    '[ _ walker-state-string ] <filter> <label-control> ;
 
 : <walker-gadget> ( status continuation thread -- gadget )
     { 0 1 } walker-gadget new-track
@@ -89,7 +89,7 @@ walker-gadget "toolbar" f {
     } cond ;
 
 : find-walker-window ( thread -- world/f )
-    [ swap walker-for-thread? ] curry find-window ;
+    '[ _ swap walker-for-thread? ] find-window ;
 
 : walker-window ( status continuation thread -- )
     [ <walker-gadget> ] [ name>> ] bi open-status-window ;
diff --git a/basis/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor
index 6536cb8c7d..3b689eee39 100644
--- a/basis/ui/tools/workspace/workspace.factor
+++ b/basis/ui/tools/workspace/workspace.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
-sequences assocs arrays namespaces accessors math.vectors ui
+sequences assocs arrays namespaces accessors math.vectors fry ui
 ui.backend ui.tools.debugger ui.gadgets ui.gadgets.books
 ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.panes
 ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
@@ -33,7 +33,7 @@ M: gadget tool-scroller drop f ;
     set-model ;
 
 : get-workspace* ( quot -- workspace )
-    [ >r dup workspace? r> [ drop f ] if ] curry find-window
+    '[ dup workspace? _ [ drop f ] if ] find-window
     [ dup raise-window gadget-child ]
     [ workspace-window* ] if* ; inline
 
diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor
index 978bd24055..de2df4ee6e 100644
--- a/basis/ui/ui-docs.factor
+++ b/basis/ui/ui-docs.factor
@@ -1,6 +1,6 @@
 USING: help.markup help.syntax strings quotations debugger
 io.styles namespaces ui.backend ui.gadgets ui.gadgets.worlds
-ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids math.geometry.rect ;
+ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids math.geometry.rect colors ;
 IN: ui
 
 HELP: windows
@@ -47,18 +47,19 @@ HELP: (open-window)
 { $description "Opens a native window containing the given world. This grafts the world by calling " { $link graft } ". Each world can only be displayed in one top-level window at a time." }
 { $notes "This word should not be called directly by user code. Instead, use " { $link open-window } "." } ;
 
+HELP: raise-window
+{ $values { "gadget" gadget } }
+{ $description "Makes the native window containing the given gadget the front-most window." } ;
+
+HELP: with-ui
+{ $values { "quot" quotation } }
+{ $description "Calls the quotation, starting the UI first if necessary." }
+{ $notes "This combinator should be used in the " { $link POSTPONE: MAIN: } " word of a vocabulary, in order for the vocabulary to work when run from the UI listener (" { $snippet "\"my-app\" run" } " and the command line (" { $snippet "./factor -run=my-app" } ")." }
+{ $examples "The " { $vocab-link "hello-ui" } " vocabulary implements a simple UI application which uses this combinator." } ;
+
 ARTICLE: "ui-glossary" "UI glossary"
 { $table
-    { "color specifier"
-        { "an array of four elements, all numbers between 0 and 1:"
-            { $list
-                "red"
-                "green"
-                "blue"
-                "alpha - 0 is completely transparent, 1 is completely opaque"
-            }
-        }
-    }
+    { "color" { "an instance of " { $link color } } }
     { "dimension" "a pair of integers denoting pixel size on screen" }
     { "font specifier"
         { "an array of three elements:"
@@ -129,9 +130,7 @@ ARTICLE: "ui-backend" "Developing UI backends"
 "UI backends may implement the " { $link "clipboard-protocol" } "." ;
 
 ARTICLE: "ui-backend-init" "UI initialization and the event loop"
-"An UI backend is required to define a word to start the UI:"
-{ $subsection ui }
-"This word should contain backend initialization, together with some boilerplate:"
+"An UI backend is required to define a method on the " { $link ui } " word. This word should contain backend initialization, together with some boilerplate:"
 { $code
     "IN: shells"
     ""
@@ -163,10 +162,6 @@ ARTICLE: "ui-backend-windows" "UI backend window management"
 "If the user clicks the window's close box, you must call the following word:"
 { $subsection close-window } ;
 
-HELP: raise-window
-{ $values { "gadget" gadget } }
-{ $description "Makes the native window containing the given gadget the front-most window." } ;
-
 ARTICLE: "ui-layouts" "Gadget hierarchy and layouts"
 "A layout gadget is a gadget whose sole purpose is to contain other gadgets. Layout gadgets position and resize children according to a certain policy, taking the preferred size of the children into account. Gadget hierarchies are constructed by building up nested layouts."
 { $subsection "ui-layout-basics" }
@@ -240,7 +235,23 @@ $nl
 { $subsection "clipboard-protocol" }
 { $see-also "ui-layout-impl" } ;
 
+ARTICLE: "starting-ui" "Starting the UI"
+"The UI starts automatically where possible:"
+{ $list
+    { "On Windows, the UI starts when the Factor executable is run." }
+    { "On X11, the UI starts if the " { $snippet "DISPLAY" } " environment variable is set." }
+    { "On Mac OS X, the UI starts if the " { $snippet "Factor.app" } " application bundle is run." }
+}
+"In all cases, passing the " { $snippet "-run=listener" } " command line switch starts the terminal listener instead. The UI can be started from the terminal listener using a word:"
+{ $subsection ui }
+"To run the terminal listener and the UI simultaneously, start the UI in a new thread:"
+{ $code "USING: threads ui ;" "[ ui ] in-thread" }
+"The main word of a vocabulary implementing a UI application should use a combinator to ensure that the application works when run from the command line as well as in the UI listener:"
+{ $subsection with-ui } ;
+
 ARTICLE: "ui" "UI framework"
+"The " { $vocab-link "ui" } " vocabulary hierarchy implements the Factor UI framework. The implementation relies on a small amount of platform-specific code to open windows and receive keyboard and mouse events; UI gadgets are rendered using OpenGL."
+{ $subsection "starting-ui" }
 { $subsection "ui-glossary" }
 { $subsection "building-ui" }
 { $subsection "new-gadgets" }
diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor
index 99a7d5fe0f..6e1ce8f77f 100755
--- a/basis/ui/windows/windows.factor
+++ b/basis/ui/windows/windows.factor
@@ -285,10 +285,10 @@ SYMBOL: nc-buttons
     swap [ push ] [ delete ] if ;
 
 : >lo-hi ( WORD -- array ) [ lo-word ] keep hi-word 2array ;
-: mouse-wheel ( lParam -- array ) >lo-hi [ sgn neg ] map ;
+: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
 
 : mouse-absolute>relative ( lparam handle -- array )
-    >r >lo-hi r>
+    [ >lo-hi ] dip
     "RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep
     get-RECT-top-left 2array v- ;
 
@@ -297,7 +297,7 @@ SYMBOL: nc-buttons
     [ <button-down> ] [ <button-up> ] if ;
 
 : prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
-    nip >r mouse-event>gesture r> >lo-hi rot window ;
+    [ drop mouse-event>gesture ] dip >lo-hi rot window ;
 
 : set-capture ( hwnd -- )
     mouse-captured get [
@@ -312,10 +312,10 @@ SYMBOL: nc-buttons
     mouse-captured off ;
 
 : handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
-    >r >r
-    over set-capture
-    dup message>button drop nc-buttons get delete
-    r> r> prepare-mouse send-button-down ;
+    [
+        over set-capture
+        dup message>button drop nc-buttons get delete
+    ] 2dip prepare-mouse send-button-down ;
 
 : handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
     mouse-captured get [ release-capture ] when
@@ -337,9 +337,10 @@ SYMBOL: nc-buttons
     TrackMouseEvent drop
     >lo-hi swap window move-hand fire-motion ;
 
-: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
-    >r nip r>
-    pick mouse-absolute>relative >r mouse-wheel r> rot window send-wheel ;
+:: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
+    wParam mouse-wheel
+    lParam hWnd mouse-absolute>relative
+    hWnd window send-wheel ;
 
 : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
     #! message sent if windows needs application to stop dragging
@@ -456,10 +457,11 @@ M: windows-ui-backend do-events
 
 : create-window ( rect -- hwnd )
     make-adjusted-RECT
-    >r class-name-ptr get-global f r>
-    >r >r >r ex-style r> r>
+    [ class-name-ptr get-global f ] dip
+    [
+        [ ex-style ] 2dip
         { WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
-    r> get-RECT-dimensions
+    ] dip get-RECT-dimensions
     f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ;
 
 : show-window ( hWnd -- )
@@ -515,7 +517,7 @@ M: windows-ui-backend raise-window* ( world -- )
 M: windows-ui-backend set-title ( string world -- )
     handle>>
     dup title>> [ free ] when*
-    >r utf16n malloc-string r>
+    [ utf16n malloc-string ] dip
     2dup (>>title)
     hWnd>> WM_SETTEXT 0 roll alien-address SendMessage drop ;
 
diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor
index de57c2dc72..b9889c75d4 100644
--- a/basis/ui/x11/x11.factor
+++ b/basis/ui/x11/x11.factor
@@ -79,7 +79,7 @@ M: world configure-event
 : key-down-event>gesture ( event world -- string gesture )
     dupd
     handle>> xic>> lookup-string
-    >r swap event-modifiers r> key-code <key-down> ;
+    [ swap event-modifiers ] dip key-code <key-down> ;
 
 M: world key-down-event
     [ key-down-event>gesture ] keep
@@ -92,18 +92,18 @@ M: world key-down-event
     dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
 
 M: world key-up-event
-    >r key-up-event>gesture r> world-focus propagate-gesture ;
+    [ key-up-event>gesture ] dip world-focus propagate-gesture ;
 
 : mouse-event>gesture ( event -- modifiers button loc )
     dup event-modifiers over XButtonEvent-button
     rot mouse-event-loc ;
 
 M: world button-down-event
-    >r mouse-event>gesture >r <button-down> r> r>
+    [ mouse-event>gesture [ <button-down> ] dip ] dip
     send-button-down ;
 
 M: world button-up-event
-    >r mouse-event>gesture >r <button-up> r> r>
+    [ mouse-event>gesture [ <button-up> ] dip ] dip
     send-button-up ;
 
 : mouse-event>scroll-direction ( event -- pair )
@@ -115,7 +115,7 @@ M: world button-up-event
     } at ;
 
 M: world wheel-event
-    >r dup mouse-event>scroll-direction swap mouse-event-loc r>
+    [ dup mouse-event>scroll-direction swap mouse-event-loc ] dip
     send-wheel ;
 
 M: world enter-event motion-event ;
@@ -123,7 +123,7 @@ M: world enter-event motion-event ;
 M: world leave-event 2drop forget-rollover ;
 
 M: world motion-event
-    >r dup XMotionEvent-x swap XMotionEvent-y 2array r>
+    [ dup XMotionEvent-x swap XMotionEvent-y 2array ] dip
     move-hand fire-motion ;
 
 M: world focus-in-event
@@ -158,7 +158,7 @@ M: world selection-notify-event
     [ XSelectionRequestEvent-requestor ] keep
     [ XSelectionRequestEvent-property ] keep
     [ XSelectionRequestEvent-target ] keep
-    >r 8 PropModeReplace r>
+    [ 8 PropModeReplace ] dip
     [
         XSelectionRequestEvent-selection
         clipboard-for-atom contents>>
@@ -208,8 +208,7 @@ M: x-clipboard copy-clipboard
     (>>contents) ;
 
 M: x-clipboard paste-clipboard
-    >r find-world handle>> window>>
-    r> atom>> convert-selection ;
+    [ find-world handle>> window>> ] dip atom>> convert-selection ;
 
 : init-clipboard ( -- )
     XA_PRIMARY <x-clipboard> selection set-global
@@ -219,14 +218,13 @@ M: x-clipboard paste-clipboard
     dup [ 127 <= ] all? [ XStoreName drop ] [ 3drop ] if ;
 
 : set-title-new ( dpy window string -- )
-    >r
-    XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace
-    r> utf8 encode dup length XChangeProperty drop ;
+    [ XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace ] dip
+    utf8 encode dup length XChangeProperty drop ;
 
 M: x11-ui-backend set-title ( string world -- )
     handle>> window>> swap dpy get -rot
     3dup set-title-old set-title-new ;
-    
+
 M: x11-ui-backend set-fullscreen* ( ? world -- )
     handle>> window>> "XClientMessageEvent" <c-object>
     tuck set-XClientMessageEvent-window
@@ -237,8 +235,7 @@ M: x11-ui-backend set-fullscreen* ( ? world -- )
     "_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
     32 over set-XClientMessageEvent-format
     "_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
-    >r dpy get root get 0 SubstructureNotifyMask r> XSendEvent drop ;
-
+    [ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
 
 M: x11-ui-backend (open-window) ( world -- )
     dup gadget-window
diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor
index eecf427c9e..555eb573fc 100644
--- a/basis/x11/xlib/xlib.factor
+++ b/basis/x11/xlib/xlib.factor
@@ -13,7 +13,7 @@
 
 USING: kernel arrays alien alien.c-types alien.strings
 alien.syntax math math.bitwise words sequences namespaces
-continuations io.encodings.ascii ;
+continuations io io.encodings.ascii ;
 IN: x11.xlib
 
 LIBRARY: xlib
@@ -1359,8 +1359,8 @@ SYMBOL: scr
 SYMBOL: root
 
 : init-locale ( -- )
-   LC_ALL "" setlocale [ "setlocale() failed" throw ] unless
-   XSupportsLocale [ "XSupportsLocale() failed" throw ] unless ;
+   LC_ALL "" setlocale [ "setlocale() failed" print flush ] unless
+   XSupportsLocale [ "XSupportsLocale() failed" print flush ] unless ;
 
 : flush-dpy ( -- ) dpy get XFlush drop ;
 
@@ -1381,4 +1381,4 @@ SYMBOL: root
 : close-x ( -- ) dpy get XCloseDisplay drop ;
 
 : with-x ( display-string quot -- )
-    >r initialize-x r> [ close-x ] [ ] cleanup ;
+    [ initialize-x ] dip [ close-x ] [ ] cleanup ;
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 4624963aa6..a4cee5c7b9 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -348,6 +348,7 @@ tuple
 {
     { "(execute)" "words.private" }
     { "(call)" "kernel.private" }
+    { "both-fixnums?" "math.private" }
     { "fixnum+fast" "math.private" }
     { "fixnum-fast" "math.private" }
     { "fixnum*fast" "math.private" }
@@ -534,6 +535,7 @@ tuple
     { "unimplemented" "kernel.private" }
     { "gc-reset" "memory" }
     { "jit-compile" "quotations" }
+    { "load-locals" "locals.backend" }
 }
 [ [ first2 ] dip make-primitive ] each-index
 
diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor
index 35029a3fb0..429e272647 100644
--- a/core/generic/generic-docs.factor
+++ b/core/generic/generic-docs.factor
@@ -165,3 +165,19 @@ HELP: (call-next-method)
 { $values { "method" method-body } }
 { $description "Low-level word implementing " { $link POSTPONE: call-next-method } "." }
 { $notes "In most cases, " { $link POSTPONE: call-next-method } " should be used instead." } ;
+
+HELP: no-next-method
+{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the current method is already the least specific method." }
+{ $examples
+    "The following code throws this error:"
+    { $code
+        "GENERIC: error-test ( object -- )"
+        ""
+        "M: number error-test 3 + call-next-method ;"
+        ""
+        "M: integer error-test recip call-next-method ;"
+        ""
+        "123 error-test"
+    }
+    "This results in the method on " { $link integer } " being called, which then calls the method on " { $link number } ". The latter then calls " { $link POSTPONE: call-next-method } ", however there is no method less specific than the method on " { $link number } " and so an error is thrown."
+} ;
diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 8d7ed4cb60..0cd5a35623 100644
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -58,8 +58,10 @@ GENERIC: next-method-quot* ( class generic combination -- quot )
         ] bi next-method-quot*
     ] cache ;
 
+ERROR: no-next-method method ;
+
 : (call-next-method) ( method -- )
-    next-method-quot call ;
+    dup next-method-quot [ call ] [ no-next-method ] ?if ;
 
 TUPLE: check-method class generic ;
 
diff --git a/core/generic/math/math-docs.factor b/core/generic/math/math-docs.factor
index da5d4f9eed..4323f91bc3 100644
--- a/core/generic/math/math-docs.factor
+++ b/core/generic/math/math-docs.factor
@@ -15,7 +15,7 @@ HELP: no-math-method
 HELP: math-method
 { $values { "word" generic } { "class1" class } { "class2" class } { "quot" quotation } }
 { $description "Generates a definition for " { $snippet "word" } " when the two inputs are instances of " { $snippet "class1" } " and " { $snippet "class2" } ", respectively." }
-{ $examples { $example "USING: generic.math math prettyprint ;" "\\ + fixnum float math-method ." "[ [ >float ] dip float=>+ ]" } } ;
+{ $examples { $example "USING: generic.math math prettyprint ;" "\\ + fixnum float math-method ." "[ { fixnum float } declare [ >float ] dip float=>+ ]" } } ;
 
 HELP: math-class
 { $class-description "The class of subtypes of " { $link number } " which are not " { $link null } "." } ;
diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor
index 0c7bb2d8e8..0acbdac8f8 100644
--- a/core/generic/math/math.factor
+++ b/core/generic/math/math.factor
@@ -56,9 +56,11 @@ ERROR: no-math-method left right generic ;
 
 : math-method ( word class1 class2 -- quot )
     2dup and [
-        2dup math-upgrade
-        [ math-class-max over order min-class applicable-method ] dip
-        prepend
+        [
+            2dup 2array , \ declare ,
+            2dup math-upgrade %
+            math-class-max over order min-class applicable-method %
+        ] [ ] make
     ] [
         2drop object-method
     ] if ;
@@ -67,13 +69,9 @@ SYMBOL: picker
 
 : math-vtable ( picker quot -- quot )
     [
-        swap picker set
-        picker get , [ tag 0 eq? ] %
-        num-tags get swap [ bootstrap-type>class ] prepose map
-        unclip ,
-        [
-            picker get , [ tag 1 fixnum-fast ] % , \ dispatch ,
-        ] [ ] make , \ if ,
+        [ , \ tag , ]
+        [ num-tags get swap [ bootstrap-type>class ] prepose map , ] bi*
+        \ dispatch ,
     ] [ ] make ; inline
 
 TUPLE: math-combination ;
@@ -84,13 +82,18 @@ M: math-combination make-default-method
 M: math-combination perform-combination
     drop
     dup
-    \ over [
-        dup math-class? [
-            \ dup [ [ 2dup ] dip math-method ] math-vtable
-        ] [
-            over object-method
-        ] if nip
-    ] math-vtable nip define ;
+    [
+        \ both-fixnums? ,
+        dup fixnum bootstrap-word dup math-method ,
+        \ over [
+            dup math-class? [
+                \ dup [ [ 2dup ] dip math-method ] math-vtable
+            ] [
+                over object-method
+            ] if nip
+        ] math-vtable nip ,
+        \ if ,
+    ] [ ] make define ;
 
 PREDICATE: math-generic < generic ( word -- ? )
     "combination" word-prop math-combination? ;
diff --git a/core/generic/standard/standard-docs.factor b/core/generic/standard/standard-docs.factor
index 15913b46be..ec2e78c48d 100644
--- a/core/generic/standard/standard-docs.factor
+++ b/core/generic/standard/standard-docs.factor
@@ -33,22 +33,6 @@ HELP: define-simple-generic
 
 { standard-combination hook-combination } related-words
 
-HELP: no-next-method
-{ $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the current method is already the least specific method." }
-{ $examples
-    "The following code throws this error:"
-    { $code
-        "GENERIC: error-test ( object -- )"
-        ""
-        "M: number error-test 3 + call-next-method ;"
-        ""
-        "M: integer error-test recip call-next-method ;"
-        ""
-        "123 error-test"
-    }
-    "This results in the method on " { $link integer } " being called, which then calls the method on " { $link number } ". The latter then calls " { $link POSTPONE: call-next-method } ", however there is no method less specific than the method on " { $link number } " and so an error is thrown."
-} ;
-
 HELP: inconsistent-next-method
 { $error-description "Thrown by " { $link POSTPONE: call-next-method } " if the values on the stack are not compatible with the current method." }
 { $examples
diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor
index f6635276b3..7dadc807fd 100644
--- a/core/generic/standard/standard-tests.factor
+++ b/core/generic/standard/standard-tests.factor
@@ -200,7 +200,7 @@ M: ceo salary
 [ T{ inconsistent-next-method f ceo salary } = ] must-fail-with
 
 [ intern boa salary ]
-[ T{ no-next-method f intern salary } = ] must-fail-with
+[ no-next-method? ] must-fail-with
 
 ! Weird shit
 TUPLE: a ;
diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor
index 4f26c40e78..300bd44fb4 100644
--- a/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@@ -79,20 +79,15 @@ ERROR: no-method object generic ;
 
 ERROR: inconsistent-next-method class generic ;
 
-ERROR: no-next-method class generic ;
-
-: single-next-method-quot ( class generic -- quot )
-    [
-        [ drop "predicate" word-prop % ]
+: single-next-method-quot ( class generic -- quot/f )
+    2dup next-method dup [
         [
-            2dup next-method
-            [ 2nip 1quotation ]
-            [ [ no-next-method ] 2curry [ ] like ] if* ,
-        ]
-        [ [ inconsistent-next-method ] 2curry , ]
-        2tri
-        \ if ,
-    ] [ ] make ;
+            pick "predicate" word-prop %
+            1quotation ,
+            [ inconsistent-next-method ] 2curry ,
+            \ if ,
+        ] [ ] make
+    ] [ 3drop f ] if ;
 
 : single-effective-method ( obj word -- method )
     [ [ order [ instance? ] with find-last nip ] keep method ]
@@ -130,7 +125,8 @@ M: standard-combination method-declaration
 
 M: standard-combination next-method-quot*
     [
-        single-next-method-quot picker prepend
+        single-next-method-quot
+        dup [ picker prepend ] when
     ] with-standard ;
 
 M: standard-generic effective-method
@@ -145,9 +141,12 @@ PREDICATE: hook-generic < generic
 
 : with-hook ( combination quot -- quot' )
     0 (dispatch#) [
-        dip var>> [ get ] curry prepend
+        [ hook-combination ] dip with-variable
     ] with-variable ; inline
 
+: prepend-hook-var ( quot -- quot' )
+    hook-combination get var>> [ get ] curry prepend ;
+
 M: hook-combination dispatch# drop 0 ;
 
 M: hook-combination method-declaration 2drop [ ] ;
@@ -159,13 +158,18 @@ M: hook-generic effective-method
     single-effective-method ;
 
 M: hook-combination make-default-method
-    [ error-method ] with-hook ;
+    [ error-method prepend-hook-var ] with-hook ;
 
 M: hook-combination perform-combination
-    [ drop ] [ [ single-combination ] with-hook ] 2bi define ;
+    [ drop ] [
+        [ single-combination prepend-hook-var ] with-hook
+    ] 2bi define ;
 
 M: hook-combination next-method-quot*
-    [ single-next-method-quot ] with-hook ;
+    [
+        single-next-method-quot
+        dup [ prepend-hook-var ] when
+    ] with-hook ;
 
 M: simple-generic definer drop \ GENERIC: f ;
 
diff --git a/core/io/encodings/encodings-docs.factor b/core/io/encodings/encodings-docs.factor
index ba25e79509..b893e7f717 100644
--- a/core/io/encodings/encodings-docs.factor
+++ b/core/io/encodings/encodings-docs.factor
@@ -1,21 +1,6 @@
-USING: help.markup help.syntax ;
+USING: help.markup help.syntax io quotations ;
 IN: io.encodings
 
-ABOUT: "io.encodings"
-
-ARTICLE: "io.encodings" "I/O encodings"
-"Bytes can't be understood in isolation as text. They must be interpreted under a certain encoding. Factor provides utilities for dealing with encoded text by declaring that a stream has a particular encoding, and utilities to encode and decode strings."
-{ $subsection "encodings-descriptors" }
-{ $subsection "encodings-constructors" }
-{ $subsection "io.encodings.string" }
-"New types of encodings can be defined:"
-{ $subsection "encodings-protocol" } ;
-
-ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"
-"The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves. Most stream constructors take an encoding descriptor as a parameter and internally call these constructors."
-{ $subsection <encoder> }
-{ $subsection <decoder> } ;
-
 HELP: <encoder>
 { $values { "stream" "an output stream" }
     { "encoding" "an encoding descriptor" }
@@ -30,8 +15,66 @@ HELP: <decoder>
 { $description "Wraps the given stream in a new stream using the given encoding for all input. The encoding descriptor can either be a class or an instance of something conforming to the " { $link "encodings-protocol" } "." }
 $low-level-note ;
 
+HELP: decode-char
+{ $values { "stream" "an underlying input stream" }
+    { "encoding" "An encoding descriptor tuple" } { "char/f" "a code point or " { $link f } } }
+{ $contract "Reads a single code point from the underlying stream, interpreting it by the encoding. Returns " { $link f } " if the stream is reached." }
+$low-level-note ;
+
+HELP: encode-char
+{ $values { "char" "a character" }
+    { "stream" "an underlying output stream" }
+    { "encoding" "an encoding descriptor" } }
+{ $contract "Writes the code point to the underlying stream in the given encoding." }
+$low-level-note ;
+
+{ encode-char decode-char } related-words
+
+HELP: decode-input
+{ $values
+     { "encoding" "an encoding descriptor" }
+}
+{ $description "Changes the encoding of the current input stream stored in the " { $link input-stream } " variable." } ;
+
+HELP: encode-output
+{ $values
+     { "encoding" "an encoding descriptor" }
+}
+{ $description "Changes the encoding of the current output stream stored in the " { $link output-stream } " variable." } ;
+
+HELP: re-decode
+{ $values
+     { "stream" "a stream" } { "encoding" "an encoding descriptor" }
+     { "newstream" "a new stream" }
+}
+{ $description "Creates a new decoding stream with the supplied encoding descriptor from an existing stream by calling the " { $link <decoder> } " word." } ;
+
+HELP: re-encode
+{ $values
+     { "stream" "a stream" } { "encoding" "an encoding descriptor" }
+     { "newstream" "a new stream" }
+}
+{ $description "Creates a new encoding stream with the supplied encoding descriptor from an existing stream by calling the " { $link <encoder> } " word." } ;
+
+{ re-decode re-encode } related-words
+
+HELP: with-decoded-input
+{ $values
+     { "encoding" "an encoding descriptor" } { "quot" quotation }
+}
+{ $description "Creates a new decoding stream with the given encoding descriptor and calls the quotation with this stream set to the " { $link input-stream } " variable. The original decoder stream is restored after the quotation returns and the stream is kept open for future input operations." } ;
+
+HELP: with-encoded-output
+{ $values
+     { "encoding" "an encoding descriptor" } { "quot" quotation }
+}
+{ $description "Creates a new encoder with the given encoding descriptor and calls the quotation using this encoder. The original encoder object is restored after the quotation returns and the stream is kept open for future output operations." } ;
+
+HELP: replacement-char
+{ $description "A code point that replaces input that could not be decoded. The presence of this character in the decoded data usually signifies an error." } ;
+
 ARTICLE: "encodings-descriptors" "Encoding descriptors"
-"An encoding descriptor is something which can be used for input or output streams to encode or decode files. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
+"An encoding descriptor is something which can be used for input or output streams to encode or decode bytes stored in a certain representation. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
 { $subsection "io.encodings.binary" }
 { $subsection "io.encodings.utf8" }
 { $subsection "io.encodings.utf16" }
@@ -50,17 +93,26 @@ ARTICLE: "encodings-protocol" "Encoding protocol"
 { $subsection encode-char }
 { $see-also "encodings-introduction" } ;
 
-HELP: decode-char
-{ $values { "stream" "an underlying input stream" }
-    { "encoding" "An encoding descriptor tuple" } { "char/f" "a code point or " { $link f } } }
-{ $contract "Reads a single code point from the underlying stream, interpreting it by the encoding." }
-$low-level-note ;
+ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"
+"The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves. Most stream constructors take an encoding descriptor as a parameter and call these constructors internally."
+{ $subsection <encoder> }
+{ $subsection <decoder> } ;
 
-HELP: encode-char
-{ $values { "char" "a character" }
-    { "stream" "an underlying output stream" }
-    { "encoding" "an encoding descriptor" } }
-{ $contract "Writes the code point in the encoding to the underlying stream given." }
-$low-level-note ;
+ARTICLE: "io.encodings" "I/O encodings"
+"The " { $vocab-link "io.encodings" } " vocabulary provides utilities for encoding and decoding bytes that represent text. Both strings and streams may be encoded."
+{ $subsection "encodings-descriptors" }
+{ $subsection "encodings-constructors" }
+{ $subsection "io.encodings.string" }
+"New types of encodings can be defined:"
+{ $subsection "encodings-protocol" }
+"Setting encodings on the current streams:"
+{ $subsection encode-output }
+{ $subsection decode-input }
+"Setting encodings on streams:"
+{ $subsection re-encode }
+{ $subsection re-decode }
+"Combinators to change the encoding:"
+{ $subsection with-encoded-output }
+{ $subsection with-decoded-input } ;
 
-{ encode-char decode-char } related-words
+ABOUT: "io.encodings"
diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor
index 43f66657a7..c55377e4a0 100644
--- a/core/io/io-docs.factor
+++ b/core/io/io-docs.factor
@@ -114,6 +114,9 @@ HELP: input-stream
 HELP: output-stream
 { $var-description "Holds an output stream for various implicit stream operations. Rebound using " { $link with-output-stream } " and " { $link with-output-stream* } "." } ;
 
+HELP: error-stream
+{ $var-description "Holds an error stream." } ;
+
 HELP: readln
 { $values { "str/f" "a string or " { $link f } } }
 { $description "Reads a line of input from " { $link input-stream } ". Outputs " { $link f } " on stream exhaustion." }
diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index e1fa0f6fa3..3fc3d175a0 100644
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -599,7 +599,7 @@ HELP: 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." }
+{ $description "Calls " { $snippet "quot" } " with " { $snippet "x" } " and " { $snippet "y" } " hidden on the retain stack." }
 { $notes "The following are equivalent:"
     { $code "[ [ foo bar ] dip ] dip" }
     { $code "[ foo bar ] 2dip" }
diff --git a/extra/benchmark/partial-sums/partial-sums.factor b/extra/benchmark/partial-sums/partial-sums.factor
index 2d8cdc40c7..7c7c68b12d 100644
--- a/extra/benchmark/partial-sums/partial-sums.factor
+++ b/extra/benchmark/partial-sums/partial-sums.factor
@@ -1,63 +1,44 @@
-USING: math math.functions kernel sequences io io.styles
-prettyprint words hints ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math math.functions kernel io io.styles prettyprint
+combinators hints fry namespaces sequences ;
 IN: benchmark.partial-sums
 
-: summing ( n quot -- y )
-    [ >float ] swap [ + ] 3compose
-    0.0 -rot 1 -rot (each-integer) ; inline
-
-: 2/3^k ( n -- y ) [ 2.0 3.0 / swap 1- ^ ] summing ;
-
-HINTS: 2/3^k fixnum ;
-
-: k^-0.5 ( n -- y ) [ -0.5 ^ ] summing ;
-
-HINTS: k^-0.5 fixnum ;
-
-: 1/k(k+1) ( n -- y ) [ dup 1+ * recip ] summing ;
-
-HINTS: 1/k(k+1) fixnum ;
-
+! Helper words
+: summing-integers ( n quot -- y ) [ 0.0 ] 2dip '[ 1+ @ + ] each ; inline
+: summing-floats ( n quot -- y ) '[ >float @ ] summing-integers ; inline
 : cube ( x -- y ) dup dup * * ; inline
+: -1^ ( n -- -1/1 ) 2 mod 2 * 1- ; inline
 
-: flint-hills ( n -- y )
-    [ dup cube swap sin sq * recip ] summing ;
+! The functions
+: 2/3^k ( n -- y ) [ 2.0 3.0 / swap 1- ^ ] summing-floats ; inline
+: k^-0.5 ( n -- y ) [ -0.5 ^ ] summing-floats ; inline
+: 1/k(k+1) ( n -- y ) [ dup 1+ * recip ] summing-floats ; inline
+: flint-hills ( n -- y ) [ [ cube ] [ sin sq ] bi * recip ] summing-floats ; inline
+: cookson-hills ( n -- y ) [ [ cube ] [ cos sq ] bi * recip ] summing-floats ; inline
+: harmonic ( n -- y ) [ recip ] summing-floats ; inline
+: riemann-zeta ( n -- y ) [ sq recip ] summing-floats ; inline
+: alternating-harmonic ( n -- y ) [ [ -1^ ] keep /f ] summing-integers ; inline
+: gregory ( n -- y ) [ [ -1^ ] [ 2.0 * 1- ] bi / ] summing-integers ; inline
 
-HINTS: flint-hills fixnum ;
+: partial-sums ( n -- results )
+    [
+        {
+            [ 2/3^k                 \ 2/3^k                set ]
+            [ k^-0.5                \ k^-0.5               set ]
+            [ 1/k(k+1)              \ 1/k(k+1)             set ]
+            [ flint-hills           \ flint-hills          set ]
+            [ cookson-hills         \ cookson-hills        set ]
+            [ harmonic              \ harmonic             set ]
+            [ riemann-zeta          \ riemann-zeta         set ]
+            [ alternating-harmonic  \ alternating-harmonic set ]
+            [ gregory               \ gregory              set ]
+        } cleave
+    ] { } make-assoc ;
 
-: cookson-hills ( n -- y )
-    [ dup cube swap cos sq * recip ] summing ;
+HINTS: partial-sums fixnum ;
 
-HINTS: cookson-hills fixnum ;
-
-: harmonic ( n -- y ) [ recip ] summing ;
-
-HINTS: harmonic fixnum ;
-
-: riemann-zeta ( n -- y ) [ sq recip ] summing ;
-
-HINTS: riemann-zeta fixnum ;
-
-: -1^ 2 mod zero? 1 -1 ? ; inline
-
-: alternating-harmonic ( n -- y ) [ dup -1^ swap / ] summing ;
-
-HINTS: alternating-harmonic fixnum ;
-
-: gregory ( n -- y ) [ dup -1^ swap 2 * 1- / ] summing ;
-
-HINTS: gregory fixnum ;
-
-: functions
-    { 2/3^k k^-0.5 1/k(k+1) flint-hills cookson-hills harmonic riemann-zeta alternating-harmonic gregory } ;
-
-: partial-sums ( n -- )
-    standard-table-style [
-        functions [
-            [ tuck execute pprint-cell pprint-cell ] with-row
-        ] with each
-    ] tabular-output ;
-
-: partial-sums-main ( -- ) 2500000 partial-sums ;
+: partial-sums-main ( -- )
+    2500000 partial-sums simple-table. ;
 
 MAIN: partial-sums-main
diff --git a/extra/io/files/unique/unique-docs.factor b/extra/io/files/unique/unique-docs.factor
index bb4e9ef01f..825eb212f1 100644
--- a/extra/io/files/unique/unique-docs.factor
+++ b/extra/io/files/unique/unique-docs.factor
@@ -2,7 +2,32 @@ USING: help.markup help.syntax io io.ports kernel math
 io.files.unique.private math.parser io.files ;
 IN: io.files.unique
 
-ARTICLE: "unique" "Making and using unique files"
+HELP: make-unique-file ( prefix suffix -- path )
+{ $values { "prefix" "a string" } { "suffix" "a string" }
+{ "path" "a pathname string" } }
+{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." }
+{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
+{ $see-also with-unique-file } ;
+
+HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- )
+{ $values { "prefix" "a string" } { "suffix" "a string" }
+{ "quot" "a quotation" } }
+{ $description "Creates a file with " { $link make-unique-file } " and calls the quotation with the path name on the stack." }
+{ $notes "The unique file will be deleted after calling this word." } ;
+
+HELP: make-unique-directory ( -- path )
+{ $values { "path" "a pathname string" } }
+{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
+{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." }
+{ $see-also with-unique-directory } ;
+
+HELP: with-unique-directory ( quot -- )
+{ $values { "quot" "a quotation" } }
+{ $description "Creates a directory with " { $link make-unique-directory } " and calls the quotation with the pathname on the stack using the " { $link with-directory } " combinator. The quotation can access the " { $link current-directory } " symbol for the name of the temporary directory." }
+{ $notes "The directory will be deleted after calling this word, even if an error is thrown in the quotation." } ;
+
+ARTICLE: "io.files.unique" "Temporary files"
+"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl
 "Files:"
 { $subsection make-unique-file }
 { $subsection with-unique-file }
@@ -10,28 +35,4 @@ ARTICLE: "unique" "Making and using unique files"
 { $subsection make-unique-directory }
 { $subsection with-unique-directory } ;
 
-ABOUT: "unique"
-
-HELP: make-unique-file ( prefix suffix -- path )
-{ $values { "prefix" "a string" } { "suffix" "a string" }
-{ "path" "a pathname string" } }
-{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory.  The file name is composed of a prefix, a number of random digits and letters, and the suffix.  Returns the full pathname." }
-{ $errors "Throws an error if a new unique file cannot be created after a number of tries.  Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." }
-{ $see-also with-unique-file } ;
-
-HELP: make-unique-directory ( -- path )
-{ $values { "path" "a pathname string" } }
-{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
-{ $errors "Throws an error if the directory cannot be created after a number of tries.  Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." }
-{ $see-also with-unique-directory } ;
-
-HELP: with-unique-file ( prefix suffix quot -- )
-{ $values { "prefix" "a string" } { "suffix" "a string" }
-{ "quot" "a quotation" } }
-{ $description "Creates a file with " { $link make-unique-file } " and calls the quotation with the path name on the stack." }
-{ $notes "The unique file will be deleted after calling this word." } ;
-
-HELP: with-unique-directory ( quot -- )
-{ $values { "quot" "a quotation" } }
-{ $description "Creates a directory with " { $link make-unique-directory } " and calls the quotation with the pathname on the stack." }
-{ $notes "The directory will be deleted after calling this word." } ;
+ABOUT: "io.files.unique"
diff --git a/extra/io/files/unique/unique-tests.factor b/extra/io/files/unique/unique-tests.factor
index c29a94f395..178e4572d0 100644
--- a/extra/io/files/unique/unique-tests.factor
+++ b/extra/io/files/unique/unique-tests.factor
@@ -1,13 +1,20 @@
 USING: io.encodings.ascii sequences strings io io.files accessors
-tools.test kernel io.files.unique ;
+tools.test kernel io.files.unique namespaces continuations ;
 IN: io.files.unique.tests
 
 [ 123 ] [
     "core" ".test" [
-        [
-            ascii [
-                123 CHAR: a <repetition> >string write
-            ] with-file-writer
-        ] keep file-info size>>
+        [ [ 123 CHAR: a <repetition> ] dip ascii set-file-contents ]
+        [ file-info size>> ] bi
     ] with-unique-file
 ] unit-test
+
+[ t ] [
+    [ current-directory get file-info directory? ] with-unique-directory
+] unit-test
+
+[ t ] [
+    current-directory get
+    [ [ "FAILDOG" throw ] with-unique-directory ] [ drop ] recover
+    current-directory get =
+] unit-test
diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor
index db11471a7a..3a6c556846 100644
--- a/extra/io/files/unique/unique.factor
+++ b/extra/io/files/unique/unique.factor
@@ -3,10 +3,17 @@
 USING: kernel math math.bitwise combinators.lib math.parser
 random sequences sequences.lib continuations namespaces
 io.files io arrays io.files.unique.backend system
-combinators vocabs.loader ;
+combinators vocabs.loader fry ;
 IN: io.files.unique
 
+SYMBOL: unique-length
+SYMBOL: unique-retries
+
+10 unique-length set-global
+10 unique-retries set-global
+
 <PRIVATE
+
 : random-letter ( -- ch )
     26 random { CHAR: a CHAR: A } random + ;
 
@@ -17,29 +24,27 @@ IN: io.files.unique
 : random-name ( n -- string )
     [ random-ch ] "" replicate-as ;
 
-: unique-length ( -- n ) 10 ; inline
-: unique-retries ( -- n ) 10 ; inline
 PRIVATE>
 
 : make-unique-file ( prefix suffix -- path )
     temporary-path -rot
     [
-        unique-length random-name swap 3append append-path
+        unique-length get random-name swap 3append append-path
         dup (make-unique-file)
-    ] 3curry unique-retries retry ;
+    ] 3curry unique-retries get retry ;
 
-: with-unique-file ( prefix suffix quot -- )
-    >r make-unique-file r> keep delete-file ; inline
+: with-unique-file ( prefix suffix quot: ( path -- ) -- )
+    [ make-unique-file ] dip [ delete-file ] bi ; inline
 
 : make-unique-directory ( -- path )
     [
-        temporary-path unique-length random-name append-path
+        temporary-path unique-length get random-name append-path
         dup make-directory
-    ] unique-retries retry ;
+    ] unique-retries get retry ;
 
-: with-unique-directory ( quot -- )
-    >r make-unique-directory r>
-    [ with-directory ] curry keep delete-tree ; inline
+: with-unique-directory ( quot: ( -- ) -- )
+    [ make-unique-directory ] dip
+    '[ _ with-directory ] [ delete-tree ] bi ; inline
 
 {
     { [ os unix? ] [ "io.unix.files.unique" ] }
diff --git a/extra/math/floating-point/floating-point-tests.factor b/extra/math/floating-point/floating-point-tests.factor
index 2a60d30d02..7f3a87f9a5 100644
--- a/extra/math/floating-point/floating-point-tests.factor
+++ b/extra/math/floating-point/floating-point-tests.factor
@@ -1,4 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test math.floating-point ;
+USING: tools.test math.floating-point math.constants kernel ;
 IN: math.floating-point.tests
+
+[ t ] [ pi >double< >double pi = ] unit-test
+[ t ] [ -1.0 >double< >double -1.0 = ] unit-test
diff --git a/extra/math/floating-point/floating-point.factor b/extra/math/floating-point/floating-point.factor
index 3792d6ba9b..0d224bfc9d 100644
--- a/extra/math/floating-point/floating-point.factor
+++ b/extra/math/floating-point/floating-point.factor
@@ -1,20 +1,20 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math sequences prettyprint math.parser io
-math.functions ;
+math.functions math.bitwise ;
 IN: math.floating-point
 
 : (double-sign) ( bits -- n ) -63 shift ; inline
 : double-sign ( double -- n ) double>bits (double-sign) ;
 
 : (double-exponent-bits) ( bits -- n )
-    -52 shift 11 2^ 1- bitand ; inline
+    -52 shift 11 on-bits mask ; inline
 
 : double-exponent-bits ( double -- n )
     double>bits (double-exponent-bits) ;
 
 : (double-mantissa-bits) ( double -- n )
-    52 2^ 1- bitand ;
+    52 on-bits mask ;
 
 : double-mantissa-bits ( double -- n )
     double>bits (double-mantissa-bits) ;
@@ -37,4 +37,3 @@ IN: math.floating-point
         (double-mantissa-bits) >bin 52 CHAR: 0 pad-left
         11 [ bl ] times print
     ] tri ;
-
diff --git a/extra/math/matrices/matrices-tests.factor b/extra/math/matrices/matrices-tests.factor
index ee2516e9a6..6f87109ba0 100644
--- a/extra/math/matrices/matrices-tests.factor
+++ b/extra/math/matrices/matrices-tests.factor
@@ -102,3 +102,5 @@ USING: math.matrices math.vectors tools.test math ;
 [ { 0 0 -1 } ] [ { 1 0 0 } { 0 1 0 } cross ] unit-test
 [ { 1 0 0 } ] [ { 0 1 0 } { 0 0 1 } cross ] unit-test
 [ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test
+
+[ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test
diff --git a/extra/maze/maze.factor b/extra/maze/maze.factor
index 40e12a97c9..f56c579a3f 100644
--- a/extra/maze/maze.factor
+++ b/extra/maze/maze.factor
@@ -41,7 +41,6 @@ SYMBOL: visited
     ] if ;
 
 : draw-maze ( n -- )
-    -0.5 0.5 0 glTranslated
     line-width 2 - glLineWidth
     line-width 2 - glPointSize
     1.0 1.0 1.0 1.0 glColor4d
diff --git a/misc/factor.el b/misc/factor.el
index 346642f70c..2ffabf7de9 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -89,6 +89,11 @@ buffer."
   :type 'boolean
   :group 'factor)
 
+(defcustom factor-help-use-minibuffer t
+  "When enabled, use the minibuffer for short help messages."
+  :type 'boolean
+  :group 'factor)
+
 (defcustom factor-display-compilation-output t
   "Display the REPL buffer before compiling files."
   :type 'boolean
@@ -113,6 +118,10 @@ buffer."
   "Face for parsing words."
   :group 'factor-faces)
 
+(defface factor-font-lock-declaration (face-default-spec font-lock-keyword-face)
+  "Face for declaration words (inline, parsing ...)."
+  :group 'factor-faces)
+
 (defface factor-font-lock-comment (face-default-spec font-lock-comment-face)
   "Face for comments."
   :group 'factor-faces)
@@ -173,10 +182,15 @@ buffer."
     "UNION:" "USE:" "USING:" "V{" "VAR:" "VARS:" "W{"))
 
 (defconst factor--regex-parsing-words-ext
-  (regexp-opt '("B" "call-next-method" "delimiter" "f" "flushable" "foldable"
-                "initial:" "inline" "parsing" "read-only" "recursive")
+  (regexp-opt '("B" "call-next-method" "delimiter" "f" "initial:" "read-only")
               'words))
 
+(defconst factor--declaration-words
+  '("flushable" "foldable" "inline" "parsing" "recursive"))
+
+(defconst factor--regex-declaration-words
+  (regexp-opt factor--declaration-words 'words))
+
 (defsubst factor--regex-second-word (prefixes)
   (format "^%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
 
@@ -195,39 +209,46 @@ buffer."
 (defconst factor--regex-symbol-definition
   (factor--regex-second-word '("SYMBOL:")))
 
-(defconst factor--regex-using-line "^USING: +\\([^;]*\\);")
+(defconst factor--regex-stack-effect " ( .* )")
+
+(defconst factor--regex-using-lines "^USING: +\\(\\([^;]\\|[\n\r\f]\\)*\\);")
+
 (defconst factor--regex-use-line "^USE: +\\(.*\\)$")
 
 (defconst factor--font-lock-keywords
-  `(("( .* )" . 'factor-font-lock-stack-effect)
+  `((,factor--regex-stack-effect . 'factor-font-lock-stack-effect)
     ("\\(P\\|SBUF\\)\"" 1 'factor-font-lock-parsing-word)
     ,@(mapcar #'(lambda (w) (cons (concat "\\(^\\| \\)\\(" w "\\)\\($\\| \\)")
                              '(2 'factor-font-lock-parsing-word)))
               factor--parsing-words)
     (,factor--regex-parsing-words-ext . 'factor-font-lock-parsing-word)
+    (,factor--regex-declaration-words 1 'factor-font-lock-declaration)
     (,factor--regex-word-definition 2 'factor-font-lock-word-definition)
     (,factor--regex-type-definition 2 'factor-font-lock-type-definition)
     (,factor--regex-parent-type 1 'factor-font-lock-type-definition)
     (,factor--regex-constructor . 'factor-font-lock-constructor)
     (,factor--regex-setter . 'factor-font-lock-setter-word)
     (,factor--regex-symbol-definition 2 'factor-font-lock-symbol-definition)
-    (,factor--regex-using-line 1 'factor-font-lock-vocabulary-name)
+    (,factor--regex-using-lines 1 'factor-font-lock-vocabulary-name)
     (,factor--regex-use-line 1 'factor-font-lock-vocabulary-name))
   "Font lock keywords definition for Factor mode.")
 
 
 ;;; Factor mode syntax:
 
-(defconst factor--regexp-word-start
-  (let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M")))
-    (format "^\\(%s\\)\\(:\\) " (regexp-opt sws))))
+(defconst factor--regex-definition-starters
+  (regexp-opt '("TUPLE" "MACRO" "MACRO:" "M" ":" "")))
+
+(defconst factor--regex-definition-start
+  (format "^\\(%s:\\) " factor--regex-definition-starters))
+
+(defconst factor--regex-definition-end
+  (format "\\(;\\( +%s\\)*\\)" factor--regex-declaration-words))
 
 (defconst factor--font-lock-syntactic-keywords
-  `(("^\\(:\\)\\(:\\)" (1 ".") (2 "(;"))
-    (,factor--regexp-word-start (2 "(;"))
-    ("\\(;\\)" (1 "):"))
-    ("\\(#!\\)" (1 "<"))
-    ("\\(!\\)" (1 "<"))
+  `(("\\(#!\\)" (1 "<"))
+    (" \\(!\\)" (1 "<"))
+    ("^\\(!\\)" (1 "<"))
     ("\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))))
 
 (defvar factor-mode-syntax-table nil
@@ -279,6 +300,26 @@ buffer."
     (modify-syntax-entry ?\" "\"" factor-mode-syntax-table)
     (modify-syntax-entry ?\\ "/" factor-mode-syntax-table)))
 
+
+;;; symbol-at-point
+
+(defun factor--beginning-of-symbol ()
+  "Move point to the beginning of the current symbol."
+  (while (eq (char-before) ?:) (backward-char))
+  (skip-syntax-backward "w_"))
+
+(defun factor--end-of-symbol ()
+  "Move point to the end of the current symbol."
+  (skip-syntax-forward "w_")
+  (while (looking-at ":") (forward-char)))
+
+(put 'factor-symbol 'end-op 'factor--end-of-symbol)
+(put 'factor-symbol 'beginning-op 'factor--beginning-of-symbol)
+
+(defsubst factor--symbol-at-point ()
+  (let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
+    (and (> (length s) 0) s)))
+
 
 ;;; Factor mode indentation:
 
@@ -293,7 +334,7 @@ buffer."
     (save-excursion
       (beginning-of-buffer)
       (while (not iw)
-        (if (not (re-search-forward factor--regexp-word-start nil t))
+        (if (not (re-search-forward factor--regex-definition-start nil t))
             (setq iw factor-default-indent-width)
           (forward-line)
           (when (looking-at word-cont)
@@ -306,13 +347,17 @@ buffer."
 (defsubst factor--ppss-brackets-start ()
   (nth 1 (syntax-ppss)))
 
+(defun factor--ppss-brackets-end ()
+  (save-excursion
+    (goto-char (factor--ppss-brackets-start))
+    (condition-case nil
+        (progn (forward-sexp)
+               (1- (point)))
+      (error -1))))
+
 (defsubst factor--indentation-at (pos)
   (save-excursion (goto-char pos) (current-indentation)))
 
-(defconst factor--regex-closing-paren "[])}]")
-(defsubst factor--at-closing-paren-p ()
-  (looking-at factor--regex-closing-paren))
-
 (defsubst factor--at-first-char-p ()
   (= (- (point) (line-beginning-position)) (current-indentation)))
 
@@ -320,16 +365,28 @@ buffer."
   (format "^%s" (regexp-opt '("DEFER:" "GENERIC:" "IN:"
                               "PRIVATE>" "<PRIVATE" "SYMBOL:" "USE:"))))
 
+(defconst factor--regex-begin-of-def
+  (format "^USING: \\|\\(%s\\)\\|\\(%s .*\\)"
+          factor--regex-definition-start
+          factor--regex-single-liner))
+
+(defconst factor--regex-end-of-def-line
+  (format "^.*%s" factor--regex-definition-end))
+
+(defconst factor--regex-end-of-def
+  (format "\\(%s\\)\\|\\(%s .*\\)"
+          factor--regex-end-of-def-line
+          factor--regex-single-liner))
+
 (defsubst factor--at-begin-of-def ()
-  (looking-at factor--regexp-word-start))
+  (looking-at factor--regex-begin-of-def))
+
+(defsubst factor--at-end-of-def ()
+  (looking-at factor--regex-end-of-def))
 
 (defsubst factor--looking-at-emptiness ()
   (looking-at "^[ \t]*$"))
 
-(defun factor--at-end-of-def ()
-  (or (looking-at ".*;[ \t]*$")
-      (looking-at factor--regex-single-liner)))
-
 (defun factor--at-setter-line ()
   (save-excursion
     (beginning-of-line)
@@ -352,13 +409,12 @@ buffer."
 (defun factor--indent-in-brackets ()
   (save-excursion
     (beginning-of-line)
-    (when (or (and (re-search-forward factor--regex-closing-paren
-                                      (line-end-position) t)
-                   (not (backward-char)))
-              (> (factor--ppss-brackets-depth) 0))
-      (let ((op (factor--ppss-brackets-start)))
-        (when (> (line-number-at-pos) (line-number-at-pos op))
-          (if (factor--at-closing-paren-p)
+    (when (> (factor--ppss-brackets-depth) 0)
+      (let ((op (factor--ppss-brackets-start))
+            (cl (factor--ppss-brackets-end))
+            (ln (line-number-at-pos)))
+        (when (> ln (line-number-at-pos op))
+          (if (and (> cl 0) (= ln (line-number-at-pos cl)))
               (factor--indentation-at op)
             (factor--increased-indentation (factor--indentation-at op))))))))
 
@@ -387,7 +443,8 @@ buffer."
       (forward-line -1))
     (if (or (factor--at-end-of-def) (factor--at-setter-line))
         (factor--decreased-indentation)
-      (if (factor--at-begin-of-def)
+      (if (and (factor--at-begin-of-def)
+               (not (looking-at factor--regex-using-lines)))
           (factor--increased-indentation)
         (current-indentation)))))
 
@@ -414,7 +471,91 @@ buffer."
           (goto-char (- (point-max) pos))))))
 
 
-;;; Factor mode commands:
+;; Factor mode:
+(defvar factor-mode-map (make-sparse-keymap)
+  "Key map used by Factor mode.")
+
+(defsubst factor--beginning-of-defun (times)
+  (re-search-backward factor--regex-begin-of-def nil t times))
+
+(defsubst factor--end-of-defun ()
+  (re-search-forward factor--regex-end-of-def nil t))
+
+;;;###autoload
+(defun factor-mode ()
+  "A mode for editing programs written in the Factor programming language.
+\\{factor-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map factor-mode-map)
+  (setq major-mode 'factor-mode)
+  (setq mode-name "Factor")
+  ;; Font locking
+  (set (make-local-variable 'comment-start) "! ")
+  (set (make-local-variable 'parse-sexp-lookup-properties) t)
+  (set (make-local-variable 'font-lock-comment-face) 'factor-font-lock-comment)
+  (set (make-local-variable 'font-lock-string-face) 'factor-font-lock-string)
+  (set (make-local-variable 'font-lock-defaults)
+       `(factor--font-lock-keywords
+         nil nil nil nil
+         (font-lock-syntactic-keywords . ,factor--font-lock-syntactic-keywords)))
+
+  (set-syntax-table factor-mode-syntax-table)
+  ;; Defun navigation
+  (set (make-local-variable 'beginning-of-defun-function) 'factor--beginning-of-defun)
+  (set (make-local-variable 'end-of-defun-function) 'factor--end-of-defun)
+  (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
+  ;; Indentation
+  (set (make-local-variable 'indent-line-function) 'factor--indent-line)
+  (setq factor-indent-width (factor--guess-indent-width))
+  (setq indent-tabs-mode nil)
+  ;; ElDoc
+  (set (make-local-variable 'eldoc-documentation-function) 'factor--eldoc)
+
+  (run-hooks 'factor-mode-hook))
+
+(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
+
+
+;;; Factor listener mode:
+
+;;;###autoload
+(define-derived-mode factor-listener-mode comint-mode "Factor Listener"
+  "Major mode for interacting with an inferior Factor listener process.
+\\{factor-listener-mode-map}"
+  (set (make-local-variable 'comint-prompt-regexp) "^( [^)]+ ) "))
+
+(defvar factor--listener-buffer nil
+  "The buffer in which the Factor listener is running.")
+
+(defun factor--listener-start-process ()
+  "Start an inferior Factor listener process, using
+`factor-binary' and `factor-image'."
+  (setq factor--listener-buffer
+        (apply 'make-comint "factor" (expand-file-name factor-binary) nil
+               `("-run=listener" ,(format "-i=%s" (expand-file-name factor-image)))))
+  (with-current-buffer factor--listener-buffer
+    (factor-listener-mode)))
+
+(defun factor--listener-process (&optional start)
+  (or (and (buffer-live-p factor--listener-buffer)
+           (get-buffer-process factor--listener-buffer))
+      (if (not start)
+          (error "No running factor listener. Try M-x run-factor.")
+        (factor--listener-start-process)
+        (factor--listener-process t))))
+
+;;;###autoload
+(defalias 'switch-to-factor 'run-factor)
+;;;###autoload
+(defun run-factor (&optional arg)
+  "Show the factor-listener buffer, starting the process if needed."
+  (interactive)
+  (let ((buf (process-buffer (factor--listener-process t)))
+        (pop-up-windows factor-listener-window-allow-split))
+    (if factor-listener-use-other-window
+        (pop-to-buffer buf)
+      (switch-to-buffer buf))))
 
 (defun factor-telnet-to-port (port)
   (interactive "nPort: ")
@@ -429,21 +570,123 @@ buffer."
   (interactive)
   (factor-telnet-to-port 9010))
 
+
+;;; Factor listener interaction:
+
+(defun factor--listener-send-cmd (cmd)
+  (let ((proc (factor--listener-process)))
+    (when proc
+      (let* ((out (get-buffer-create "*factor messages*"))
+             (beg (with-current-buffer out (goto-char (point-max)))))
+        (comint-redirect-send-command-to-process cmd out proc nil t)
+        (with-current-buffer factor--listener-buffer
+          (while (not comint-redirect-completed) (sleep-for 0 1)))
+        (with-current-buffer out
+          (split-string (buffer-substring-no-properties beg (point-max))
+                        "[\"\f\n\r\v]+" t))))))
+
+;;;;; Current vocabulary:
+(make-variable-buffer-local
+ (defvar factor--current-vocab nil
+   "Current vocabulary."))
+
+(defconst factor--regexp-current-vocab "^IN: +\\([^ \r\n\f]+\\)")
+
+(defun factor--current-buffer-vocab ()
+  (save-excursion
+    (when (or (re-search-backward factor--regexp-current-vocab nil t)
+              (re-search-forward factor--regexp-current-vocab nil t))
+      (setq factor--current-vocab (match-string-no-properties 1)))))
+
+(defun factor--current-listener-vocab ()
+  (car (factor--listener-send-cmd "USING: parser ; in get .")))
+
+(defun factor--set-current-listener-vocab (&optional vocab)
+  (factor--listener-send-cmd
+   (format "IN: %s" (or vocab (factor--current-buffer-vocab))))
+  t)
+
+(defmacro factor--with-vocab (vocab &rest body)
+  (let ((current (make-symbol "current")))
+    `(let ((,current (factor--current-listener-vocab)))
+       (factor--set-current-listener-vocab ,vocab)
+       (prog1 (condition-case nil (progn . ,body) (error nil))
+         (factor--set-current-listener-vocab ,current)))))
+
+(put 'factor--with-vocab 'lisp-indent-function 1)
+
+;;;;; Synchronous interaction:
+
+(defsubst factor--listener-vocab-cmds (cmds &optional vocab)
+  (factor--with-vocab vocab
+    (mapcar #'factor--listener-send-cmd cmds)))
+
+(defsubst factor--listener-vocab-cmd (cmd &optional vocab)
+  (factor--with-vocab vocab
+    (factor--listener-send-cmd cmd)))
+
+;;;;; Interface: see
+
+(defconst factor--regex-error-marker "^Type :help for debugging")
+(defconst factor--regex-data-stack "^--- Data stack:")
+
+(defun factor--prune-ans-strings (ans)
+  (nreverse
+   (catch 'done
+     (let ((res))
+       (dolist (a ans res)
+         (cond ((string-match factor--regex-stack-effect a)
+                (throw 'done (cons a res)))
+               ((string-match factor--regex-data-stack a)
+                (throw 'done res))
+               ((string-match factor--regex-error-marker a)
+                (throw 'done nil))
+               (t (push a res))))))))
+
+(defun factor--see-ans-to-string (ans)
+  (let ((s (mapconcat #'identity (factor--prune-ans-strings ans) " "))
+        (font-lock-verbose nil))
+    (and (> (length s) 0)
+         (with-temp-buffer
+           (insert s)
+           (factor-mode)
+           (font-lock-fontify-buffer)
+           (buffer-string)))))
+
+(defun factor--see-current-word (&optional word)
+  (let ((word (or word (factor--symbol-at-point))))
+    (when word
+      (let ((answer (factor--listener-send-cmd (format "\\ %s see" word))))
+        (and answer (factor--see-ans-to-string answer))))))
+
+(defalias 'factor--eldoc 'factor--see-current-word)
+
+(defun factor-see-current-word (&optional word)
+  "Echo in the minibuffer information about word at point."
+  (interactive)
+  (let* ((proc (factor--listener-process))
+         (word (or word (factor--symbol-at-point)))
+         (msg (factor--see-current-word word)))
+    (if msg (message "%s" msg)
+      (if word (message "No help found for '%s'" word)
+        (message "No word at point")))))
+
+;;; to fix:
 (defun factor-run-file ()
   (interactive)
   (when (and (buffer-modified-p)
-			 (y-or-n-p (format "Save file %s? " (buffer-file-name))))
-	(save-buffer))
+             (y-or-n-p (format "Save file %s? " (buffer-file-name))))
+    (save-buffer))
   (when factor-display-compilation-output
-	(factor-display-output-buffer))
+    (factor-display-output-buffer))
   (comint-send-string "*factor*" (format "\"%s\"" (buffer-file-name)))
   (comint-send-string "*factor*" " run-file\n"))
 
 (defun factor-display-output-buffer ()
   (with-current-buffer "*factor*"
-	(goto-char (point-max))
-	(unless (get-buffer-window (current-buffer) t)
-	  (display-buffer (current-buffer) t))))
+    (goto-char (point-max))
+    (unless (get-buffer-window (current-buffer) t)
+      (display-buffer (current-buffer) t))))
 
 (defun factor-send-string (str)
   (let ((n (length (split-string str "\n"))))
@@ -485,83 +728,6 @@ buffer."
   (beginning-of-line)
   (insert "! "))
 
-(defvar factor-mode-map (make-sparse-keymap)
-  "Key map used by Factor mode.")
-
-
-;; Factor mode:
-
-;;;###autoload
-(defun factor-mode ()
-  "A mode for editing programs written in the Factor programming language.
-\\{factor-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map factor-mode-map)
-  (setq major-mode 'factor-mode)
-  (setq mode-name "Factor")
-  ;; Font locking
-  (set (make-local-variable 'comment-start) "! ")
-  (set (make-local-variable 'parse-sexp-lookup-properties) t)
-  (set (make-local-variable 'font-lock-comment-face) 'factor-font-lock-comment)
-  (set (make-local-variable 'font-lock-string-face) 'factor-font-lock-string)
-  (set (make-local-variable 'font-lock-defaults)
-       `(factor--font-lock-keywords
-         nil nil nil nil
-         (font-lock-syntactic-keywords . ,factor--font-lock-syntactic-keywords)))
-
-  (set-syntax-table factor-mode-syntax-table)
-  ;; Defun navigation
-  (setq defun-prompt-regexp "[^ :]+")
-  (set (make-local-variable 'open-paren-in-column-0-is-defun-start) t)
-  ;; Indentation
-  (set (make-local-variable 'indent-line-function) 'factor--indent-line)
-  (setq factor-indent-width (factor--guess-indent-width))
-  (setq indent-tabs-mode nil)
-
-  (run-hooks 'factor-mode-hook))
-
-(add-to-list 'auto-mode-alist '("\\.factor\\'" . factor-mode))
-
-
-;;; Factor listener mode:
-
-;;;###autoload
-(define-derived-mode factor-listener-mode comint-mode "Factor Listener"
-  "Major mode for interacting with an inferior Factor listener process.
-\\{factor-listener-mode-map}"
-  (set (make-local-variable 'comint-prompt-regexp) "^( [^)]+ ) "))
-
-(defvar factor--listener-buffer nil
-  "The buffer in which the Factor listener is running.")
-
-(defun factor--listener-start-process ()
-  "Start an inferior Factor listener process, using
-`factor-binary' and `factor-image'."
-  (setq factor--listener-buffer
-        (apply 'make-comint "factor" (expand-file-name factor-binary) nil
-               `("-run=listener" ,(format "-i=%s" (expand-file-name factor-image)))))
-  (with-current-buffer factor--listener-buffer
-    (factor-listener-mode)))
-
-(defun factor--listener-process ()
-  (or (and (buffer-live-p factor--listener-buffer)
-           (get-buffer-process factor--listener-buffer))
-      (progn (factor--listener-start-process)
-             (factor--listener-process))))
-
-;;;###autoload
-(defalias 'switch-to-factor 'run-factor)
-;;;###autoload
-(defun run-factor (&optional arg)
-  "Show the factor-listener buffer, starting the process if needed."
-  (interactive)
-  (let ((buf (process-buffer (factor--listener-process)))
-        (pop-up-windows factor-listener-window-allow-split))
-    (if factor-listener-use-other-window
-        (pop-to-buffer buf)
-      (switch-to-buffer buf))))
-
 
 ;;;; Factor help mode:
 
@@ -611,33 +777,43 @@ buffer."
 
 (defun factor--listener-help-buffer ()
   (with-current-buffer (get-buffer-create "*factor-help*")
-    (let ((inhibit-read-only t))
-      (delete-region (point-min) (point-max)))
+    (let ((inhibit-read-only t)) (erase-buffer))
     (factor-help-mode)
     (current-buffer)))
 
 (defvar factor--help-history nil)
 
 (defun factor--listener-show-help (&optional see)
-  (let* ((def (thing-at-point 'sexp))
-         (prompt (format "%s (%s): " (if see "See" "Help") def))
+  (let* ((proc (factor--listener-process))
+         (def (factor--symbol-at-point))
+         (prompt (format "See%s help on%s: " (if see " short" "")
+                         (if def (format " (%s)" def) "")))
          (ask (or (not (eq major-mode 'factor-mode))
                   (not def)
                   factor-help-always-ask))
          (cmd (format "\\ %s %s"
                       (if ask (read-string prompt nil 'factor--help-history def) def)
                       (if see "see" "help")))
-         (hb (factor--listener-help-buffer))
-         (proc (factor--listener-process)))
+         (hb (factor--listener-help-buffer)))
     (comint-redirect-send-command-to-process cmd hb proc nil)
     (pop-to-buffer hb)
     (beginning-of-buffer hb)))
 
-(defun factor-see ()
-  (interactive)
-  (factor--listener-show-help t))
+;;;; Interface: see/help commands
+
+(defun factor-see (&optional arg)
+  "See a help summary of symbol at point.
+By default, the information is shown in the minibuffer. When
+called with a prefix argument, the information is displayed in a
+separate help buffer."
+  (interactive "P")
+  (if (if factor-help-use-minibuffer (not arg) arg)
+      (factor-see-current-word)
+    (factor--listener-show-help t)))
 
 (defun factor-help ()
+  "Show extended help about the symbol at point, using a help
+buffer."
   (interactive)
   (factor--listener-show-help))
 
@@ -659,6 +835,13 @@ vocabularies which have been modified on disk."
       (define-key m (vector '(control ?c) key) cmd)
       (define-key m (vector '(control ?c) `(control ,key)) cmd))))
 
+(defun factor--define-auto-indent-key (key)
+  (define-key factor-mode-map (vector key)
+    (lambda (n)
+      (interactive "p")
+      (self-insert-command n)
+      (indent-for-tab-command))))
+
 (factor--define-key ?f 'factor-run-file)
 (factor--define-key ?r 'factor-send-region)
 (factor--define-key ?d 'factor-send-definition)
@@ -667,6 +850,9 @@ vocabularies which have been modified on disk."
 (factor--define-key ?z 'switch-to-factor t)
 (factor--define-key ?c 'comment-region)
 
+(factor--define-auto-indent-key ?\])
+(factor--define-auto-indent-key ?\})
+
 (define-key factor-mode-map "\C-ch" 'factor-help)
 (define-key factor-help-mode-map "\C-ch" 'factor-help)
 (define-key factor-mode-map "\C-m" 'newline-and-indent)
diff --git a/vm/Config.macosx.x86.64 b/vm/Config.macosx.x86.64
index e2063c4a75..7ef5f89559 100644
--- a/vm/Config.macosx.x86.64
+++ b/vm/Config.macosx.x86.64
@@ -1,3 +1,3 @@
 include vm/Config.macosx
 include vm/Config.x86.64
-CFLAGS += -arch x86_64
+CFLAGS += -m64
diff --git a/vm/cpu-ppc.S b/vm/cpu-ppc.S
index e12707819a..17db742211 100755
--- a/vm/cpu-ppc.S
+++ b/vm/cpu-ppc.S
@@ -2,6 +2,47 @@
 in the public domain. */
 #include "asm.h"
 
+#define DS_REG r29
+
+DEF(void,primitive_fixnum_add,(void)):
+    lwz r3,0(DS_REG)
+    lwz r4,-4(DS_REG)
+    subi DS_REG,DS_REG,4
+    li r0,0
+    mtxer r0
+    addo. r5,r3,r4
+    bso add_overflow
+    stw r5,0(DS_REG)
+    blr
+add_overflow:
+	b MANGLE(overflow_fixnum_add)
+
+DEF(void,primitive_fixnum_subtract,(void)):
+    lwz r3,0(DS_REG)
+    lwz r4,-4(DS_REG)
+    subi DS_REG,DS_REG,4
+    li r0,0
+    mtxer r0
+    subfo. r5,r3,r4
+	bso sub_overflow
+    stw r5,0(DS_REG)
+    blr
+sub_overflow:
+    b MANGLE(overflow_fixnum_subtract)
+
+DEF(void,primitive_fixnum_multiply,(void)):
+    lwz r3,0(DS_REG)
+    lwz r4,-4(DS_REG)
+    subi DS_REG,DS_REG,4
+    srawi r3,r3,3
+    mullwo. r5,r3,r4
+    bso multiply_overflow
+    stw r5,0(DS_REG)
+    blr
+multiply_overflow:
+    srawi r4,r4,3
+    b MANGLE(overflow_fixnum_multiply)
+    
 /* Note that the XT is passed to the quotation in r11 */
 #define CALL_OR_JUMP_QUOT \
 	lwz r11,9(r3)	   /* load quotation-xt slot */ XX \
diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S
index 6ddbd52da2..36db5d6c80 100755
--- a/vm/cpu-x86.32.S
+++ b/vm/cpu-x86.32.S
@@ -12,6 +12,10 @@ and the callstack top is passed in EDX */
 
 #define NV_TEMP_REG %ebx
 
+#define ARITH_TEMP_1 %ebp
+#define ARITH_TEMP_2 %ebx
+#define DIV_RESULT %eax
+
 #define CELL_SIZE 4
 #define STACK_PADDING 12
 
diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S
index c981095d62..7b5b5f3167 100644
--- a/vm/cpu-x86.64.S
+++ b/vm/cpu-x86.64.S
@@ -9,6 +9,10 @@
 
 #define NV_TEMP_REG %rbp
 
+#define ARITH_TEMP_1 %r8
+#define ARITH_TEMP_2 %r9
+#define DIV_RESULT %rax
+
 #ifdef WINDOWS
 
 	#define ARG0 %rcx
diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S
index 4d6737baeb..7a0d738fe0 100755
--- a/vm/cpu-x86.S
+++ b/vm/cpu-x86.S
@@ -1,3 +1,39 @@
+DEF(void,primitive_fixnum_add,(void)):
+    mov (DS_REG),ARG0
+    mov -CELL_SIZE(DS_REG),ARG1
+    sub $CELL_SIZE,DS_REG
+    mov ARG1,ARITH_TEMP_1
+    add ARG0,ARITH_TEMP_1
+    jo MANGLE(overflow_fixnum_add)
+    mov ARITH_TEMP_1,(DS_REG)
+    ret
+
+DEF(void,primitive_fixnum_subtract,(void)):
+    mov (DS_REG),ARG1
+    mov -CELL_SIZE(DS_REG),ARG0
+    sub $CELL_SIZE,DS_REG
+    mov ARG0,ARITH_TEMP_1
+    sub ARG1,ARITH_TEMP_1
+    jo MANGLE(overflow_fixnum_subtract)
+    mov ARITH_TEMP_1,(DS_REG)
+    ret
+
+DEF(void,primitive_fixnum_multiply,(void)):
+    mov (DS_REG),ARITH_TEMP_1
+    mov ARITH_TEMP_1,DIV_RESULT
+    mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
+    sar $3,ARITH_TEMP_2
+    sub $CELL_SIZE,DS_REG
+    imul ARITH_TEMP_2
+    jo multiply_overflow
+    mov DIV_RESULT,(DS_REG)
+    ret
+multiply_overflow:
+    sar $3,ARITH_TEMP_1
+    mov ARITH_TEMP_1,ARG0
+    mov ARITH_TEMP_2,ARG1
+    jmp MANGLE(overflow_fixnum_multiply)
+
 DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
 	PUSH_NONVOLATILE
 	mov ARG0,NV_TEMP_REG
diff --git a/vm/data_gc.c b/vm/data_gc.c
index ac77058fea..513a7c429c 100755
--- a/vm/data_gc.c
+++ b/vm/data_gc.c
@@ -985,6 +985,7 @@ void primitive_become(void)
 	}
 
 	gc();
+	iterate_code_heap(relocate_code_block);
 }
 
 CELL find_all_words(void)
diff --git a/vm/debug.c b/vm/debug.c
index db8e60c781..909cc8f710 100755
--- a/vm/debug.c
+++ b/vm/debug.c
@@ -129,7 +129,7 @@ void print_nested_obj(CELL obj, F_FIXNUM nesting)
 		print_string(" ]");
 		break;
 	default:
-		print_string("#<type "); print_cell(type_of(obj)); print_string(" @ "); print_cell_hex(obj);
+		print_string("#<type "); print_cell(type_of(obj)); print_string(" @ "); print_cell_hex(obj); print_string(">");
 		break;
 	}
 }
diff --git a/vm/math.c b/vm/math.c
index 07493a947f..dd01e852ad 100644
--- a/vm/math.c
+++ b/vm/math.c
@@ -1,7 +1,6 @@
 #include "master.h"
 
 /* Fixnums */
-
 F_FIXNUM to_fixnum(CELL tagged)
 {
 	switch(TAG(tagged))
@@ -31,50 +30,35 @@ void primitive_float_to_fixnum(void)
 	drepl(tag_fixnum(float_to_fixnum(dpeek())));
 }
 
-#define POP_FIXNUMS(x,y) \
-	F_FIXNUM y = untag_fixnum_fast(dpop()); \
-	F_FIXNUM x = untag_fixnum_fast(dpeek());
-
-void primitive_fixnum_add(void)
+/* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
+overflow, they call these functions. */
+F_FASTCALL void overflow_fixnum_add(F_FIXNUM x, F_FIXNUM y)
 {
-	POP_FIXNUMS(x,y)
-	drepl(allot_integer(x + y));
+	drepl(tag_bignum(fixnum_to_bignum(
+		untag_fixnum_fast(x) + untag_fixnum_fast(y))));
 }
 
-void primitive_fixnum_subtract(void)
+F_FASTCALL void overflow_fixnum_subtract(F_FIXNUM x, F_FIXNUM y)
 {
-	POP_FIXNUMS(x,y)
-	drepl(allot_integer(x - y));
+	drepl(tag_bignum(fixnum_to_bignum(
+		untag_fixnum_fast(x) - untag_fixnum_fast(y))));
 }
 
-/* Multiply two integers, and trap overflow.
-Thanks to David Blaikie (The_Vulture from freenode #java) for the hint. */
-void primitive_fixnum_multiply(void)
+F_FASTCALL void overflow_fixnum_multiply(F_FIXNUM x, F_FIXNUM y)
 {
-	POP_FIXNUMS(x,y)
-
-	if(x == 0 || y == 0)
-		drepl(tag_fixnum(0));
-	else
-	{
-		F_FIXNUM prod = x * y;
-		/* if this is not equal, we have overflow */
-		if(prod / x == y)
-			drepl(allot_integer(prod));
-		else
-		{
-			F_ARRAY *bx = fixnum_to_bignum(x);
-			REGISTER_BIGNUM(bx);
-			F_ARRAY *by = fixnum_to_bignum(y);
-			UNREGISTER_BIGNUM(bx);
-			drepl(tag_bignum(bignum_multiply(bx,by)));
-		}
-	}
+	F_ARRAY *bx = fixnum_to_bignum(x);
+	REGISTER_BIGNUM(bx);
+	F_ARRAY *by = fixnum_to_bignum(y);
+	UNREGISTER_BIGNUM(bx);
+	drepl(tag_bignum(bignum_multiply(bx,by)));
 }
 
+/* Division can only overflow when we are dividing the most negative fixnum
+by -1. */
 void primitive_fixnum_divint(void)
 {
-	POP_FIXNUMS(x,y)
+	F_FIXNUM y = untag_fixnum_fast(dpop()); \
+	F_FIXNUM x = untag_fixnum_fast(dpeek());
 	F_FIXNUM result = x / y;
 	if(result == -FIXNUM_MIN)
 		drepl(allot_integer(-FIXNUM_MIN));
@@ -99,31 +83,30 @@ void primitive_fixnum_divmod(void)
 }
 
 /*
- * Note the hairy overflow check.
  * If we're shifting right by n bits, we won't overflow as long as none of the
  * high WORD_SIZE-TAG_BITS-n bits are set.
  */
+#define SIGN_MASK(x) ((x) >> (WORD_SIZE - 1))
+#define BRANCHLESS_MAX(x,y) ((x) - (((x) - (y)) & SIGN_MASK((x) - (y))))
+#define BRANCHLESS_ABS(x) ((x ^ SIGN_MASK(x)) - SIGN_MASK(x))
+
 void primitive_fixnum_shift(void)
 {
-	POP_FIXNUMS(x,y)
+	F_FIXNUM y = untag_fixnum_fast(dpop()); \
+	F_FIXNUM x = untag_fixnum_fast(dpeek());
 
-	if(x == 0 || y == 0)
-	{
-		drepl(tag_fixnum(x));
+	if(x == 0)
 		return;
-	}
 	else if(y < 0)
 	{
-		if(y <= -WORD_SIZE)
-			drepl(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
-		else
-			drepl(tag_fixnum(x >> -y));
+		y = BRANCHLESS_MAX(y,-WORD_SIZE + 1);
+		drepl(tag_fixnum(x >> -y));
 		return;
 	}
 	else if(y < WORD_SIZE - TAG_BITS)
 	{
 		F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y));
-		if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
+		if(!(BRANCHLESS_ABS(x) & mask))
 		{
 			drepl(tag_fixnum(x << y));
 			return;
diff --git a/vm/math.h b/vm/math.h
index 4fa3c8d35f..f94f12b76d 100644
--- a/vm/math.h
+++ b/vm/math.h
@@ -12,6 +12,11 @@ void primitive_float_to_fixnum(void);
 void primitive_fixnum_add(void);
 void primitive_fixnum_subtract(void);
 void primitive_fixnum_multiply(void);
+
+DLLEXPORT F_FASTCALL void overflow_fixnum_add(F_FIXNUM x, F_FIXNUM y);
+DLLEXPORT F_FASTCALL void overflow_fixnum_subtract(F_FIXNUM x, F_FIXNUM y);
+DLLEXPORT F_FASTCALL void overflow_fixnum_multiply(F_FIXNUM x, F_FIXNUM y);
+
 void primitive_fixnum_divint(void);
 void primitive_fixnum_divmod(void);
 void primitive_fixnum_shift(void);
diff --git a/vm/primitives.c b/vm/primitives.c
index a34d695bb8..135d5478ea 100755
--- a/vm/primitives.c
+++ b/vm/primitives.c
@@ -141,4 +141,5 @@ void *primitives[] = {
 	primitive_unimplemented,
 	primitive_gc_reset,
 	primitive_jit_compile,
+	primitive_load_locals,
 };
diff --git a/vm/run.c b/vm/run.c
index a28a956f29..c7002eb0ec 100755
--- a/vm/run.c
+++ b/vm/run.c
@@ -190,3 +190,11 @@ void primitive_set_slot(void)
 	CELL value = dpop();
 	set_slot(obj,slot,value);
 }
+
+void primitive_load_locals(void)
+{
+	F_FIXNUM count = untag_fixnum_fast(dpop());
+	memcpy((CELL *)(rs + CELLS),(CELL *)(ds - CELLS * (count - 1)),CELLS * count);
+	ds -= CELLS * count;
+	rs += CELLS * count;
+}
diff --git a/vm/run.h b/vm/run.h
index f156ba3f03..06b6317015 100755
--- a/vm/run.h
+++ b/vm/run.h
@@ -247,5 +247,6 @@ void primitive_set_os_envs(void);
 void primitive_micros(void);
 void primitive_sleep(void);
 void primitive_set_slot(void);
+void primitive_load_locals(void);
 
 bool stage2;
diff --git a/vm/types.c b/vm/types.c
index f1588465a4..d6e78013cb 100755
--- a/vm/types.c
+++ b/vm/types.c
@@ -139,18 +139,6 @@ CELL allot_array_1(CELL obj)
 	return tag_object(a);
 }
 
-CELL allot_array_2(CELL v1, CELL v2)
-{
-	REGISTER_ROOT(v1);
-	REGISTER_ROOT(v2);
-	F_ARRAY *a = allot_array_internal(ARRAY_TYPE,2);
-	UNREGISTER_ROOT(v2);
-	UNREGISTER_ROOT(v1);
-	set_array_nth(a,0,v1);
-	set_array_nth(a,1,v2);
-	return tag_object(a);
-}
-
 CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
 {
 	REGISTER_ROOT(v1);
@@ -331,15 +319,9 @@ void primitive_tuple_boa(void)
 {
 	F_TUPLE_LAYOUT *layout = untag_object(dpop());
 	F_FIXNUM size = untag_fixnum_fast(layout->size);
-
-	REGISTER_UNTAGGED(layout);
 	F_TUPLE *tuple = allot_tuple(layout);
-	UNREGISTER_UNTAGGED(layout);
-
-	F_FIXNUM i;
-	for(i = size - 1; i >= 0; i--)
-		put(AREF(tuple,i),dpop());
-
+	memcpy(tuple + 1,(CELL *)(ds - CELLS * (size - 1)),CELLS * size);
+	ds -= CELLS * size;
 	dpush(tag_tuple(tuple));
 }
 
diff --git a/vm/types.h b/vm/types.h
index ebbb8a2642..47747547db 100755
--- a/vm/types.h
+++ b/vm/types.h
@@ -109,7 +109,6 @@ F_ARRAY *allot_array(CELL type, CELL capacity, CELL fill);
 F_BYTE_ARRAY *allot_byte_array(CELL size);
 
 CELL allot_array_1(CELL obj);
-CELL allot_array_2(CELL v1, CELL v2);
 CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4);
 
 void primitive_array(void);