diff --git a/compiler.scm b/compiler.scm
index fe9ecba..611248e 100755
--- a/compiler.scm
+++ b/compiler.scm
@@ -1,10 +1,15 @@
 #! /usr/bin/mzscheme
 #lang scheme/base
 
+(require scheme/pretty)
+
 (require (file "libcompiler/reader.scm"))
 (require (file "libcompiler/compiler.scm"))
 (require (file "libcompiler/writer.scm"))
 
+(optimize? #t)
+
+;(pretty-print (reduce-function (read-module)))
 (write-rla-value (compile-function (read-module)))
 (write-char #\Newline)
 
diff --git a/libcompiler/compiler.scm b/libcompiler/compiler.scm
index 7cf19f1..e9975d7 100644
--- a/libcompiler/compiler.scm
+++ b/libcompiler/compiler.scm
@@ -5,7 +5,9 @@
 (require (file "mapper.scm"))
 
 (provide reduce-function
-         compile-function)
+         compile-function
+         optimize?
+         box-free-variables?)
 
 (define optimize? (make-parameter #t))
 (define box-free-variables? (make-parameter #f))
@@ -16,7 +18,7 @@
 (define (reduce-function lambda-form)
   ((compose (if (optimize?) optimize-function values)
             (if (box-free-variables?) promote-free-variables values)
-            simplify-function)
+            simplify-lambda)
    lambda-form))
 
 ; vim:set sw=2 expandtab:
diff --git a/libcompiler/mapper.scm b/libcompiler/mapper.scm
index 7059ff6..52c5a14 100644
--- a/libcompiler/mapper.scm
+++ b/libcompiler/mapper.scm
@@ -24,10 +24,12 @@
             (set! g-vars (append g-vars (list value)))
             g-var))))
 
