diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss
index ecb8529..3fd0ec0 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.ss
@@ -1,7 +1,8 @@
 
 (module etc mzscheme
 
-  (require (lib "main-collects.ss" "setup"))
+  (require (lib "main-collects.ss" "setup")
+           "kw.ss")
 
   (require-for-syntax (lib "kerncase.ss" "syntax")
                       (lib "stx.ss" "syntax")
@@ -23,6 +24,7 @@
            loop-until
 
            opt-lambda
+           define-opt
 
            local
            recur
@@ -129,52 +131,82 @@
     (eq? x y))
 
  (define-syntax (opt-lambda stx)
-   (with-syntax ([name (or (syntax-local-infer-name stx)
-                           (quote-syntax opt-lambda-proc))])
-     (syntax-case stx ()
-       [(_ args body1 body ...)
-        (let ([clauses (let loop ([pre-args null]
-                                  [args (syntax args)]
-                                  [needs-default? #f])
-                         (syntax-case args ()
-                           [id
-                            (identifier? (syntax id))
-                            (with-syntax ([(pre-arg ...) pre-args])
-                              (syntax ([(pre-arg ... . id)
-                                        body1 body ...])))]
-                           [()
-                            (with-syntax ([(pre-arg ...) pre-args])
-                              (syntax ([(pre-arg ...)
-                                        body1 body ...])))]
-                           [(id . rest)
-                            (identifier? (syntax id))
-                            (begin
-                              (when needs-default?
-                                (raise-syntax-error
-                                 #f "default value missing" stx (syntax id)))
-                              (loop (append pre-args (list (syntax id)))
-                                    (syntax rest)
-                                    #f))]
-                           [([id default] . rest)
-                            (identifier? (syntax id))
-                            (with-syntax ([rest (loop (append pre-args (list (syntax id)))
-                                                      (syntax rest)
-                                                      #t)]
-                                          [(pre-arg ...) pre-args])
-                              (syntax ([(pre-arg ...) (name pre-arg ... default)]
-                                       . rest)))]
-                           [(bad . rest)
-                            (raise-syntax-error
-                             #f
-                             "not an identifier or identifier with default"
-                             stx
-                             (syntax bad))]
-                           [else
-                            (raise-syntax-error
-                             #f "bad identifier sequence" stx (syntax args))]))])
-          (with-syntax ([clauses clauses])
-            (syntax/loc stx
-              (letrec ([name (case-lambda . clauses)]) name))))])))
+   (syntax-case stx ()
+     [(_ args body1 body ...)
+      (with-syntax ([((plain ...) (opt ...) (kw ...) need-kw rest)
+                     (let loop ([args (syntax args)]
+                                [needs-default? #f])
+                       (syntax-case args ()
+                         [id
+                          (identifier? (syntax id))
+                          #'(() () () () (#:body id))]
+                         [()
+                          #'(() () () () ())]
+                         [(id . rest)
+                          (identifier? (syntax id))
+                          (begin
+                            (when needs-default?
+                              (raise-syntax-error
+                               #f "default value missing" stx (syntax id)))
+                            (with-syntax ([(plain opts kws need-kw rest) (loop #'rest #f)])
+                              #'((id . plain) opts kws need-kw rest)))]
+                         [([id default] . rest)
+                          (identifier? (syntax id))
+                          (with-syntax ([(plain opts kws need-kw rest) (loop #'rest #t)])
+                            #'(plain ([id default] . opts) kws need-kw rest))]
+                         [(kw id . rest)
+                          (and (identifier? #'id)
+                               (keyword? (syntax-e #'kw)))
+                          (with-syntax ([(plain opts kws need-kw rest) (loop #'rest needs-default?)])
+                            #'(plain opts ([id kw #f] . kws) (kw . need-kw) rest))]
+                         [(kw [id default] . rest)
+                          (and (identifier? #'id)
+                               (keyword? (syntax-e #'kw)))
+                          (with-syntax ([(plain opts kws need-kw rest) (loop #'rest needs-default?)])
+                            #'(plain opts ([id kw default] . kws) need-kw rest))]
+                         [(bad . rest)
+                          (raise-syntax-error
+                           #f
+                           "not an identifier or identifier with default"
+                           stx
+                           (syntax bad))]
+                         [else
+                          (raise-syntax-error
+                           #f "bad identifier sequence" stx (syntax args))]))])
+        (let ([kw-proc (syntax/loc stx
+                         (lambda/kw [plain ... #:optional opt ... #:key kw ... . rest] body1 body ...))])
+          (if (null? (syntax-e #'(kw ...)))
+              kw-proc
+              (with-syntax ([name (or (syntax-local-infer-name stx)
+                                      (quote-syntax opt-lambda-proc))]
+                            [kw-proc kw-proc]
+                            [len (length (syntax->list #'(plain ...)))])
+                (syntax/loc stx
+                  (let ([name kw-proc])
+                    (lambda all-args
+                      (apply name (sort-kws len 'need-kw all-args)))))))))]))
+
+ (define-syntax define-opt
+   (syntax-rules ()
+     [(_ (id . args) body1 body ...)
+      (define id (opt-lambda args body1 body ...))]
+     [(_ . rest) (define . rest)]))
+
+ (define (sort-kws len need-kw l)
+   (for-each (lambda (kw)
+               (unless (memq kw l)
+                 (error "missing required argument for" kw)))
+             need-kw)
+   (let loop ([len len][l l][kws null])
+     (cond
+      [(null? l) (append kws l)]
+      [(zero? len) (append kws l)]
+      [(and (keyword? (car l))
+            (pair? (cdr l)))
+       (loop len (cddr l) (list* (car l) 
+                                 (cadr l)
+                                 kws))]
+      [else (cons (car l) (loop (sub1 len) (cdr l) kws))])))
 
  (define-syntax (local stx)
    (syntax-case stx ()
diff --git a/collects/mzlib/for.ss b/collects/mzlib/for.ss
index 3396b7d..ec9a8f6 100644
--- a/collects/mzlib/for.ss
+++ b/collects/mzlib/for.ss
@@ -8,6 +8,8 @@
            for/or for*/or
            for/first for*/first
            for/last for*/last
+
+           for/fold/derived for*/fold/derived
            
            (rename *in-range in-range)
            (rename *in-naturals in-naturals)