From 88ef60fe1d80c2c3fb227b8f8950d2cddd072498 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 10:29:34 -0500
Subject: [PATCH 01/20] better smtp docs

---
 basis/smtp/smtp-docs.factor | 11 +++++++++++
 basis/smtp/smtp.factor      |  4 ++--
 2 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/basis/smtp/smtp-docs.factor b/basis/smtp/smtp-docs.factor
index 435b04504d..e859e082ff 100644
--- a/basis/smtp/smtp-docs.factor
+++ b/basis/smtp/smtp-docs.factor
@@ -4,12 +4,18 @@ USING: accessors kernel quotations help.syntax help.markup
 io.sockets strings calendar ;
 IN: smtp
 
+HELP: smtp-domain
+{ $description "The name of the machine that is sending the email.  This variable will be filled in by the " { $link host-name } " word if not set by the user." } ;
+
 HELP: smtp-server
 { $description "Holds an " { $link inet } " object with the address of an SMTP server." } ;
 
 HELP: smtp-read-timeout
 { $description "Holds an " { $link duration } " object that specifies how long to wait for a response from the SMTP server." } ;
 
+HELP: esmtp?
+{ $description "Set true by default, determines whether the SMTP client is using the Extended SMTP protocol." } ;
+
 HELP: with-smtp-connection
 { $values { "quot" quotation } }
 { $description "Connects to an SMTP server stored in " { $link smtp-server } " and calls the quotation." } ;
@@ -36,5 +42,10 @@ HELP: send-email
 } ;
 
 ARTICLE: "smtp" "SMTP Client Library"
+"Configuring SMTP:"
+{ $subsection smtp-server }
+{ $subsection smtp-read-timeout }
+{ $subsection smtp-domain }
+{ $subsection esmtp? }
 "Sending an email:"
 { $subsection send-email } ;
diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor
index f95ecddc1e..26bfea9a13 100755
--- a/basis/smtp/smtp.factor
+++ b/basis/smtp/smtp.factor
@@ -10,7 +10,7 @@ IN: smtp
 SYMBOL: smtp-domain
 SYMBOL: smtp-server     "localhost" "smtp" <inet> smtp-server set-global
 SYMBOL: smtp-read-timeout    1 minutes smtp-read-timeout set-global
-SYMBOL: esmtp           t esmtp set-global
+SYMBOL: esmtp?           t esmtp? set-global
 
 LOG: log-smtp-connection NOTICE ( addrspec -- )
 
@@ -39,7 +39,7 @@ TUPLE: email
 : command ( string -- ) write crlf flush ;
 
 : helo ( -- )
-    esmtp get "EHLO " "HELO " ? host-name append command ;
+    esmtp? get "EHLO " "HELO " ? host-name append command ;
 
 ERROR: bad-email-address email ;
 

From efeea9293560c3d5c79d8e679546face17d940a0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 10:36:00 -0500
Subject: [PATCH 02/20] make editors use make

---
 basis/editors/editpadpro/editpadpro.factor     | 2 +-
 basis/editors/editplus/editplus.factor         | 2 +-
 basis/editors/emacs/emacs.factor               | 2 +-
 basis/editors/emeditor/emeditor.factor         | 3 ++-
 basis/editors/gvim/gvim.factor                 | 2 +-
 basis/editors/notepadpp/notepadpp.factor       | 2 +-
 basis/editors/scite/scite.factor               | 2 +-
 basis/editors/ted-notepad/ted-notepad.factor   | 2 +-
 basis/editors/textmate/textmate.factor         | 2 +-
 basis/editors/textwrangler/textwrangler.factor | 2 +-
 basis/editors/ultraedit/ultraedit.factor       | 2 +-
 basis/editors/vim/vim.factor                   | 3 ++-
 12 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/basis/editors/editpadpro/editpadpro.factor b/basis/editors/editpadpro/editpadpro.factor
index 9da57e16bf..09f59f0916 100755
--- a/basis/editors/editpadpro/editpadpro.factor
+++ b/basis/editors/editpadpro/editpadpro.factor
@@ -1,6 +1,6 @@
 USING: definitions kernel parser words sequences math.parser
 namespaces editors io.launcher windows.shell32 io.files
-io.paths strings unicode.case ;
+io.paths strings unicode.case make ;
 IN: editors.editpadpro
 
 : editpadpro-path
diff --git a/basis/editors/editplus/editplus.factor b/basis/editors/editplus/editplus.factor
index 363d202f6c..8af036f290 100755
--- a/basis/editors/editplus/editplus.factor
+++ b/basis/editors/editplus/editplus.factor
@@ -1,5 +1,5 @@
 USING: editors io.files io.launcher kernel math.parser
-namespaces sequences windows.shell32 ;
+namespaces sequences windows.shell32 make ;
 IN: editors.editplus
 
 : editplus-path ( -- path )
diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor
index 966c4f368e..1d9f72f8c3 100755
--- a/basis/editors/emacs/emacs.factor
+++ b/basis/editors/emacs/emacs.factor
@@ -1,5 +1,5 @@
 USING: definitions io.launcher kernel parser words sequences math
-math.parser namespaces editors ;
+math.parser namespaces editors make ;
 IN: editors.emacs
 
 : emacsclient ( file line -- )
diff --git a/basis/editors/emeditor/emeditor.factor b/basis/editors/emeditor/emeditor.factor
index 8aecb49ae5..9aec22eed1 100755
--- a/basis/editors/emeditor/emeditor.factor
+++ b/basis/editors/emeditor/emeditor.factor
@@ -1,5 +1,6 @@
 USING: editors hardware-info.windows io.files io.launcher
-kernel math.parser namespaces sequences windows.shell32 ;
+kernel math.parser namespaces sequences windows.shell32
+make ;
 IN: editors.emeditor
 
 : emeditor-path ( -- path )
diff --git a/basis/editors/gvim/gvim.factor b/basis/editors/gvim/gvim.factor
index 4cc9de17a1..ad6fb65cfb 100755
--- a/basis/editors/gvim/gvim.factor
+++ b/basis/editors/gvim/gvim.factor
@@ -1,6 +1,6 @@
 USING: io.backend io.files kernel math math.parser
 namespaces sequences system combinators
-editors.vim vocabs.loader ;
+editors.vim vocabs.loader make ;
 IN: editors.gvim
 
 SINGLETON: gvim
diff --git a/basis/editors/notepadpp/notepadpp.factor b/basis/editors/notepadpp/notepadpp.factor
index 959e633cc3..540612aeec 100755
--- a/basis/editors/notepadpp/notepadpp.factor
+++ b/basis/editors/notepadpp/notepadpp.factor
@@ -1,5 +1,5 @@
 USING: editors io.files io.launcher kernel math.parser
-namespaces sequences windows.shell32 ;
+namespaces sequences windows.shell32 make ;
 IN: editors.notepadpp
 
 : notepadpp-path
diff --git a/basis/editors/scite/scite.factor b/basis/editors/scite/scite.factor
index a0bacaabba..aa5c5ef2a1 100755
--- a/basis/editors/scite/scite.factor
+++ b/basis/editors/scite/scite.factor
@@ -9,7 +9,7 @@
 ! if not on the path.
 !
 USING: io.files io.launcher kernel namespaces math
-math.parser editors sequences windows.shell32 ;
+math.parser editors sequences windows.shell32 make ;
 IN: editors.scite
 
 : scite-path ( -- path )
diff --git a/basis/editors/ted-notepad/ted-notepad.factor b/basis/editors/ted-notepad/ted-notepad.factor
index 9b341dd2a8..b4135c92a0 100755
--- a/basis/editors/ted-notepad/ted-notepad.factor
+++ b/basis/editors/ted-notepad/ted-notepad.factor
@@ -1,5 +1,5 @@
 USING: editors io.files io.launcher kernel math.parser
-namespaces sequences windows.shell32 ;
+namespaces sequences windows.shell32 make ;
 IN: editors.ted-notepad
 
 : ted-notepad-path
diff --git a/basis/editors/textmate/textmate.factor b/basis/editors/textmate/textmate.factor
index 12d45aa192..8bea085c7f 100755
--- a/basis/editors/textmate/textmate.factor
+++ b/basis/editors/textmate/textmate.factor
@@ -1,5 +1,5 @@
 USING: definitions io.launcher kernel math math.parser parser
-namespaces prettyprint editors ;
+namespaces prettyprint editors make ;
 
 IN: editors.textmate
 
diff --git a/basis/editors/textwrangler/textwrangler.factor b/basis/editors/textwrangler/textwrangler.factor
index e97dadcdcb..f5a33f044d 100644
--- a/basis/editors/textwrangler/textwrangler.factor
+++ b/basis/editors/textwrangler/textwrangler.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Ben Schlingelhof.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: definitions io.launcher kernel parser words sequences
-math math.parser namespaces editors ;
+math math.parser namespaces editors make ;
 IN: editors.textwrangler
 
 : tw ( file line -- )
