diff --git a/extra/db/db.factor b/extra/db/db.factor
index 309847209f..ac46be4422 100755
--- a/extra/db/db.factor
+++ b/extra/db/db.factor
@@ -33,6 +33,19 @@ HOOK: db-close db ( handle -- )
 TUPLE: statement handle sql in-params out-params bind-params bound? ;
 TUPLE: simple-statement ;
 TUPLE: prepared-statement ;
+TUPLE: nonthrowable-statement ;
+: make-nonthrowable ( obj -- obj' )
+    dup sequence? [
+        [ make-nonthrowable ] map
+    ] [
+        nonthrowable-statement construct-delegate
+    ] if ;
+
+MIXIN: throwable-statement
+INSTANCE: statement throwable-statement
+INSTANCE: simple-statement throwable-statement
+INSTANCE: prepared-statement throwable-statement
+
 TUPLE: result-set sql in-params out-params handle n max ;
 : <statement> ( sql in out -- statement )
     { (>>sql) (>>in-params) (>>out-params) } statement construct ;
@@ -50,13 +63,22 @@ GENERIC# row-column-typed 1 ( result-set column -- sql )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 
-: execute-statement ( statement -- )
+GENERIC: execute-statement ( statement -- )
+
+M: throwable-statement execute-statement ( statement -- )
     dup sequence? [
         [ execute-statement ] each
     ] [
         query-results dispose
     ] if ;
 
+M: nonthrowable-statement execute-statement ( statement -- )
+    dup sequence? [
+        [ execute-statement ] each
+    ] [
+        [ query-results dispose ] [ 2drop ] recover
+    ] if ;
+
 : bind-statement ( obj statement -- )
     swap >>bind-params
     [ bind-statement* ] keep
diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor
index b48c87f0ca..928b51dc59 100755
--- a/extra/db/postgresql/lib/lib.factor
+++ b/extra/db/postgresql/lib/lib.factor
@@ -73,7 +73,7 @@ IN: db.postgresql.lib
         sql-spec-type {
             { FACTOR-BLOB [
                 dup [
-                    binary [ serialize ] with-byte-writer
+                    object>bytes
                     malloc-byte-array/length ] [ 0 ] if ] }
             { BLOB [
                 dup [ malloc-byte-array/length ] [ 0 ] if ] }
@@ -164,7 +164,7 @@ M: postgresql-malloc-destructor dispose ( obj -- )
         { BLOB [ pq-get-blob ] }
         { FACTOR-BLOB [
             pq-get-blob
-            dup [ binary [ deserialize ] with-byte-reader ] when ] }
+            dup [ bytes>object ] when ] }
         [ no-sql-type ]
     } case ;
     ! PQgetlength PQgetisnull
diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor
index b2042c98bd..8a6f8632ec 100755
--- a/extra/db/postgresql/postgresql.factor
+++ b/extra/db/postgresql/postgresql.factor
@@ -10,6 +10,7 @@ IN: db.postgresql
 
 TUPLE: postgresql-db host port pgopts pgtty db user pass ;
 TUPLE: postgresql-statement ;
+INSTANCE: postgresql-statement throwable-statement
 TUPLE: postgresql-result-set ;
 : <postgresql-statement> ( statement in out -- postgresql-statement )
     <statement>
@@ -194,7 +195,7 @@ M: postgresql-db <insert-native-statement> ( class -- statement )
         ");" 0%
     ] postgresql-make ;
 
-M: postgresql-db <insert-assigned-statement> ( class -- statement )
+M: postgresql-db <insert-nonnative-statement> ( class -- statement )
     [
         "insert into " 0% 0%
         "(" 0%
diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor
index d630522eb8..0e512ad018 100755
--- a/extra/db/sqlite/lib/lib.factor
+++ b/extra/db/sqlite/lib/lib.factor
@@ -94,7 +94,7 @@ IN: db.sqlite.lib
         { TIMESTAMP [ sqlite-bind-text-by-name ] }
         { BLOB [ sqlite-bind-blob-by-name ] }
         { FACTOR-BLOB [
-            binary [ serialize ] with-byte-writer
+            object>bytes
             sqlite-bind-blob-by-name
         ] }
         { +native-id+ [ sqlite-bind-int-by-name ] }
@@ -106,6 +106,8 @@ IN: db.sqlite.lib
 : sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ;
 : sqlite-#columns ( query -- int ) sqlite3_column_count ;
 : sqlite-column ( handle index -- string ) sqlite3_column_text ;
+: sqlite-column-name ( handle index -- string ) sqlite3_column_name ;
+: sqlite-column-type ( handle index -- string ) sqlite3_column_type ;
 
 : sqlite-column-blob ( handle index -- byte-array/f )
     [ sqlite3_column_bytes ] 2keep
@@ -131,7 +133,7 @@ IN: db.sqlite.lib
         { BLOB [ sqlite-column-blob ] }
         { FACTOR-BLOB [
             sqlite-column-blob
-            dup [ binary [ deserialize ] with-byte-reader ] when
+            dup [ bytes>object ] when
         ] }
         ! { NULL [ 2drop f ] }
         [ no-sql-type ]
@@ -140,7 +142,7 @@ IN: db.sqlite.lib
 : sqlite-row ( handle -- seq )
     dup sqlite-#columns [ sqlite-column ] with map ;
 
-: sqlite-step-has-more-rows? ( step-result -- bool )
+: sqlite-step-has-more-rows? ( prepared -- bool )
     dup SQLITE_ROW =  [
         drop t
     ] [
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index 3466301390..1b594d6fa4 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -6,6 +6,7 @@ prettyprint sequences strings tuples alien.c-types
 continuations db.sqlite.lib db.sqlite.ffi db.tuples
 words combinators.lib db.types combinators
 combinators.cleave io namespaces.lib ;
+USE: tools.walker
 IN: db.sqlite
 
 TUPLE: sqlite-db path ;
@@ -22,6 +23,8 @@ M: sqlite-db dispose ( db -- ) dispose-db ;
 : with-sqlite ( path quot -- ) sqlite-db swap with-db ; inline
 
 TUPLE: sqlite-statement ;
+INSTANCE: sqlite-statement throwable-statement
+
 TUPLE: sqlite-result-set has-more? ;
 
 M: sqlite-db <simple-statement> ( str in out -- obj )
@@ -33,12 +36,20 @@ M: sqlite-db <prepared-statement> ( str in out -- obj )
         set-statement-in-params
         set-statement-out-params
     } statement construct
-    db get db-handle over statement-sql sqlite-prepare
-    over set-statement-handle
     sqlite-statement construct-delegate ;
 
+: sqlite-maybe-prepare ( statement -- statement )
+    dup statement-handle [
+        [
+            delegate
+            db get db-handle over statement-sql sqlite-prepare
+            swap set-statement-handle
+        ] keep
+    ] unless ;
+
 M: sqlite-statement dispose ( statement -- )
-    statement-handle sqlite-finalize ;
+    statement-handle
+    [ [ sqlite3_reset drop ] keep sqlite-finalize ] when* ;
 
 M: sqlite-result-set dispose ( result-set -- )
     f swap set-result-set-handle ;
@@ -46,9 +57,12 @@ M: sqlite-result-set dispose ( result-set -- )
 : sqlite-bind ( triples handle -- )
     swap [ first3 sqlite-bind-type ] with each ;
 
-: reset-statement ( statement -- ) statement-handle sqlite-reset ;
+: reset-statement ( statement -- )
+    sqlite-maybe-prepare
+    statement-handle sqlite-reset ;
 
 M: sqlite-statement bind-statement* ( statement -- )
+    sqlite-maybe-prepare
     dup statement-bound? [ dup reset-statement ] when
     [ statement-bind-params ] [ statement-handle ] bi
     sqlite-bind ;
@@ -89,6 +103,7 @@ M: sqlite-result-set more-rows? ( result-set -- ? )
     sqlite-result-set-has-more? ;
 
 M: sqlite-statement query-results ( query -- result-set )
+    sqlite-maybe-prepare
     dup statement-handle sqlite-result-set <result-set>
     dup advance-row ;
 
@@ -125,7 +140,7 @@ M: sqlite-db <insert-native-statement> ( tuple -- statement )
         ");" 0%
     ] sqlite-make ;
 
