diff --git a/basis/ui/gadgets/tabs/tabs.factor b/basis/ui/gadgets/tabs/tabs.factor
index 12031e5911..50e2df2e9e 100755
--- a/basis/ui/gadgets/tabs/tabs.factor
+++ b/basis/ui/gadgets/tabs/tabs.factor
@@ -48,8 +48,8 @@ DEFER: (del-page)
 : del-page ( name tabbed -- )
     [ names>> index ] 2keep (del-page) ;
 
-: <tabbed> ( assoc -- tabbed )
-  tabbed new-frame
+: new-tabbed ( assoc class -- tabbed )
+    new-frame
     0 <model> >>model
     <pile> 1 >>fill >>toggler
     dup toggler>> @left grid-add
@@ -59,3 +59,4 @@ DEFER: (del-page)
     bi
     dup redo-toggler ;
     
+: <tabbed> ( assoc -- tabbed ) tabbed new-tabbed ;
diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index c221ad073b..2e0aa4c279 100755
--- a/core/effects/effects.factor
+++ b/core/effects/effects.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math namespaces sequences strings words assocs
-combinators accessors arrays ;
+USING: kernel math math.parser namespaces sequences strings
+words assocs combinators accessors arrays ;
 IN: effects
 
 TUPLE: effect in out terminated? ;
@@ -25,10 +25,11 @@ TUPLE: effect in out terminated? ;
 GENERIC: effect>string ( obj -- str )
 M: string effect>string ;
 M: word effect>string name>> ;
-M: integer effect>string drop "object" ;
+M: integer effect>string number>string ;
 M: pair effect>string first2 [ effect>string ] bi@ ": " swap 3append ;
 
 : stack-picture ( seq -- string )
+    dup integer? [ "object" <repetition> ] when
     [ [ effect>string % CHAR: \s , ] each ] "" make ;
 
 M: effect effect>string ( effect -- string )
diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 0a1a3cb7f2..94f0ddea51 100755
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -629,7 +629,7 @@ HELP: 2bi*
     "The following two lines are equivalent:"
     { $code
         "[ p ] [ q ] 2bi*"
-        ">r >r q r> r> q"
+        ">r >r p r> r> q"
     }
 } ;
 
diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor
index 3c1a794121..db2c50173c 100755
--- a/extra/backtrack/backtrack.factor
+++ b/extra/backtrack/backtrack.factor
@@ -66,3 +66,5 @@ MACRO: amb-execute ( seq -- quot )
         tri* if
     ] with-scope ; inline
 
+: cut-amb ( -- )
+    f failure set ;
diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor
index 1b338df442..2b4b501952 100644
--- a/extra/irc/client/client-tests.factor
+++ b/extra/irc/client/client-tests.factor
@@ -1,190 +1,178 @@
 USING: kernel tools.test accessors arrays sequences qualified
-       io.streams.string io.streams.duplex namespaces threads
+       io io.streams.duplex namespaces threads
        calendar irc.client.private irc.client irc.messages.private
        concurrency.mailboxes classes assocs combinators ;
 EXCLUDE: irc.messages => join ;
 RENAME: join irc.messages => join_
 IN: irc.client.tests
 
-! Utilities
-: <test-stream> ( lines -- stream )
-  "\n" join <string-reader> <string-writer> <duplex-stream> ;
+! Streams for testing
+TUPLE: mb-writer lines last-line disposed ;
+TUPLE: mb-reader lines disposed ;
+: <mb-writer> ( -- mb-writer ) V{ } clone V{ } clone f mb-writer boa ;
+: <mb-reader> ( -- mb-reader ) <mailbox> f mb-reader boa ;
+: push-line ( line test-reader-stream -- ) lines>> mailbox-put ;
+: <test-stream> ( -- stream ) <mb-reader> <mb-writer> <duplex-stream> ;
+M: mb-writer stream-write ( line mb-writer -- ) last-line>> push ;
+M: mb-writer stream-flush ( mb-writer -- ) drop ;
+M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ;
+M: mb-writer stream-nl ( mb-writer -- )
+    [ [ last-line>> concat ] [ lines>> ] bi push ] keep
+    V{ } clone >>last-line drop ;
 
-: make-client ( lines -- irc-client )
-    "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
-    swap [ 2nip <test-stream> f ] curry >>connect ;
+: spawn-client ( lines listeners -- irc-client )
+    "someserver" irc-port "factorbot" f <irc-profile>
+    <irc-client>
+        t >>is-running
+        <test-stream> >>stream
+    dup [ spawn-irc yield ] with-irc-client ;
 
-: set-nick ( irc-client nickname -- )
-    swap profile>> (>>nickname) ;
+! to be used inside with-irc-client quotations
+: %add-named-listener ( listener -- ) [ name>> ] keep set+run-listener ;
+: %join ( channel -- ) <irc-channel-listener> irc> add-listener ;
+: %push-line ( line -- ) irc> stream>> in>> push-line yield ;
 