diff --git a/basis/editors/ultraedit/ultraedit.factor b/basis/editors/ultraedit/ultraedit.factor
index d0bb789c1b..7c9c41df7a 100755
--- a/basis/editors/ultraedit/ultraedit.factor
+++ b/basis/editors/ultraedit/ultraedit.factor
@@ -1,5 +1,5 @@
 USING: editors io.files io.launcher kernel math.parser
-namespaces sequences windows.shell32 ;
+namespaces sequences windows.shell32 wne ;
 IN: editors.ultraedit
 
 : ultraedit-path ( -- path )
diff --git a/basis/editors/vim/vim.factor b/basis/editors/vim/vim.factor
index bfbb8f15a5..f07f257888 100755
--- a/basis/editors/vim/vim.factor
+++ b/basis/editors/vim/vim.factor
@@ -1,5 +1,6 @@
 USING: definitions io io.launcher kernel math math.parser
-namespaces parser prettyprint sequences editors accessors ;
+namespaces parser prettyprint sequences editors accessors
+make ;
 IN: editors.vim
 
 SYMBOL: vim-path

From f497c7e1519dad6624ac912600c95a2a6f6e1f25 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 11:29:12 -0500
Subject: [PATCH 03/20] Move map-reduce combinator to core, re-implement
 norm-sq and v. for better performance

---
 basis/math/vectors/vectors-tests.factor |  4 ++++
 basis/math/vectors/vectors.factor       |  6 +++---
 core/sequences/sequences.factor         | 11 +++++++++++
 extra/sequences/lib/lib-tests.factor    |  3 ---
 extra/sequences/lib/lib.factor          |  3 ---
 5 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/basis/math/vectors/vectors-tests.factor b/basis/math/vectors/vectors-tests.factor
index 5c71e2374f..498bb81f62 100644
--- a/basis/math/vectors/vectors-tests.factor
+++ b/basis/math/vectors/vectors-tests.factor
@@ -5,3 +5,7 @@ USING: math.vectors tools.test ;
 [ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
 [ { 1 2 3 } ] [ { 2 4 6 } 2 v/n ] unit-test
 [ { 1/1 1/2 1/3 } ] [ 1 { 1 2 3 } n/v ] unit-test
+
+[ 4 ] [ { 1 2 } norm-sq ] unit-test
+[ 36 ] [ { 2 3 } norm-sq ] unit-test
+
diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index b6ac459123..5316720b2f 100755
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel sequences math math.functions hints
 math.order ;
@@ -19,8 +19,8 @@ IN: math.vectors
 : vmax ( u v -- w ) [ max ] 2map ;
 : vmin ( u v -- w ) [ min ] 2map ;
 
-: v. ( u v -- x ) 0 [ * + ] 2reduce ;
-: norm-sq ( v -- x ) 0 [ absq + ] reduce ;
+: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
+: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
 : norm ( v -- x ) norm-sq sqrt ;
 : normalize ( u -- v ) dup norm v/n ;
 
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 6f755e5cb5..ae895f4853 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -747,6 +747,17 @@ PRIVATE>
 : unclip-slice ( seq -- rest first )
     [ rest-slice ] [ first ] bi ; inline
 
+: map-reduce ( seq map-quot reduce-quot -- result )
+    [ [ unclip-slice ] dip [ call ] keep ] dip
+    compose reduce ; inline
+
+: 2map-reduce ( seq1 seq2 map-quot reduce-quot -- result )
+    [ [ 2unclip-slice ] dip [ call ] keep ] dip
+    compose 2reduce ; inline
+
+: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 )
+    [ unclip-slice ] bi@ swapd ; inline
+
 : unclip-last-slice ( seq -- butlast last )
     [ but-last-slice ] [ peek ] bi ; inline
 
diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor
index 12bdd45c46..18c9d7f735 100755
--- a/extra/sequences/lib/lib-tests.factor
+++ b/extra/sequences/lib/lib-tests.factor
@@ -10,9 +10,6 @@ IN: sequences.lib.tests
 { { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
 [ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
 
-[ 4 ] [ { 1 2 } [ sq ] [ * ] map-reduce ] unit-test
-[ 36 ] [ { 2 3 } [ sq ] [ * ] map-reduce ] unit-test
-
 [ 10 ] [ { 1 2 3 4 } [ + ] reduce* ] unit-test
 [ 24 ] [ { 1 2 3 4 } [ * ] reduce* ] unit-test
 
diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index ba49b8ee9e..0ce4f56f7a 100755
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -31,9 +31,6 @@ IN: sequences.lib
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: map-reduce ( seq map-quot reduce-quot -- result )
-    >r [ unclip ] dip [ call ] keep r> compose reduce ; inline
-
 : reduce* ( seq quot -- result ) [ ] swap map-reduce ; inline
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

From fdff43ee0023a21fee92222d2813c19a2837705f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 11:32:40 -0500
Subject: [PATCH 04/20] Fix load problem

---
 core/sequences/sequences.factor | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index ae895f4853..57dba9ed4e 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -747,6 +747,9 @@ PRIVATE>
 : unclip-slice ( seq -- rest first )
     [ rest-slice ] [ first ] bi ; inline
 
+: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 )
+    [ unclip-slice ] bi@ swapd ; inline
+
 : map-reduce ( seq map-quot reduce-quot -- result )
     [ [ unclip-slice ] dip [ call ] keep ] dip
     compose reduce ; inline
@@ -755,9 +758,6 @@ PRIVATE>
     [ [ 2unclip-slice ] dip [ call ] keep ] dip
     compose 2reduce ; inline
 
-: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 )
-    [ unclip-slice ] bi@ swapd ; inline
-
 : unclip-last-slice ( seq -- butlast last )
     [ but-last-slice ] [ peek ] bi ; inline
 

From 1c038b611adaa7384d8cc2c8e91426c63bf0fc87 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 12:08:01 -0500
Subject: [PATCH 05/20] add docs for mime-types

---
 basis/mime-types/mime-types-docs.factor | 35 +++++++++++++++++++++++++
 1 file changed, 35 insertions(+)
 create mode 100644 basis/mime-types/mime-types-docs.factor

diff --git a/basis/mime-types/mime-types-docs.factor b/basis/mime-types/mime-types-docs.factor
new file mode 100644
index 0000000000..cf44808725
--- /dev/null
+++ b/basis/mime-types/mime-types-docs.factor
@@ -0,0 +1,35 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs help.markup help.syntax io.streams.string sequences ;
+IN: mime-types
+
+HELP: mime-db
+{ $values
+    
+     { "seq" sequence } }
+{ $description "Outputs an array where the first element is a MIME type and the rest of the array is file extensions that have that MIME type." } ;
+
+HELP: mime-type
+{ $values
+    { "path" "a pathname string" }
+    { "mime-type" "a MIME type string" } }
+{ $description "Outputs the MIME type associtated with a path by parsing the path's file extension and looking it up in the table returned by " { $link mime-types } "." } ;
+
+HELP: mime-types
+{ $values
+    
+     { "assoc" assoc } }
+{ $description "Outputs an " { $snippet "assoc" } " made from the data in the " { $link mime-db } " word where the keys are file extensions and the values are the corresponding MIME types." } ;
+
+HELP: nonstandard-mime-types
+{ $values
+    
+     { "assoc" assoc } }
+{ $description "A list of Factor-specific MIME types that are added to the MIME database loaded from disk." } ;
+
+ARTICLE: "mime-types" "mime-types"
+"The " { $vocab-link "mime-types" } " vocabulary loads a file of MIME types and provides a word to look up the MIME type based on a file extension." $nl
+"Looking up a MIME type:"
+{ $subsection mime-type } ;
+
+ABOUT: "mime-types"

From 7f3b0de65996d87a9d338130ca6d83531943f267 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 12:16:21 -0500
Subject: [PATCH 06/20] better docs

---
 basis/alias/alias-docs.factor | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/basis/alias/alias-docs.factor b/basis/alias/alias-docs.factor
index f4d4ac0361..4dcf1a7738 100644
--- a/basis/alias/alias-docs.factor
+++ b/basis/alias/alias-docs.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: kernel words help.markup help.syntax ;
 IN: alias
 
@@ -14,4 +16,11 @@ HELP: ALIAS:
     }
 } ;
 
+ARTICLE: "alias" "Alias"
+"The " { $vocab-link "alias" } " vocabulary implements a way to make many different names for the same word. Although creating new names for words is generally frowned upon, aliases are useful for the Win32 API and other cases where words need to be renamed for symmetry." $nl 
+"Make a new word that aliases another word:"
+{ $subsection define-alias }
+"Make an alias at parse-time:"
+{ $subsection POSTPONE: ALIAS: } ;
 
+ABOUT: "alias"

From 31939341e3a2ffe8f623347d58b80d654e8dd9d8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 12:16:27 -0500
Subject: [PATCH 07/20] better article name

---
 basis/mime-types/mime-types-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/mime-types/mime-types-docs.factor b/basis/mime-types/mime-types-docs.factor
index cf44808725..058a71d838 100644
--- a/basis/mime-types/mime-types-docs.factor
+++ b/basis/mime-types/mime-types-docs.factor
@@ -27,7 +27,7 @@ HELP: nonstandard-mime-types
      { "assoc" assoc } }
 { $description "A list of Factor-specific MIME types that are added to the MIME database loaded from disk." } ;
 
-ARTICLE: "mime-types" "mime-types"
+ARTICLE: "mime-types" "MIME types"
 "The " { $vocab-link "mime-types" } " vocabulary loads a file of MIME types and provides a word to look up the MIME type based on a file extension." $nl
 "Looking up a MIME type:"
 { $subsection mime-type } ;

From 022a90c843a51b2098822b4852166a0bc360faee Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 12:21:32 -0500
Subject: [PATCH 08/20] add vocab-link in docs

---
 basis/alarms/alarms-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/alarms/alarms-docs.factor b/basis/alarms/alarms-docs.factor
index 49480c0fe0..dac8b72dd5 100755
--- a/basis/alarms/alarms-docs.factor
+++ b/basis/alarms/alarms-docs.factor
@@ -23,7 +23,7 @@ HELP: every
 { $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency." } ;
 
 ARTICLE: "alarms" "Alarms"
-"Alarms provide a lightweight way to schedule one-time and recurring tasks without spawning a new thread."
+"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread."
 { $subsection alarm }
 { $subsection add-alarm }
 { $subsection later }

From 1384514ad91501d0d5b9c7c8c1bee5c3add0a202 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 12:30:42 -0500
Subject: [PATCH 09/20] better base64 docs

---
 basis/ascii/ascii-docs.factor   |  2 +-
 basis/base64/base64-docs.factor | 18 +++++++++++++-----
 basis/base64/base64.factor      |  2 +-
 3 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/basis/ascii/ascii-docs.factor b/basis/ascii/ascii-docs.factor
index 1f7a56bed9..75af8a7102 100755
--- a/basis/ascii/ascii-docs.factor
+++ b/basis/ascii/ascii-docs.factor
@@ -38,7 +38,7 @@ HELP: quotable?
 { $description "Tests for characters which may appear in a Factor string literal without escaping." } ;
 
 ARTICLE: "ascii" "ASCII character classes"
-"Traditional ASCII character classes:"
+"The " { $vocab-link "ascii" } " vocabulary implements traditional ASCII character classes:"
 { $subsection blank? }
 { $subsection letter? }
 { $subsection LETTER? }
diff --git a/basis/base64/base64-docs.factor b/basis/base64/base64-docs.factor
index fe948bf667..ed92a19577 100644
--- a/basis/base64/base64-docs.factor
+++ b/basis/base64/base64-docs.factor
@@ -1,20 +1,28 @@
-USING: help.markup help.syntax kernel math ;
+USING: help.markup help.syntax kernel math sequences ;
 IN: base64
 
 HELP: >base64
-{ $values { "seq" "a sequence" } { "base64" "a string of base64 characters" } }
+{ $values { "seq" sequence } { "base64" "a string of base64 characters" } }
 { $description "Converts a sequence to its base64 representation by taking six bits at a time as an index into a lookup table containing alphanumerics, '+', and '/'.  The result is padded with '=' if the input was not a multiple of six bits." }
 { $examples
-    { $unchecked-example "\"The monorail is a free service.\" >base64 ." "VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==" }
+    { $example "USING: prettyprint base64 strings ;" "\"The monorail is a free service.\" >base64 >string ." "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\"" }
 }
 { $see-also base64> } ;
 
 HELP: base64>
-{ $values { "base64" "a string of base64 characters" } { "str" "a string" } }
+{ $values { "base64" "a string of base64 characters" } { "seq" sequence } }
 { $description "Converts a string in base64 encoding back into its binary representation." }
 { $examples
-    { $unchecked-example "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\" base64> ." "\"The monorail is a free service.\"" }
+    { $example "USING: prettyprint base64 strings ;" "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\" base64> >string ." "\"The monorail is a free service.\"" }
 }
 { $notes "This word will throw if the input string contains characters other than those allowed in base64 encodings." }
 { $see-also >base64 } ;
 
+ARTICLE: "base64" "Base 64 conversions"
+"The " { $vocab-link "base64" } " vocabulary implements conversions of sequences to printable characters in base 64. These plain-text representations of binary data may be passed around and converted back to binary data later." $nl
+"Converting to base 64:"
+{ $subsection >base64 }
+"Converting back to binary:"
+{ $subsection base64> } ;
+
+ABOUT: "base64"
diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor
index 7097de6c6e..e3033a2bde 100644
--- a/basis/base64/base64.factor
+++ b/basis/base64/base64.factor
@@ -43,7 +43,7 @@ PRIVATE>
     [ [ "" ] [ >base64-rem ] if-empty ]
     bi* append ;
 
-: base64> ( base64 -- str )
+: base64> ( base64 -- seq )
     #! input length must be a multiple of 4
     [ 4 <groups> [ decode4 ] map concat ]
     [ [ CHAR: = = ] count-end ]

From 624f0f552c24dfbb0dd2b7834706d28b368e5c79 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 12 Sep 2008 12:32:34 -0500
Subject: [PATCH 10/20] move about to end

---
 basis/binary-search/binary-search-docs.factor | 22 +++++++++----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/basis/binary-search/binary-search-docs.factor b/basis/binary-search/binary-search-docs.factor
index 8b85e078ce..caabbd7419 100644
--- a/basis/binary-search/binary-search-docs.factor
+++ b/basis/binary-search/binary-search-docs.factor
@@ -1,17 +1,6 @@
 IN: binary-search
 USING: help.markup help.syntax sequences kernel math.order ;
 
-ARTICLE: "binary-search" "Binary search"
-"The " { $emphasis "binary search" } " algorithm allows elements to be located in sorted sequence in " { $snippet "O(log n)" } " time."
-{ $subsection search }
-"Variants of sequence words optimized for sorted sequences:"
-{ $subsection sorted-index }
-{ $subsection sorted-member? }
-{ $subsection sorted-memq? }
-{ $see-also "order-specifiers" "sequences-sorting" } ;
-
-ABOUT: "binary-search"
-
 HELP: search
 { $values { "seq" "a sorted sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- <=> )" } } { "i" "an index, or " { $link f } } { "elt" "an element, or " { $link f } } }
 { $description "Performs a binary search on a sequence, calling the quotation to decide whether to end the search (" { $link +eq+ } "), search lower (" { $link +lt+ } ") or search higher (" { $link +gt+ } ")."
@@ -41,3 +30,14 @@ HELP: sorted-memq?
 { $description "Tests if the sorted sequence contains " { $snippet "elt" } ". Equality is tested with " { $link eq? } "." } ;
 
 { memq? sorted-memq? } related-words
+
+ARTICLE: "binary-search" "Binary search"
+"The " { $emphasis "binary search" } " algorithm allows elements to be located in sorted sequence in " { $snippet "O(log n)" } " time."
+{ $subsection search }
+"Variants of sequence words optimized for sorted sequences:"
+{ $subsection sorted-index }
+{ $subsection sorted-member? }
+{ $subsection sorted-memq? }
+{ $see-also "order-specifiers" "sequences-sorting" } ;
+
+ABOUT: "binary-search"

From 82a076df7923b5ddf1b89c840562e22906a964ab Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 15:49:46 -0500
Subject: [PATCH 11/20] Clean up human sort, move it to basis

---
 basis/sorting/human/human-tests.factor |  6 ++++++
 basis/sorting/human/human.factor       | 10 ++++++++++
 extra/sequences/lib/lib.factor         | 25 -------------------------
 3 files changed, 16 insertions(+), 25 deletions(-)
 create mode 100644 basis/sorting/human/human-tests.factor
 create mode 100644 basis/sorting/human/human.factor

diff --git a/basis/sorting/human/human-tests.factor b/basis/sorting/human/human-tests.factor
new file mode 100644
index 0000000000..0e20b54c2f
--- /dev/null
+++ b/basis/sorting/human/human-tests.factor
@@ -0,0 +1,6 @@
+USING: sorting.human tools.test ;
+IN: sorting.human.tests
+
+\ human-sort must-infer
+
+[ { "x1y" "x2" "x10y" } ] [ { "x1y" "x10y" "x2" } human-sort ] unit-test
diff --git a/basis/sorting/human/human.factor b/basis/sorting/human/human.factor
new file mode 100644
index 0000000000..1c2ba419c7
--- /dev/null
+++ b/basis/sorting/human/human.factor
@@ -0,0 +1,10 @@
+! Copyright (C) 2008 Doug Coleman, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: peg.ebnf math.parser kernel assocs sorting ;
+IN: sorting.human
+
+: find-numbers ( string -- seq )
+    [EBNF Result = ([0-9]+ => [[ string>number ]] | (!([0-9]) .)+)* EBNF] ;
+
+: human-sort ( seq -- seq' )
+    [ dup find-numbers ] { } map>assoc sort-values keys ;
diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 0ce4f56f7a..690d7f4b76 100755
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -131,23 +131,6 @@ PRIVATE>
 : power-set ( seq -- subsets )
     2 over length exact-number-strings swap [ switches ] curry map ;
 
-: cut-find ( seq pred -- before after )
-    dupd find drop dup [ cut ] when ;
-
-: cut3 ( seq pred -- first mid last )
-    [ cut-find ] keep [ not ] compose cut-find ;
-
-: (cut-all) ( seq pred quot -- )
-    [ >r cut3 r> dip >r >r , r> [ , ] when* r> ] 2keep
-    pick [ (cut-all) ] [ 3drop ] if ;
-
-: cut-all ( seq pred quot -- first mid last )
-    [ (cut-all) ] { } make ;
-
-: human-sort ( seq -- newseq )
-    [ dup [ digit? ] [ string>number ] cut-all ] { } map>assoc
-    sort-values keys ;
-
 : ?first ( seq -- first/f ) 0 swap ?nth ; inline
 : ?second ( seq -- second/f ) 1 swap ?nth ; inline
 : ?third ( seq -- third/f ) 2 swap ?nth ; inline
@@ -164,14 +147,6 @@ USE: continuations
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! List the positions of obj in seq
-
-: indices ( seq obj -- seq )
-  >r dup length swap r>
-  [ = [ ] [ drop f ] if ] curry
-  2map
-  sift ;
-
 <PRIVATE
 : (attempt-each-integer) ( i n quot -- result )
     [

From a295469a50b0a01f8a9c02713ebb346abd58539a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 15:50:34 -0500
Subject: [PATCH 12/20] Add meta-data

---
 basis/sorting/human/authors.txt | 2 ++
 basis/sorting/human/summary.txt | 1 +
 basis/sorting/human/tags.txt    | 2 ++
 3 files changed, 5 insertions(+)
 create mode 100644 basis/sorting/human/authors.txt
 create mode 100644 basis/sorting/human/summary.txt
 create mode 100644 basis/sorting/human/tags.txt

diff --git a/basis/sorting/human/authors.txt b/basis/sorting/human/authors.txt
new file mode 100644
index 0000000000..5674120196
--- /dev/null
+++ b/basis/sorting/human/authors.txt
@@ -0,0 +1,2 @@
+Doug Coleman
+Slava Pestov
diff --git a/basis/sorting/human/summary.txt b/basis/sorting/human/summary.txt
new file mode 100644
index 0000000000..a72934f9e6
--- /dev/null
+++ b/basis/sorting/human/summary.txt
@@ -0,0 +1 @@
+Correct sorting of sequences of strings with embedded numbers
diff --git a/basis/sorting/human/tags.txt b/basis/sorting/human/tags.txt
new file mode 100644
index 0000000000..3ab2d731fe
--- /dev/null
+++ b/basis/sorting/human/tags.txt
@@ -0,0 +1,2 @@
+collections
+text

From d5140cf248050b3ace5a111ef8ceeb14dab3e268 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 15:52:43 -0500
Subject: [PATCH 13/20] Fix math.vectors unit tests

---
 basis/math/vectors/vectors-tests.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/basis/math/vectors/vectors-tests.factor b/basis/math/vectors/vectors-tests.factor
index 498bb81f62..aef4ade877 100644
--- a/basis/math/vectors/vectors-tests.factor
+++ b/basis/math/vectors/vectors-tests.factor
@@ -6,6 +6,6 @@ USING: math.vectors tools.test ;
 [ { 1 2 3 } ] [ { 2 4 6 } 2 v/n ] unit-test
 [ { 1/1 1/2 1/3 } ] [ 1 { 1 2 3 } n/v ] unit-test
 
-[ 4 ] [ { 1 2 } norm-sq ] unit-test
-[ 36 ] [ { 2 3 } norm-sq ] unit-test
+[ 5 ] [ { 1 2 } norm-sq ] unit-test
+[ 13 ] [ { 2 3 } norm-sq ] unit-test
 

From 996dd6442e0e1bb36481f3315c51377b1119a105 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 16:03:47 -0500
Subject: [PATCH 14/20] Add indices word

---
 core/sequences/sequences-tests.factor | 4 +++-
 core/sequences/sequences.factor       | 5 +++++
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 8018fe1cdc..f8765bc946 100755
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -265,4 +265,6 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
 
 [ { 1 3 7 } ] [ 2 { 1 3 5 7 } remove-nth ] unit-test
 
-[ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] unit-test
+[ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] 
+
+[ V{ 0 2 } ] [ "a" { "a" "b" "a" } indices ] unit-test
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 57dba9ed4e..b08d6eb2c7 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -480,6 +480,11 @@ PRIVATE>
 : last-index-from ( obj i seq -- n )
     rot [ = ] curry find-last-from drop ;
 
+: indices ( obj seq -- indices )
+    V{ } clone spin
+    [ rot = [ over push ] [ drop ] if ]
+    curry each-index ;
+
 : nths ( seq indices -- seq' )
     swap [ nth ] curry map ;
 

From 162faace98ff164fece38e9e926738e63941a373 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 16:04:01 -0500
Subject: [PATCH 15/20] Fix typo in 3bi docs

---
 core/kernel/kernel-docs.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 8483293274..c833325c41 100755
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -550,7 +550,7 @@ HELP: 2bi
 
 HELP: 3bi
 { $values { "x" object } { "y" object } { "z" object } { "p" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } { "q" "a quotation with stack effect " { $snippet "( x y z -- ... )" } } }
-{ $description "Applies " { $snippet "p" } " to the two input values, then applies " { $snippet "q" } " to the two input values." }
+{ $description "Applies " { $snippet "p" } " to the three input values, then applies " { $snippet "q" } " to the three input values." }
 { $examples
     "If " { $snippet "[ p ]" } " and " { $snippet "[ q ]" } " have stack effect " { $snippet "( x y z -- )" } ", then the following two lines are equivalent:"
     { $code

From 8d7ebc510603772433b865ae8aa99ec0413793da Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 18:08:19 -0500
Subject: [PATCH 16/20] Change stack effect of nths to match nth, rice
 bounds-check?

---
 .../strength-reduction-tests.factor           | 119 ------------------
 .../strength-reduction.factor                 |   5 -
 core/sequences/sequences.factor               |   6 +-
 3 files changed, 3 insertions(+), 127 deletions(-)
 delete mode 100644 basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
 delete mode 100644 basis/compiler/tree/strength-reduction/strength-reduction.factor

diff --git a/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor b/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
deleted file mode 100644
index 86fe74d939..0000000000
--- a/basis/compiler/tree/strength-reduction/strength-reduction-tests.factor
+++ /dev/null
@@ -1,119 +0,0 @@
-! TUPLE: declared-fixnum { x fixnum } ;
-! 
-! [ t ] [
-!     [ { declared-fixnum } declare [ 1 + ] change-x ]
-!     { + fixnum+ >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { declared-fixnum } declare x>> drop ]
-!     { slot } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ hashtable new ] \ new inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ dup hashtable eq? [ new ] when ] \ new inlined?
-! ] unit-test
-! 
-! [ f ] [
-!     [ { integer } declare -63 shift 4095 bitand ]
-!     \ shift inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { integer } declare 127 bitand 3 + ]
-!     { + +-integer-fixnum +-integer-fixnum-fast bitand } inlined?
-! ] unit-test
-! 
-! [ f ] [
-!     [ { integer } declare 127 bitand 3 + ]
-!     { >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare
-!         dup 0 >= [
-!             615949 * 797807 + 20 2^ mod dup 19 2^ -
-!         ] [ dup ] if
-!     ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { fixnum } declare
-!         615949 * 797807 + 20 2^ mod dup 19 2^ -
-!     ] { >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare 0 swap
-!         [
-!             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
-!         ] map
-!     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { fixnum } declare 0 swap
-!         [
-!             drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
-!         ] map
-!     ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
-! ] unit-test
-! 
-! 
-! 
-! [ t ] [
-!     [
-!         { integer } declare [ 256 mod ] map
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! 
-! [ f ] [
-!     [
-!         256 mod
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ f ] [
-!     [
-!         dup 0 >= [ 256 mod ] when
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare dup 0 >= [ 256 mod ] when
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare 256 rem
-!     ] { mod fixnum-mod } inlined?
-! ] unit-test
-! 
-! [ t ] [
-!     [
-!         { integer } declare [ 256 rem ] map
-!     ] { mod fixnum-mod rem } inlined?
-! ] unit-test
diff --git a/basis/compiler/tree/strength-reduction/strength-reduction.factor b/basis/compiler/tree/strength-reduction/strength-reduction.factor
deleted file mode 100644
index c36395bbee..0000000000
--- a/basis/compiler/tree/strength-reduction/strength-reduction.factor
+++ /dev/null
@@ -1,5 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: compiler.tree.strength-reduction
-
-: strength-reduce ( nodes -- nodes' ) ;
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index b08d6eb2c7..6cda7fc73f 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -51,7 +51,7 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ;
 : push ( elt seq -- ) [ length ] [ set-nth ] bi ;
 
 : bounds-check? ( n seq -- ? )
-    length 1- 0 swap between? ; inline
+    dupd length < [ 0 >= ] [ drop f ] if ; inline
 
 ERROR: bounds-error index seq ;
 
@@ -485,8 +485,8 @@ PRIVATE>
     [ rot = [ over push ] [ drop ] if ]
     curry each-index ;
 
-: nths ( seq indices -- seq' )
-    swap [ nth ] curry map ;
+: nths ( indices seq -- seq' )
+    [ nth ] curry map ;
 
 : contains? ( seq quot -- ? )
     find drop >boolean ; inline

From 10c68ebb21b4077210bddfc3a173908d66584e39 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 18:08:38 -0500
Subject: [PATCH 17/20] New modular arithmetic optimization pass

---
 .../tree/cleanup/cleanup-tests.factor         |  16 +--
 basis/compiler/tree/cleanup/cleanup.factor    |   8 --
 .../tree/dead-code/branches/branches.factor   |   2 +-
 basis/compiler/tree/debugger/debugger.factor  |  45 +++++-
 .../simplified/simplified-tests.factor        |  10 ++
 .../tree/def-use/simplified/simplified.factor |  40 ++++++
 .../tree/finalization/finalization.factor     |  31 +----
 .../late-optimizations.factor                 |  29 ++++
 .../modular-arithmetic-tests.factor           | 130 ++++++++++++++++++
 .../modular-arithmetic.factor                 | 108 +++++++++++++++
 .../compiler/tree/optimizer/optimizer.factor  |   5 +-
 .../tree/propagation/inlining/inlining.factor |  13 +-
 .../known-words/known-words.factor            |  26 ++++
 .../tree/propagation/propagation-tests.factor |  27 ++--
 .../partial-dispatch-tests.factor             |  17 ++-
 .../partial-dispatch/partial-dispatch.factor  |  54 ++++++--
 16 files changed, 482 insertions(+), 79 deletions(-)
 create mode 100644 basis/compiler/tree/def-use/simplified/simplified-tests.factor
 create mode 100644 basis/compiler/tree/def-use/simplified/simplified.factor
 create mode 100644 basis/compiler/tree/late-optimizations/late-optimizations.factor
 create mode 100644 basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
 create mode 100644 basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor

diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index 2e8eb15959..b3ba62b73b 100644
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -13,10 +13,8 @@ compiler.tree.builder
 compiler.tree.recursive
 compiler.tree.normalization
 compiler.tree.propagation
-compiler.tree.checker ;
-
-: cleaned-up-tree ( quot -- nodes )
-    build-tree analyze-recursive normalize propagate cleanup dup check-nodes ;
+compiler.tree.checker
+compiler.tree.debugger ;
 
 [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
 
@@ -34,12 +32,6 @@ compiler.tree.checker ;
 
 [ t ] [ [ t recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test
 
-: inlined? ( quot seq/word -- ? )
-    [ cleaned-up-tree ] dip
-    dup word? [ 1array ] when
-    '[ dup #call? [ word>> _ member? ] [ drop f ] if ]
-    contains-node? not ;
-
 [ f ] [
     [ { integer } declare >fixnum ]
     \ >fixnum inlined?
@@ -498,3 +490,7 @@ cell-bits 32 = [
     [ 2 swap >fixnum ribs ]
     { <-integer-fixnum +-integer-fixnum } inlined?
 ] unit-test
+
+[ t ] [
+    [ hashtable new ] \ new inlined?
+] unit-test
diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor
index 58dc07d868..563926f233 100644
--- a/basis/compiler/tree/cleanup/cleanup.factor
+++ b/basis/compiler/tree/cleanup/cleanup.factor
@@ -64,14 +64,6 @@ GENERIC: cleanup* ( node -- node/nodes )
     ] [ body>> cleanup ] bi ;
 
 ! Removing overflow checks
-: no-overflow-variant ( op -- fast-op )
-    H{
-        { fixnum+ fixnum+fast }
-        { fixnum- fixnum-fast }
-        { fixnum* fixnum*fast }
-        { fixnum-shift fixnum-shift-fast }
-    } at ;
-
 : (remove-overflow-check?) ( #call -- ? )
     node-output-infos first class>> fixnum class<= ;
 
diff --git a/basis/compiler/tree/dead-code/branches/branches.factor b/basis/compiler/tree/dead-code/branches/branches.factor
index a19e49494e..719c80f911 100644
--- a/basis/compiler/tree/dead-code/branches/branches.factor
+++ b/basis/compiler/tree/dead-code/branches/branches.factor
@@ -36,7 +36,7 @@ M: #branch remove-dead-code*
     '[ _ nth _ key? ] filter ; inline
 
 : drop-indexed-values ( values indices -- node )
-    [ drop filter-live ] [ nths ] 2bi
+    [ drop filter-live ] [ swap nths ] 2bi
     [ make-values ] keep
     [ drop ] [ zip ] 2bi
     #shuffle ;
diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index 691c564661..4d2881af5a 100644
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -1,13 +1,21 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs fry match accessors namespaces make effects
+USING: kernel assocs match fry accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.sections math words
-combinators io sorting hints
+combinators io sorting hints qualified
 compiler.tree
+compiler.tree.recursive
+compiler.tree.normalization
+compiler.tree.cleanup
+compiler.tree.propagation
+compiler.tree.propagation.info
+compiler.tree.def-use
 compiler.tree.builder
 compiler.tree.optimizer
-compiler.tree.combinators ;
+compiler.tree.combinators
+compiler.tree.checker ;
+RENAME: _ match => __
 IN: compiler.tree.debugger
 
 ! A simple tool for turning tree IR into quotations and
@@ -42,7 +50,7 @@ MATCH-VARS: ?a ?b ?c ;
         { { { ?a ?b ?c } { ?b ?c ?a } } [ rot ] }
         { { { ?a ?b } { ?b } } [ nip ] }
         { { { ?a ?b ?c } { ?c } } [ 2nip ] }
-        { _ f }
+        { __ f }
     } match-choose ;
 
 TUPLE: shuffle-node { effect effect } ;
@@ -146,3 +154,32 @@ SYMBOL: node-count
 
 : optimizer-report. ( word -- )
     make-report report. ;
+
+! More utilities
+
+: final-info ( quot -- seq )
+    build-tree
+    analyze-recursive
+    normalize
+    propagate
+    compute-def-use
+    dup check-nodes
+    peek node-input-infos ;
+
+: final-classes ( quot -- seq )
+    final-info [ class>> ] map ;
+
+: final-literals ( quot -- seq )
+    final-info [ literal>> ] map ;
+
+: cleaned-up-tree ( quot -- nodes )
+    [
+        check-optimizer? on
+        build-tree optimize-tree 
+    ] with-scope ;
+
+: inlined? ( quot seq/word -- ? )
+    [ cleaned-up-tree ] dip
+    dup word? [ 1array ] when
+    '[ dup #call? [ word>> _ member? ] [ drop f ] if ]
+    contains-node? not ;
diff --git a/basis/compiler/tree/def-use/simplified/simplified-tests.factor b/basis/compiler/tree/def-use/simplified/simplified-tests.factor
new file mode 100644
index 0000000000..a1a768d429
--- /dev/null
+++ b/basis/compiler/tree/def-use/simplified/simplified-tests.factor
@@ -0,0 +1,10 @@
+USING: kernel tools.test compiler.tree compiler.tree.builder
+compiler.tree.def-use compiler.tree.def-use.simplified accessors
+sequences sorting classes ;
+IN: compiler.tree.def-use.simplified
+
+[ { #call #return } ] [
+    [ 1 dup reverse ] build-tree compute-def-use
+    first out-d>> first actually-used-by
+    [ node>> class ] map natural-sort
+] unit-test
diff --git a/basis/compiler/tree/def-use/simplified/simplified.factor b/basis/compiler/tree/def-use/simplified/simplified.factor
new file mode 100644
index 0000000000..edfe633057
--- /dev/null
+++ b/basis/compiler/tree/def-use/simplified/simplified.factor
@@ -0,0 +1,40 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences sequences.deep kernel
+compiler.tree compiler.tree.def-use ;
+IN: compiler.tree.def-use.simplified
+
+! Simplified def-use follows chains of copies.
+
+! A 'real' usage is a usage of a value that is not a #renaming.
+TUPLE: real-usage value node ;
+
+GENERIC: actually-used-by* ( value node -- real-usages )
+
+! Def
+GENERIC: actually-defined-by* ( value node -- real-usage )
+
+: actually-defined-by ( value -- real-usage )
+    dup defined-by actually-defined-by* ;
+
+M: #renaming actually-defined-by*
+    inputs/outputs swap [ index ] dip nth actually-defined-by ;
+
+M: #return-recursive actually-defined-by* real-usage boa ;
+
+M: node actually-defined-by* real-usage boa ;
+
+! Use
+: (actually-used-by) ( value -- real-usages )
+    dup used-by [ actually-used-by* ] with map ;
+
+M: #renaming actually-used-by*
+    inputs/outputs [ indices ] dip nths
+    [ (actually-used-by) ] map ;
+
+M: #return-recursive actually-used-by* real-usage boa ;
+
+M: node actually-used-by* real-usage boa ;
+
+: actually-used-by ( value -- real-usages )
+    (actually-used-by) flatten ;
diff --git a/basis/compiler/tree/finalization/finalization.factor b/basis/compiler/tree/finalization/finalization.factor
index ba7e4ff652..c312cb68dc 100644
--- a/basis/compiler/tree/finalization/finalization.factor
+++ b/basis/compiler/tree/finalization/finalization.factor
@@ -6,27 +6,20 @@ classes.tuple.private slots.private combinators layouts
 byte-arrays alien.accessors
 compiler.intrinsics
 compiler.tree
-compiler.tree.builder
-compiler.tree.recursive
-compiler.tree.normalization
-compiler.tree.propagation
+compiler.tree.combinators
 compiler.tree.propagation.info
-compiler.tree.cleanup
-compiler.tree.def-use
-compiler.tree.dead-code
-compiler.tree.combinators ;
+compiler.tree.late-optimizations ;
 IN: compiler.tree.finalization
 
+! This is a late-stage optimization.
+! See the comment in compiler.tree.late-optimizations.
+
 ! This pass runs after propagation, so that it can expand
 ! built-in type predicates and memory allocation; these cannot
 ! be expanded before propagation since we need to see 'fixnum?'
 ! instead of 'tag 0 eq?' and so on, for semantic reasoning.
 ! We also delete empty stack shuffles and copies to facilitate
-! tail call optimization in the code generator. After this pass
-! runs, stack flow information is no longer accurate, since we
-! punt in 'splice-quot' and don't update everything that we
-! should; this simplifies the code, improves performance, and we
-! don't need the stack flow information after this pass anyway.
+! tail call optimization in the code generator.
 
 GENERIC: finalize* ( node -- nodes )
 
@@ -37,18 +30,6 @@ M: #shuffle finalize*
     [ in>> ] [ out>> ] bi sequence=
     [ drop f ] when ;
 
-: splice-quot ( quot -- nodes )
-    [
-        build-tree
-        analyze-recursive 
-        normalize
-        propagate
-        cleanup
-        compute-def-use
-        remove-dead-code
-        but-last
-    ] with-scope ;
-
 : builtin-predicate? ( #call -- ? )
     word>> "predicating" word-prop builtin-class? ;
 
diff --git a/basis/compiler/tree/late-optimizations/late-optimizations.factor b/basis/compiler/tree/late-optimizations/late-optimizations.factor
new file mode 100644
index 0000000000..e2641416b2
--- /dev/null
+++ b/basis/compiler/tree/late-optimizations/late-optimizations.factor
@@ -0,0 +1,29 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences namespaces compiler.tree.builder
+compiler.tree.recursive
+compiler.tree.normalization
+compiler.tree.propagation
+compiler.tree.propagation.info
+compiler.tree.cleanup
+compiler.tree.def-use
+compiler.tree.dead-code ;
+IN: compiler.tree.late-optimizations
+
+! Late optimizations modify the tree such that stack flow
+! information is no longer accurate, since we punt in
+! 'splice-quot' and don't update everything that we should;
+! this simplifies the code, improves performance, and we
+! don't need the stack flow information after this pass anyway.
+
+: splice-quot ( quot -- nodes )
+    [
+        build-tree
+        analyze-recursive 
+        normalize
+        propagate
+        cleanup
+        compute-def-use
+        remove-dead-code
+        but-last
+    ] with-scope ;
diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
new file mode 100644
index 0000000000..b535dfe39c
--- /dev/null
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
@@ -0,0 +1,130 @@
+IN: compiler.tree.modular-arithmetic.tests
+USING: kernel kernel.private tools.test math math.partial-dispatch
+math.private accessors slots.private sequences strings sbufs
+compiler.tree.builder
+compiler.tree.optimizer
+compiler.tree.debugger ;
+
+: test-modular-arithmetic ( quot -- quot' )
+    build-tree optimize-tree nodes>quot ;
+
+[ [ >r >fixnum r> >fixnum fixnum+fast ] ]
+[ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
+
+[ [ +-integer-integer dup >fixnum ] ]
+[ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
+
+[ [ >r >fixnum r> >fixnum fixnum+fast 4 fixnum*fast ] ]
+[ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
+
+TUPLE: declared-fixnum { x fixnum } ;
+
+[ t ] [
+    [ { declared-fixnum } declare [ 1 + ] change-x ]
+    { + fixnum+ >fixnum } inlined?
+] unit-test
+
+[ t ] [
+    [ { declared-fixnum } declare x>> drop ]
+    { slot } inlined?
+] unit-test
+
+[ f ] [
+    [ { integer } declare -63 shift 4095 bitand ]
+    \ shift inlined?
+] unit-test
+
+[ t ] [
+    [ { integer } declare 127 bitand 3 + ]
+    { + +-integer-fixnum bitand } inlined?
+] unit-test
+
+[ f ] [
+    [ { integer } declare 127 bitand 3 + ]
+    { >fixnum } inlined?
+] unit-test
+
+[ t ] [
+    [
+        { integer } declare
+        dup 0 >= [
+            615949 * 797807 + 20 2^ mod dup 19 2^ -
+        ] [ dup ] if
+    ] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
+] unit-test
+
+[ t ] [
+    [
+        { fixnum } declare
+        615949 * 797807 + 20 2^ mod dup 19 2^ -
+    ] { >fixnum } inlined?
+] unit-test
+
+[ t ] [
+    [
+        { integer } declare 0 swap
+        [
+            drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
+        ] map
+    ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
+] unit-test
+
+[ t ] [
+    [
+        { fixnum } declare 0 swap
+        [
+            drop 615949 * 797807 + 20 2^ rem dup 19 2^ -
+        ] map
+    ] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
+] unit-test
+
+[ t ] [
+    [ { string sbuf } declare ] \ push-all def>> append \ + inlined?
+] unit-test
+
+[ t ] [
+    [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
+] unit-test
+
+[ t ] [
+    [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
+] unit-test
+
+
+
+[ t ] [
+    [
+        { integer } declare [ 256 mod ] map
+    ] { mod fixnum-mod } inlined?
+] unit-test
+
+
+[ f ] [
+    [
+        256 mod
+    ] { mod fixnum-mod } inlined?
+] unit-test
+
+[ f ] [
+    [
+        dup 0 >= [ 256 mod ] when
+    ] { mod fixnum-mod } inlined?
+] unit-test
+
+[ t ] [
+    [
+        { integer } declare dup 0 >= [ 256 mod ] when
+    ] { mod fixnum-mod } inlined?
+] unit-test
+
+[ t ] [
+    [
+        { integer } declare 256 rem
+    ] { mod fixnum-mod } inlined?
+] unit-test
+
+[ t ] [
+    [
+        { integer } declare [ 256 rem ] map
+    ] { mod fixnum-mod rem } inlined?
+] unit-test
diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
new file mode 100644
index 0000000000..d65b1def16
--- /dev/null
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor
@@ -0,0 +1,108 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: math math.partial-dispatch namespaces sequences sets
+accessors assocs words kernel memoize fry combinators
+compiler.tree
+compiler.tree.combinators
+compiler.tree.def-use
+compiler.tree.def-use.simplified
+compiler.tree.late-optimizations ;
+IN: compiler.tree.modular-arithmetic
+
+! This is a late-stage optimization.
+! See the comment in compiler.tree.late-optimizations.
+
+! Modular arithmetic optimization pass.
+!
+! { integer integer } declare + >fixnum
+!    ==>
+!        [ >fixnum ] bi@ fixnum+fast
+
+{ + - * bitand bitor bitxor } [
+    [
+        t "modular-arithmetic" set-word-prop
+    ] each-integer-derived-op
+] each
+
+{ bitand bitor bitxor bitnot }
+[ t "modular-arithmetic" set-word-prop ] each
+
+SYMBOL: modularize-values
+
+: modular-value? ( value -- ? )
+    modularize-values get key? ;
+
+: modularize-value ( value -- ) modularize-values get conjoin ;
+
+GENERIC: maybe-modularize* ( value node -- )
+
+: maybe-modularize ( value -- )
+    actually-defined-by [ value>> ] [ node>> ] bi
+    over actually-used-by length 1 = [
+        maybe-modularize*
+    ] [ 2drop ] if ;
+
+M: #call maybe-modularize*
+    dup word>> "modular-arithmetic" word-prop [
+        [ modularize-value ]
+        [ in-d>> [ maybe-modularize ] each ] bi*
+    ] [ 2drop ] if ;
+
+M: node maybe-modularize* 2drop ;
+
+GENERIC: compute-modularized-values* ( node -- )
+
+M: #call compute-modularized-values*
+    dup word>> {
+        { [ \ >fixnum eq? ] [ in-d>> first maybe-modularize ] }
+        ! { [
+        !     {
+        !         mod-integer-fixnum
+        !         mod-integer-integer
+        !         mod-fixnum-integer
+        !     } memq?
+        ! ] [ ] }
+        [ drop ]
+    } cond ;
+
+M: node compute-modularized-values* drop ;
+
+: compute-modularized-values ( nodes -- )
+    [ compute-modularized-values* ] each-node ;
+
+GENERIC: optimize-modular-arithmetic* ( node -- nodes )
+
+: redundant->fixnum? ( #call -- ? )
+    in-d>> first actually-defined-by value>> modular-value? ;
+
+: optimize->fixnum ( #call -- nodes )
+    dup redundant->fixnum? [ drop f ] when ;
+
+MEMO: fixnum-coercion ( flags -- nodes )
+    [ [ ] [ >fixnum ] ? ] map '[ _ spread ] splice-quot ;
+
+: optimize-modular-op ( #call -- nodes )
+    dup out-d>> first modular-value? [
+        [ in-d>> ] [ word>> integer-op-input-classes ] [ ] tri
+        [
+            [
+                [ actually-defined-by value>> modular-value? ]
+                [ fixnum eq? ]
+                bi* or
+            ] 2map fixnum-coercion
+        ] [ [ modular-variant ] change-word ] bi* suffix
+    ] when ;
+
+M: #call optimize-modular-arithmetic*
+    dup word>> {
+        { [ dup \ >fixnum eq? ] [ drop optimize->fixnum ] }
+        { [ dup "modular-arithmetic" word-prop ] [ drop optimize-modular-op ] }
+        [ drop ]
+    } cond ;
+
+M: node optimize-modular-arithmetic* ;
+
+: optimize-modular-arithmetic ( nodes -- nodes' )
+    H{ } clone modularize-values set
+    dup compute-modularized-values
+    [ optimize-modular-arithmetic* ] map-nodes ;
diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor
index 3196253d45..e37323a2ec 100644
--- a/basis/compiler/tree/optimizer/optimizer.factor
+++ b/basis/compiler/tree/optimizer/optimizer.factor
@@ -10,7 +10,7 @@ compiler.tree.tuple-unboxing
 compiler.tree.identities
 compiler.tree.def-use
 compiler.tree.dead-code
-compiler.tree.strength-reduction
+compiler.tree.modular-arithmetic
 compiler.tree.finalization
 compiler.tree.checker ;
 IN: compiler.tree.optimizer
@@ -27,9 +27,10 @@ SYMBOL: check-optimizer?
     apply-identities
     compute-def-use
     remove-dead-code
-    ! strength-reduce
     check-optimizer? get [
         compute-def-use
         dup check-nodes
     ] when
+    compute-def-use
+    optimize-modular-arithmetic
     finalize ;
diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index 48864d8782..197d1820bf 100644
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -3,7 +3,7 @@
 USING: accessors kernel arrays sequences math math.order
 math.partial-dispatch generic generic.standard generic.math
 classes.algebra classes.union sets quotations assocs combinators
-words namespaces
+words namespaces continuations
 compiler.tree
 compiler.tree.builder
 compiler.tree.recursive
@@ -33,7 +33,7 @@ M: quotation splicing-nodes
     body>> (propagate) ;
 
 ! Dispatch elimination
-: eliminate-dispatch ( #call class/f word/f -- ? )
+: eliminate-dispatch ( #call class/f word/quot/f -- ? )
     dup [
         [ >>class ] dip
         over method>> over = [ drop ] [
@@ -156,12 +156,19 @@ SYMBOL: history
 : always-inline-word? ( word -- ? )
     { curry compose } memq? ;
 
+: custom-inlining? ( word -- ? )
+    "custom-inlining" word-prop ;
+
+: inline-custom ( #call word -- ? )
+    [ dup 1array ] [ "custom-inlining" word-prop ] bi* with-datastack
+    first object swap eliminate-dispatch ;
+
 : do-inlining ( #call word -- ? )
     {
+        { [ dup custom-inlining? ] [ inline-custom ] }
         { [ dup always-inline-word? ] [ inline-word ] }
         { [ dup standard-generic? ] [ inline-standard-method ] }
         { [ dup math-generic? ] [ inline-math-method ] }
-        { [ dup math-partial? ] [ inline-math-partial ] }
         { [ dup method-body? ] [ inline-method-body ] }
         [ 2drop f ]
     } cond ;
diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index d208d31389..9f208bdc12 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -230,6 +230,32 @@ generic-comparison-ops [
     ] "outputs" set-word-prop
 ] assoc-each
 
+{
+    mod-integer-integer
+    mod-integer-fixnum
+    mod-fixnum-integer
+    fixnum-mod
+    rem
+} [
+    [
+        in-d>> second value-info >literal<
+        [ power-of-2? [ 1- bitand ] f ? ] when
+    ] "custom-inlining" set-word-prop
+] each
+
+{
+    bitand-integer-integer
+    bitand-integer-fixnum
+    bitand-fixnum-integer
+} [
+    [
+        in-d>> second value-info >literal< [
+            0 most-positive-fixnum between?
+            [ [ >fixnum ] bi@ fixnum-bitand ] f ?
+        ] when
+    ] "custom-inlining" set-word-prop
+] each
+
 {
     alien-signed-1
     alien-unsigned-1
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index a115ee53c2..6638951723 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -6,27 +6,12 @@ alien.accessors alien.c-types sequences.private
 byte-arrays classes.algebra classes.tuple.private
 math.functions math.private strings layouts
 compiler.tree.propagation.info compiler.tree.def-use
-compiler.tree.checker slots.private words hashtables
-classes assocs ;
+compiler.tree.debugger compiler.tree.checker
+slots.private words hashtables classes assocs ;
 IN: compiler.tree.propagation.tests
 
 \ propagate must-infer
 
-: final-info ( quot -- seq )
-    build-tree
-    analyze-recursive
-    normalize
-    propagate
-    compute-def-use
-    dup check-nodes
-    peek node-input-infos ;
-
-: final-classes ( quot -- seq )
-    final-info [ class>> ] map ;
-
-: final-literals ( quot -- seq )
-    final-info [ literal>> ] map ;
-
 [ V{ } ] [ [ ] final-classes ] unit-test
 
 [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test
@@ -594,6 +579,14 @@ MIXIN: empty-mixin
     [ { float } declare 0 eq? ] final-classes
 ] unit-test
 
+[ V{ integer } ] [
+    [ { integer fixnum } declare mod ] final-classes
+] unit-test
+
+[ V{ integer } ] [
+    [ { fixnum integer } declare bitand ] final-classes
+] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test
diff --git a/basis/math/partial-dispatch/partial-dispatch-tests.factor b/basis/math/partial-dispatch/partial-dispatch-tests.factor
index 64605b1818..388b4127cd 100644
--- a/basis/math/partial-dispatch/partial-dispatch-tests.factor
+++ b/basis/math/partial-dispatch/partial-dispatch-tests.factor
@@ -1,5 +1,6 @@
 IN: math.partial-dispatch.tests
-USING: math.partial-dispatch tools.test math kernel sequences ;
+USING: math.partial-dispatch math.private
+tools.test math kernel sequences ;
 
 [ t ] [ \ + integer fixnum math-both-known? ] unit-test
 [ t ] [ \ + bignum fixnum math-both-known? ] unit-test
@@ -10,3 +11,17 @@ USING: math.partial-dispatch tools.test math kernel sequences ;
 [ f ] [ \ number= fixnum object math-both-known? ] unit-test
 [ t ] [ \ number= integer fixnum math-both-known? ] unit-test
 [ f ] [ \ >fixnum \ shift derived-ops memq? ] unit-test
+
+[ { integer fixnum } ] [ \ +-integer-fixnum integer-op-input-classes ] unit-test
+[ { fixnum fixnum } ] [ \ fixnum+ integer-op-input-classes ] unit-test
+[ { fixnum fixnum } ] [ \ fixnum+fast integer-op-input-classes ] unit-test
+[ { integer } ] [ \ bitnot integer-op-input-classes ] unit-test
+
+[ shift ] [ \ fixnum-shift generic-variant ] unit-test
+[ fixnum-shift-fast ] [ \ fixnum-shift no-overflow-variant ] unit-test
+
+[ fixnum-shift-fast ] [ \ shift modular-variant ] unit-test
+[ fixnum-bitnot ] [ \ bitnot modular-variant ] unit-test
+[ fixnum+fast ] [ \ fixnum+ modular-variant ] unit-test
+[ fixnum+fast ] [ \ fixnum+fast modular-variant ] unit-test
+
diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor
index b162406e5a..61678eb088 100644
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@@ -6,13 +6,41 @@ generic generic.math hashtables effects compiler.units
 classes.algebra ;
 IN: math.partial-dispatch
 
-! Partial dispatch.
-
-! This code will be overhauled and generalized when
-! multi-methods go into the core.
 PREDICATE: math-partial < word
     "derived-from" word-prop >boolean ;
 
+GENERIC: integer-op-input-classes ( word -- classes )
+
+M: math-partial integer-op-input-classes
+    "derived-from" word-prop rest ;
+
+M: word integer-op-input-classes
+    "input-classes" word-prop
+    [ "Bug: integer-op-input-classes" throw ] unless* ;
+
+: generic-variant ( op -- generic-op/f )
+    dup "derived-from" word-prop [ first ] [ ] ?if ;
+
+: no-overflow-variant ( op -- fast-op )
+    H{
+        { fixnum+ fixnum+fast }
+        { fixnum- fixnum-fast }
+        { fixnum* fixnum*fast }
+        { fixnum-shift fixnum-shift-fast }
+    } at ;
+
+: modular-variant ( op -- fast-op )
+    generic-variant dup H{
+        { + fixnum+fast }
+        { - fixnum-fast }
+        { * fixnum*fast }
+        { shift fixnum-shift-fast }
+        { bitand fixnum-bitand }
+        { bitor fixnum-bitor }
+        { bitxor fixnum-bitxor }
+        { bitnot fixnum-bitnot }
+    } at swap or ;
+
 :: fixnum-integer-op ( a b fix-word big-word -- c )
     b tag 0 eq? [
         a b fix-word execute
@@ -69,10 +97,17 @@ PREDICATE: math-partial < word
     } swap [ prefix ] curry map ;
 
 : define-integer-ops ( word fix-word big-word -- )
-    >r >r integer-op-triples r> r>
-    [ define-integer-op-words ]
-    [ 2drop [ dup integer-op-word ] { } map>assoc % ]
-    3bi ;
+    [
+        rot tuck
+        [ fixnum fixnum 3array "derived-from" set-word-prop ]
+        [ bignum bignum 3array "derived-from" set-word-prop ]
+        2bi*
+    ] [
+        [ integer-op-triples ] 2dip
+        [ define-integer-op-words ]
+        [ 2drop [ dup integer-op-word ] { } map>assoc % ]
+        3bi
+    ] 3bi ;
 
 : define-math-ops ( op -- )
     { fixnum bignum float }
@@ -125,6 +160,9 @@ SYMBOL: fast-math-ops
 : each-fast-derived-op ( word quot -- )
     >r fast-derived-ops r> each ; inline
 
+: each-integer-derived-op ( word quot -- )
+    >r integer-derived-ops r> each ; inline
+
 [
     [
         \ +       define-math-ops

From 379566374cd568810d33a39dc947dad5a80ae478 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 18:15:22 -0500
Subject: [PATCH 18/20] Fix usages of nths

---
 extra/math/combinatorics/combinatorics.factor | 2 +-
 extra/project-euler/186/186.factor            | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/math/combinatorics/combinatorics.factor b/extra/math/combinatorics/combinatorics.factor
index 7c5d5ba4c0..a0c6df083b 100644
--- a/extra/math/combinatorics/combinatorics.factor
+++ b/extra/math/combinatorics/combinatorics.factor
@@ -39,7 +39,7 @@ PRIVATE>
     twiddle [ nPk ] keep factorial / ;
 
 : permutation ( n seq -- seq )
-    tuck permutation-indices nths ;
+    tuck permutation-indices swap nths ;
 
 : all-permutations ( seq -- seq )
     [
diff --git a/extra/project-euler/186/186.factor b/extra/project-euler/186/186.factor
index ac846f6064..5308662daf 100644
--- a/extra/project-euler/186/186.factor
+++ b/extra/project-euler/186/186.factor
@@ -9,7 +9,7 @@ IN: project-euler.186
     55 [1,b] [ (generator) ] map <circular> ;
 
 : advance ( lag -- )
-    [ { 0 31 } nths sum 1000000 rem ] keep push-circular ;
+    [ { 0 31 } swap nths sum 1000000 rem ] keep push-circular ;
 
 : next ( lag -- n )
     [ first ] [ advance ] bi ;

From f2eeeb4ae80e5686a80f0ce260a2d61059c53b55 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 18:15:26 -0500
Subject: [PATCH 19/20] Cleanup

---
 extra/benchmark/spectral-norm/spectral-norm.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/benchmark/spectral-norm/spectral-norm.factor b/extra/benchmark/spectral-norm/spectral-norm.factor
index 6d4d42116c..3c20a1ceff 100644
--- a/extra/benchmark/spectral-norm/spectral-norm.factor
+++ b/extra/benchmark/spectral-norm/spectral-norm.factor
@@ -41,7 +41,7 @@ IN: benchmark.spectral-norm
     ] times ; inline
 
 : spectral-norm ( n -- norm )
-    u/v [ v. ] keep norm-sq /f sqrt ;
+    u/v [ v. ] [ norm-sq ] bi /f sqrt ;
 
 HINTS: spectral-norm fixnum ;
 

From 20cc730501312cdc9da64cfd61066edc26d39943 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 12 Sep 2008 18:57:34 -0500
Subject: [PATCH 20/20] Fix sequences tests

---
 core/sequences/sequences-tests.factor | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index f8765bc946..e27f2410b3 100755
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -250,11 +250,11 @@ unit-test
 [ 50 ] [ 100 [ even? ] count ] unit-test
 [ 50 ] [ 100 [ odd?  ] count ] unit-test
 
-[ { "b" "d" } ] [ { "a" "b" "c" "d" } { 1 3 } nths ] unit-test
-[ { "a" "b" "c" "d" } ] [ { "a" "b" "c" "d" } { 0 1 2 3 } nths ] unit-test
-[ { "d" "c" "b" "a" } ] [ { "a" "b" "c" "d" } { 3 2 1 0 } nths ] unit-test
-[ { "d" "a" "b" "c" } ] [ { "a" "b" "c" "d" } { 3 0 1 2 } nths ] unit-test
-
+[ { "b" "d" } ] [ { 1 3 } { "a" "b" "c" "d" } nths ] unit-test
+[ { "a" "b" "c" "d" } ] [ { 0 1 2 3 } { "a" "b" "c" "d" } nths ] unit-test
+[ { "d" "c" "b" "a" } ] [ { 3 2 1 0 } { "a" "b" "c" "d" } nths ] unit-test
+[ { "d" "a" "b" "c" } ] [ { 3 0 1 2 } { "a" "b" "c" "d" } nths ] unit-test
+                          
 TUPLE: bogus-hashcode ;
 
 M: bogus-hashcode hashcode* 2drop 0 >bignum ;
@@ -265,6 +265,6 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
 
 [ { 1 3 7 } ] [ 2 { 1 3 5 7 } remove-nth ] unit-test
 
-[ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] 
+[ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] unit-test
 
 [ V{ 0 2 } ] [ "a" { "a" "b" "a" } indices ] unit-test