-    (for ([free-var (in-list (filter frame/instance-variable? (free-variables bind)))]
-          [inst-var (in-list instance-variables)])
-      (set! i-vars (append i-vars (list free-var)))
-      (set! bind (subst-var free-var inst-var bind)))
+    (let* ([free-vars (filter frame/instance-variable? (free-variables bind))]
+           [var-map (for/list ([free-var (in-list free-vars)]
+                               [inst-var (in-list instance-variables)])
+                      (set! i-vars (append i-vars (list free-var)))
+                      (list free-var inst-var))])
+      (set! bind (subst-var* var-map bind)))
 
     (for ([bound-var (in-list (second bind))]
           [frame-var (in-list frame-variables)])
@@ -44,3 +46,5 @@
 
     `(,(if (null? i-vars) '%lambda '%template) ,g-vars ,i-vars
        ,bind)))
+
+; vim:set sw=2 expandtab:
diff --git a/libcompiler/optimizer.scm b/libcompiler/optimizer.scm
index d0e7e9a..168c74b 100644
--- a/libcompiler/optimizer.scm
+++ b/libcompiler/optimizer.scm
@@ -1,6 +1,7 @@
 #lang scheme/base
 
 (require scheme/list)
+(require scheme/match)
 (require (file "utilities.scm"))
 
 (provide reduce-variables
@@ -31,17 +32,13 @@
       (if (and (pair? subform)
                (eq? (first subform) '%set!)
                (or (memq (second subform) vars)
-                   ; Top-level (free) variables are presumed to be
-                   ; constant. The alternative was to assume them
-                   ; to be boxes, which has its own complications.
-                   (error "Setting unbound var:" subform))
+                   (error "Setting unbound (constant) variable:" subform))
                (not (value-used? (second subform) after)))
           after
           (cons subform after)))
     `(%bind ,vars
        ,@(foldr prepend-if-used '() (map recurse subforms))))
-  (narrow-binds
-    (map-form form #:bind bind-fn)))
+  (map-form form #:bind bind-fn))
 
 (define (propogate-value variable value invalidates? forms)
   (if (null? forms)
@@ -84,53 +81,45 @@
 ; Known values are:
 ;   literals, always
 ;   var, until (%set! var ...)
-;   (%unbox var), until (%set-box! var ...) or (%set! var)
-;   (%car var), until (%set-car! var) or (%set! var)
-;   (%cdr var), until (%set-cdr! var) or (%set! var)
+;   (%unbox var), until (%set-box! ...) or (%set! var)
+;   (%car var), until (%set-car! ...) or (%set! var)
+;   (%cdr var), until (%set-cdr! ...) or (%set! var)
 (define (propogate-set! form)
   (define (bind-fn recurse op vars . subforms)
     (define (prepend subform after)
-      (if (eq? (first subform) '%set!)
-          (let ([var (second subform)]
-                [value (third subform)])
-            (cons
-             subform
-             (cond
-               [(simple-value? value)
-                (propogate-simple-value var value
-                                        (lambda (form)
-                                          (and (eq? (first form) '%set!)
-                                               (eq? (second form) value)))
-                                        after)]
-               [(eq? (first value) '%unbox)
-                (let ([box-var (second value)])
-                  (propogate-value var value
-                                   (lambda (form)
-                                     (or (and (eq? (first form) '%set!)
-                                              (eq? (second form) box-var))
-                                         (and (eq? (first form) '%set-box!)
-                                              (eq? (second form) box-var))))
-                                   after))]
-               [(eq? (first value) '%car)
-                (let ([pair-var (second value)])
-                  (propogate-value var value
-                                   (lambda (form)
-                                     (or (and (eq? (first form) '%set!)
-                                              (eq? (second form) pair-var))
-                                         (and (eq? (first form) '%set-car!)
-                                              (eq? (second form) pair-var))))
-                                   after))]
-               [(eq? (first value) '%cdr)
-                (let ([pair-var (second value)])
-                  (propogate-value var value
-                                   (lambda (form)
-                                     (or (and (eq? (first form) '%set!)
-                                              (eq? (second form) pair-var))
-                                         (and (eq? (first form) '%set-cdr!)
-                                              (eq? (second form) pair-var))))
-                                   after))]
-              [else after])))
-          (cons subform after)))
+      (cons
+       subform
+       (match subform
+         [`(%set! ,var ,(? simple-value? value))
+          (propogate-simple-value var value
+                                  (lambda (form)
+                                    (and (eq? (first form) '%set!)
+                                         (eq? (second form) value)))
+                                  after)]
+         [`(%set! ,var ,(and value `(%unbox ,box-var)))
+          (propogate-value var value
+                           (lambda (form)
+                             (or (and (eq? (first form) '%set!)
+                                      (eq? (second form) box-var))
+                                 (eq? (first form) '%set-box!)))
+                           after)]
+         [`(%set! ,var ,(and value `(%car ,pair-var)))
+          (propogate-value var value
+                           (lambda (form)
+                             (or (and (eq? (first form) '%set!)
+                                      (eq? (second form) pair-var))
+                                 (eq? (first form) '%set-car!)))
+                           after)]
+         [`(%set! ,var ,(and value `(%cdr ,pair-var)))
+          (propogate-value var value
+                           (lambda (form)
+                             (or (and (eq? (first form) '%set!)
+                                      (eq? (second form) pair-var))
+                                 (eq? (first form) '%set-cdr!)))
+                           after)]
+         [_ after])))
     `(%bind ,vars
        ,@(foldr prepend '() (map recurse subforms))))
   (map-form form #:bind bind-fn))
+
+; vim:set sw=2 expandtab:
diff --git a/libcompiler/reader.scm b/libcompiler/reader.scm
index dbcad05..afb8af1 100644
--- a/libcompiler/reader.scm
+++ b/libcompiler/reader.scm
@@ -1,6 +1,7 @@
 #lang scheme/base
 
 (require scheme/list)
+(require scheme/path)
 
 (provide read-module)
 
@@ -8,24 +9,35 @@
   `(lambda *argv*
      ,@(let iter ([forms (read-forms port)]
                   [bindings '()])
-         (cond
-           [(null? forms) (if (null? bindings)
-                              '()
-                              `(letrec ,bindings))]
-           [(simple-define-form? (first forms))
-            (iter (cdr forms) (cons (cdr (first forms))
-                                    bindings))]
-           [(lambda-define-form? (first forms))
-            (iter (cdr forms) (cons `(,(first (second (first forms)))
-                                      (lambda ,(cdr (second (first forms)))
-                                        ,@(cddr (first forms))))
-                                    bindings))]
-           [(begin-form? (first forms))
-            (iter (append (cdr (first forms)) (cdr forms)) bindings)]
-           [(null? bindings)
-            (cons (first forms) (iter (cdr forms) '()))]
-           [else
-            `((letrec ,bindings ,@(iter forms '())))]))))
+         (match forms
+           ['()
+            (if (null? bindings)
+                '()
+                `((letrec ,(reverse bindings))))]
+           [`((define ,var ,expr) . ,rst)
+            (iter rst (cons (list var expr) bindings))]
+           [`((define (,var . ,arglist) . ,body) . ,rst)
+            (iter rst (cons (list var `(lambda ,arglist ,@body)) bindings))]
+           [`((define . ,_) . ,_)
+            (error "Unrecognized define-form:" (first forms))]
+           [`((begin . ,body) . ,rst)
+            (iter (append body rst) bindings)]
+           [`((load ,(? string? pathname)) . ,rst)
+            (let ([complete-path (path->complete-path pathname)]
+                  [directory (path-only complete-path)])
+              (iter (append (with-input-from-file complete-path
+                              (lambda ()
+                                (parameterize ([current-directory directory])
+                                  (read-forms))))
+                            rst)
+                    bindings))]
+           [`((load . ,_) . ,rst)
+            (error "Unrecognized load-form:" (first forms))]
+           [(,form . ,rst)
+            (if (null? bindings)
+                (cons form (iter rst '()))
+                `((letrec ,(reverse bindings)
+                    ,@(cons form (iter rst '())))))]))))
 
 (define (read-forms [port (current-input-port)])
   (reverse (let iter ([form (read port)]
@@ -34,20 +46,4 @@
                  forms
                  (iter (read port) (cons form forms))))))
 
-(define (simple-define-form? form)
-  (and (pair? form)
-       (eq? (first form) 'define)
-       (symbol? (second form))
-       (null? (cdddr form))))
-
-(define (lambda-define-form? form)
-  (and (pair? form)
-       (eq? (first form) 'define)
-       (pair? (second form))
-       (symbol? (first (second form)))))
-
-(define (begin-form? form)
-  (and (pair? form)
-       (eq? (first form) 'begin)))
-
 ; vim:set sw=2 expandtab:
diff --git a/libcompiler/simplifier.scm b/libcompiler/simplifier.scm
index 42c8f9e..17ef994 100644
--- a/libcompiler/simplifier.scm
+++ b/libcompiler/simplifier.scm
@@ -1,87 +1,114 @@
 #lang scheme/base
 
 (require scheme/list)
+(require scheme/match)
 (require (file "utilities.scm"))
 (require (file "primitives.scm"))
 
-(provide simplify-function
+(provide simplify-lambda
          promote-free-variables)
 
-(define (simplify-function lambda-form)
-  ((compose promote-shared-variables
-            simplify-lambda)
-   lambda-form))
-
 (define (simplify-form form)
   (define (same-form recurse . form) form)
+  (define (simplify-complex-form recurse op . others)
+    (case op
+      [(let)        (simplify-let form)]
+      [(let*)       (simplify-let* form)]
+      [(letrec)     (simplify-letrec form)]
+      [(if)         (simplify-if form)]
+      [(lambda)     (simplify-lambda form)]
+      [(begin)      (simplify-form `(let () ,@(cdr form)))]
+      [(set!)       (simplify-set! form)]
+      [(let/cc)     (simplify-form
+                      `(call/cc (lambda (,(second form)) ,@(cddr form))))]
+      [(fix>)       (simplify-form
+                      (let ([a (gensym)] [b (gensym)])
+                        `(let ([,a ,(second form)]
+                               [,b ,(third form)])
+                           (fix< ,b ,a))))]
+      [(fix<=)      (simplify-form
+                      (let ([a (gensym)] [b (gensym)])
+                        `(let ([,a ,(second form)]
+                               [,b ,(third form)])
+                           (fix>= ,b ,a))))]
+      [(value-list) (simplify-value-list form)]
+      [(values)     (simplify-primitive '%values  (cdr form))]
+      [(apply)      (simplify-apply (second form) (cddr form))]
+      [(call/cc)    (simplify-primitive '%call/cc (cdr form))]
+      [(call-with-values)
+       (simplify-form
+         `(apply ,(third form)
+                 (value-list (,(second form)))))]
+      [else
+       (let ([primitive (memf (lambda (x) (eq? (third x) (first form)))
+                              all-primitives)])
+         (if primitive
+             (simplify-primitive (first (first primitive))
+                                 (cdr form))
+             (simplify-apply (first form) (append (cdr form) '(%nil)))))]))
   (map-form form
-            #:bind      same-form
-            #:lambda    same-form
-            #:set       same-form
-            #:primitive same-form
-            #:simple    (lambda (recurse kind form) form)
-            #:literal   (lambda (recurse kind form)
-                          (if (and (pair? form)
-                                   (eq? (first form) 'quote)
-                                   (eq? (second form) '()))
-                              '%nil
-                              form))
-            #:other     (lambda (recurse op . others)
-                          (case op
-                            [(let) (simplify-let form)]
-                            [(let*) (simplify-let* form)]
-                            [(letrec) (simplify-letrec form)]
-                            [(if) (simplify-if form)]
-                            [(lambda) (simplify-lambda form)]
-                            [(begin) (simplify-form `(let () ,@(cdr form)))]
-                            [(set!) (simplify-set! form)]
-                            [(let/cc) (simplify-form
-                                       `(call/cc (lambda (,(second form)) ,@(cddr form))))]
-                            [(fix>) (simplify-form
-                                      (let ([a (gensym)] [b (gensym)])
-                                        `(let ([,a ,(second form)]
-                                               [,b ,(third form)])
-                                           (fix< ,b ,a))))]
-                            [(fix<=) (simplify-form
-                                       (let ([a (gensym)] [b (gensym)])
-                                         `(let ([,a ,(second form)]
-                                                [,b ,(third form)])
-                                            (fix>= ,b ,a))))]
-                            [(values)  (simplify-primitive '%values  (cdr form))]
-                            [(call/cc) (simplify-primitive '%call/cc (cdr form))]
-                            [else
-                             (let ([primitive (memf (lambda (x) (eq? (third x) (first form)))
-                                                    all-primitives)])
-                               (if primitive
-                                   (simplify-primitive (first (first primitive))
-                                                       (cdr form))
-                                   (simplify-funcall form)))]))))
+            #:bind       same-form
+            #:lambda     same-form
+            #:set        same-form
+            #:value-list same-form
+            #:primitive  same-form
+            #:simple     (lambda (recurse kind form) form)
+            #:literal    (lambda (recurse kind form)
+                           (if (equal? form '(quote ())) '%nil form))
+            #:other      simplify-complex-form))
 
 (define (simplify-set! form)
   (let ([variable (second form)]
         [value-form (simplify-form (third form))])
-    (if (and (pair? value-form) (eq? (first value-form) '%bind))
-        (if (memq variable (second value-form))
-            (let ([tmp (gensym)])
-              `(%bind (,tmp)
-                 ; guaranteed not to cause unbounded recursion: tmp is unique
-                 ,(simplify-set! `(set! ,tmp ,value-form))
-                 (%set! ,variable ,tmp)))
-            `(%bind ,(second value-form)
-               ,@(foldr (lambda (subform after)
-                          (cond
-                            [(pair? after) (cons subform after)]
-                            [(and (pair? subform) (eq? (first subform) '%values))
-                             ; Requires at least one value; ignores extras.
-                             (if (null? (cdr subform))
-                                 (error "Attempted to set variable to void in:" form)
-                                 `((%set! ,variable ,(second subform))))]
-                            [(value-form? subform)
-                             (list (simplify-set! `(set! ,variable ,subform)))]
-                            [else (error "Attempted to set variable to void in:" form)]))
-                        '()
-                        (cddr value-form))))
-        `(%set! ,variable ,value-form))))
+    (match value-form
+      [`(%bind ,bound-vars . ,subforms)
+       (if (memq variable bound-vars)
+           (let ([tmp (gensym)])
+             `(%bind (,tmp)
+                ; guaranteed not to cause unbounded recursion: tmp is unique
+                ,(simplify-set! `(set! ,tmp ,value-form))
+                (%set! ,variable ,tmp)))
+           `(%bind ,bound-vars
+              ,@(foldr (lambda (subform after)
+                         (if (pair? after)
+                             (cons subform after)
+                             (list (simplify-set! `(set! ,variable ,subform)))))
+                       '()
+                       subforms)))]
+      [`(%values ,first-val . ,other-vals)
+       `(%set! ,variable ,first-val)]
+      [`(%values)
+       (error "Attempted to set variable to void in:" form)]
+      [(? value-form?)
+       `(%set! ,variable ,value-form)]
+      [else
+       (error "Attempted to set variable to void in:" form)])))
+
+(define (simplify-value-list form)
+  (let ([values-form (simplify-form (second form))])
+    (match values-form
+      [`(%bind ,bound-vars . ,subforms)
+       `(%bind ,bound-vars
+          ,@(foldr (lambda (subform after)
+                     (if (pair? after)
+                         (cons subform after)
+                         (list (simplify-value-list `(value-list ,subform)))))
+                   '()
+                   subforms))]
+      [`(%values . ,simple-vals)
+       ; (%value-list (%values ...)) => (list ...)
+       (let ([tmp (gensym)])
+         `(%bind (,tmp)
+            (%set! ,tmp %nil)
+            ,@(map (lambda (x) (simplify-set! `(set! ,tmp (cons ,x ,tmp))))
+                   (reverse simple-vals))
+            ,tmp))]
+      [(or `(%apply _ _)
+           `(%call/cc _))
+       `(%value-list ,values-form)]
+      [(? value-form?)
+       (simplify-value-list `(value-list (values ,values-form)))]
+      [_ '%nil])))
 
 (define (simplify-primitive simple-op value-forms)
   (define (value->binding value-form)
@@ -207,195 +234,263 @@
 ;                     (if (eq? argv-temp %nil)
 ;                         (set! optional-1 default-expr-1)
 ;                         (set! optional-1 (car argv-temp)))
+;                     ; TODO: Handle keyword arguments here...
 ;                     (set! argv-temp (cdr argv-temp))
 ;                     (...
 ;                       (let ([rest argv-temp])
 ;                         bodyexpr...)...)))...)))
 
+(define (promote-to-box variable form)
+  (map-form form
+            #:bind       (lambda (recurse op vars . subforms)
+                           (flatten-binds
+                             `(%bind ,(subst variable variable vars)
+                                ,@(if (memq variable vars)
+                                      `((%set! ,variable (%make-box %undef)))
+                                      '())
+                                ,@(map recurse subforms))))
+            #:set        (lambda (recurse op var value)
+                           (let ([new-value (recurse value)])
+                             (if (eq? var variable)
+                                 (if (simple-value? new-value)
+                                     `(%set-box! ,variable ,new-value)
+                                     (let ([tmp (gensym)])
+                                       `(%bind (,tmp)
+                                          ,(simplify-set! `(set! ,tmp ,new-value))
+                                          (%set-box! ,variable ,tmp))))
+                                 (simplify-set! `(set! ,var ,new-value)))))
+            #:value-list (lambda (recurse op values-form)
+                           `(,op ,(recurse values-form)))
+            #:primitive  (lambda (recurse op . simple-values)
+                           (let ([new-args (map recurse simple-values)])
+                             ;; if any new-arg is not simple, must bind to a temp first
+                             (let ([temps (map (lambda (x)
+                                                 (if (simple-value? x)
+                                                     (list x #f)
+                                                     (let ([tmp (gensym)])
+                                                       (list tmp `(%set! ,tmp ,x)))))
+                                               new-args)])
+                               (if (ormap second temps)
+                                   `(%bind ,(map first (filter second temps))
+                                      ,@(filter-map second temps)
+                                      (,op ,@(map first temps)))
+                                   `(,op ,@new-args)))))
+            #:variable   (lambda (recurse op var)
+                           (if (eq? var variable) `(%unbox ,variable) var))))
+
+(define (is-shared-var? var forms)
+  (define captured-input?  (ormap (lambda (f) (form-captures-input?  f var)) forms))
+  (define captured-output? (ormap (lambda (f) (form-captures-output? f var)) forms))
+  (define (set-after-first-capture?)
+    (let/cc return
+      (foldr (lambda (form set-after?)
+               (if (or set-after? (form-sets? form var captured-output?))
+                   (if (form-captures-input? form var)
+                       (return #t)
+                       #t)
+                   #f))
+             #f
+             forms)
+      #f))
+  (or captured-output?
+      (and captured-input?
+           (set-after-first-capture?))))
+
+(define (promote-shared-variables nested-bind)
+  (define flat-bind (flatten-binds nested-bind))
+  (foldl (lambda (var frm)
+           (if (is-shared-var? var (cddr frm))
+               (promote-to-box var frm)
+               frm))
+         flat-bind
+         (second flat-bind)))
+
+(define (promote-free-variables form)
+  (foldl promote-to-box form (free-variables form)))
+
+(define (narrow-binds+promote nested-bind)
+  (define flat-bind (flatten-binds nested-bind))
+
+  (define (at-top-level? var)
+    (or (ormap (lambda (x) (form-sets? x var #f)) (cddr flat-bind))
+        (ormap (lambda (x) (form-uses? x var #f)) (cddr flat-bind))))
+
+  (define (captured-twice? var)
+    (let/cc return
+      (foldl (lambda (subform once?)
+               (if (form-captures? subform var)
+                   (if once? (return #t) #t)
+                   once?))
+             (at-top-level? var)
+             (cddr flat-bind))
+      #f))
+
+  (define extra-bindings
+    (filter-not captured-twice?
+                (filter-not at-top-level?
+                            (second flat-bind))))
+
+  (promote-shared-variables
+    `(%bind ,(remove* extra-bindings (second flat-bind))
+       ,@(map (lambda (subform)
+                (match subform
+                  [`(%set! ,var (%lambda ,g-vars ,i-vars ,bind))
+                   `(%set! ,var (%lambda ,g-vars ,i-vars
+                                  ,(narrow-binds+promote
+                                     (foldl (lambda (var temp-bind)
+                                              (if (memq var (free-variables temp-bind))
+                                                  `(%bind (,@(second temp-bind) ,var)
+                                                     ,@(cddr temp-bind))
+                                                  temp-bind))
+                                            bind
+                                            extra-bindings))))]
+                  [_ subform]))
+              (cddr flat-bind)))))
+
 (define (split-arglist arglist)
-   (define (split-optional arglist)
-      (if (pair? arglist)
-          (let-values ([(opt rst) (split-optional (cdr arglist))])
-            (values (cons (car arglist) opt) rst)) 
-          (values '() arglist)))
-   (cond
-    [(null? arglist)       (values '() '() #f)]
-    [(not (pair? arglist)) (values '() '() arglist)]
-    [(pair? (car arglist)) (let-values ([(opt rst) (split-optional arglist)])
-                             (values '() opt rst))]
-    [else                  (let-values ([(req opt rst) (split-arglist (cdr arglist))])
-                             (values (cons (car arglist) req) opt rst))]))
+  (match arglist
+    [`(,(? symbol? reqs) ... ,(and opts (list (? symbol?) _)) ... . ,(? symbol? rst))
+     (values reqs opts rst)]
+    [`(,(? symbol? reqs) ... ,(and opts (list (? symbol?) _)) ...)
+     (values reqs opts #f)]
+    [_ (error "Invalid argument list:" arglist)]))
 
 (define (add-return ctx k nested-bind)
   (define flat-bind (flatten-binds nested-bind))
   (define argv (gensym))
   `(%bind (,@(second flat-bind) ,argv)
      ,@(foldr (lambda (subform after)
-                (cond
-                  [(pair? after)
-                   (cons subform after)]
-                  [(simple-value? subform)
-                   `((%set! ,argv (%cons ,subform %nil))
-                     (%tail-call ,k ,argv #f #f))]
-                  [(eq? (first subform) '%apply)
-                   `((%tail-call ,(second subform) ,(third subform) ,ctx ,k))]
-                  [(eq? (first subform) '%call/cc)
-                   `((%set! ,argv (%cons %k %nil))
-                     (%tail-call ,(second subform) ,argv ,ctx %k))]
-                  [(eq? (first subform) '%values)
-                   `((%set! ,argv %nil)
-                     ,@(map (lambda (sv) `(%set! ,argv (%cons ,sv ,argv)))
-                            (reverse (cdr subform)))
-                     (%tail-call ,k ,argv #f #f))]
-                  [(value-form? subform)
-                   `((%set! ,argv ,subform)
-                     (%set! ,argv (%cons ,argv %nil))
-                     (%tail-call ,k ,argv #f #f))]
-                  [(eq? (first subform) '%tail-call)
-                   `(,subform)]
-                  [else
-                   `(,subform
-                     (%tail-call ,k %nil #f #f))]))
+                (if (pair? after)
+                    (cons subform after)
+                    (match subform
+                      [(? simple-value?)
+                       `((%set! ,argv (%cons ,subform %nil))
+                         (%tail-call ,k ,argv #f #f))]
+                      [`(%apply ,x ,y)
+                       `((%tail-call ,x ,y ,ctx ,k))]
+                      [`(%call/cc ,x)
+                       `((%set! ,argv (%cons %k %nil))
+                         (%tail-call ,x ,argv ,ctx %k))]
+                      [`(%values . ,simple-vals)
+                       `((%set! ,argv %nil)
+                         ,@(map (lambda (sv) `(%set! ,argv (%cons ,sv ,argv)))
+                                (reverse simple-vals))
+                         (%tail-call ,k ,argv #f #f))]
+                      [(? value-form?)
+                       `(,(simplify-set! `(set! ,argv ,subform))
+                         (%set! ,argv (%cons ,argv %nil))
+                         (%tail-call ,k ,argv #f #f))]
+                      [`(%tail-call . ,_)
+                       `(,subform)]
+                      [_
+                       `(,subform
+                         (%tail-call ,k %nil #f #f))])))
                '()
                (cddr flat-bind))))
 
-; <= (%bind (var...)
-;      @before
-;      (%apply x y)
-;      @after))
-; => (%bind (var... k)
-;      @before
-;      (%set! k (lambda _ @after))
-;      (%tail-call x y ctx k)))
-
-; <= (%bind (var...)
-;      @before
-;      (%set! v (%apply x y))
-;      @after))
-; => (%bind (var... k)
-;      @before
-;      (%set! k (lambda (x)
-;                 (%set! v x)
-;                 @after))
-;      (%tail-call x y ctx k)))
-
-; <= (%bind (var...)
-;      @before
-;      (call/cc l)
-;      @after)
-; => (%bind (var... k k2)
-;      @before
-;      (%set! k (lambda _ @after))
-;      (%set! k-argv (%cons k %nil))
-;      (%tail-call l k-argv ctx k))
-
 (define (transform-to-cps ctx nested-bind)
   (define flat-bind (flatten-binds nested-bind))
   (define (cps-prepend subform after)
-    (cond
-      ; (%set! v (%apply x y))
-      [(and (pair? subform)
-            (eq? (first subform) '%set!)
-            (pair? (third subform))
-            (eq? (first (third subform)) '%apply))
-         (let ([k (gensym)]
-               [x (gensym)])
-           `((%bind (,k ,x)
-               (%set! ,k ,(simplify-form
-                            `(lambda (,x . ,(gensym))
-                               (%set! ,(second subform) ,x)
-                               ,@after)))
-               (%tail-call ,(second (third subform))
-                           ,(third (third subform))
-                           ,ctx
-                           ,k))))]
-      ; (%apply x y)
-      [(and (pair? subform)
-            (eq? (first subform) '%apply))
-         (let ([k (gensym)])
-           `((%bind (,k)
-               (%set! ,k ,(simplify-form
-                            `(lambda ,(gensym)
-                               ,@after)))
-               (%tail-call ,(second subform)
-                           ,(third subform)
-                           ,ctx
-                           ,k))))]
-      ; (%set! v (%call/cc x))
-      [(and (pair? subform)
-            (eq? (first subform) '%set!)
-            (pair? (third subform))
-            (eq? (first (third subform)) '%call/cc))
-         (let ([k (gensym)]
-               [k-argv (gensym)]
-               [x (gensym)])
-           `((%bind (,k ,k-argv)
-               (%set! ,k ,(simplify-form
-                            `(lambda (,x . ,(gensym))
-                               (%set! ,(second subform) ,x)
-                               ,@after)))
-               (%set! ,k-argv (%cons ,k %nil))
-               (%tail-call ,(second (third subform))
-                           ,k-argv
-                           ,ctx
-                           ,k))))]
-      ; (%call/cc x)
-      [(and (pair? subform)
-            (eq? (first subform) '%call/cc))
-         (let ([k (gensym)]
-               [k-argv (gensym)])
-           `((%bind (,k ,k-argv)
-               (%set! ,k ,(simplify-form
-                            `(lambda ,(gensym)
-                               ,@after)))
-               (%set! ,k-argv (%cons ,k %nil))
-               (%tail-call ,(second subform)
-                           ,k-argv
-                           ,ctx
-                           ,k))))]
+    (match subform
+      [`(%set! ,v (%value-list (%apply ,x ,y)))
+       (let ([k (gensym)])
+         `((%bind (,k)
+             (%set! ,k ,(simplify-form
+                          `(lambda ,v
+                             ,@after)))
+             (%tail-call ,x ,y ,ctx ,k))))]
+      [`(%set! ,v (%apply ,x ,y))
+       (let ([k (gensym)])
+         `((%bind (,k)
+             (%set! ,k ,(simplify-form
+                          `(lambda (,v . ,(gensym))
+                             ,@after)))
+             (%tail-call ,x ,y ,ctx ,k))))]
+      [(or `(%value-list (%apply ,x ,y))
+           `(%apply ,x ,y))
+       (let ([k (gensym)])
+         `((%bind (,k)
+             (%set! ,k ,(simplify-form
+                          `(lambda ,(gensym)
+                             ,@after)))
+             (%tail-call ,x ,y ,ctx ,k))))]
+      [`(%set! ,v (%value-list (%call/cc ,x)))
+       (let ([k (gensym)]
+             [k-argv (gensym)])
+         `((%bind (,k ,k-argv)
+             (%set! ,k ,(simplify-form
+                          `(lambda ,v
+                             ,@after)))
+             (%set! ,k-argv (%cons ,k %nil))
+             (%tail-call ,x ,k-argv ,ctx ,k))))]
+      [`(%set! ,v (%call/cc ,x))
+       (let ([k (gensym)]
+             [k-argv (gensym)])
+         `((%bind (,k ,k-argv)
+             (%set! ,k ,(simplify-form
+                          `(lambda (,v . ,(gensym))
+                             ,@after)))
+             (%set! ,k-argv (%cons ,k %nil))
+             (%tail-call ,x ,k-argv ,ctx ,k))))]
+      [(or `(%value-list (%call/cc ,x))
+           `(%call/cc ,x))
+       (let ([k (gensym)]
+             [k-argv (gensym)])
+         `((%bind (,k ,k-argv)
+             (%set! ,k ,(simplify-form
+                          `(lambda ,(gensym)
+                             ,@after)))
+             (%set! ,k-argv (%cons ,k %nil))
+             (%tail-call ,x ,k-argv ,ctx ,k))))]
       ; keep all other forms with side-effects as-is
-      [(statement-form? subform)
-         (cons subform after)]
+      [(? statement-form?) (cons subform after)]
       ; discard any form without side-effects
-      [else after]))
-  (flatten-binds
-    `(%bind ,(second flat-bind)
-       ,@(foldr cps-prepend '() (cddr flat-bind)))))
+      [_ after]))
+  `(%bind ,(second flat-bind)
+     ,@(foldr cps-prepend '() (cddr flat-bind))))
 
 (define (simplify-lambda form)
-   (define arglist (car (cdr form)))
-   (define bodyexprs (cdr (cdr form)))
+  (define arglist   (cadr form))
+  (define bodyexprs (cddr form))
 
-   (define-values (requireds optionals rest) (split-arglist arglist))
-   (define argv (gensym))
-   (define ctx (gensym))
-   (define k (gensym))
+  (define-values (requireds optionals rest) (split-arglist arglist))
 
-   (define (add-req req inner) `(let ([,req (car ,argv)])
-                                  (set! ,argv (cdr ,argv))
-                                  ,inner))
-   (define (add-opt opt-list inner) `(let (,(car opt-list))
-                                       (if (pair? ,argv)
-                                           (begin
-                                             (set! ,(first opt-list) (car ,argv))
-                                             (set! ,argv (cdr ,argv)))
-                                           (set! ,(first opt-list) ,(second opt-list)))
-                                       ,inner))
-   (define rest+bodyexprs (if rest `(let ([,rest ,argv]) ,@bodyexprs)
-                                   `(begin ,@bodyexprs)))
-   (narrow-binds
-     `(%lambda () ()
-        ,((compose (lambda (bind) (transform-to-cps ctx bind))
-                   (lambda (bind) (add-return ctx k bind)))
-          (simplify-form
-            `(let ([,argv %argv]
-                   [,ctx  %ctx]
-                   [,k    %k])
-               ,(foldr add-req
-                       (foldr add-opt
-                              rest+bodyexprs
-                              optionals)
-                       requireds)))))))
+  (define argv (gensym))
+  (define ctx (gensym))
+  (define k (gensym))
+
+  (define (add-req req inner)
+    `(let ([,req (car ,argv)])
+       (set! ,argv (cdr ,argv))
+       ,inner))
+
+  (define (add-opt opt-list inner)
+    `(let (,(car opt-list))
+       (if (pair? ,argv)
+           (begin
+             (set! ,(first opt-list) (car ,argv))
+             (set! ,argv (cdr ,argv)))
+           (set! ,(first opt-list) ,(second opt-list)))
+       ,inner))
+
+  (define rest+bodyexprs
+    (if rest
+        `(let ([,rest ,argv]) ,@bodyexprs)
+        `(begin ,@bodyexprs)))
+
+  `(%lambda () ()
+     ,((compose narrow-binds+promote
+                (lambda (bind) (transform-to-cps ctx bind))
+                (lambda (bind) (add-return ctx k bind))
+                simplify-form)
+       `(let ([,argv %argv]
+              [,ctx  %ctx]
+              [,k    %k])
+          ,(foldr add-req
+                  (foldr add-opt
+                         rest+bodyexprs
+                         optionals)
+                  requireds)))))
 
 ; (fn-expr arg-expr...)
 ;    => (let ([fn-var fn-expr] arg-var... argv)
@@ -405,89 +500,22 @@
 ;         (set! argv (cons arg-var argv))... [reversed]
 ;         (%apply fn-var argv))
 
-(define (simplify-funcall form)
-  (define fn-expr (car form))
-  (define arg-exprs (cdr form))
+(define (simplify-apply fn-expr arg-exprs)
   (define fn-var (gensym))
-  (define arg-vars (map (lambda (x) (gensym)) arg-exprs))
   (define argv (gensym))
+  (define arguments
+    (foldr (lambda (expr args)
+             (if (null? args)
+                 (cons (list argv expr) args)
+                 (if (literal-value? expr)
+                     (cons (list expr #f) args)
+                     (cons (list (gensym) expr) args))))
+           '()
+           arg-exprs))
   (simplify-form
-    `(let (,fn-var ,@arg-vars ,argv)
-       (set! ,fn-var ,fn-expr)
-       ,@(map (lambda (x y) `(set! ,x ,y)) arg-vars arg-exprs)
-       (%set! ,argv %nil)
-       ,@(reverse (map (lambda (x) `(%set! ,argv (%cons ,x ,argv))) arg-vars))
+    `(let ([,fn-var ,fn-expr] ,@(filter second arguments))
+       ,@(map (lambda (x) `(%set! ,argv (%cons ,x ,argv)))
+              (map first (reverse (drop-right arguments 1))))
        (%apply ,fn-var ,argv))))
 
-(define (promote-to-box variable form)
-  (map-form form
-            #:bind      (lambda (recurse op vars . subforms)
-                          (flatten-binds
-                            `(%bind ,(subst variable variable vars)
-                               ,@(if (memq variable vars)
-                                     `((%set! ,variable (%make-box %undef)))
-                                     '())
-                               ,@(map recurse subforms))))
-            #:set       (lambda (recurse op var value)
-                          (let ([new-value (recurse value)])
-                            (if (eq? var variable)
-                                (if (simple-value? new-value)
-                                    `(%set-box! ,variable ,new-value)
-                                    (let ([tmp (gensym)])
-                                      `(%bind (,tmp)
-                                         ,(simplify-set! `(set! ,tmp ,new-value))
-                                         (%set-box! ,variable ,tmp))))
-                                (simplify-set! `(set! ,var ,new-value)))))
-            #:primitive (lambda (recurse op . simple-values)
-                          (let ([new-args (map recurse simple-values)])
-                            ;; if any new-arg is not simple, must bind to a temp first
-                            (let ([temps (map (lambda (x)
-                                                (if (simple-value? x)
-                                                    (list x #f)
-                                                    (let ([tmp (gensym)])
-                                                      (list tmp `(%set! ,tmp ,x)))))
-                                              new-args)])
-                              (if (ormap second temps)
-                                  `(%bind ,(map first (filter second temps))
-                                     ,@(filter-map second temps)
-                                     (,op ,@(map first temps)))
-                                  `(,op ,@new-args)))))
-            #:variable  (lambda (recurse op var)
-                          (if (eq? var variable) `(%unbox ,variable) var))))
-
-; form needs to be flattened (%bind ...)
-(define (is-shared-var? var bind)
-  (define captured-input?  (ormap (lambda (f) (form-captures-input?  f var)) (cddr bind)))
-  (define captured-output? (ormap (lambda (f) (form-captures-output? f var)) (cddr bind)))
-  (define (set-after-first-use?)
-    (let/cc return
-      (foldr (lambda (subform set-after?)
-               (if (or set-after? (form-sets? subform var captured-output?))
-                   (if (form-uses? subform var captured-input?)
-                       (return #t)
-                       #t)
-                   #f))
-             #f
-             (cddr bind))
-      #f))
-  (and (not (special-variable? var))
-       (or captured-input?
-           captured-output?)
-       (set-after-first-use?)))
-
-(define (promote-shared-variables simple-lambda-form)
-  (define bind (fourth simple-lambda-form))
-  `(%lambda ,(second simple-lambda-form) ,(third simple-lambda-form)
-     ,(foldl (lambda (var frm)
-               (if (is-shared-var? var frm)
-                   (promote-to-box var frm)
-                   frm))
-             bind
-             (second bind))))
-
-(define (promote-free-variables simple-lambda-form)
-  (define bind (fourth simple-lambda-form))
-  `(%lambda ,(second simple-lambda-form) ,(third simple-lambda-form)
-     ,(foldl promote-to-box bind (free-variables bind))))
-
 ; vim:set sw=2 expandtab:
diff --git a/libcompiler/utilities.scm b/libcompiler/utilities.scm
index 6a5de94..7b69c94 100644
--- a/libcompiler/utilities.scm
+++ b/libcompiler/utilities.scm
@@ -1,12 +1,15 @@
 #lang scheme/base
 
 (require scheme/list)
+(require scheme/match)
 (require scheme/pretty)
 (require (file "primitives.scm"))
 
 (provide trace
          subst
+         subst*
          find
+         curry-keywords
          variable-value?
          literal-value?
          simple-value?
@@ -15,6 +18,7 @@
          primitive-form?
          pure-form?
          bind-form?
+         traverse-form
          map-form
          search-form
          form-sets?
@@ -22,8 +26,8 @@
          form-captures?
          form-captures-input?
          form-captures-output?
-         narrow-binds
          subst-var
+         subst-var*
          flatten-binds
          free-variables
          free-input-variables
@@ -37,10 +41,14 @@
 
 (define (subst old new lst)
   (foldr (lambda (x rst)
-           (cons (if (eq? x old)
-                     new
-                     x)
-                 rst))
+           (cons (if (eq? x old) new x) rst))
+         '()
+         lst))
+
+(define (subst* old->new lst)
+  (foldr (lambda (x rst)
+           (let ([item (assoc x old->new)])
+             (cons (if item (second item) x) rst)))
          '()
          lst))
 
@@ -51,6 +59,43 @@
       (when (eq? y x) (return i)))
     #f))
 
+;; Combines two sorted keyword-value list pairs into a single
+;; sorted list-pair, taking the values from the second list
+;; where the same keyword exists in both lists.
+(define (merge-keywords keywords-1 kw-values-1 keywords-2 kw-values-2)
+  (let iter ([kw   '()]        [kv   '()]
+             [kw-1 keywords-1] [kv-1 kw-values-1]
+             [kw-2 keywords-2] [kv-2 kw-values-2])
+    (cond
+      [(null? kw-2) (values (append (reverse kw) kw-1) (append (reverse kv) kv-1))]
+      [(null? kw-1) (values (append (reverse kw) kw-2) (append (reverse kv) kv-2))]
+      [(eq? (car kw-1) (car kw-2))
+       (iter (cons (car kw-2) kw) (cons (car kv-2) kv)
+             (cdr kw-1)           (cdr kv-1)
+             (cdr kw-2)           (cdr kv-2))]
+      [(keyword<? (car kw-1) (car kw-2))
+       (iter (cons (car kw-1) kw) (cons (car kv-1) kv)
+             (cdr kw-1)           (cdr kv-1)
+             kw-2                 kv-2)]
+      [else
+       (iter (cons (car kw-2) kw) (cons (car kv-2) kv)
+             kw-1                 kv-1
+             (cdr kw-2)           (cdr kv-2))])))
+
+;; Like (curry ...) from scheme/function, but with much better support for
+;; keyword arguments. Keyword arguments supplied to curry-keywords act as
+;; defaults, which may be overridden by keywords passed to the resulting
+;; function. It can also curry non-keyword arguments, naturally.
+(define curry-keywords
+  (make-keyword-procedure
+    (lambda (curried-keywords curried-kw-values fn . curried-non-keywords)
+      (make-keyword-procedure
+        (lambda (keywords kw-values . non-keywords)
+          (let-values ([(all-keywords all-kw-values)
+                        (merge-keywords curried-keywords curried-kw-values keywords kw-values)])
+            (keyword-apply fn all-keywords all-kw-values
+                           (append curried-non-keywords non-keywords))))))))
+
 (define (variable-value? form)
   (and (symbol? form)
        (not (eq? form '%undef))))
@@ -68,7 +113,7 @@
 ; A value-form is any simple form which can appear on the right-hand side of a (set! ...).
 ; If there are any side-effect they occur before the variable is updated.
 (define (value-form? form)
-  (define complex-values '(%bind %apply %call/cc %values))
+  (define complex-values '(%bind %lambda %apply %call/cc %values %value-list))
   (or (simple-value? form)
       (memq (first form) complex-values)
       (memq (first form) (map first value-primitives))))
@@ -91,129 +136,120 @@
 (define (bind-form? form)
   (and (pair? form) (eq? (first form) '%bind)))
 
-(define (map-form form
-                  #:bind       [bind-fn       (lambda (recurse op vars . subforms)
-                                                `(,op ,vars ,@(map recurse subforms)))]
-                  #:lambda     [lambda-fn     (lambda (recurse op g-vars i-vars bind)
-                                                `(,op ,g-vars ,i-vars ,(recurse bind)))]
-                  #:set        [set-fn        (lambda (recurse op var value)
-                                                `(,op ,var ,(recurse value)))]
-
-                  #:primitive  [primitive-fn  (lambda (recurse op . simple-values)
-                                                `(,op ,@(map recurse simple-values)))]
-                  #:values     [values-fn     primitive-fn]
-                  #:call       [call-fn       primitive-fn]
-                  #:apply      [apply-fn      call-fn]
-                  #:call/cc    [call/cc-fn    call-fn]
-                  #:tail-call  [tail-call-fn  call-fn]
-
-                  #:simple     [simple-fn     (lambda (recurse kind form) form)]
-                  #:variable   [variable-fn   simple-fn]
-                  #:literal    [literal-fn    simple-fn]
-
-                  #:other      [other-fn      (lambda (recurse . form)
-                                                (error "Unsimplified form:" form))])
+(define (traverse-form form
+          #:bind       [bind-fn       (lambda (recurse op vars . subforms)
+                                        (for ([subform (in-list subforms)])
+                                          (recurse subform)))]
+          #:lambda     [lambda-fn     (lambda (recurse op g-vars i-vars bind)
+                                        (recurse bind))]
+          #:set        [set-fn        (lambda (recurse op var value-form)
+                                        (recurse value-form))]
+          #:value-list [value-list-fn (lambda (recurse op values-form)
+                                        (recurse values-form))]
+          #:primitive  [primitive-fn  (lambda (recurse op . simple-values)
+                                        (for ([val (in-list simple-values)])
+                                          (recurse val)))]
+          #:simple     [simple-fn     (lambda (recurse kind simple-value) (void))]
+          #:other      [other-fn      (lambda (recurse . form)
+                                        (error "Unsimplified form:" form))]
+          #:values     [values-fn     primitive-fn]
+          #:call       [call-fn       primitive-fn]
+          #:variable   [variable-fn   simple-fn]
+          #:literal    [literal-fn    simple-fn]
+          #:apply      [apply-fn      call-fn]
+          #:call/cc    [call/cc-fn    call-fn]
+          #:tail-call  [tail-call-fn  call-fn])
   (define (recurse subform)
-    (map-form subform
-              #:bind      bind-fn
-              #:lambda    lambda-fn
-              #:set       set-fn
-              #:primitive primitive-fn
-              #:values    values-fn
-              #:call      call-fn
-              #:apply     apply-fn
-              #:call/cc   call/cc-fn
-              #:tail-call tail-call-fn
-              #:simple    simple-fn
-              #:variable  variable-fn
-              #:literal   literal-fn
-              #:other     other-fn))
+    ; Can skip #:primitive, #:call, and #:simple, which only set defaults.
+    (traverse-form subform
+      #:bind       bind-fn
+      #:lambda     lambda-fn
+      #:set        set-fn
+      #:value-list value-list-fn
+      #:primitive  primitive-fn
+      #:other      other-fn
+      #:values     values-fn
+      #:variable   variable-fn
+      #:literal    literal-fn
+      #:apply      apply-fn
+      #:call/cc    call/cc-fn
+      #:tail-call  tail-call-fn))
 
   (cond
     [(variable-value? form) (variable-fn recurse 'variable form)]
     [(literal-value?  form) (literal-fn  recurse 'literal  form)]
     [else
      (let ([handler (case (first form)
-                      [(%bind)      bind-fn]
-                      [(%lambda)    lambda-fn]
-                      [(%set!)      set-fn]
-                      [(%values)    values-fn]
-                      [(%apply)     apply-fn]
-                      [(%call/cc)   call/cc-fn]
-                      [(%tail-call) tail-call-fn]
-                      [else         (if (primitive-form? form)
-                                        primitive-fn
-                                        other-fn)])])
+                      [(%bind)       bind-fn]
+                      [(%lambda)     lambda-fn]
+                      [(%set!)       set-fn]
+                      [(%value-list) value-list-fn]
+                      [(%values)     values-fn]
+                      [(%apply)      apply-fn]
+                      [(%call/cc)    call/cc-fn]
+                      [(%tail-call)  tail-call-fn]
+                      [else          (if (primitive-form? form)
+                                         primitive-fn
+                                         other-fn)])])
        (apply handler recurse form))]))
 
-; Like map-form, but intended for boolean results. (Just different defaults.)
-(define (search-form form
-                     #:merge-with [merge-fn      ormap]
-                     #:base-value [base-value    #f]
-                     #:bind       [bind-fn       (lambda (recurse op vars . subforms)
-                                                   (merge-fn recurse subforms))]
-                     #:lambda     [lambda-fn     (lambda (recurse op g-vars i-vars bind)
-                                                   (recurse bind))]
-                     #:set        [set-fn        (lambda (recurse op var value)
-                                                   (recurse value))]
+(define map-form
+  (curry-keywords traverse-form
+    #:bind       (lambda (recurse op vars . subforms)
+                   `(,op ,vars ,@(map recurse subforms)))
+    #:lambda     (lambda (recurse op g-vars i-vars bind)
+                   `(,op ,g-vars ,i-vars ,(recurse bind)))
+    #:set        (lambda (recurse op var value-form)
+                   `(,op ,var ,(recurse value-form)))
+    #:value-list (lambda (recurse op values-form)
+                   `(,op ,(recurse values-form)))
+    #:primitive  (lambda (recurse op . simple-values)
+                   `(,op ,@(map recurse simple-values)))
+    #:simple     (lambda (recurse kind form) form)))
 
-                     #:primitive  [primitive-fn  (lambda (recurse op . simple-values)
-                                                   (merge-fn recurse simple-values))]
-                     #:values     [values-fn     primitive-fn]
-                     #:call       [call-fn       primitive-fn]
-                     #:apply      [apply-fn      call-fn]
-                     #:call/cc    [call/cc-fn    call-fn]
-                     #:tail-call  [tail-call-fn  call-fn]
-
-                     #:simple     [simple-fn     (lambda (recurse kind form) base-value)]
-                     #:variable   [variable-fn   simple-fn]
-                     #:literal    [literal-fn    simple-fn]
-
-                     #:other      [other-fn      (lambda (recurse . form)
-                                                   (error "Unsimplified form:" form))])
-  (map-form form
-            #:bind      bind-fn
-            #:lambda    lambda-fn
-            #:set       set-fn
-            #:primitive primitive-fn
-            #:values    values-fn
-            #:call      call-fn
-            #:apply     apply-fn
-            #:call/cc   call/cc-fn
-            #:tail-call tail-call-fn
-            #:simple    simple-fn
-            #:variable  variable-fn
-            #:literal   literal-fn
-            #:other     other-fn))
+; Like map-form, but intended for boolean results.
+(define search-form
+  (curry-keywords traverse-form
+    #:bind       (lambda (recurse op vars . subforms)
+                   (ormap recurse subforms))
+    #:lambda     (lambda (recurse op g-vars i-vars bind)
+                   (recurse bind))
+    #:set        (lambda (recurse op var value)
+                   (recurse value))
+    #:value-list (lambda (recurse op var values-form)
+                   (recurse values-form))
+    #:primitive  (lambda (recurse op . simple-values)
+                   (ormap recurse simple-values))
+    #:simple     (lambda (recurse kind form) #f)))
 
 (define (form-sets? form variable [call-may-set? #t])
   (search-form form
-               #:bind      (lambda (recurse op vars . subforms)
-                             (and (not (memq variable vars))
-                                  (ormap recurse subforms)))
-               #:lambda    (lambda _ #f)
-               #:set       (lambda (recurse op var complex-value)
-                             (eq? var variable))
-               #:call      (lambda _ call-may-set?)))
+    #:bind      (lambda (recurse op vars . subforms)
+                  (and (not (memq variable vars))
+                       (ormap recurse subforms)))
+    #:lambda    (lambda _ #f)
+    #:set       (lambda (recurse op var value-form)
+                  (or (eq? var variable)
+                      (recurse value-form)))
+    #:call      (lambda _ call-may-set?)))
 
-(define (form-uses? form variable [call-may-use? #t] [descend? #t])
+(define (form-uses? form variable [call-may-use? #t])
   (search-form form
-               #:bind      (lambda (recurse op vars . subforms)
-                             (and (not (memq variable vars))
-                                  (ormap recurse subforms)))
-               #:lambda    (lambda (recurse op g-vars i-vars bind)
-                             (and descend? (recurse bind)))
-               #:call      (lambda (recurse op . simple-values)
-                             (or call-may-use? (ormap recurse simple-values)))
-               #:variable  (lambda (recurse op var) (eq? var variable))))
+    #:bind     (lambda (recurse op vars . subforms)
+                 (and (not (memq variable vars))
+                      (ormap recurse subforms)))
+    #:lambda   (lambda (recurse . form) #f)
+    #:call     (lambda (recurse op . simple-values)
+                 (or call-may-use? (ormap recurse simple-values)))
+    #:variable (lambda (recurse op var) (eq? var variable))))
 
 (define (form-captures? form variable [input? #t] [output? #t])
   (search-form form
-               #:bind      (lambda (recurse op vars . subforms)
-                             (and (not (memq variable vars))
-                                  (ormap recurse subforms)))
-               #:lambda    (lambda (recurse op g-vars i-vars bind)
-                             (and (memq variable (free-variables bind input? output?)) #t))))
+    #:bind     (lambda (recurse op vars . subforms)
+                 (and (not (memq variable vars))
+                      (ormap recurse subforms)))
+    #:lambda   (lambda (recurse op g-vars i-vars bind)
+                 (and (memq variable (free-variables bind input? output?)) #t))))
 
 (define (form-captures-input? form var)
   (form-captures? form var #t #f))
@@ -224,64 +260,30 @@
 (define (value-used? variable forms)
   (cond
     [(null? forms) #f]
-    [(form-uses? (first forms) variable #f #t) #t]
+    [(form-captures-input? (first forms) variable) #t]
+    [(form-uses? (first forms) variable #f) #t]
     [(form-sets? (first forms) variable #f) #f]
     [else (value-used? variable (cdr forms))]))
 
 (define (subst-var old-var new-var form)
   (map-form form
-            #:bind     (lambda (recurse op vars . subforms)
-                         `(%bind ,(subst old-var new-var vars) ,@(map recurse subforms)))
-            #:set      (lambda (recurse op var value)
-                         `(,op ,(if (eq? var old-var) new-var var) ,(recurse value)))
-            #:variable (lambda (recurse op var)
-                         (if (eq? var old-var) new-var var))))
+    #:bind     (lambda (recurse op vars . subforms)
+                 `(%bind ,(subst old-var new-var vars) ,@(map recurse subforms)))
+    #:set      (lambda (recurse op var value)
+                 `(,op ,(if (eq? var old-var) new-var var) ,(recurse value)))
+    #:variable (lambda (recurse op var)
+                 (if (eq? var old-var) new-var var))))
 
-(define (narrow-binds simple-lambda-form)
-  (define bind (fourth simple-lambda-form))
-
-  (define (at-top-level? var)
-    (or (ormap (lambda (x) (form-sets? x var #f)) (cddr bind))
-        (ormap (lambda (x) (form-uses? x var #f #f)) (cddr bind))))
-
-  (define (captured-twice? var)
-    (let/cc return
-      (foldl (lambda (subform once?)
-               (if (form-captures? subform var)
-                   (if once? (return #t) #t)
-                   once?))
-             (at-top-level? var)
-             (cddr bind))
-      #f))
-
-  (define extra-binds
-    (filter-not captured-twice?
-                (filter-not at-top-level?
-                            (second bind))))
-
-  `(%lambda ,(second simple-lambda-form) ,(third simple-lambda-form)
-     (%bind ,(remove* extra-binds (second bind))
-       ,@(map (lambda (subform)
-                (if (and (pair? subform)
-                         (eq? (first subform) '%set!)
-                         (pair? (third subform))
-                         (eq? (first (third subform)) '%lambda))
-                    (let* ([dest (second subform)]
-                           [value (third subform)]
-                           [g-vars (second value)]
-                           [i-vars (third value)])
-                      `(%set! ,dest ,(foldl (lambda (var temp-value)
-                                              (define temp-bind (fourth temp-value))
-                                              (if (form-captures? temp-value var)
-                                                  (narrow-binds
-                                                    `(%lambda ,g-vars ,i-vars
-                                                       (%bind (,@(second temp-bind) ,var)
-                                                         ,@(cddr temp-bind))))
-                                                  temp-value))
-                                            value
-                                            extra-binds)))
-                    subform))
-              (cddr bind)))))
+(define (subst-var* var-map form)
+  (map-form form
+    #:bind     (lambda (recurse op vars . subforms)
+                 `(%bind ,(subst* var-map vars) ,@(map recurse subforms)))
+    #:set      (lambda (recurse op var value)
+                 (let ([item (assoc var var-map)])
+                   `(,op ,(if item (second item) var) ,(recurse value))))
+    #:variable (lambda (recurse op var)
+                 (let ([item (assoc var var-map)])
+                   (if item (second item) var)))))
 
 (define (flatten-binds form)
   (define (make-bindings-unique bind rename-vars)
@@ -293,42 +295,41 @@
     (foldr make-binding-unique bind (filter needs-rename? (second bind))))
 
   (map-form form
-            #:bind   (lambda (recurse op bound-vars . original-subforms)
-                       (define rename-vars
-                          (remove-duplicates
-                            (append (free-variables `(,op ,bound-vars ,@original-subforms))
-                                    bound-vars)))
-                       (define (form->list subform)
-                         (if (bind-form? subform)
-                             (let ([unique-form (make-bindings-unique
-                                                  (recurse subform)
-                                                  rename-vars)])
-                               (set! bound-vars (append (second unique-form) bound-vars))
-                               (cddr unique-form))
-                             (list subform)))
-                       (let ([subforms (append-map form->list original-subforms)])
-                         `(%bind ,bound-vars ,@subforms)))
-            #:lambda (lambda (recurse . form) form)))
+    #:bind   (lambda (recurse op bound-vars . original-subforms)
+               (define rename-vars
+                  (remove-duplicates
+                    (append (free-variables `(,op ,bound-vars ,@original-subforms))
+                            bound-vars)))
+               (define (form->list subform)
+                 (if (bind-form? subform)
+                     (let ([unique-form (make-bindings-unique
+                                          (recurse subform)
+                                          rename-vars)])
+                       (set! bound-vars (append (second unique-form) bound-vars))
+                       (cddr unique-form))
+                     (list subform)))
+               (let ([subforms (append-map form->list original-subforms)])
+                 `(%bind ,bound-vars ,@subforms)))
+    #:lambda (lambda (recurse . form) form)))
 
 (define (free-variables form [input? #t] [output? #t])
-  (map-form form
-            #:bind      (lambda (recurse op vars . subforms)
-                          (remove-duplicates (remove* vars (append-map recurse subforms))))
-            #:lambda    (lambda (recurse op g-vars i-vars bind)
-                          (recurse bind))
-            #:set       (lambda (recurse op var value)
-                          (let ([value-free (recurse value)])
-                            (if output?
-                                (cons var value-free)
-                                value-free)))
-            #:primitive (lambda (recurse op . simple-values)
-                          (remove-duplicates (append-map recurse simple-values)))
-            #:simple    (lambda (recurse kind form)
-                          (if (and input?
-                                   (variable-value? form)
-                                   (not (memq form '(%nil %self %argv %ctx %k))))
-                              (list form)
-                              '()))))
+  (define (append-map/unique fn . lsts)
+    (remove-duplicates (apply append-map fn lsts)))
+  (traverse-form form
+    #:bind       (lambda (recurse op vars . subforms)
+                   (remove* vars (append-map/unique recurse subforms)))
+    #:set        (lambda (recurse op var value)
+                   (let ([value-free (recurse value)])
+                     (if (and output? (not (memq var value-free)))
+                         (cons var value-free)
+                         value-free)))
+    #:primitive  (lambda (recurse op . simple-values)
+                   (append-map/unique recurse simple-values))
+    #:simple     (lambda (recurse kind form) '())
+    #:variable   (lambda (recurse kind var)
+                   (if (and input? (not (special-variable? var)))
+                       (list var)
+                       '()))))
 
 (define (free-input-variables form)
   (free-variables form #t #f))
diff --git a/libcompiler/writer.scm b/libcompiler/writer.scm
index 64dfbc8..127f58f 100644
--- a/libcompiler/writer.scm
+++ b/libcompiler/writer.scm
@@ -195,3 +195,5 @@
                    (variable->code (third  form))
                    (variable->code (fourth form)))]
         [else (error "Unsupported form:" form)])))
+
+; vim:set sw=2 expandtab: