diff --git a/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
new file mode 100644
index 00000000..800f688e
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
@@ -0,0 +1,4 @@
+#lang typed/racket #:optimize
+(require racket/unsafe/ops)
+(apply + (map add1 (list 1 2 3)))
+(apply * (map add1 (list 1 2 3)))
diff --git a/collects/typed-scheme/optimizer/apply.rkt b/collects/typed-scheme/optimizer/apply.rkt
new file mode 100644
index 00000000..4fa67d97
--- /dev/null
+++ b/collects/typed-scheme/optimizer/apply.rkt
@@ -0,0 +1,32 @@
+#lang scheme/base
+(require syntax/parse
+         syntax/id-table racket/dict
+         unstable/match scheme/match
+         (for-template scheme/unsafe/ops racket/base (prefix-in k: '#%kernel))
+         (for-syntax racket/base)
+         "../utils/utils.rkt"
+         (rep type-rep)
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide apply-opt-expr)
+
+(define-syntax-class apply-op
+  #:literals (+ *)
+  (pattern + #:with identity #'0)
+  (pattern * #:with identity #'1))
+
+(define-syntax-class apply-opt-expr
+		     #:literals (k:apply map #%plain-app #%app)
+  (pattern (#%plain-app k:apply op:apply-op (#%plain-app map f l))
+           #:with opt
+           (begin (reset-unboxed-gensym)
+           (with-syntax ([(f* lp v lst) (map unboxed-gensym '(f* loop v lst))]
+			 [l ((optimize) #'l)]
+			 [f ((optimize) #'f)])
+	     (log-optimization "apply-map" #'op)
+	     #'(let ([f* f])
+                 (let lp ([v op.identity] [lst l])
+                   (if (null? lst)
+                       v
+                       (lp (op v (f* (unsafe-car lst))) (unsafe-cdr lst)))))))))
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index a3a93ea8..c0f3c08b 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -8,7 +8,7 @@
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
          (optimizer utils number fixnum float inexact-complex vector string
-                    pair sequence box struct dead-code))
+                    pair sequence box struct dead-code apply))
 
 (provide optimize-top)
 
@@ -21,6 +21,7 @@
   #:literal-sets (kernel-literals)
 
   ;; interesting cases, where something is optimized
+  (pattern e:apply-opt-expr           #:with opt #'e.opt)
   (pattern e:number-opt-expr          #:with opt #'e.opt)
   (pattern e:fixnum-opt-expr          #:with opt #'e.opt)
   (pattern e:float-opt-expr           #:with opt #'e.opt)
@@ -47,9 +48,10 @@
   (pattern (letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs:opt-expr] ...) e-body:opt-expr ...)
            #:with opt #'(letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs.opt] ...) e-body.opt ...))
   (pattern (kw:identifier expr ...)
-           #:when (ormap (lambda (k) (free-identifier=? k #'kw))
-                         (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
-                               #'#%variable-reference #'with-continuation-mark))
+           #:when 
+	   (for/or ([k (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
+			     #'#%variable-reference #'with-continuation-mark)])
+	     (free-identifier=? k #'kw))
            ;; we don't want to optimize in the cases that don't match the #:when clause
            #:with (expr*:opt-expr ...) #'(expr ...)
            #:with opt #'(kw expr*.opt ...))
@@ -64,12 +66,8 @@
                   (current-output-port))))
     (begin0
       (parameterize ([current-output-port port]
-                     [optimize (lambda (stx)
-                                 (syntax-parse stx #:literal-sets (kernel-literals)
-                                               [e:opt-expr
-                                                (syntax/loc stx e.opt)]))])
+                     [optimize (syntax-parser [e:opt-expr #'e.opt])])
         ((optimize) stx))
-      (if (and *log-optimizations?*
-               *log-optimizatons-to-log-file?*)
-          (close-output-port port)
-          #t))))
+      (when (and *log-optimizations?*
+                 *log-optimizatons-to-log-file?*)
+        (close-output-port port)))))
diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index 912b0184..088f0fd0 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -52,9 +52,9 @@
 ;; necessary to have predictable symbols to add in the hand-optimized versions
 ;; of the optimizer tests (which check for equality of expanded code)
 (define *unboxed-gensym-counter* 0)
-(define (unboxed-gensym)
+(define (unboxed-gensym [name 'unboxed-gensym-])
   (set! *unboxed-gensym-counter* (add1 *unboxed-gensym-counter*))
-  (format-unique-id #'here "unboxed-gensym-~a" *unboxed-gensym-counter*))
+  (format-unique-id #'here "~a~a" name *unboxed-gensym-counter*))
 (define (reset-unboxed-gensym)
   (set! *unboxed-gensym-counter* 0))