-: with-dummy-client ( irc-client quot -- )
-    [ current-irc-client ] dip with-variable ; inline
+: read-matching-message ( listener quot: ( msg -- ? ) -- irc-message )
+    [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ;
 
-{ "" } make-client dup "factorbot" set-nick [
-    { t } [ irc> profile>> nickname>> me? ] unit-test
+: with-irc ( quot: ( -- ) -- )
+    [ spawn-client ] dip [ f %push-line ] compose with-irc-client ; inline
 
-    { "factorbot" } [ irc> profile>> nickname>> ] unit-test
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                       TESTS
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-    { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
+[ { t } [ irc> profile>> nickname>> me? ] unit-test
 
-    { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
-                        parse-irc-line irc-message-origin ] unit-test
+  { "factorbot" } [ irc> profile>> nickname>> ] unit-test
 
-    { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
-                     parse-irc-line irc-message-origin ] unit-test
-] with-dummy-client
+  { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
+
+  { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
+                      parse-irc-line irc-message-origin ] unit-test
+
+  { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
+                   parse-irc-line irc-message-origin ] unit-test
+] with-irc
 
 ! Test login and nickname set
-{ "factorbot" } [
-    { "NOTICE AUTH :*** Looking up your hostname..."
-      "NOTICE AUTH :*** Checking ident"
-      "NOTICE AUTH :*** Found your hostname"
-      "NOTICE AUTH :*** No identd (auth) response"
-      ":some.where 001 factorbot :Welcome factorbot"
-    } make-client
-    { [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ profile>> nickname>> ]
-      [ terminate-irc ]
-    } cleave ] unit-test
+[ { "factorbot2" } [
+     ":some.where 001 factorbot2 :Welcome factorbot2" %push-line
+      irc> profile>> nickname>>
+  ] unit-test
+] with-irc
 
-{ join_ "#factortest" } [
-    { ":factorbot!n=factorbo@some.where JOIN :#factortest"
-      ":ircserver.net MODE #factortest +ns"
-      ":ircserver.net 353 factorbot @ #factortest :@factorbot "
-      ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
-      ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
-    } make-client
-    { [ "factorbot" set-nick ]
-      [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ join-messages>> 0.1 seconds mailbox-get-timeout ]
-      [ terminate-irc ]
-    } cleave
-    [ class ] [ trailing>> ] bi ] unit-test
+[ { join_ "#factortest" } [
+      { ":factorbot!n=factorbo@some.where JOIN :#factortest"
+        ":ircserver.net 353 factorbot @ #factortest :@factorbot "
+        ":ircserver.net 366 factorbot #factortest :End of /NAMES list."
+        ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
+      } [ %push-line ] each
+      irc> join-messages>> 0.1 seconds mailbox-get-timeout
+      [ class ] [ trailing>> ] bi
+  ] unit-test
+] with-irc
 
-{ +join+ "somebody" } [
-    { ":somebody!n=somebody@some.where JOIN :#factortest" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
-      [ connect-irc ]
-      [ listeners>> [ "#factortest" ] dip at
-        [ read-message drop ] [ read-message drop ] [ read-message ] tri ]
-      [ terminate-irc ]
-    } cleave
-    [ action>> ] [ nick>> ] bi
-    ] unit-test
+[ { T{ participant-changed f "somebody" +join+ } } [
+      "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
+      ":somebody!n=somebody@some.where JOIN :#factortest" %push-line
+      [ participant-changed? ] read-matching-message
+  ] unit-test
+] with-irc
 
-{ privmsg "#factortest" "hello" } [
-    { ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
-      [ connect-irc ]
-      [ listeners>> [ "#factortest" ] dip at
-        [ read-message drop ] [ read-message ] bi ]
-      [ terminate-irc ]
-    } cleave
-    [ class ] [ name>> ] [ trailing>> ] tri
-    ] unit-test
+[ { privmsg "#factortest" "hello" } [
+      "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
+      ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line
+      [ privmsg? ] read-matching-message
+      [ class ] [ name>> ] [ trailing>> ] tri
+  ] unit-test
+] with-irc
 
-{ privmsg "factorbot" "hello" } [
-    { ":somedude!n=user@isp.net PRIVMSG factorbot :hello" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "somedude" [ <irc-nick-listener> ] keep ] dip set-at ]
-      [ connect-irc ]
-      [ listeners>> [ "somedude" ] dip at
-        [ read-message drop ] [ read-message ] bi ]
-      [ terminate-irc ]
-    } cleave
-    [ class ] [ name>> ] [ trailing>> ] tri
-    ] unit-test
+[ { privmsg "factorbot" "hello" } [
+      "somedude" <irc-nick-listener>  [ %add-named-listener ] keep
+      ":somedude!n=user@isp.net PRIVMSG factorbot :hello" %push-line
+      [ privmsg? ] read-matching-message
+      [ class ] [ name>> ] [ trailing>> ] tri
+  ] unit-test
+] with-irc
 
-! Participants lists tests
-{ H{ { "somedude" +normal+ } } } [
-    { ":somedude!n=user@isp.net JOIN :#factortest" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
-      [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ listeners>> [ "#factortest" ] dip at participants>> ]
-      [ terminate-irc ]
-    } cleave
-    ] unit-test
+[ { mode } [
+      "#factortest" <irc-channel-listener>  [ %add-named-listener ] keep
+      ":ircserver.net MODE #factortest +ns" %push-line
+      [ mode? ] read-matching-message class
+  ] unit-test
+] with-irc
 
-{ H{ { "somedude2" +normal+ } } } [
-    { ":somedude!n=user@isp.net PART #factortest" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener>
-                          H{ { "somedude2" +normal+ }
-                             { "somedude" +normal+ } } clone >>participants ] keep
-        ] dip set-at ]
-      [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ listeners>> [ "#factortest" ] dip at participants>> ]
-      [ terminate-irc ]
-    } cleave
-    ] unit-test
+! Participant lists tests
+[ { H{ { "somedude" +normal+ } } } [
+      "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
+      ":somedude!n=user@isp.net JOIN :#factortest" %push-line
+      participants>>
+  ] unit-test
+] with-irc
 
-{ H{ { "somedude2" +normal+ } } } [
-    { ":somedude!n=user@isp.net QUIT" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener>
-                          H{ { "somedude2" +normal+ }
-                             { "somedude" +normal+ } } clone >>participants ] keep
-        ] dip set-at ]
-      [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ listeners>> [ "#factortest" ] dip at participants>> ]
-      [ terminate-irc ]
-    } cleave
-    ] unit-test
+[ { H{ { "somedude2" +normal+ } } } [
+      "#factortest" <irc-channel-listener>
+          H{ { "somedude2" +normal+ }
+             { "somedude" +normal+ } } clone >>participants
+      [ %add-named-listener ] keep
+      ":somedude!n=user@isp.net PART #factortest" %push-line
+      participants>>
+  ] unit-test
+] with-irc
 
-{ H{ { "somedude2" +normal+ } } } [
-    { ":somedude2!n=user2@isp.net KICK #factortest somedude" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener>
-                          H{ { "somedude2" +normal+ }
-                             { "somedude" +normal+ } } clone >>participants ] keep
-        ] dip set-at ]
-      [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ listeners>> [ "#factortest" ] dip at participants>> ]
-      [ terminate-irc ]
-    } cleave
-    ] unit-test
+[ { H{ { "somedude2" +normal+ } } } [
+      "#factortest" <irc-channel-listener>
+          H{ { "somedude2" +normal+ }
+             { "somedude" +normal+ } } clone >>participants
+      [ %add-named-listener ] keep
+      ":somedude!n=user@isp.net QUIT" %push-line
+      participants>>
+  ] unit-test
+] with-irc
+
+[ { H{ { "somedude2" +normal+ } } } [
+      "#factortest" <irc-channel-listener>
+          H{ { "somedude2" +normal+ }
+             { "somedude" +normal+ } } clone >>participants
+      [ %add-named-listener ] keep
+      ":somedude2!n=user2@isp.net KICK #factortest somedude" %push-line
+      participants>>
+  ] unit-test
+] with-irc
+
+[ { H{ { "somedude2" +normal+ } } } [
+      "#factortest" <irc-channel-listener>
+          H{ { "somedude" +normal+ } } clone >>participants
+      [ %add-named-listener ] keep
+      ":somedude!n=user2@isp.net NICK :somedude2" %push-line
+      participants>>
+  ] unit-test
+] with-irc
 
 ! Namelist change notification
-{ T{ participant-changed f f f } } [
-    { ":ircserver.net 353 factorbot @ #factortest :@factorbot "
-      ":ircserver.net 366 factorbot #factortest :End of /NAMES list." } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
-      [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ listeners>> [ "#factortest" ] dip at [ read-message drop ] [ read-message ] bi ]
-      [ terminate-irc ]
-    } cleave
-    ] unit-test
+[ { T{ participant-changed f f f f } } [
+      "#factortest" <irc-channel-listener> [ %add-named-listener ] keep
+      ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line
+      ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line
+      [ participant-changed? ] read-matching-message
+  ] unit-test
+] with-irc
 
-{ T{ participant-changed f "somedude" +part+ } } [
-    { ":somedude!n=user@isp.net QUIT" } make-client
-    { [ "factorbot" set-nick ]
-      [ listeners>>
-        [ "#factortest" [ <irc-channel-listener>
-                          H{ { "somedude" +normal+ } } clone >>participants ] keep
-        ] dip set-at ]
-      [ connect-irc ]
-      [ drop 0.1 seconds sleep ]
-      [ listeners>> [ "#factortest" ] dip at
-        [ read-message drop ] [ read-message drop ] [ read-message ] tri ]
-      [ terminate-irc ]
-    } cleave
-    ] unit-test
\ No newline at end of file
+[ { T{ participant-changed f "somedude" +part+ f } } [
+      "#factortest" <irc-channel-listener>
+          H{ { "somedude" +normal+ } } clone >>participants
+      [ %add-named-listener ] keep
+      ":somedude!n=user@isp.net QUIT" %push-line
+      [ participant-changed? ] read-matching-message
+  ] unit-test
+] with-irc
+
+[ { T{ participant-changed f "somedude" +nick+ "somedude2" } } [
+      "#factortest" <irc-channel-listener>
+          H{ { "somedude" +normal+ } } clone >>participants
+      [ %add-named-listener ] keep
+      ":somedude!n=user2@isp.net NICK :somedude2" %push-line
+      [ participant-changed? ] read-matching-message
+  ] unit-test
+] with-irc
diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor
index 99922b1fb5..e91767b22d 100644
--- a/extra/irc/client/client.factor
+++ b/extra/irc/client/client.factor
@@ -41,6 +41,7 @@ SYMBOL: +normal+
 SYMBOL: +join+
 SYMBOL: +part+
 SYMBOL: +mode+
+SYMBOL: +nick+
 
 ! listener objects
 : <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
@@ -59,7 +60,7 @@ SYMBOL: +mode+
 ! Message objects
 ! ======================================
 
-TUPLE: participant-changed nick action ;
+TUPLE: participant-changed nick action parameter ;
 C: <participant-changed> participant-changed
 
 SINGLETON: irc-listener-end ! send to a listener to stop its execution
@@ -100,17 +101,21 @@ M: string to-listener ( message string -- )
     listener> [ +server-listener+ listener> ] unless*
     [ to-listener ] [ drop ] if* ;
 
+M: irc-listener to-listener ( message irc-listener -- )
+    in-messages>> mailbox-put ;
+
 : unregister-listener ( name -- )
     irc> listeners>>
         [ at [ irc-listener-end ] dip to-listener ]
         [ delete-at ]
     2bi ;
 
-M: irc-listener to-listener ( message irc-listener -- )
-    in-messages>> mailbox-put ;
+: (remove-participant) ( nick listener -- )
+    [ participants>> delete-at ]
+    [ [ +part+ f <participant-changed> ] dip to-listener ] 2bi ;
 
 : remove-participant ( nick channel -- )
-    listener> [ participants>> delete-at ] [ drop ] if* ;
+    listener> [ (remove-participant) ] [ drop ] if* ;
 
 : listeners-with-participant ( nick -- seq )
     irc> listeners>> values
@@ -118,10 +123,24 @@ M: irc-listener to-listener ( message irc-listener -- )
     with filter ;
 
 : remove-participant-from-all ( nick -- )
-    dup listeners-with-participant [ participants>> delete-at ] with each ;
+    dup listeners-with-participant [ (remove-participant) ] with each ;
+
+: notify-rename ( newnick oldnick listener -- )
+    [ participant-changed new +nick+ >>action
+      [ (>>nick) ] [ (>>parameter) ] [ ] tri ] dip to-listener ;
+
+: rename-participant ( newnick oldnick listener -- )
+    [ participants>> [ delete-at* drop ] [ [ swap ] dip set-at ] bi ]
+    [ notify-rename ] 3bi ;
+
+: rename-participant-in-all ( oldnick newnick -- )
+    swap dup listeners-with-participant [ rename-participant ] with with each ;
 
 : add-participant ( mode nick channel -- )
-    listener> [ participants>> set-at ] [ 2drop ] if* ;
+    listener> [
+        [ participants>> set-at ]
+        [ [ +join+ f <participant-changed> ] dip to-listener ] 2bi
+    ] [ 2drop ] if* ;
 
 DEFER: me?
 
@@ -164,25 +183,6 @@ DEFER: me?
 : broadcast-message-to-listeners ( message -- )
     irc> listeners>> values [ to-listener ] with each ;
 
-GENERIC: handle-participant-change ( irc-message -- )
-
-M: join handle-participant-change ( join -- )
-    [ prefix>> parse-name +join+ <participant-changed> ]
-    [ trailing>> ] bi to-listener ;
-
-M: part handle-participant-change ( part -- )
-    [ prefix>> parse-name +part+ <participant-changed> ]
-    [ channel>> ] bi to-listener ;
-
-M: kick handle-participant-change ( kick -- )
-    [ who>> +part+ <participant-changed> ]
-    [ channel>> ] bi to-listener ;
-
-M: quit handle-participant-change ( quit -- )
-    prefix>> parse-name
-    [ +part+ <participant-changed> ] [ listeners-with-participant ] bi
-    [ to-listener ] with each ;
-
 GENERIC: handle-incoming-irc ( irc-message -- )
 
 M: irc-message handle-incoming-irc ( irc-message -- )
@@ -201,35 +201,36 @@ M: privmsg handle-incoming-irc ( privmsg -- )
     dup irc-message-origin to-listener ;
 
 M: join handle-incoming-irc ( join -- )
-    { [ maybe-forward-join ]
-      [ dup trailing>> to-listener ]
-      [ [ drop +normal+ ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
-      [ handle-participant-change ]
-    } cleave ;
+    [ maybe-forward-join ]
+    [ dup trailing>> to-listener ]
+    [ [ drop +normal+ ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
+    tri ;
 
 M: part handle-incoming-irc ( part -- )
     [ dup channel>> to-listener ]
     [ [ prefix>> parse-name ] [ channel>> ] bi remove-participant ]
-    [ handle-participant-change ]
-    tri ;
+    bi ;
 
 M: kick handle-incoming-irc ( kick -- )
-    { [ dup channel>> to-listener ]
-      [ [ who>> ] [ channel>> ] bi remove-participant ]
-      [ handle-participant-change ]
-      [ dup who>> me? [ unregister-listener ] [ drop ] if ]
-    } cleave ;
+    [ dup channel>> to-listener ]
+    [ [ who>> ] [ channel>> ] bi remove-participant ]
+    [ dup who>> me? [ unregister-listener ] [ drop ] if ]
+    tri ;
 
 M: quit handle-incoming-irc ( quit -- )
     [ dup prefix>> parse-name listeners-with-participant
       [ to-listener ] with each ]
-    [ handle-participant-change ]
     [ prefix>> parse-name remove-participant-from-all ]
-    tri ;
+    bi ;
 
-! FIXME: implement this
-! M: mode handle-incoming-irc ( mode -- ) call-next-method ;
-! M: nick handle-incoming-irc ( nick -- ) call-next-method ;
+M: mode handle-incoming-irc ( mode -- ) ! FIXME: modify participant list
+    dup channel>> to-listener ;
+
+M: nick handle-incoming-irc ( nick -- )
+    [ dup prefix>> parse-name listeners-with-participant
+      [ to-listener ] with each ]
+    [ [ prefix>> parse-name ] [ trailing>> ] bi rename-participant-in-all ]
+    bi ;
 
 : >nick/mode ( string -- nick mode )
     dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
@@ -241,7 +242,7 @@ M: quit handle-incoming-irc ( quit -- )
 M: names-reply handle-incoming-irc ( names-reply -- )
     [ names-reply>participants ] [ channel>> listener> ] bi [
         [ (>>participants) ]
-        [ [ f f <participant-changed> ] dip name>> to-listener ] bi
+        [ [ f f f <participant-changed> ] dip name>> to-listener ] bi
     ] [ drop ] if* ;
 
 M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
@@ -367,7 +368,7 @@ M: irc-server-listener (remove-listener) ( irc-server-listener -- )
     in-messages>> [ irc-connected ] dip mailbox-put ;
 
 : with-irc-client ( irc-client quot: ( -- ) -- )
-    [ current-irc-client ] dip with-variable ; inline
+    [ \ current-irc-client ] dip with-variable ; inline
 
 PRIVATE>
 
diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor
index 59f4526d23..ddae783f06 100755
--- a/extra/irc/ui/commands/commands.factor
+++ b/extra/irc/ui/commands/commands.factor
@@ -6,8 +6,15 @@ USING: accessors kernel irc.client irc.messages irc.ui namespaces ;
 IN: irc.ui.commands
 
 : say ( string -- )
-    [ client get profile>> nickname>> <own-message> print-irc ]
-    [ listener get write-message ] bi ;
+    irc-tab get
+    [ window>> client>> profile>> nickname>> <own-message> print-irc ]
+    [ listener>> write-message ] 2bi ;
+
+: join ( string -- )
+    irc-tab get window>> join-channel ;
+
+: query ( string -- )
+    irc-tab get window>> query-nick ;
 
 : quote ( string -- )
     drop ; ! THIS WILL CHANGE
diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor
index a524168d54..4757e36660 100755
--- a/extra/irc/ui/ui.factor
+++ b/extra/irc/ui/ui.factor
@@ -19,9 +19,9 @@ SYMBOL: listener
 
 SYMBOL: client
 
-TUPLE: ui-window client tabs ;
+TUPLE: ui-window < tabbed client ;
 
-TUPLE: irc-tab < frame listener client userlist ;
+TUPLE: irc-tab < frame listener client window userlist ;
 
 : write-color ( str color -- )
     foreground associate format ;
@@ -161,44 +161,54 @@ M: object handle-inbox
     <scrolling-pane>
     [ <pane-stream> swap display ] 2keep ;
 
-TUPLE: irc-editor < editor outstream listener client ;
+TUPLE: irc-editor < editor outstream tab ;
 
 : <irc-editor> ( tab pane -- tab editor )
-    over irc-editor new-editor
-    swap listener>> >>listener swap <pane-stream> >>outstream
-    over client>> >>client ;
+    irc-editor new-editor
+    swap <pane-stream> >>outstream ;
 
 : editor-send ( irc-editor -- )
     { [ outstream>> ]
-      [ listener>> ]
-      [ client>> ]
+      [ [ irc-tab? ] find-parent ]
       [ editor-string ]
       [ "" swap set-editor-string ] } cleave
-     '[ , listener set , client set , parse-message ] with-output-stream ;
+     '[ , irc-tab set , parse-message ] with-output-stream ;
 
 irc-editor "general" f {
     { T{ key-down f f "RET" } editor-send }
     { T{ key-down f f "ENTER" } editor-send }
 } define-command-map
 
-: <irc-tab> ( listener client -- irc-tab )
-    irc-tab new-frame
-    swap client>> >>client swap >>listener
+: new-irc-tab ( listener ui-window class -- irc-tab )
+    new-frame
+    swap >>window
+    swap >>listener
     <irc-pane> [ <scroller> @center grid-add ] keep
     <irc-editor> <scroller> @bottom grid-add ;
 
-: <irc-channel-tab> ( listener client -- irc-tab )
-    <irc-tab>
-    <pile> [ <scroller> @right grid-add ] keep >>userlist ;
-
-: <irc-server-tab> ( listener client -- irc-tab )
-    <irc-tab> ;
-
 M: irc-tab graft*
-    [ listener>> ] [ client>> ] bi add-listener ;
+    [ listener>> ] [ window>> client>> ] bi add-listener ;
 
 M: irc-tab ungraft*
-    [ listener>> ] [ client>> ] bi remove-listener ;
+    [ listener>> ] [ window>> client>> ] bi remove-listener ;
+
+TUPLE: irc-channel-tab < irc-tab userlist ;
+
+: <irc-channel-tab> ( listener ui-window -- irc-tab )
+    irc-tab new-irc-tab
+    <pile> [ <scroller> @right grid-add ] keep >>userlist ;
+
+TUPLE: irc-server-tab < irc-tab ;
+
+: <irc-server-tab> ( listener -- irc-tab )
+    f irc-server-tab new-irc-tab ;
+
+M: irc-server-tab ungraft*
+    [ window>> client>> terminate-irc ]
+    [ listener>> ] [ window>> client>> ] tri remove-listener ;
+
+: <irc-nick-tab> ( listener ui-window -- irc-tab )
+    irc-tab new-irc-tab ;
 
 M: irc-tab pref-dim*
     drop { 480 480 } ;
@@ -206,19 +216,25 @@ M: irc-tab pref-dim*
 : join-channel ( name ui-window -- )
     [ dup <irc-channel-listener> ] dip
     [ <irc-channel-tab> swap ] keep
-    tabs>> add-page ;
+    add-page ;
+
+: query-nick ( nick ui-window -- )
+    [ dup <irc-nick-listener> ] dip
+    [ <irc-nick-tab> swap ] keep
+    add-page ;
 
 : irc-window ( ui-window -- )
-    [ tabs>> ]
+    [ ]
     [ client>> profile>> server>> ] bi
     open-window ;
 
 : ui-connect ( profile -- ui-window )
-    <irc-client> ui-window new over >>client swap
-    [ connect-irc ]
-    [ [ <irc-server-listener> ] dip add-listener ]
-    [ listeners>> +server-listener+ swap at over <irc-tab>
-      "Server" associate <tabbed> >>tabs ] tri ;
+    <irc-client>
+    { [ [ <irc-server-listener> ] dip add-listener ]
+      [ listeners>> +server-listener+ swap at <irc-server-tab> dup
+        "Server" associate ui-window new-tabbed [ swap (>>window) ] keep ]
+      [ >>client ]
+      [ connect-irc ] } cleave ;
 
 : server-open ( server port nick password channels -- )
     [ <irc-profile> ui-connect [ irc-window ] keep ] dip
diff --git a/unfinished/compiler/cfg/builder/builder-tests.factor b/unfinished/compiler/cfg/builder/builder-tests.factor
new file mode 100644
index 0000000000..098919c868
--- /dev/null
+++ b/unfinished/compiler/cfg/builder/builder-tests.factor
@@ -0,0 +1,4 @@
+IN: compiler.cfg.builder.tests
+USING: compiler.cfg.builder tools.test ;
+
+\ build-cfg must-infer
diff --git a/unfinished/compiler/cfg/builder/builder.factor b/unfinished/compiler/cfg/builder/builder.factor
index 2f68864e81..76a1b67dd2 100644
--- a/unfinished/compiler/cfg/builder/builder.factor
+++ b/unfinished/compiler/cfg/builder/builder.factor
@@ -1,29 +1,33 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel assocs sequences sequences.lib fry accessors
-compiler.cfg compiler.vops compiler.vops.builder
-namespaces math inference.dataflow optimizer.allot combinators
-math.order ;
+namespaces math combinators math.order
+compiler.tree
+compiler.tree.combinators
+compiler.tree.propagation.info
+compiler.cfg
+compiler.vops
+compiler.vops.builder ;
 IN: compiler.cfg.builder
 
-! Convert dataflow IR to procedure CFG.
+! Convert tree SSA IR to CFG SSA IR.
+
 ! We construct the graph and set successors first, then we
 ! set predecessors in a separate pass. This simplifies the
 ! logic.
 
 SYMBOL: procedures
 
-SYMBOL: values>vregs
-
 SYMBOL: loop-nesting
 
-GENERIC: convert* ( node -- )
+SYMBOL: values>vregs
 
 GENERIC: convert ( node -- )
 
+M: #introduce convert drop ;
+
 : init-builder ( -- )
-    H{ } clone values>vregs set
-    V{ } clone loop-nesting set ;
+    H{ } clone values>vregs set ;
 
 : end-basic-block ( -- )
     basic-block get [ %b emit ] when ;
@@ -40,15 +44,12 @@ GENERIC: convert ( node -- )
     set-basic-block ;
 
 : convert-nodes ( node -- )
-    dup basic-block get and [
-        [ convert ] [ successor>> convert-nodes ] bi
-    ] [ drop ] if ;
+    [ convert ] each ;
 
 : (build-cfg) ( node word -- )
     init-builder
     begin-basic-block
     basic-block get swap procedures get set-at
-    %prolog emit
     convert-nodes ;
 
 : build-cfg ( node word -- procedures )
@@ -73,10 +74,9 @@ GENERIC: convert ( node -- )
         2bi
     ] if ;
 
-: load-inputs ( node -- )
-    [ in-d>> %data (load-inputs) ]
-    [ in-r>> %retain (load-inputs) ]
-    bi ;
+: load-in-d ( node -- ) in-d>> %data (load-inputs) ;
+
+: load-in-r ( node -- ) in-r>> %retain (load-inputs) ;
 
 : (store-outputs) ( seq stack -- )
     over empty? [ 2drop ] [
@@ -86,40 +86,21 @@ GENERIC: convert ( node -- )
         2bi
     ] if ;
 
-: store-outputs ( node -- )
-    [ out-d>> %data (store-outputs) ]
-    [ out-r>> %retain (store-outputs) ]
-    bi ;
+: store-out-d ( node -- ) out-d>> %data (store-outputs) ;
 
-M: #push convert*
-    out-d>> [
-        [ produce-vreg ] [ value-literal ] bi
-        emit-literal
-    ] each ;
-
-M: #shuffle convert* drop ;
-
-M: #>r convert* drop ;
-
-M: #r> convert* drop ;
-
-M: node convert
-    [ load-inputs ]
-    [ convert* ]
-    [ store-outputs ]
-    tri ;
+: store-out-r ( node -- ) out-r>> %retain (store-outputs) ;
 
 : (emit-call) ( word -- )
     begin-basic-block %call emit begin-basic-block ;
 
 : intrinsic-inputs ( node -- )
-    [ load-inputs ]
+    [ load-in-d ]
     [ in-d>> { #1 #2 #3 #4 } [ [ value>vreg ] dip set ] 2each ]
     bi ;
 
 : intrinsic-outputs ( node -- )
     [ out-d>> { ^1 ^2 ^3 ^4 } [ get output-vreg ] 2each ]
-    [ store-outputs ]
+    [ store-out-d ]
     bi ;
 
 : intrinsic ( node quot -- )
@@ -132,19 +113,17 @@ M: node convert
         tri
     ] with-scope ; inline
 
-USING: kernel.private math.private slots.private
-optimizer.allot ;
+USING: kernel.private math.private slots.private ;
 
 : maybe-emit-fixnum-shift-fast ( node -- node )
-    dup dup in-d>> second node-literal? [
-        dup dup in-d>> second node-literal
+    dup dup in-d>> second node-value-info literal>> dup fixnum? [
         '[ , emit-fixnum-shift-fast ] intrinsic
     ] [
-        dup param>> (emit-call)
+        drop dup word>> (emit-call)
     ] if ;
 
 : emit-call ( node -- )
-    dup param>> {
+    dup word>> {
         { \ tag [ [ emit-tag ] intrinsic ] }
 
         { \ slot [ [ dup emit-slot ] intrinsic ] }
@@ -175,24 +154,43 @@ optimizer.allot ;
         { \ float> [ [ emit-float> ] intrinsic ] }
         { \ float? [ [ emit-float= ] intrinsic ] }
 
-        { \ (tuple) [ dup first-input '[ , emit-(tuple) ] intrinsic ] }
-        { \ (array) [ dup first-input '[ , emit-(array) ] intrinsic ] }
-        { \ (byte-array) [ dup first-input '[ , emit-(byte-array) ] intrinsic ] }
+        ! { \ (tuple) [ dup first-input '[ , emit-(tuple) ] intrinsic ] }
+        ! { \ (array) [ dup first-input '[ , emit-(array) ] intrinsic ] }
+        ! { \ (byte-array) [ dup first-input '[ , emit-(byte-array) ] intrinsic ] }
 
         [ (emit-call) ]
     } case drop ;
 
 M: #call convert emit-call ;
 
-M: #call-label convert
-    dup param>> loop-nesting get at [
-        basic-block get successors>> push
-        end-basic-block
-        basic-block off
-        drop
-    ] [
-        (emit-call)
-    ] if* ;
+: emit-call-loop ( #recursive -- )
+    dup label>> loop-nesting get at basic-block get successors>> push
+    end-basic-block
+    basic-block off
+    drop ;
+
+: emit-call-recursive ( #recursive -- )
+    label>> id>> (emit-call) ;
+
+M: #call-recursive convert
+    dup label>> loop?>>
+    [ emit-call-loop ] [ emit-call-recursive ] if ;
+
+M: #push convert
+    [
+        [ out-d>> first produce-vreg ]
+        [ node-output-infos first literal>> ]
+        bi emit-literal
+    ]
+    [ store-out-d ] bi ;
+
+M: #shuffle convert [ load-in-d ] [ store-out-d ] bi ;
+
+M: #>r convert [ load-in-d ] [ store-out-r ] bi ;
+
+M: #r> convert [ load-in-r ] [ store-out-d ] bi ;
+
+M: #terminate convert drop ;
 
 : integer-conditional ( in1 in2 cc -- )
     [ [ next-vreg dup ] 2dip %icmp emit ] dip %bi emit ; inline
@@ -221,50 +219,38 @@ M: #call-label convert
     [ set-basic-block ]
     bi ;
 
-: phi-inputs ( #if -- vregs-seq )
-    children>>
-    [ last-node ] map
-    [ #values? ] filter
-    [ in-d>> [ value>vreg ] map ] map ;
-
-: phi-outputs ( #if -- vregs )
-    successor>> out-d>> [ produce-vreg ] map ;
-
-: emit-phi ( #if -- )
-    [ phi-outputs ] [ phi-inputs ] bi %phi emit ;
-
 M: #if convert
-    {
-        [ load-inputs ]
-        [ emit-if ]
-        [ convert-if-children ]
-        [ emit-phi ]
-    } cleave ;
+    [ load-in-d ] [ emit-if ] [ convert-if-children ] tri ;
 
-M: #values convert drop ;
+M: #dispatch convert
+    "Unimplemented" throw ;
 
-M: #merge convert drop ;
-
-M: #entry convert drop ;
+M: #phi convert drop ;
 
 M: #declare convert drop ;
 
-M: #terminate convert drop ;
+M: #return convert drop %return emit ;
 
-M: #label convert
-    #! Labels create a new procedure.
-    [ [ param>> ] [ node-child ] bi (build-cfg) ] [ (emit-call) ] bi ;
+: convert-recursive ( #recursive -- )
+    [ [ label>> id>> ] [ child>> ] bi (build-cfg) ]
+    [ (emit-call) ]
+    bi ;
 
-M: #loop convert
-    #! Loops become part of the current CFG.
-    begin-basic-block
-    [ param>> basic-block get 2array loop-nesting get push ]
-    [ node-child convert-nodes ]
-    bi
+: begin-loop ( #recursive -- )
+    label>> basic-block get 2array loop-nesting get push ;
+
+: end-loop ( -- )
     loop-nesting get pop* ;
 
-M: #return convert
-    param>> loop-nesting get key? [
-        %epilog emit
-        %return emit
-    ] unless ;
+: convert-loop ( #recursive -- )
+    begin-basic-block
+    [ begin-loop ]
+    [ child>> convert-nodes ]
+    [ drop end-loop ]
+    tri ;
+
+M: #recursive convert
+    dup label>> loop?>>
+    [ convert-loop ] [ convert-recursive ] if ;
+
+M: #copy convert drop ;
diff --git a/unfinished/compiler/machine/debug/debug.factor b/unfinished/compiler/machine/debugger/debugger.factor
similarity index 58%
rename from unfinished/compiler/machine/debug/debug.factor
rename to unfinished/compiler/machine/debugger/debugger.factor
index f83dadadec..adc84d771f 100644
--- a/unfinished/compiler/machine/debug/debug.factor
+++ b/unfinished/compiler/machine/debugger/debugger.factor
@@ -1,12 +1,17 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces sequences assocs io
-prettyprint inference generator optimizer compiler.vops
-compiler.cfg.builder compiler.cfg.simplifier
-compiler.machine.builder compiler.machine.simplifier ;
-IN: compiler.machine.debug
+prettyprint inference generator optimizer
+compiler.vops
+compiler.tree.builder
+compiler.tree.optimizer
+compiler.cfg.builder
+compiler.cfg.simplifier
+compiler.machine.builder
+compiler.machine.simplifier ;
+IN: compiler.machine.debugger
 
-: dataflow>linear ( dataflow word -- linear )
+: tree>linear ( tree word -- linear )
     [
         init-counter
         build-cfg
@@ -20,15 +25,16 @@ IN: compiler.machine.debug
     ] assoc-each ;
 
 : linearized-quot. ( quot -- )
-    dataflow optimize
-    "Anonymous quotation" dataflow>linear
+    build-tree optimize-tree
+    "Anonymous quotation" tree>linear
     linear. ;
 
 : linearized-word. ( word -- )
-    dup word-dataflow nip optimize swap dataflow>linear linear. ;
+    dup build-tree-from-word nip optimize-tree
+    dup word-dataflow nip optimize swap tree>linear linear. ;
 
 : >basic-block ( quot -- basic-block )
-    dataflow optimize
+    build-tree optimize-tree
     [
         init-counter
         "Anonymous quotation" build-cfg
diff --git a/unfinished/compiler/tree/builder/builder.factor b/unfinished/compiler/tree/builder/builder.factor
index afa57556ca..e2315dbdf7 100644
--- a/unfinished/compiler/tree/builder/builder.factor
+++ b/unfinished/compiler/tree/builder/builder.factor
@@ -22,6 +22,11 @@ IN: compiler.tree.builder
     ] with-tree-builder nip
     unclip-last in-d>> ;
 
+: build-sub-tree ( #call quot -- nodes )
+    [ [ out-d>> ] [ in-d>> ] bi ] dip
+    build-tree-with
+    rot #copy suffix ;
+
 : (make-specializer) ( class picker -- quot )
     swap "predicate" word-prop append ;
 
diff --git a/unfinished/compiler/tree/debugger/debugger-tests.factor b/unfinished/compiler/tree/debugger/debugger-tests.factor
new file mode 100644
index 0000000000..e6a4385c3e
--- /dev/null
+++ b/unfinished/compiler/tree/debugger/debugger-tests.factor
@@ -0,0 +1,6 @@
+IN: compiler.tree.debugger.tests
+USING: compiler.tree.debugger tools.test ;
+
+\ optimized-quot. must-infer
+\ optimized-word. must-infer
+\ optimizer-report. must-infer
diff --git a/unfinished/compiler/tree/debugger/debugger.factor b/unfinished/compiler/tree/debugger/debugger.factor
new file mode 100644
index 0000000000..5e8b8888ee
--- /dev/null
+++ b/unfinished/compiler/tree/debugger/debugger.factor
@@ -0,0 +1,144 @@
+! Copyright (C) 2006, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel assocs fry match accessors namespaces effects
+sequences sequences.private quotations generic macros arrays
+prettyprint prettyprint.backend prettyprint.sections math words
+combinators io sorting
+compiler.tree
+compiler.tree.builder
+compiler.tree.optimizer
+compiler.tree.combinators
+compiler.tree.propagation.info ;
+IN: compiler.tree.debugger
+
+! A simple tool for turning tree IR into quotations and
+! printing reports, for debugging purposes.
+
+GENERIC: node>quot ( node -- )
+
+MACRO: match-choose ( alist -- )
+    [ '[ , ] ] assoc-map '[ , match-cond ] ;
+
+MATCH-VARS: ?a ?b ?c ;
+
+: pretty-shuffle ( in out -- word/f )
+    2array {
+        { { { } { } } [ ] }
+        { { { ?a } { ?a } } [ ] }
+        { { { ?a ?b } { ?a ?b } } [ ] }
+        { { { ?a ?b ?c } { ?a ?b ?c } } [ ] }
+        { { { ?a } { } } [ drop ] }
+        { { { ?a ?b } { } } [ 2drop ] }
+        { { { ?a ?b ?c } { } } [ 3drop ] }
+        { { { ?a } { ?a ?a } } [ dup ] }
+        { { { ?a ?b } { ?a ?b ?a ?b } } [ 2dup ] }
+        { { { ?a ?b ?c } { ?a ?b ?c ?a ?b ?c } } [ 3dup ] }
+        { { { ?a ?b } { ?a ?b ?a } } [ over ] }
+        { { { ?b ?a } { ?a ?b } } [ swap ] }
+        { { { ?b ?a ?c } { ?a ?b ?c } } [ swapd ] }
+        { { { ?a ?b } { ?a ?a ?b } } [ dupd ] }
+        { { { ?a ?b } { ?b ?a ?b } } [ tuck ] }
+        { { { ?a ?b ?c } { ?a ?b ?c ?a } } [ pick ] }
+        { { { ?a ?b ?c } { ?c ?a ?b } } [ -rot ] }
+        { { { ?a ?b ?c } { ?b ?c ?a } } [ rot ] }
+        { { { ?a ?b } { ?b } } [ nip ] }
+        { { { ?a ?b ?c } { ?c } } [ 2nip ] }
+        { _ f }
+    } match-choose ;
+
+TUPLE: shuffle effect ;
+
+M: shuffle pprint* effect>> effect>string text ;
+
+: shuffle-inputs/outputs ( node -- in out )
+    [ in-d>> ] [ out-d>> ] [ mapping>> ] tri
+    [ at ] curry map ;
+
+M: #shuffle node>quot
+    shuffle-inputs/outputs 2dup pretty-shuffle dup
+    [ 2nip % ] [ drop <effect> shuffle boa , ] if ;
+
+: pushed-literals ( node -- seq )
+    dup out-d>> [ node-value-info literal>> literalize ] with map ;
+
+M: #push node>quot pushed-literals % ;
+
+M: #call node>quot word>> , ;
+
+M: #call-recursive node>quot label>> id>> , ;
+
+DEFER: nodes>quot
+
+DEFER: label
+
+M: #recursive node>quot
+    [ label>> id>> literalize , ]
+    [ child>> nodes>quot , \ label , ]
+    bi ;
+
+M: #if node>quot
+    children>> [ nodes>quot ] map % \ if , ;
+
+M: #dispatch node>quot
+    children>> [ nodes>quot ] map , \ dispatch , ;
+
+M: #>r node>quot in-d>> length \ >r <repetition> % ;
+
+M: #r> node>quot out-d>> length \ r> <repetition> % ;
+
+M: node node>quot drop ;
+
+: nodes>quot ( node -- quot )
+    [ [ node>quot ] each ] [ ] make ;
+
+: optimized. ( quot/word -- )
+    dup word? [ specialized-def ] when
+    build-tree optimize-tree nodes>quot . ;
+
+SYMBOL: words-called
+SYMBOL: generics-called
+SYMBOL: methods-called
+SYMBOL: intrinsics-called
+SYMBOL: node-count
+
+: make-report ( word/quot -- assoc )
+    [
+        dup word? [ build-tree-from-word nip ] [ build-tree ] if
+        optimize-tree
+
+        H{ } clone words-called set
+        H{ } clone generics-called set
+        H{ } clone methods-called set
+        H{ } clone intrinsics-called set
+
+        0 swap [
+            >r 1+ r>
+            dup #call? [
+                word>> {
+                    { [ dup "intrinsics" word-prop over "if-intrinsics" word-prop or ] [ intrinsics-called ] }
+                    { [ dup generic? ] [ generics-called ] }
+                    { [ dup method-body? ] [ methods-called ] }
+                    [ words-called ]
+                } cond 1 -rot get at+
+            ] [ drop ] if
+        ] each-node
+        node-count set
+    ] H{ } make-assoc ;
+
+: report. ( report -- )
+    [
+        "==== Total number of IR nodes:" print
+        node-count get .
+
+        {
+            { generics-called "==== Generic word calls:" }
+            { words-called "==== Ordinary word calls:" }
+            { methods-called "==== Non-inlined method calls:" }
+            { intrinsics-called "==== Open-coded intrinsic calls:" }
+        } [
+            nl print get keys natural-sort stack.
+        ] assoc-each
+    ] bind ;
+
+: optimizer-report. ( word -- )
+    make-report report. ;
diff --git a/unfinished/compiler/tree/intrinsics/intrinsics.factor b/unfinished/compiler/tree/intrinsics/intrinsics.factor
index a3328114bd..322e0dabe1 100644
--- a/unfinished/compiler/tree/intrinsics/intrinsics.factor
+++ b/unfinished/compiler/tree/intrinsics/intrinsics.factor
@@ -1,6 +1,26 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel ;
+USING: kernel classes.tuple classes.tuple.private math arrays 
+byte-arrays words stack-checker.known-words ;
 IN: compiler.tree.intrinsics
 
-: <immutable-tuple-boa> ( ... class -- tuple ) "Intrinsic" throw ;
+: <immutable-tuple-boa> ( ... class -- tuple )
+    "BUG: missing <immutable-tuple-boa> intrinsic" throw ;
+
+: (tuple) ( layout -- tuple )
+    "BUG: missing (tuple) intrinsic" throw ;
+
+\ (tuple) { tuple-layout } { tuple } define-primitive
+\ (tuple) make-flushable
+
+: (array) ( n -- array )
+    "BUG: missing (array) intrinsic" throw ;
+
+\ (array) { integer } { array } define-primitive
+\ (array) make-flushable
+
+: (byte-array) ( n -- byte-array )
+    "BUG: missing (byte-array) intrinsic" throw ;
+
+\ (byte-array) { integer } { byte-array } define-primitive
+\ (byte-array) make-flushable
diff --git a/unfinished/compiler/tree/loop/detection/detection.factor b/unfinished/compiler/tree/loop/detection/detection.factor
index 1c881e9ee4..21d7e2a694 100644
--- a/unfinished/compiler/tree/loop/detection/detection.factor
+++ b/unfinished/compiler/tree/loop/detection/detection.factor
@@ -1,22 +1,13 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences namespaces assocs accessors fry
-compiler.tree ;
+compiler.tree dequeues search-dequeues ;
 IN: compiler.tree.loop.detection
 
 ! A loop is a #recursive which only tail calls itself, and those
-! calls are nested inside other loops only.
-
-TUPLE: recursive-call tail? nesting ;
-
-! calls is a sequence of recursive-call instances
-TUPLE: loop-info calls height ;
-
-! Mapping inline-recursive instances to loop-info instances
-SYMBOL: loop-infos
-
-! A sequence of inline-recursive instances
-SYMBOL: label-stack
+! calls are nested inside other loops only. We optimistically
+! assume all #recursive nodes are loops, disqualifying them as
+! we see evidence to the contrary.
 
 : (tail-calls) ( tail? seq -- seq' )
     reverse [ swap [ and ] keep ] map nip reverse ;
@@ -29,6 +20,11 @@ SYMBOL: label-stack
         tri or or
     ] map (tail-calls) ;
 
+SYMBOL: loop-heights
+SYMBOL: loop-calls
+SYMBOL: loop-stack
+SYMBOL: work-list
+
 GENERIC: collect-loop-info* ( tail? node -- )
 
 : non-tail-label-info ( nodes -- )
@@ -37,24 +33,32 @@ GENERIC: collect-loop-info* ( tail? node -- )
 : (collect-loop-info) ( tail? nodes -- )
     [ tail-calls ] keep [ collect-loop-info* ] 2each ;
 
-: remember-loop-info ( #recursive -- )
-    V{ } clone label-stack get length loop-info boa
-    swap label>> loop-infos get set-at ;
+: remember-loop-info ( label -- )
+    loop-stack get length swap loop-heights get set-at ;
 
 M: #recursive collect-loop-info*
     nip
     [
-        [ label-stack [ swap label>> suffix ] change ]
-        [ remember-loop-info ]
-        [ t swap child>> (collect-loop-info) ]
-        tri
+        [
+            label>>
+            [ loop-stack [ swap suffix ] change ]
+            [ remember-loop-info ]
+            [ t >>loop? drop ]
+            tri
+        ]
+        [ t swap child>> (collect-loop-info) ] bi
     ] with-scope ;
 
+: current-loop-nesting ( label -- labels )
+    loop-stack get swap loop-heights get at tail ;
+
+: disqualify-loop ( label -- )
+    work-list get push-front ;
+
 M: #call-recursive collect-loop-info*
-    label>> loop-infos get at
-    [ label-stack get swap height>> tail recursive-call boa ]
-    [ calls>> ]
-    bi push ;
+    label>>
+    swap [ dup disqualify-loop ] unless
+    dup current-loop-nesting [ loop-calls get push-at ] with each ;
 
 M: #if collect-loop-info*
     children>> [ (collect-loop-info) ] with each ;
@@ -65,39 +69,20 @@ M: #dispatch collect-loop-info*
 M: node collect-loop-info* 2drop ;
 
 : collect-loop-info ( node -- )
-    { } label-stack set
-    H{ } clone loop-infos set
+    { } loop-stack set
+    H{ } clone loop-calls set
+    H{ } clone loop-heights set
+    <hashed-dlist> work-list set
     t swap (collect-loop-info) ;
 
-! Sub-assoc of loop-infos
-SYMBOL: potential-loops
-
-: remove-non-tail-calls ( -- )
-    loop-infos get
-    [ nip calls>> [ tail?>> ] all? ] assoc-filter
-    potential-loops set ;
-
-: (remove-non-loop-calls) ( loop-infos -- )
-    f over [
-        ! If label X is called from within a label Y that is
-        ! no longer a potential loop, then X is no longer a
-        ! potential loop either.
-        over potential-loops get key? [
-            potential-loops get '[ , key? ] all?
-            [ drop ] [ potential-loops get delete-at t or ] if
-        ] [ 2drop ] if
-    ] assoc-each
-    [ (remove-non-loop-calls) ] [ drop ] if ;
-
-: remove-non-loop-calls ( -- )
-    ! Boolean is set to t if something changed.
-    !  We recurse until a fixed point is reached.
-    loop-infos get [ calls>> [ nesting>> ] map concat ] assoc-map
-    (remove-non-loop-calls) ;
+: disqualify-loops ( -- )
+    work-list get [
+        dup loop?>> [
+            [ f >>loop? drop ]
+            [ loop-calls get at [ disqualify-loop ] each ]
+            bi
+        ] [ drop ] if
+    ] slurp-dequeue ;
 
 : detect-loops ( nodes -- nodes )
-    dup
-    collect-loop-info
-    remove-non-tail-calls
-    remove-non-loop-calls
-    potential-loops get [ drop t >>loop? drop ] assoc-each ;
+    dup collect-loop-info disqualify-loops ;
diff --git a/unfinished/compiler/tree/elaboration/elaboration.factor b/unfinished/compiler/tree/loop/inversion/inversion.factor
similarity index 57%
rename from unfinished/compiler/tree/elaboration/elaboration.factor
rename to unfinished/compiler/tree/loop/inversion/inversion.factor
index b0f4306964..719fc4ad70 100644
--- a/unfinished/compiler/tree/elaboration/elaboration.factor
+++ b/unfinished/compiler/tree/loop/inversion/inversion.factor
@@ -1,5 +1,5 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: compiler.tree.elaboration
+IN: compiler.tree.loop.inversion
 
-: elaborate ( nodes -- nodes' ) ;
+: invert-loops ( nodes -- nodes' ) ;
diff --git a/unfinished/compiler/tree/optimizer/optimizer-tests.factor b/unfinished/compiler/tree/optimizer/optimizer-tests.factor
new file mode 100644
index 0000000000..1075e441e7
--- /dev/null
+++ b/unfinished/compiler/tree/optimizer/optimizer-tests.factor
@@ -0,0 +1,4 @@
+USING: compiler.tree.optimizer tools.test ;
+IN: compiler.tree.optimizer.tests
+
+\ optimize-tree must-infer
diff --git a/unfinished/compiler/tree/optimizer/optimizer.factor b/unfinished/compiler/tree/optimizer/optimizer.factor
index e44cf44db7..2d2a376bc0 100644
--- a/unfinished/compiler/tree/optimizer/optimizer.factor
+++ b/unfinished/compiler/tree/optimizer/optimizer.factor
@@ -8,7 +8,8 @@ compiler.tree.tuple-unboxing
 compiler.tree.def-use
 compiler.tree.dead-code
 compiler.tree.strength-reduction
-compiler.tree.loop-detection
+compiler.tree.loop.detection
+compiler.tree.loop.inversion
 compiler.tree.branch-fusion ;
 IN: compiler.tree.optimizer
 
@@ -16,11 +17,11 @@ IN: compiler.tree.optimizer
     normalize
     propagate
     cleanup
+    detect-loops
+    invert-loops
+    fuse-branches
     escape-analysis
     unbox-tuples
     compute-def-use
     remove-dead-code
-    strength-reduce
-    detect-loops
-    fuse-branches
-    elaborate ;
+    strength-reduce ;
diff --git a/unfinished/compiler/tree/propagation/inlining/inlining.factor b/unfinished/compiler/tree/propagation/inlining/inlining.factor
index 22e056ce60..d333842657 100644
--- a/unfinished/compiler/tree/propagation/inlining/inlining.factor
+++ b/unfinished/compiler/tree/propagation/inlining/inlining.factor
@@ -18,10 +18,7 @@ M: word splicing-nodes
     [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
 
 M: quotation splicing-nodes
-    [ [ out-d>> ] [ in-d>> ] bi ] dip
-    build-tree-with
-    rot #copy suffix
-    normalize ;
+    build-sub-tree normalize ;
 
 : propagate-body ( #call -- )
     body>> (propagate) ;
diff --git a/unfinished/stack-checker/known-words/known-words.factor b/unfinished/stack-checker/known-words/known-words.factor
index 01991147f7..2e0c979f98 100755
--- a/unfinished/stack-checker/known-words/known-words.factor
+++ b/unfinished/stack-checker/known-words/known-words.factor
@@ -165,24 +165,27 @@ M: object infer-call*
 { call execute dispatch load-locals get-local drop-locals }
 [ t "no-compile" set-word-prop ] each
 
+SYMBOL: +primitive+
+
 : non-inline-word ( word -- )
     dup +called+ depends-on
     {
         { [ dup +shuffle+ word-prop ] [ infer-shuffle-word ] }
         { [ dup +special+ word-prop ] [ infer-special ] }
-        { [ dup primitive? ] [ infer-primitive ] }
+        { [ dup +primitive+ word-prop ] [ infer-primitive ] }
         { [ dup +cannot-infer+ word-prop ] [ cannot-infer-effect ] }
-        { [ dup +inferred-effect+ word-prop ] [ cached-infer ] }
         { [ dup +transform-quot+ word-prop ] [ apply-transform ] }
+        { [ dup +inferred-effect+ word-prop ] [ cached-infer ] }
         { [ dup "macro" word-prop ] [ apply-macro ] }
         { [ dup recursive-label ] [ call-recursive-word ] }
         [ dup infer-word apply-word/effect ]
     } cond ;
 
 : define-primitive ( word inputs outputs -- )
+    [ 2drop t +primitive+ set-word-prop ]
     [ drop "input-classes" set-word-prop ]
     [ nip "default-output-classes" set-word-prop ]
-    3bi ;
+    3tri ;
 
 ! Stack effects for all primitives
 \ fixnum< { fixnum fixnum } { object } define-primitive
diff --git a/unfinished/stack-checker/transforms/transforms.factor b/unfinished/stack-checker/transforms/transforms.factor
index 5ec3f5ad64..d9e889f188 100755
--- a/unfinished/stack-checker/transforms/transforms.factor
+++ b/unfinished/stack-checker/transforms/transforms.factor
@@ -11,31 +11,45 @@ IN: stack-checker.transforms
 SYMBOL: +transform-quot+
 SYMBOL: +transform-n+
 
-: (apply-transform) ( quot n -- newquot )
-    dup zero? [
-        drop recursive-state get 1array
-    ] [
-        consume-d
-        [ #drop, ]
-        [ [ literal value>> ] map ]
-        [ first literal recursion>> ] tri prefix
-    ] if
-    swap with-datastack ;
+: give-up-transform ( word -- )
+    dup recursive-label
+    [ call-recursive-word ]
+    [ dup infer-word apply-word/effect ]
+    if ;
+
+: ((apply-transform)) ( word quot stack -- )
+    swap with-datastack first2
+    dup [ swap infer-quot drop ] [ 2drop give-up-transform ] if ;
+    inline
+
+: (apply-transform) ( word quot n -- )
+    consume-d dup [ known literal? ] all? [
+        dup empty? [
+            drop recursive-state get 1array
+        ] [
+            [ #drop, ]
+            [ [ literal value>> ] map ]
+            [ first literal recursion>> ] tri prefix
+        ] if
+        ((apply-transform))
+    ] [ 2drop give-up-transform ] if ;
 
 : apply-transform ( word -- )
     [ +inlined+ depends-on ] [
+        [ ]
         [ +transform-quot+ word-prop ]
         [ +transform-n+ word-prop ]
-        bi (apply-transform)
-        first2 swap infer-quot
+        tri
+        (apply-transform)
     ] bi ;
 
 : apply-macro ( word -- )
     [ +inlined+ depends-on ] [
+        [ ]
         [ "macro" word-prop ]
         [ "declared-effect" word-prop in>> length ]
-        bi (apply-transform)
-        first2 swap infer-quot
+        tri
+        (apply-transform)
     ] bi ;
 
 : define-transform ( word quot n -- )
@@ -66,20 +80,80 @@ SYMBOL: +transform-n+
 
 \ spread [ spread>quot ] 1 define-transform
 
+\ (call-next-method) [
+    [ [ +inlined+ depends-on ] bi@ ] [ next-method-quot ] 2bi
+] 2 define-transform
+
+! Constructors
 \ boa [
     dup tuple-class? [
         dup +inlined+ depends-on
         [ "boa-check" word-prop ]
         [ tuple-layout '[ , <tuple-boa> ] ]
         bi append
-    ] [
-        \ boa \ no-method boa time-bomb
-    ] if
+    ] [ drop f ] if
 ] 1 define-transform
 
-\ (call-next-method) [
-    [ [ +inlined+ depends-on ] bi@ ] [ next-method-quot ] 2bi
-] 2 define-transform
+\ new [
+    dup tuple-class? [
+        dup +inlined+ depends-on
+        dup all-slots rest-slice ! delegate slot
+        [ [ initial>> literalize , ] each literalize , \ boa , ] [ ] make
+    ] [ drop f ] if
+] 1 define-transform
+
+! Membership testing
+: bit-member-n 256 ; inline
+
+: bit-member? ( seq -- ? )
+    #! Can we use a fast byte array test here?
+    {
+        { [ dup length 8 < ] [ f ] }
+        { [ dup [ integer? not ] contains? ] [ f ] }
+        { [ dup [ 0 < ] contains? ] [ f ] }
+        { [ dup [ bit-member-n >= ] contains? ] [ f ] }
+        [ t ]
+    } cond nip ;
+
+: bit-member-seq ( seq -- flags )
+    bit-member-n swap [ member? 1 0 ? ] curry B{ } map-as ;
+
+: exact-float? ( f -- ? )
+    dup float? [ dup >integer >float = ] [ drop f ] if ; inline
+
+: bit-member-quot ( seq -- newquot )
+    [
+        [ drop ] % ! drop the sequence itself; we don't use it at run time
+        bit-member-seq ,
+        [
+            {
+                { [ over fixnum? ] [ ?nth 1 eq? ] }
+                { [ over bignum? ] [ ?nth 1 eq? ] }
+                { [ over exact-float? ] [ ?nth 1 eq? ] }
+                [ 2drop f ]
+            } cond
+        ] %
+    ] [ ] make ;
+
+: member-quot ( seq -- newquot )
+    dup bit-member? [
+        bit-member-quot
+    ] [
+        [ literalize [ t ] ] { } map>assoc
+        [ drop f ] suffix [ nip case ] curry
+    ] if ;
+
+\ member? [
+    dup sequence? [ member-quot ] [ drop f ] if
+] 1 define-transform
+
+: memq-quot ( seq -- newquot )
+    [ [ dupd eq? ] curry [ drop t ] ] { } map>assoc
+    [ drop f ] suffix [ nip cond ] curry ;
+
+\ memq? [
+    dup sequence? [ memq-quot ] [ drop f ] if
+] 1 define-transform
 
 ! Deprecated
 \ get-slots [ [ 1quotation ] map [ cleave ] curry ] 1 define-transform