-M: sqlite-db <insert-assigned-statement> ( tuple -- statement )
+M: sqlite-db <insert-nonnative-statement> ( tuple -- statement )
     <insert-native-statement> ;
 
 : where-primary-key% ( specs -- )
@@ -175,6 +190,7 @@ M: sqlite-db modifier-table ( -- hashtable )
     H{
         { +native-id+ "primary key" }
         { +assigned-id+ "primary key" }
+        ! { +nonnative-id+ "primary key" }
         { +autoincrement+ "autoincrement" }
         { +unique+ "unique" }
         { +default+ "default" }
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index ba6441bc53..2dbf6d1008 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -9,7 +9,7 @@ IN: db.tuples.tests
 TUPLE: person the-id the-name the-number the-real
 ts date time blob factor-blob ;
 
-: <person> ( name age real ts date time blob -- person )
+: <person> ( name age real ts date time blob factor-blob -- person )
     {
         set-person-the-name
         set-person-the-number
@@ -190,11 +190,18 @@ TUPLE: annotation n paste-id summary author mode contents ;
 : test-postgresql ( -- )
 >r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ;
 
+: test-repeated-insert
+    [ ] [ person ensure-table ] unit-test
+    
+    [ ] [ person1 get insert-tuple ] unit-test
+    [ person1 get insert-tuple ] must-fail ;
+
 [ native-person-schema test-tuples ] test-sqlite
 [ assigned-person-schema test-tuples ] test-sqlite
-
-! [ native-person-schema test-tuples ] test-postgresql
-! [ assigned-person-schema test-tuples ] test-postgresql
+[ native-person-schema test-tuples ] test-postgresql
+[ assigned-person-schema test-tuples ] test-postgresql
+[ assigned-person-schema test-repeated-insert ] test-sqlite
+[ assigned-person-schema test-repeated-insert ] test-postgresql
 
 TUPLE: serialize-me id data ;
 
diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor
index d50e42c0fb..0f69b0fafb 100755
--- a/extra/db/tuples/tuples.factor
+++ b/extra/db/tuples/tuples.factor
@@ -28,7 +28,7 @@ HOOK: create-sql-statement db ( class -- obj )
 HOOK: drop-sql-statement db ( class -- obj )
 
 HOOK: <insert-native-statement> db ( class -- obj )
-HOOK: <insert-assigned-statement> db ( class -- obj )
+HOOK: <insert-nonnative-statement> db ( class -- obj )
 
 HOOK: <update-tuple-statement> db ( class -- obj )
 HOOK: <update-tuples-statement> db ( class -- obj )
@@ -75,21 +75,25 @@ HOOK: insert-tuple* db ( tuple statement -- )
     drop-sql-statement [ execute-statement ] with-disposals ;
 
 : ensure-table ( class -- )
-    [ dup drop-table ] ignore-errors create-table ;
+    [
+        drop-sql-statement make-nonthrowable
+        [ execute-statement ] with-disposals
+    ] [ create-table ] bi ;
 
 : insert-native ( tuple -- )
     dup class
     db get db-insert-statements [ <insert-native-statement> ] cache
     [ bind-tuple ] 2keep insert-tuple* ;
 
-: insert-assigned ( tuple -- )
+: insert-nonnative ( tuple -- )
+! TODO logic here for unique ids
     dup class
-    db get db-insert-statements [ <insert-assigned-statement> ] cache
+    db get db-insert-statements [ <insert-nonnative-statement> ] cache
     [ bind-tuple ] keep execute-statement ;
 
 : insert-tuple ( tuple -- )
-    dup class db-columns find-primary-key assigned-id? [
-        insert-assigned
+    dup class db-columns find-primary-key nonnative-id? [
+        insert-nonnative
     ] [
         insert-native
     ] if ;
diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor
index 7014aaa943..532c097957 100755
--- a/extra/db/types/types.factor
+++ b/extra/db/types/types.factor
@@ -3,7 +3,8 @@
 USING: arrays assocs db kernel math math.parser
 sequences continuations sequences.deep sequences.lib
 words namespaces tools.walker slots slots.private classes
-mirrors tuples combinators calendar.format symbols ;
+mirrors tuples combinators calendar.format symbols
+singleton ;
 IN: db.types
 
 HOOK: modifier-table db ( -- hash )
@@ -14,22 +15,32 @@ HOOK: compound-type db ( str n -- hash )
 
 TUPLE: sql-spec class slot-name column-name type modifiers primary-key ;
 
-SYMBOLS: +native-id+ +assigned-id+ +autoincrement+
-+serial+ +unique+ +default+ +null+ +not-null+
+
+SINGLETON: +native-id+
+SINGLETON: +assigned-id+
+SINGLETON: +random-id+
+UNION: +primary-key+ +native-id+ +assigned-id+ +random-id+ ;
+UNION: +nonnative-id+ +random-id+ +assigned-id+ ;
+
+! +native-id+ +assigned-id+ +random-assigned-id+
+SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
 +foreign-id+ +has-many+ ;
 
-: (primary-key?) ( obj -- ? )
-    { +native-id+ +assigned-id+ } member? ;
-
 : primary-key? ( spec -- ? )
-    sql-spec-primary-key (primary-key?) ;
+    sql-spec-primary-key +primary-key+? ;
+
+: native-id? ( spec -- ? )
+    sql-spec-primary-key +native-id+? ;
+
+: nonnative-id? ( spec -- ? )
+    sql-spec-primary-key +nonnative-id+? ;
 
 : normalize-spec ( spec -- )
-    dup sql-spec-type dup (primary-key?) [
+    dup sql-spec-type dup +primary-key+? [
         swap set-sql-spec-primary-key
     ] [
         drop dup sql-spec-modifiers [
-            (primary-key?)
+            +primary-key+?
         ] deep-find
         [ swap set-sql-spec-primary-key ] [ drop ] if*
     ] if ;
@@ -37,12 +48,6 @@ SYMBOLS: +native-id+ +assigned-id+ +autoincrement+
 : find-primary-key ( specs -- obj )
     [ sql-spec-primary-key ] find nip ;
 
-: native-id? ( spec -- ? )
-    sql-spec-primary-key +native-id+ = ;
-
-: assigned-id? ( spec -- ? )
-    sql-spec-primary-key +assigned-id+ = ;
-
 : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ;
 
 SYMBOLS: INTEGER BIG-INTEGER DOUBLE REAL BOOLEAN TEXT VARCHAR
@@ -69,7 +74,7 @@ TUPLE: no-sql-modifier ;
     dup number? [ number>string ] when ;
 
 : maybe-remove-id ( specs -- obj )
-    [ native-id? not ] subset ;
+    [ +native-id+? not ] subset ;
 
 : remove-relations ( specs -- newcolumns )
     [ relation? not ] subset ;
diff --git a/extra/delegate/delegate.factor b/extra/delegate/delegate.factor
index 9eabfae95c..67b8a39320 100755
--- a/extra/delegate/delegate.factor
+++ b/extra/delegate/delegate.factor
@@ -27,11 +27,11 @@ M: tuple-class group-words
     swap [ slot-spec-writer ] map append ;
 
 : define-consult-method ( word class quot -- )
-    pick add spin define-method ;
+    pick add >r swap create-method r> define ;
 
 : define-consult ( class group quot -- )
-    >r group-words r>
-    swapd [ define-consult-method ] 2curry each ;
+    >r group-words swap r>
+    [ define-consult-method ] 2curry each ;
 
 : CONSULT:
     scan-word scan-word parse-definition swapd define-consult ; parsing
@@ -39,7 +39,7 @@ M: tuple-class group-words
 : define-mimic ( group mimicker mimicked -- )
     >r >r group-words r> r> [
         pick "methods" word-prop at dup
-        [ "method-def" word-prop spin define-method ]
+        [ >r swap create-method r> word-def define ]
         [ 3drop ] if
     ] 2curry each ; 
 
diff --git a/extra/http/http-tests.factor b/extra/http/http-tests.factor
index 66182b10ae..2e7370bc39 100755
--- a/extra/http/http-tests.factor
+++ b/extra/http/http-tests.factor
@@ -5,8 +5,8 @@ IN: http.tests
 [ "hello%20world" ] [ "hello world" url-encode ] unit-test
 [ "hello world" ] [ "hello%20world" url-decode ] unit-test
 [ "~hello world" ] [ "%7ehello+world" url-decode ] unit-test
-[ "" ] [ "%XX%XX%XX" url-decode ] unit-test
-[ "" ] [ "%XX%XX%X" url-decode ] unit-test
+[ f ] [ "%XX%XX%XX" url-decode ] unit-test
+[ f ] [ "%XX%XX%X" url-decode ] unit-test
 
 [ "hello world"   ] [ "hello+world"    url-decode ] unit-test
 [ "hello world"   ] [ "hello%20world"  url-decode ] unit-test
diff --git a/extra/http/server/actions/actions.factor b/extra/http/server/actions/actions.factor
index 91671392c7..52567ed352 100755
--- a/extra/http/server/actions/actions.factor
+++ b/extra/http/server/actions/actions.factor
@@ -38,10 +38,13 @@ TUPLE: action init display submit get-params post-params ;
     action get display>> call exit-with ;
 
 M: action call-responder ( path action -- response )
-    [ +path+ associate request-params union params set ]
-    [ action set ] bi*
-    request get method>> {
-        { "GET" [ handle-get ] }
-        { "HEAD" [ handle-get ] }
-        { "POST" [ handle-post ] }
-    } case ;
+    '[
+        , ,
+        [ +path+ associate request-params union params set ]
+        [ action set ] bi*
+        request get method>> {
+            { "GET" [ handle-get ] }
+            { "HEAD" [ handle-get ] }
+            { "POST" [ handle-post ] }
+        } case
+    ] with-exit-continuation ;
diff --git a/extra/http/server/auth/auth.factor b/extra/http/server/auth/auth.factor
index 1b1534b85e..69a3c76c2b 100755
--- a/extra/http/server/auth/auth.factor
+++ b/extra/http/server/auth/auth.factor
@@ -1,9 +1,26 @@
 ! Copyright (c) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: http.server.sessions accessors
-http.server.auth.providers ;
+http.server.auth.providers assocs namespaces kernel ;
 IN: http.server.auth
 
 SYMBOL: logged-in-user
+SYMBOL: user-profile-changed?
+
+GENERIC: init-user-profile ( responder -- )
+
+M: object init-user-profile drop ;
 
 : uid ( -- string ) logged-in-user sget username>> ;
+
+: profile ( -- assoc ) logged-in-user sget profile>> ;
+
+: uget ( key -- value )
+    profile at ;
+
+: uset ( value key -- )
+    profile set-at user-profile-changed? on ;
+
+: uchange ( quot key -- )
+    profile swap change-at
+    user-profile-changed? on ; inline
diff --git a/extra/http/server/auth/login/login.factor b/extra/http/server/auth/login/login.factor
index a1c99f749c..275fb0ff63 100755
--- a/extra/http/server/auth/login/login.factor
+++ b/extra/http/server/auth/login/login.factor
@@ -7,16 +7,29 @@ http.server.actions http.server.components http.server.sessions
 http.server.templating.fhtml http.server.validators
 http.server.auth http sequences io.files namespaces hashtables
 fry io.sockets combinators.cleave arrays threads locals
-qualified ;
+qualified continuations destructors ;
 IN: http.server.auth.login
 QUALIFIED: smtp
 
+SYMBOL: post-login-url
+SYMBOL: login-failed?
+
 TUPLE: login users ;
 
 : users login get users>> ;
 
-SYMBOL: post-login-url
-SYMBOL: login-failed?
+! Destructor
+TUPLE: user-saver user ;
+
+C: <user-saver> user-saver
+
+M: user-saver dispose
+    user-profile-changed? get [
+        user>> users update-user
+    ] [ drop ] if ;
+
+: save-user-after ( user -- )
+    <user-saver> add-always-destructor ;
 
 ! ! ! Login
 
@@ -116,6 +129,8 @@ SYMBOL: user-exists?
                 ] unless*
 
                 successful-login
+
+                login get responder>> init-user-profile
             ] >>submit
     ] ;
 
@@ -155,23 +170,21 @@ SYMBOL: previous-page
 
                 form validate-form
 
+                logged-in-user sget
+
                 "password" value empty? [
-                    logged-in-user sget
-                ] [
                     same-password-twice
 
                     "password" value uid users check-login
                     [ login-failed? on validation-failed ] unless
 
-                    "new-password" value uid users set-password
-                    [ "User deleted" throw ] unless*
-                ] if
+                    "new-password" value set-password
+                ] unless
 
                 "realname" value >>realname
                 "email" value >>email
 
-                dup users update-user
-                logged-in-user sset
+                user-profile-changed? on
 
                 previous-page sget f <permanent-redirect>
             ] >>submit
@@ -330,6 +343,7 @@ C: <protected> protected
 
 M: protected call-responder ( path responder -- response )
     logged-in-user sget [
+        dup save-user-after
         request get request-url previous-page sset
         responder>> call-responder
     ] [
diff --git a/extra/http/server/auth/providers/assoc/assoc-tests.factor b/extra/http/server/auth/providers/assoc/assoc-tests.factor
index ae4c5d051f..f99e4d3d2e 100755
--- a/extra/http/server/auth/providers/assoc/assoc-tests.factor
+++ b/extra/http/server/auth/providers/assoc/assoc-tests.factor
@@ -22,11 +22,11 @@ namespaces accessors kernel ;
 
 [ f ] [ "fdasf" "slava" "provider" get check-login >boolean ] unit-test
 
-[ t ] [ "foobar" "slava" "provider" get check-login >boolean ] unit-test
+[ ] [ "foobar" "slava" "provider" get check-login "user" set ] unit-test
 
-[ f ] [ "xx" "blah" "provider" get set-password ] unit-test
+[ t ] [ "user" get >boolean ] unit-test
 
-[ t ] [ "fdasf" "slava" "provider" get set-password >boolean ] unit-test
+[ ] [ "user" get "fdasf" set-password drop ] unit-test
 
 [ t ] [ "fdasf" "slava" "provider" get check-login >boolean ] unit-test
 
diff --git a/extra/http/server/auth/providers/db/db-tests.factor b/extra/http/server/auth/providers/db/db-tests.factor
index 1ee7278163..340e1bb35d 100755
--- a/extra/http/server/auth/providers/db/db-tests.factor
+++ b/extra/http/server/auth/providers/db/db-tests.factor
@@ -12,26 +12,28 @@ users-in-db "provider" set
 
     [ t ] [
         <user>
-        "slava" >>username
-        "foobar" >>password
-        "slava@factorcode.org" >>email
-        "provider" get new-user
-        username>> "slava" =
+            "slava" >>username
+            "foobar" >>password
+            "slava@factorcode.org" >>email
+            "provider" get new-user
+            username>> "slava" =
     ] unit-test
 
     [ f ] [
         <user>
-        "slava" >>username
+            "slava" >>username
         "provider" get new-user
     ] unit-test
 
     [ f ] [ "fdasf" "slava" "provider" get check-login >boolean ] unit-test
 
-    [ t ] [ "foobar" "slava" "provider" get check-login >boolean ] unit-test
+    [ ] [ "foobar" "slava" "provider" get check-login "user" set ] unit-test
 
-    [ f ] [ "xx" "blah" "provider" get set-password ] unit-test
+    [ t ] [ "user" get >boolean ] unit-test
 
-    [ t ] [ "fdasf" "slava" "provider" get set-password >boolean ] unit-test
+    [ ] [ "user" get "fdasf" set-password drop ] unit-test
+
+    [ ] [ "user" get "provider" get update-user ] unit-test
 
     [ t ] [ "fdasf" "slava" "provider" get check-login >boolean ] unit-test
 
diff --git a/extra/http/server/auth/providers/providers.factor b/extra/http/server/auth/providers/providers.factor
index cd9cc995c7..d51679016e 100755
--- a/extra/http/server/auth/providers/providers.factor
+++ b/extra/http/server/auth/providers/providers.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel new-slots accessors random math.parser locals
-sequences math ;
+sequences math crypto.sha2 ;
 IN: http.server.auth.providers
 
 TUPLE: user username realname password email ticket profile ;
@@ -17,14 +17,7 @@ GENERIC: new-user ( user provider -- user/f )
 : check-login ( password username provider -- user/f )
     get-user dup [ [ password>> = ] keep and ] [ 2drop f ] if ;
 
-:: set-password ( password username provider -- user/f )
-    [let | user [ username provider get-user ] |
-        user [
-            user
-                password >>password
-            dup provider update-user
-        ] [ f ] if
-    ] ;
+: set-password ( user password -- user ) >>password ;
 
 ! Password recovery support
 
diff --git a/extra/http/server/callbacks/callbacks.factor b/extra/http/server/callbacks/callbacks.factor
index 45a6ff85f8..eb264279cb 100755
--- a/extra/http/server/callbacks/callbacks.factor
+++ b/extra/http/server/callbacks/callbacks.factor
@@ -98,11 +98,18 @@ SYMBOL: current-show
     cont-id query-param swap callbacks>> at ;
 
 M: callback-responder call-responder ( path responder -- response )
-    [ callback-responder set ]
-    [ request get resuming-callback ] bi
+    '[
+        , ,
 
-    [ invoke-callback ]
-    [ callback-responder get responder>> call-responder ] ?if ;
+        [ callback-responder set ]
+        [ request get resuming-callback ] bi
+
+        [
+            invoke-callback
+        ] [
+            callback-responder get responder>> call-responder
+        ] ?if
+    ] with-exit-continuation ;
 
 : show-page ( quot -- )
     >r redirect-to-here store-current-show r>
diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor
index ce6a1244cb..7448752c60 100755
--- a/extra/http/server/server.factor
+++ b/extra/http/server/server.factor
@@ -185,21 +185,20 @@ SYMBOL: exit-continuation
 
 : exit-with exit-continuation get continue-with ;
 
+: with-exit-continuation ( quot -- )
+    '[ exit-continuation set @ ] callcc1 exit-continuation off ;
+
 : do-request ( request -- response )
-    '[
-        exit-continuation set ,
-        [
-            [ log-request ]
-            [ request set ]
-            [ path>> main-responder get call-responder ] tri
-            [ <404> ] unless*
-        ] [
-            [ \ do-request log-error ]
-            [ <500> ]
-            bi
-        ] recover
-    ] callcc1
-    exit-continuation off ;
+    [
+        [ log-request ]
+        [ request set ]
+        [ path>> main-responder get call-responder ] tri
+        [ <404> ] unless*
+    ] [
+        [ \ do-request log-error ]
+        [ <500> ]
+        bi
+    ] recover ;
 
 : default-timeout 1 minutes stdio get set-timeout ;
 
diff --git a/extra/http/server/sessions/sessions-tests.factor b/extra/http/server/sessions/sessions-tests.factor
index a6a42f9129..26e6927d7c 100755
--- a/extra/http/server/sessions/sessions-tests.factor
+++ b/extra/http/server/sessions/sessions-tests.factor
@@ -1,8 +1,8 @@
 IN: http.server.sessions.tests
 USING: tools.test http http.server.sessions
 http.server.sessions.storage http.server.sessions.storage.assoc
-http.server math namespaces kernel accessors prettyprint
-io.streams.string splitting destructors ;
+http.server.actions http.server math namespaces kernel accessors
+prettyprint io.streams.string splitting destructors sequences ;
 
 [ H{ } ] [ H{ } add-session-id ] unit-test
 
@@ -72,9 +72,9 @@ M: foo call-responder
 : url-responder-mock-test
     [
         <request>
-        "GET" >>method
-        "id" get session-id-key set-query-param
-        "/" >>path
+            "GET" >>method
+            "id" get session-id-key set-query-param
+            "/" >>path
         request set
         "/" "manager" get call-responder
         [ write-response-body drop ] with-string-writer
@@ -107,9 +107,9 @@ response set
 : cookie-responder-mock-test
     [
         <request>
-        "GET" >>method
-        "cookies" get >>cookies
-        "/" >>path
+            "GET" >>method
+            "cookies" get >>cookies
+            "/" >>path
         request set
         "/" "manager" get call-responder
         [ write-response-body drop ] with-string-writer
@@ -118,3 +118,28 @@ response set
 [ "2" ] [ cookie-responder-mock-test ] unit-test
 [ "3" ] [ cookie-responder-mock-test ] unit-test
 [ "4" ] [ cookie-responder-mock-test ] unit-test
+
+: <exiting-action>
+    <action>
+        [
+            "text/plain" <content> exit-with
+        ] >>display ;
+
+[
+    [ ] [
+        <request>
+            "GET" >>method
+            "id" get session-id-key set-query-param
+            "/" >>path
+        request set
+
+        [
+            "/" <exiting-action> <cookie-sessions>
+            call-responder
+        ] with-destructors response set
+    ] unit-test
+
+    [ "text/plain" ] [ response get "content-type" header ] unit-test
+
+    [ f ] [ response get cookies>> empty? ] unit-test
+] with-scope
diff --git a/extra/http/server/sessions/sessions.factor b/extra/http/server/sessions/sessions.factor
index 76f022e28c..f45f10d25f 100755
--- a/extra/http/server/sessions/sessions.factor
+++ b/extra/http/server/sessions/sessions.factor
@@ -13,7 +13,7 @@ IN: http.server.sessions
 
 GENERIC: init-session* ( responder -- )
 
-M: dispatcher init-session* drop ;
+M: object init-session* drop ;
 
 TUPLE: session-manager responder sessions ;
 
@@ -56,8 +56,11 @@ M: session-saver dispose
         sessions update-session
     ] [ drop ] if ;
 
+: save-session-after ( id session -- )
+    <session-saver> add-always-destructor ;
+
 : call-responder/session ( path responder id session -- response )
-    [ <session-saver> add-always-destructor ]
+    [ save-session-after ]
     [ [ session-id set ] [ session set ] bi* ] 2bi
     [ session-manager set ] [ responder>> call-responder ] bi ;
 
diff --git a/extra/http/server/sessions/storage/db/db.factor b/extra/http/server/sessions/storage/db/db.factor
index 6ef655bde2..07cd22bc62 100755
--- a/extra/http/server/sessions/storage/db/db.factor
+++ b/extra/http/server/sessions/storage/db/db.factor
@@ -21,23 +21,18 @@ session "SESSIONS"
     session construct-empty
         swap dup [ string>number ] when >>id ;
 
-USING: namespaces io prettyprint ;
 M: sessions-in-db get-session ( id storage -- namespace/f )
-    global [ "get " write over print flush ] bind
     drop
     dup [
         <session>
-        select-tuple dup [ namespace>> ] when global [ dup . ] bind
+        select-tuple dup [ namespace>> ] when
     ] when ;
 
 M: sessions-in-db update-session ( namespace id storage -- )
-    global [ "update " write over print flush ] bind
     drop
     <session>
-        swap  global [ dup . ] bind >>namespace
-    dup update-tuple
-    id>> <session> select-tuple global [ . flush ] bind
-    ;
+        swap >>namespace
+    update-tuple ;
 
 M: sessions-in-db delete-session ( id storage -- )
     drop
@@ -45,8 +40,7 @@ M: sessions-in-db delete-session ( id storage -- )
     delete-tuple ;
 
 M: sessions-in-db new-session ( namespace storage -- id )
-    global [ "new " print flush ] bind
     drop
     f <session>
-        swap  global [ dup . ] bind >>namespace
+        swap >>namespace
     [ insert-tuple ] [ id>> number>string ] bi ;
diff --git a/extra/openssl/openssl-tests.factor b/extra/openssl/openssl-tests.factor
index c40bc5628b..2d0f5bb5d0 100755
--- a/extra/openssl/openssl-tests.factor
+++ b/extra/openssl/openssl-tests.factor
@@ -21,55 +21,55 @@ namespaces math math.parser openssl prettyprint sequences tools.test ;
 ! Initialize context
 ! =========================================================
 
-init load-error-strings
+[ ] [ init load-error-strings ] unit-test
 
-ssl-v23 new-ctx
+[ ] [ ssl-v23 new-ctx ] unit-test
 
-get-ctx "/extra/openssl/test/server.pem" resource-path use-cert-chain
+[ ] [ get-ctx "/extra/openssl/test/server.pem" resource-path use-cert-chain ] unit-test
 
 ! TODO: debug 'Memory protection fault at address 6c'
 ! get-ctx 1024 "char" malloc-array 1024 0 f password-cb set-default-passwd
 
-get-ctx "password" string>char-alien set-default-passwd-userdata
+[ ] [ get-ctx "password" string>char-alien set-default-passwd-userdata ] unit-test
 
 ! Enter PEM pass phrase: password
-get-ctx "/extra/openssl/test/server.pem" resource-path
-SSL_FILETYPE_PEM use-private-key
+[ ] [ get-ctx "/extra/openssl/test/server.pem" resource-path
+SSL_FILETYPE_PEM use-private-key ] unit-test
 
-get-ctx "/extra/openssl/test/root.pem" resource-path f
-verify-load-locations
+[ ] [ get-ctx "/extra/openssl/test/root.pem" resource-path f
+verify-load-locations ] unit-test
 
-get-ctx 1 set-verify-depth
+[ ] [ get-ctx 1 set-verify-depth ] unit-test
 
 ! =========================================================
 ! Load Diffie-Hellman parameters
 ! =========================================================
 
-"/extra/openssl/test/dh1024.pem" resource-path "r" bio-new-file
+[ ] [ "/extra/openssl/test/dh1024.pem" resource-path "r" bio-new-file ] unit-test
 
-get-bio f f f read-pem-dh-params
+[ ] [ get-bio f f f read-pem-dh-params ] unit-test
 
-get-bio bio-free
+[ ] [ get-bio bio-free ] unit-test
 
 ! TODO: debug SSL_CTX_set_tmp_dh 'No such symbol'
-! get-ctx get-dh set-tmp-dh-callback
+[ ] [ get-ctx get-dh set-tmp-dh-callback ] unit-test
 
 ! Workaround (this function should never be called directly)
-get-ctx SSL_CTRL_SET_TMP_DH 0 get-dh set-ctx-ctrl
+! [ ] [ get-ctx SSL_CTRL_SET_TMP_DH 0 get-dh set-ctx-ctrl ] unit-test
 
 ! =========================================================
 ! Generate ephemeral RSA key
 ! =========================================================
 
-512 RSA_F4 f f generate-rsa-key
+[ ] [ 512 RSA_F4 f f generate-rsa-key ] unit-test
 
 ! TODO: debug SSL_CTX_set_tmp_rsa 'No such symbol'
 ! get-ctx get-rsa set-tmp-rsa-callback
 
 ! Workaround (this function should never be called directly)
-get-ctx SSL_CTRL_SET_TMP_RSA 0 get-rsa set-ctx-ctrl
+[ ] [ get-ctx SSL_CTRL_SET_TMP_RSA 0 get-rsa set-ctx-ctrl ] unit-test
 
-get-rsa free-rsa
+[ ] [ get-rsa free-rsa ] unit-test
 
 ! =========================================================
 ! Listen and accept on socket
@@ -129,11 +129,11 @@ get-rsa free-rsa
 ! Dump errors to file
 ! =========================================================
 
-"/extra/openssl/test/errors.txt" resource-path "w" bio-new-file
+[ ] [ "/extra/openssl/test/errors.txt" resource-path "w" bio-new-file ] unit-test
 
 [ 6 ] [ get-bio "Hello\n" bio-print ] unit-test
 
-get-bio bio-free
+[ ] [ get-bio bio-free ] unit-test
 
 ! =========================================================
 ! Clean-up
diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor
new file mode 100755
index 0000000000..f4b10a7d81
--- /dev/null
+++ b/extra/reports/noise/noise.factor
@@ -0,0 +1,174 @@
+USING: assocs math kernel shuffle combinators.lib
+words quotations arrays combinators sequences math.vectors
+io.styles combinators.cleave prettyprint vocabs sorting io
+generic locals.private math.statistics ;
+IN: reports.noise
+
+: badness ( word -- n )
+    H{
+        { -nrot 5 }
+        { -roll 4 }
+        { -rot 3 }
+        { 2apply 1 }
+        { 2curry 1 }
+        { 2drop 1 }
+        { 2dup 1 }
+        { 2keep 1 }
+        { 2nip 2 }
+        { 2over 4 }
+        { 2slip 2 }
+        { 2swap 3 }
+        { 2with 2 }
+        { 2with* 3 }
+        { 3apply 1/2 }
+        { 3curry 2 }
+        { 3drop 1 }
+        { 3dup 2 }
+        { 3keep 3 }
+        { 3nip 4 }
+        { 3slip 3 }
+        { 3with 3 }
+        { 3with* 4 }
+        { 4drop 2 }
+        { 4dup 3 }
+        { 4slip 4 }
+        { compose 1/2 }
+        { curry 1/3 }
+        { dip 1 }
+        { dipd 2 }
+        { drop 1/3 }
+        { dup 1/3 }
+        { if 1/3 }
+        { when 1/4 }
+        { unless 1/4 }
+        { when* 1/3 }
+        { unless* 1/3 }
+        { ?if 1/2 }
+        { cond 1/2 }
+        { case 1/2 }
+        { keep 1 }
+        { napply 2 }
+        { ncurry 3 }
+        { ndip 5 }
+        { ndrop 2 }
+        { ndup 3 }
+        { nip 2 }
+        { nipd 3 }
+        { nkeep 5 }
+        { npick 6 }
+        { nrev 5 }
+        { nrot 5 }
+        { nslip 5 }
+        { ntuck 6 }
+        { nwith 4 }
+        { over 2 }
+        { pick 4 }
+        { roll 4 }
+        { rot 3 }
+        { slip 1 }
+        { spin 3 }
+        { swap 1 }
+        { swapd 3 }
+        { tuck 2 }
+        { tuckd 4 }
+        { with 1/2 }
+        { with* 2 }
+        { r> 1 }
+        { >r 1 }
+
+        { bi 1/2 }
+        { tri 1 }
+        { bi* 1/2 }
+        { tri* 1 }
+
+        { cleave 2 }
+        { spread 2 }
+    } at 0 or ;
+
+: vsum { 0 0 } [ v+ ] reduce ;
+
+GENERIC: noise ( obj -- pair )
+
+M: word noise badness 1 2array ;
+
+M: wrapper noise wrapped noise ;
+
+M: let noise let-body noise ;
+
+M: wlet noise wlet-body noise ;
+
+M: lambda noise lambda-body noise ;
+
+M: object noise drop { 0 0 } ;
+
+M: quotation noise [ noise ] map vsum { 1/4 1/2 } v+ ;
+
+M: array noise [ noise ] map vsum ;
+
+: noise-factor / 100 * >integer ;
+
+: quot-noise-factor ( quot -- n )
+    #! For very short words, noise doesn't count so much
+    #! (so dup foo swap bar isn't penalized as badly).
+    noise first2 {
+        { [ over 4 <= ] [ >r drop 0 r> ] }
+        { [ over 15 >= ] [ >r 2 * r> ] }
+        { [ t ] [ ] }
+    } cond
+    {
+        ! short words are easier to read
+        { [ dup 10 <= ] [ >r 2 / r> ] }
+        { [ dup 5 <= ] [ >r 3 / r> ] }
+        ! long words are penalized even more
+        { [ dup 25 >= ] [ >r 2 * r> 20 max ] }
+        { [ dup 20 >= ] [ >r 5/3 * r> ] }
+        { [ dup 15 >= ] [ >r 3/2 * r> ] }
+        { [ t ] [ ] }
+    } cond noise-factor ;
+
+GENERIC: word-noise-factor ( word -- factor )
+
+M: word word-noise-factor
+    word-def quot-noise-factor ;
+
+M: lambda-word word-noise-factor
+    "lambda" word-prop quot-noise-factor ;
+
+: flatten-generics ( words -- words' )
+    [
+        dup generic? [ methods values ] [ 1array ] if
+    ] map concat ;
+
+: noisy-words ( -- alist )
+    all-words flatten-generics
+    [ dup word-noise-factor ] { } map>assoc
+    sort-values reverse ;
+
+: noise. ( alist -- )
+    standard-table-style [
+        [
+            [ [ pprint-cell ] [ pprint-cell ] bi* ] with-row
+        ] assoc-each
+    ] tabular-output ;
+
+: vocab-noise-factor ( vocab -- factor )
+    words flatten-generics
+    [ word-noise-factor dup 20 < [ drop 0 ] when ] map
+    dup empty? [ drop 0 ] [
+        [ [ sum ] [ length 5 max ] bi /i ]
+        [ supremum ]
+        bi +
+    ] if ;
+
+: noisy-vocabs ( -- alist )
+    vocabs [ dup vocab-noise-factor ] { } map>assoc
+    sort-values reverse ;
+
+: noise-report ( -- )
+    "NOISY WORDS:" print
+    noisy-words 80 head noise.
+    nl
+    "NOISY VOCABS:" print
+    noisy-vocabs 80 head noise. ;
+
+MAIN: noise-report
diff --git a/extra/reports/optimizer/optimizer.factor b/extra/reports/optimizer/optimizer.factor
new file mode 100755
index 0000000000..42e72dee45
--- /dev/null
+++ b/extra/reports/optimizer/optimizer.factor
@@ -0,0 +1,33 @@
+USING: assocs words sequences arrays compiler tools.time
+io.styles io prettyprint vocabs kernel sorting generator
+optimizer math combinators.cleave ;
+IN: report.optimizer
+
+: count-optimization-passes ( nodes n -- n )
+    >r optimize-1
+    [ r> 1+ count-optimization-passes ] [ drop r> ] if ;
+
+: results
+    [ [ second ] swap compose compare ] curry sort 20 tail*
+    print
+    standard-table-style
+    [
+        [ [ [ pprint-cell ] each ] with-row ] each
+    ] tabular-output ; inline
+
+: optimizer-measurements ( -- alist )
+    all-words [ compiled? ] subset
+    [
+        dup [
+            word-dataflow nip 1 count-optimization-passes
+        ] benchmark nip 2array
+    ] { } map>assoc ;
+
+: optimizer-measurements. ( alist -- )
+    [ [ first ] "Worst number of optimizer passes:" results ]
+    [ [ second ] "Worst compile times:" results ] bi ;
+
+: optimizer-report ( -- )
+    optimizer-measurements optimizer-measurements. ;
+
+MAIN: optimizer-report
diff --git a/extra/serialize/serialize-tests.factor b/extra/serialize/serialize-tests.factor
index 1831495924..c5734b2ae8 100755
--- a/extra/serialize/serialize-tests.factor
+++ b/extra/serialize/serialize-tests.factor
@@ -4,7 +4,7 @@
 USING: tools.test kernel serialize io io.streams.byte-array math
 alien arrays byte-arrays sequences math prettyprint parser
 classes math.constants io.encodings.binary random
-combinators.lib ;
+combinators.lib assocs ;
 IN: serialize.tests
 
 : test-serialize-cell
@@ -56,19 +56,23 @@ C: <serialize-test> serialize-test
     } ;
 
 : check-serialize-1 ( obj -- ? )
+    "=====" print
     dup class .
+    dup .
     dup
-    binary [ serialize ] with-byte-writer
-    binary [ deserialize ] with-byte-reader = ;
+    object>bytes
+    bytes>object
+    dup . = ;
 
 : check-serialize-2 ( obj -- ? )
     dup number? over wrapper? or [
         drop t ! we don't care if numbers aren't interned
     ] [
+        "=====" print
         dup class .
-        dup 2array
-        binary [ serialize ] with-byte-writer
-        binary [ deserialize ] with-byte-reader
+        dup 2array dup .
+        object>bytes
+        bytes>object dup .
         first2 eq?
     ] if ;
 
@@ -79,3 +83,17 @@ C: <serialize-test> serialize-test
 [ t ] [ pi check-serialize-1 ] unit-test
 [ serialize ] must-infer
 [ deserialize ] must-infer
+
+[ t ] [
+    V{ } dup dup push
+    object>bytes
+    bytes>object
+    dup first eq?
+] unit-test
+
+[ t ] [
+    H{ } dup dup dup set-at
+    object>bytes
+    bytes>object
+    dup keys first eq?
+] unit-test
diff --git a/extra/serialize/serialize.factor b/extra/serialize/serialize.factor
index f573499695..86fadf55bf 100755
--- a/extra/serialize/serialize.factor
+++ b/extra/serialize/serialize.factor
@@ -6,13 +6,14 @@
 !
 ! See http://factorcode.org/license.txt for BSD license.
 !
-IN: serialize
 USING: namespaces sequences kernel math io math.functions
-io.binary strings classes words sbufs tuples arrays
-vectors byte-arrays bit-arrays quotations hashtables
-assocs help.syntax help.markup float-arrays splitting
-io.encodings.string io.encodings.utf8 combinators new-slots
-accessors ;
+io.binary strings classes words sbufs tuples arrays vectors
+byte-arrays bit-arrays quotations hashtables assocs help.syntax
+help.markup float-arrays splitting io.streams.byte-array
+io.encodings.string io.encodings.utf8 io.encodings.binary
+combinators combinators.cleave new-slots accessors locals
+prettyprint compiler.units sequences.private tuples.private ;
+IN: serialize
 
 ! Variable holding a assoc of objects already serialized
 SYMBOL: serialized
@@ -69,7 +70,8 @@ GENERIC: (serialize) ( obj -- )
 
 : serialize-shared ( obj quot -- )
     >r dup object-id
-    [ CHAR: o write1 serialize-cell drop ] r> if* ; inline
+    [ CHAR: o write1 serialize-cell drop ]
+    r> if* ; inline
 
 M: f (serialize) ( obj -- )
     drop CHAR: n write1 ;
@@ -96,75 +98,93 @@ M: ratio (serialize) ( obj -- )
     dup numerator (serialize)
     denominator (serialize) ;
 
-: serialize-string ( obj code -- )
-    write1
-    dup utf8 encode dup length serialize-cell write
-    add-object ;
-
-M: string (serialize) ( obj -- )
-    [ CHAR: s serialize-string ] serialize-shared ;
-
-: serialize-elements ( seq -- )
-    [ (serialize) ] each CHAR: . write1 ;
+: serialize-seq ( obj code -- )
+    [
+        write1
+        [ add-object ]
+        [ length serialize-cell ]
+        [ [ (serialize) ] each ] tri
+    ] curry serialize-shared ;
 
 M: tuple (serialize) ( obj -- )
     [
         CHAR: T write1
-        dup tuple>array serialize-elements
-        add-object
+        [ class (serialize) ]
+        [ add-object ]
+        [ tuple>array 1 tail (serialize) ]
+        tri
     ] serialize-shared ;
 
-: serialize-seq ( seq code -- )
-    [
-        write1
-        dup serialize-elements
-        add-object
-    ] curry serialize-shared ;
-
 M: array (serialize) ( obj -- )
     CHAR: a serialize-seq ;
 
-M: byte-array (serialize) ( obj -- )
-    [
-        CHAR: A write1
-        dup dup length serialize-cell write
-        add-object
-    ] serialize-shared ;
-
-M: bit-array (serialize) ( obj -- )
-    [
-        CHAR: b write1
-        dup length serialize-cell
-        dup [ 1 0 ? ] B{ } map-as write
-        add-object
-    ] serialize-shared ;
-
 M: quotation (serialize) ( obj -- )
-    CHAR: q serialize-seq ;
-
-M: float-array (serialize) ( obj -- )
     [
-        CHAR: f write1
-        dup length serialize-cell
-        dup [ double>bits 8 >be write ] each
-        add-object
+        CHAR: q write1 [ >array (serialize) ] [ add-object ] bi
     ] serialize-shared ;
 
 M: hashtable (serialize) ( obj -- )
     [
         CHAR: h write1
-        dup >alist (serialize)
-        add-object
+        [ add-object ] [ >alist (serialize) ] bi
     ] serialize-shared ;
 
-M: word (serialize) ( obj -- )
+M: bit-array (serialize) ( obj -- )
+    CHAR: b serialize-seq ;
+
+M: byte-array (serialize) ( obj -- )
     [
-        CHAR: w write1
-        dup word-name (serialize)
-        dup word-vocabulary (serialize)
-        add-object
+        CHAR: A write1
+        [ add-object ]
+        [ length serialize-cell ]
+        [ write ] tri
     ] serialize-shared ;
 
+M: float-array (serialize) ( obj -- )
+    [
+        CHAR: f write1
+        [ add-object ]
+        [ length serialize-cell ]
+        [ [ double>bits 8 >be write ] each ]
+        tri
+    ] serialize-shared ;
+
+M: string (serialize) ( obj -- )
+    [
+        CHAR: s write1
+        [ add-object ]
+        [
+            utf8 encode
+            [ length serialize-cell ]
+            [ write ] bi
+        ] bi
+    ] serialize-shared ;
+
+: serialize-true ( word -- )
+    drop CHAR: t write1 ;
+
+: serialize-gensym ( word -- )
+    [
+        CHAR: G write1
+        [ add-object ]
+        [ word-def (serialize) ]
+        [ word-props (serialize) ]
+        tri
+    ] serialize-shared ;
+
+: serialize-word ( word -- )
+    CHAR: w write1
+    [ word-name (serialize) ]
+    [ word-vocabulary (serialize) ]
+    bi ;
+
+M: word (serialize) ( obj -- )
+    {
+        { [ dup t eq? ] [ serialize-true ] }
+        { [ dup word-vocabulary not ] [ serialize-gensym ] }
+        { [ t ] [ serialize-word ] }
+    } cond ;
+
 M: wrapper (serialize) ( obj -- )
     CHAR: W write1
     wrapped (serialize) ;
@@ -179,6 +199,9 @@ SYMBOL: deserialized
 : deserialize-false ( -- f )
     f ;
 
+: deserialize-true ( -- f )
+    t ;
+
 : deserialize-positive-integer ( -- number )
     deserialize-cell ;
 
@@ -204,53 +227,63 @@ SYMBOL: deserialized
     (deserialize-string) dup intern-object ;
 
 : deserialize-word ( -- word )
-    (deserialize) dup (deserialize) lookup
-    [ dup intern-object ] [ "Unknown word" throw ] ?if ;
+    (deserialize) (deserialize) 2dup lookup
+    dup [ 2nip ] [
+        "Unknown word: " -rot
+        2array unparse append throw
+    ] if ;
+
+: deserialize-gensym ( -- word )
+    gensym
+    dup intern-object
+    dup (deserialize) define
+    dup (deserialize) swap set-word-props ;
 
 : deserialize-wrapper ( -- wrapper )
     (deserialize) <wrapper> ;
 
-SYMBOL: +stop+
-
-: (deserialize-seq) ( -- seq )
-    [ (deserialize) dup +stop+ get eq? not ] [ ] [ drop ] unfold ;
-
-: deserialize-seq ( seq -- array )
-    >r (deserialize-seq) r> like dup intern-object ;
+:: (deserialize-seq) ( exemplar quot -- seq )
+    deserialize-cell exemplar new
+    [ intern-object ]
+    [ dup [ drop quot call ] change-each ] bi ; inline
 
 : deserialize-array ( -- array )
-    { } deserialize-seq ;
+    { } [ (deserialize) ] (deserialize-seq) ;
 
 : deserialize-quotation ( -- array )
-    [ ] deserialize-seq ;
-
-: (deserialize-byte-array) ( -- byte-array )
-    deserialize-cell read B{ } like ;
+    (deserialize) >quotation dup intern-object ;
 
 : deserialize-byte-array ( -- byte-array )
-    (deserialize-byte-array) dup intern-object ;
+    B{ } [ read1 ] (deserialize-seq) ;
 
 : deserialize-bit-array ( -- bit-array )
-    (deserialize-byte-array) [ 0 > ] ?{ } map-as
-    dup intern-object ;
+    ?{ } [ (deserialize) ] (deserialize-seq) ;
 
 : deserialize-float-array ( -- float-array )
-    deserialize-cell
-    8 * read 8 <groups> [ be> bits>double ] F{ } map-as
-    dup intern-object ;
+    F{ } [ 8 read be> bits>double ] (deserialize-seq) ;
 
 : deserialize-hashtable ( -- hashtable )
-    (deserialize) >hashtable dup intern-object ;
+    H{ } clone
+    [ intern-object ]
+    [ (deserialize) update ]
+    [ ] tri ;
+
+: copy-seq-to-tuple ( seq tuple -- )
+    >r dup length [ 1+ ] map r> [ set-array-nth ] curry 2each ;
 
 : deserialize-tuple ( -- array )
-    (deserialize-seq) >tuple dup intern-object ;
+    #! Ugly because we have to intern the tuple before reading
+    #! slots
+    (deserialize) construct-empty
+    [ intern-object ]
+    [
+        [ (deserialize) ]
+        [ [ copy-seq-to-tuple ] keep ] bi*
+    ] bi ;
 
 : deserialize-unknown ( -- object )
     deserialize-cell deserialized get nth ;
 
-: deserialize-stop ( -- object )
-    +stop+ get ;
-
 : deserialize* ( -- object ? )
     read1 [
         {
@@ -265,14 +298,15 @@ SYMBOL: +stop+
             { CHAR: h [ deserialize-hashtable ] }
             { CHAR: m [ deserialize-negative-integer ] }
             { CHAR: n [ deserialize-false ] }
+            { CHAR: t [ deserialize-true ] }
             { CHAR: o [ deserialize-unknown ] }
             { CHAR: p [ deserialize-positive-integer ] }
             { CHAR: q [ deserialize-quotation ] }
             { CHAR: r [ deserialize-ratio ] }
             { CHAR: s [ deserialize-string ] }
             { CHAR: w [ deserialize-word ] }
+            { CHAR: G [ deserialize-word ] }
             { CHAR: z [ deserialize-zero ] }
-            { CHAR: . [ deserialize-stop ] }
         } case t
     ] [
         f f
@@ -283,13 +317,15 @@ SYMBOL: +stop+
 
 : deserialize ( -- obj )
     [
-        V{ } clone deserialized set
-        gensym +stop+ set
-        (deserialize)
-    ] with-scope ;
+        V{ } clone deserialized
+        [ (deserialize) ] with-variable
+    ] with-compilation-unit ;
 
 : serialize ( obj -- )
-    [
-        H{ } clone serialized set
-        (serialize)
-    ] with-scope ;
\ No newline at end of file
+    H{ } clone serialized [ (serialize) ] with-variable ;
+
+: bytes>object ( bytes -- obj )
+    binary [ deserialize ] with-byte-reader ;
+
+: object>bytes ( obj -- bytes )
+    binary [ serialize ] with-byte-writer ;
\ No newline at end of file