diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss
index f4121c45d3..98b05e1b01 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.ss
@@ -24,9 +24,6 @@
            loop-until
 
            opt-lambda
-           define-opt
-           keyword-apply
-           make-keyword-procedure
 
            local
            recur
@@ -133,110 +130,52 @@
     (eq? x y))
 
  (define-syntax (opt-lambda stx)
-   (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 (keyword-apply f kw-args normal-args . normal-argss)
-   (apply f (append (apply append
-                           (map (lambda (p) (list (car p) (cdr p))) kw-args))
-                    (if (null? normal-argss)
-                        normal-args
-                        (cons normal-args
-                              (let loop ([normal-argss normal-argss])
-                                (if (null? (cdr normal-argss))
-                                    (car normal-argss)
-                                    (cons (car normal-argss)
-                                          (loop (cdr normal-argss))))))))))
-
- (define (make-keyword-procedure f)
-   (lambda args
-     (let loop ([args args]
-                [normal null]
-                [kw null])
-       (cond
-        [(null? args) (apply f kw (reverse normal))]
-        [(and (keyword? (car args)) 
-              (pair? (cdr args)))
-         (loop (cddr args)
-               normal
-               (cons (cons (car args) (cadr args)) kw))]
-        [else (loop (cdr args)
-                    (cons (car args) normal)
-                    kw)]))))
-
- (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))])))
+   (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))))])))
 
  (define-syntax (local stx)
    (syntax-case stx ()
diff --git a/collects/scribblings/guide/apply.scrbl b/collects/scribblings/guide/apply.scrbl
index 4fae4b8321..d0701a0434 100644
--- a/collects/scribblings/guide/apply.scrbl
+++ b/collects/scribblings/guide/apply.scrbl
@@ -126,12 +126,14 @@ are effectively @scheme[cons]ed onto the argument list:
 The @scheme[apply] procedure supports only by-position arguments. To
 apply a procedure with keyword arguments, use the
 @scheme[keyword-apply] procedure, which accepts a procedure to apply
-and two lists. The first list contains pairs, each matching a
-keyword with its corresponding value. The second list contains
-by-position procedure arguments, as for @scheme[apply].
+and three lists. The first two lists are in parallel, where the first
+list contains keywords (sorted by @scheme[keyword<]), and the second
+list contains a corresponding argument for each keyword. The third
+list contains by-position procedure arguments, as for @scheme[apply].
 
 @schemeblock[
 (keyword-apply go 
-               (list (cons '#:mode 'fast))
+               '(#:mode)
+               '(fast)
                (list "super.ss"))
 ]
diff --git a/collects/scribblings/guide/define.scrbl b/collects/scribblings/guide/define.scrbl
index 5b5fe6eff6..13d42767ee 100644
--- a/collects/scribblings/guide/define.scrbl
+++ b/collects/scribblings/guide/define.scrbl
@@ -3,8 +3,6 @@
 @require[(lib "eval.ss" "scribble")]
 @require["guide-utils.ss"]
 
-@interaction-eval[(require (rename (lib "etc.ss") define define-opt))]
-
 @title{Definitions: @scheme[define]}
 
 A basic definition has the form
diff --git a/collects/scribblings/guide/guide-utils.ss b/collects/scribblings/guide/guide-utils.ss
index 4e346e163e..424712870b 100644
--- a/collects/scribblings/guide/guide-utils.ss
+++ b/collects/scribblings/guide/guide-utils.ss
@@ -2,7 +2,11 @@
   (require (lib "manual.ss" "scribble")
            (lib "struct.ss" "scribble")
            (lib "decode.ss" "scribble")
-           (lib "kw.ss"))
+           (lib "kw.ss")
+           (lib "eval.ss" "scribble"))
+
+  (interaction-eval (require (lib "new-lambda.ss" "scribblings")))
+
   
   (provide Quick MzScheme HtDP
            tool
diff --git a/collects/scribblings/guide/lambda.scrbl b/collects/scribblings/guide/lambda.scrbl
index e39f16695f..719502fd89 100644
--- a/collects/scribblings/guide/lambda.scrbl
+++ b/collects/scribblings/guide/lambda.scrbl
@@ -3,10 +3,6 @@
 @require[(lib "eval.ss" "scribble")]
 @require["guide-utils.ss"]
 
-@interaction-eval[(require (rename (lib "etc.ss") lambda opt-lambda))]
-@interaction-eval[(require (only (lib "etc.ss") keyword-apply
-                                                make-keyword-procedure))]
-
 @title[#:tag "guide:lambda"]{Procedures: @scheme[lambda]}
 
 Such a @scheme[lambda] expression creates a procedure. In the simplest
@@ -186,8 +182,8 @@ The @scheme[lambda] form does not directly support the creation
 of a procedure that accepts ``rest'' keywords. To construct a
 procedure that accepts any and all keyword arguments, use
 @scheme[make-keyword-procedure]. The procedure supplied to
-@scheme[make-keyword-procedure] receives all keyword arguments as
-a list of pairs through the first (by-position) argument, and
+@scheme[make-keyword-procedure] receives keyword arguments throw
+two parallel lists in the first two (by-position) arguments, and
 then all by-position arguments from an application as the
 remaining by-position arguments.
 
@@ -197,9 +193,9 @@ remaining by-position arguments.
 @defexamples[
 (define (trace-wrap f)
   (make-keyword-procedure
-   (lambda (kw-args . rest)
-     (printf "Called with ~s ~s\n" kw-args rest)
-     (keyword-apply f kw-args rest))))
+   (lambda (kws kw-args . rest)
+     (printf "Called with ~s ~s ~s\n" kws kw-args rest)
+     (keyword-apply f kws kw-args rest))))
 ((trace-wrap greet) "John" #:hi "Howdy")
 ]
 
diff --git a/collects/scribblings/new-lambda.ss b/collects/scribblings/new-lambda.ss
new file mode 100644
index 0000000000..59d0cd12e0
--- /dev/null
+++ b/collects/scribblings/new-lambda.ss
@@ -0,0 +1,689 @@
+(module new-lambda mzscheme
+  (require-for-syntax (lib "name.ss" "syntax"))
+
+  (provide (all-from-except mzscheme #%datum lambda define #%app)
+           (rename new-datum #%datum)
+           (rename new-lambda lambda)
+           (rename new-define define)
+           (rename new-app #%app)
+           (rename *make-keyword-procedure make-keyword-procedure)
+           keyword-apply)
+  
+  ;; ----------------------------------------
+  
+  (define-struct keyword-procedure (proc required allowed))
+
+  ;; Constructor for a procedure with only optional keywords.
+  ;; The `procedure' property dispatches to a procedure in the 
+  ;; struct (which has exactly the right arity).
+  (define-values (struct:okp make-optional-keyword-procedure okp? okp-ref okp-set!)
+    (make-struct-type 'procedure
+                      struct:keyword-procedure
+                      1 0 #f
+                      null (current-inspector) 0))
+  
+  ;; Constructor generator for a procedure with a required keyword.
+  ;; (This is used with lift-expression, so that the same constructor
+  ;;  is used for each evaluation of a keyword lambda.)
+  ;; The `procedure' property is a per-type method that has exactly
+  ;;  the right arity, and that sends all arguments to `missing-kw'.
+  (define (make-required name fail-proc)
+    (let-values ([(s: mk ? -ref -set!)
+                  (make-struct-type (string->symbol (format "procedure:~a" name))
+                                    struct:keyword-procedure
+                                    0 0 #f
+                                    null (current-inspector) fail-proc)])
+      mk))
+  
+  ;; ----------------------------------------
+
+  (define *make-keyword-procedure
+    (letrec ([make-keyword-procedure
+              (case-lambda 
+                [(proc) (make-keyword-procedure 
+                         proc
+                         (lambda args
+                           (apply proc null null args)))]
+                [(proc plain-proc)
+                 (make-optional-keyword-procedure
+                  proc
+                  null
+                  #f
+                  plain-proc)])])
+      make-keyword-procedure))
+
+  (define (keyword-apply proc kws kw-vals . normal-argss)
+    (let ([type-error
+           (lambda (what which)
+             (apply raise-type-error
+                    'keyword-apply
+                    what
+                    which
+                    proc
+                    kws
+                    kw-vals
+                    normal-argss))])
+      (unless (procedure? proc)
+        (type-error "procedure" 0))
+      (let loop ([ks kws])
+        (cond
+          [(null? ks) (void)]
+          [(or (not (pair? ks))
+               (not (keyword? (car ks))))
+           (type-error "list of keywords" 1)]
+          [(null? (cdr ks)) (void)]
+          [(or (not (pair? (cdr ks)))
+               (not (keyword? (cadr ks))))
+           (loop (cdr ks))]        
+          [(keyword<? (car ks) (cadr ks))
+           (loop (cdr ks))]
+          [else (type-error "sorted list of keywords" 1)]))
+      (unless (list? kw-vals)
+        (type-error "list" 2))
+      (unless (= (length kws) (length kw-vals))
+        (raise-mismatch-error
+         'keyword-apply
+         (format
+          "keyword list: ~e; does not match the length of the value list: "
+          kws)
+         kw-vals))
+      (let ([normal-args
+             (let loop ([normal-argss normal-argss][pos 3])
+               (if (null? (cdr normal-argss))
+                   (let ([l (car normal-argss)])
+                     (if (list? l)
+                         l
+                         (type-error "list" pos)))
+                   (cons (car normal-argss)
+                         (loop (cdr normal-argss) (add1 pos)))))])
+        (if (null? kws)
+            (apply proc normal-args)
+            (apply
+             (keyword-procedure-extract kws (+ 2 (length normal-args)) proc)
+             (apply list-immutable kws)
+             (apply list-immutable kw-vals)
+             normal-args)))))
+  
+  ;; ----------------------------------------
+
+  ;; #%datum that doesn't allow keywords as expressions
+  (define-syntax (new-datum stx)
+    (syntax-case stx  ()
+      [(id . kw)
+       (keyword? (syntax-e #'kw))
+       (raise-syntax-error 'expand "a keyword is not an expression" #'kw)]
+      [(id . thing)
+       #'(quote thing)]))
+  
+
+  ;; ----------------------------------------
+  ;; Sorting keywords.
+  
+  ;; The sort in "list.ss" should be moved into it's own library, 
+  ;; so we can use it here without requiring lots of other stuff.)
+  
+  ;; Also, keyword<? should be made built in. (We need it in two phases.)
+  
+  (define (keyword<? a b)
+    (string<? (keyword->string a)
+              (keyword->string b)))
+  (define-for-syntax (keyword<? a b)
+    (string<? (keyword->string a)
+              (keyword->string b)))
+  
+  (define-for-syntax (sort l <?)
+    (cond
+      [(null? l) null]
+      [(null? (cdr l)) l]
+      [else (let loop ([l l]
+                       [a null]
+                       [b null])
+              (cond
+                [(null? l) (let loop ([a (sort a <?)]
+                                      [b (sort b <?)])
+                             (cond
+                               [(null? a) b]
+                               [(null? b) a]
+                               [(<? (car a) (car b))
+                                (cons (car a) (loop (cdr a) b))]
+                               [else
+                                (cons (car b) (loop a (cdr b)))]))]
+                [else (loop (cdr l) (cons (car l) b) a)]))]))
+
+  ;; ----------------------------------------
+  ;; `lambda' with optional and keyword arguments
+  
+  (define-for-syntax (simple-args? args)
+    (cond
+      [(identifier? args) #t]
+      [(pair? args) (and (identifier? (car args))
+                         (simple-args? (cdr args)))]
+      [(syntax? args) (simple-args? (syntax-e args))]
+      [(null? args) #t]
+      [else #f]))
+  
+  ;; Helper to parse the argument list.
+  ;; The result is syntax:
+  ;;    ((plain-id ...)           ; non-potional, non-keyword args
+  ;;     (opt-id ...)             ; optional, non-keyword args
+  ;;     ([id opt-expr kind] ...) ; all args, kind is one of: #:plain, #:opt, #:kw
+  ;;     ([kw kw-id req?] ...)    ; kw args
+  ;;     (req-kw ...)             ; required keywords (could be extracted from previous)
+  ;;     rest)                    ; either () or (rest-id)
+  (define-for-syntax (parse-formals stx args)
+    (let* ([kw-ht (make-hash-table)]
+           [check-kw (lambda (kw)
+                       (when (hash-table-get kw-ht (syntax-e kw) #f)
+                         (raise-syntax-error
+                          #f
+                          "duplicate keyword for argument"
+                          stx
+                          kw))
+                       (hash-table-put! kw-ht (syntax-e kw) #t))])
+      (let loop ([args args] [needs-default? #f])
+        (syntax-case args ()
+          [id
+           (identifier? (syntax id))
+           #'(() () () () () (id))]
+          [()
+           #'(() () () () () ())]
+          [(id . rest)
+           (identifier? (syntax id))
+           (begin
+             (when needs-default?
+               (raise-syntax-error
+                #f "default value missing" stx (syntax id)))
+             (with-syntax ([(plain opt-ids opts kws need-kw rest) (loop #'rest #f)])
+               #'((id . plain) opt-ids ([id #f #:plain] . opts) kws need-kw rest)))]
+          [([id default] . rest)
+           (identifier? (syntax id))
+           (with-syntax ([(plain opt-ids opts kws need-kw rest) (loop #'rest #t)])
+             #'(plain (id . opt-ids) ([id default #:opt] . opts) kws need-kw rest))]
+          [(kw id . rest)
+           (and (identifier? #'id)
+                (keyword? (syntax-e #'kw)))
+           (begin
+             (check-kw #'kw)
+             (with-syntax ([(plain opt-ids opts kws need-kw rest) (loop #'rest needs-default?)])
+               #'(plain opt-ids ([id #f #:kw-req] . opts) ([kw id #t] . kws) (kw . need-kw) rest)))]
+          [(kw [id default] . rest)
+           (and (identifier? #'id)
+                (keyword? (syntax-e #'kw)))
+           (begin
+             (check-kw #'kw)
+             (with-syntax ([(plain opt-ids opts kws need-kw rest) (loop #'rest needs-default?)])
+               #'(plain opt-ids ([id default #:kw-opt] . opts) ([kw id #f] . kws) need-kw rest)))]
+          [(kw)
+           (keyword? (syntax-e #'kw))
+           (begin
+             (check-kw #'kw)
+             (raise-syntax-error
+              #f
+              "missing argument identifier after keyword"
+              stx
+              #'kw))]
+          [(bad . rest)
+           (raise-syntax-error
+            #f
+            "not an identifier, identifier with default, or keyword"
+            stx
+            (syntax bad))]
+          [else
+           (raise-syntax-error
+            #f "bad argument sequence" stx (syntax args))]))))
+  
+  ;; The new `lambda' form:
+  (define-syntax (new-lambda stx)
+    (syntax-case stx ()
+      [(_ args body1 body ...)
+       (if (simple-args? #'args)
+           ;; Use plain old `lambda':
+           (syntax/loc stx
+             (lambda args body1 body ...))
+           ;; Handle keyword or optional arguments:
+           (with-syntax ([((plain-id ...)
+                           (opt-id ...)
+                           ([id opt-expr kind] ...)
+                           ([kw kw-id kw-req] ...)
+                           need-kw
+                           rest)
+                          (parse-formals stx #'args)])
+             (let ([dup-id (check-duplicate-identifier (syntax->list #'(id ... . rest)))])
+               (when dup-id
+                 (raise-syntax-error
+                  #f
+                  "duplicate argument identifier"
+                  stx
+                  dup-id)))
+             (let* ([kws (syntax->list #'(kw ...))]
+                    [opts (syntax->list #'(opt-id ...))]
+                    [ids (syntax->list #'(id ...))]
+                    [plain-ids (syntax->list #'(plain-id ...))]
+                    [kw-reqs (syntax->list #'(kw-req ...))]
+                    [kw-args (generate-temporaries kws)]     ; to hold supplied value
+                    [kw-arg?s (generate-temporaries kws)]    ; to indicated whether it was supplied
+                    [opt-args (generate-temporaries opts)]   ; supplied value
+                    [opt-arg?s (generate-temporaries opts)]  ; whether supplied
+                    [needed-kws (sort (syntax->list #'need-kw)
+                                      (lambda (a b) (keyword<? (syntax-e a) (syntax-e b))))]
+                    [sorted-kws (sort (map list kws kw-args kw-arg?s kw-reqs)
+                                      (lambda (a b) (keyword<? (syntax-e (car a))
+                                                               (syntax-e (car b)))))])
+               (with-syntax ([(kw-arg ...) kw-args]
+                             [(kw-arg? ...) (let loop ([kw-arg?s kw-arg?s]
+                                                       [kw-reqs kw-reqs])
+                                              (cond
+                                                [(null? kw-arg?s) null]
+                                                [(not (syntax-e (car kw-reqs)))
+                                                 (cons (car kw-arg?s) (loop (cdr kw-arg?s) (cdr kw-reqs)))]
+                                                [else (loop (cdr kw-arg?s) (cdr kw-reqs))]))]
+                             [kws-sorted sorted-kws]
+                             [(opt-arg ...) opt-args]
+                             [(opt-arg? ...) opt-arg?s]
+                             [(new-plain-id  ...) (generate-temporaries #'(plain-id ...))]
+                             [new-rest (if (null? (syntax-e #'rest))
+                                           '()
+                                           '(new-rest))]
+                             [(rest-id) (if (null? (syntax-e #'rest))
+                                            '(())
+                                            #'rest)]
+                             [rest-empty (if (null? (syntax-e #'rest))
+                                             '()
+                                             '(null))])
+                 (let ([with-core 
+                        (lambda (result)
+                          ;; body of procedure, where all keyword and optional
+                          ;; argments come in as a pair of arguments (value and
+                          ;; whether the value is valid):
+                          (quasisyntax/loc stx
+                            (let ([core (lambda (given-kws given-args
+                                                           new-plain-id ... 
+                                                           opt-arg ...
+                                                           opt-arg? ...
+                                                           . new-rest)
+                                          ;; sort out the arguments into the user-supplied bindings,
+                                          ;; evaluating default-values expressions as needed:
+                                          (let-kws given-kws given-args kws-sorted
+                                                   (let-maybe ([id opt-expr kind] ... . rest)
+                                                              (kw-arg ...) (kw-arg? ...)
+                                                              (opt-arg ...) (opt-arg? ...)
+                                                              (new-plain-id ... . new-rest)
+                                                              ;; the original body, finally:
+                                                              body1 body ...)))])
+                              ;; entry points use `core':
+                              #,result)))]
+                       [mk-no-kws
+                        (lambda ()
+                          ;; entry point without keywords:
+                          (syntax/loc stx
+                            (opt-cases (core null null) ([opt-id opt-arg opt-arg?] ...) (plain-id ...) 
+                                       () (rest-empty rest-id . rest)
+                                       ())))]
+                       [mk-with-kws
+                        (lambda ()
+                          ;; entry point with keywords:
+                          (if (and (null? opts)
+                                   (null? #'new-rest))
+                              #'core
+                              (syntax/loc stx
+                                (opt-cases (core) ([opt-id opt-arg opt-arg?] ...) (given-kws given-args plain-id ...) 
+                                           () (rest-empty rest-id . rest)
+                                           ()))))]
+                       [mk-kw-arity-stub
+                        (lambda ()
+                          ;; struct-type entry point for no keywords when a keyword is required
+                          (syntax/loc stx
+                            (fail-opt-cases (missing-kw) (opt-id ...) (self plain-id ...) 
+                                            () (rest-id . rest)
+                                            ())))])
+                   (cond
+                     [(null? kws)
+                      ;; just the no-kw part
+                      (with-core (mk-no-kws))]
+                     [(null? needed-kws)
+                      ;; both parts dispatch to core
+                      (with-core
+                       (with-syntax ([kws (map car sorted-kws)]
+                                     [no-kws (let ([p (mk-no-kws)]
+                                                   [n (syntax-local-infer-name stx)])
+                                               (if n
+                                                   #`(let ([#,n #,p]) #,n)
+                                                   p))]
+                                     [with-kws (mk-with-kws)])
+                         (syntax/loc stx
+                           (make-optional-keyword-procedure
+                            with-kws
+                            null
+                            '(kw ...)
+                            no-kws))))]
+                     [else
+                      ;; just the keywords part dispatches to core,
+                      ;; and the other part dispatches to failure
+                      (with-core
+                       (with-syntax ([kws (map car sorted-kws)]
+                                     [needed-kws needed-kws]
+                                     [no-kws (mk-no-kws)]
+                                     [with-kws (mk-with-kws)]
+                                     [mk-id (with-syntax ([n (syntax-local-infer-name stx)]
+                                                          [call-fail (mk-kw-arity-stub)])
+                                              (syntax-local-lift-expression
+                                               #'(make-required 'n call-fail)))])
+                         (syntax/loc stx
+                           (mk-id
+                            with-kws
+                            'needed-kws
+                            '(kw ...)))))]))))))]))
+  
+  (define (missing-kw proc . args)
+    (printf "~s\n" args)
+    (apply
+     (keyword-procedure-extract null 0 proc)
+     null
+     null
+     args))
+  
+  ;; ----------------------------------------
+
+  ;; Helper macro:
+  ;; Steps through the list bound to `kw-args', extracting
+  ;; the available values. For each keyword, this binds one
+  ;; id to say whether the value is present, and one id
+  ;; to the actual value (if present); if the keyword isn't
+  ;; available, then the corresponding `req' is applied, which
+  ;; should signal an error if the keyword is required.
+  (define-syntax let-kws
+    (syntax-rules ()
+      [(_ kws kw-args () . body)
+       (begin . body)]
+      [(_ kws kw-args ([kw arg arg? #f] . rest) . body)
+       (let ([arg? (and (pair? kws)
+                        (eq? 'kw (car kws)))])
+         (let ([arg (if arg? (car kw-args))]
+               [kws (if arg? (cdr kws) kws)]
+               [kw-args (if arg? (cdr kw-args) kw-args)])
+           (let-kws kws kw-args rest . body)))]
+      [(_ kws kw-args ([kw arg arg? #t] . rest) . body)
+       (let ([arg (car kw-args)]
+             [kws (cdr kws)]
+             [kw-args (cdr kw-args)])
+         (let-kws kws kw-args rest . body))]))
+
+  ;; Used for `req' when the keyword argument is optional:
+  (define-syntax missing-ok
+    (syntax-rules ()
+      [(_ x y) #f]))
+  
+  ;; ----------------------------------------
+
+  ;; Helper macro:
+  ;; Builds up a `case-lambda' to handle the arities
+  ;; possible due to optional arguments. Each clause
+  ;; jumps directory to `core', where each optional
+  ;; argument is split into two: a boolean argument that
+  ;; indicates whether it was supplied, and an argument 
+  ;; for the value (if supplied).
+  (define-syntax opt-cases 
+    (syntax-rules ()
+      [(_ (core ...) () (base ...) () (rest-empty rest-id . rest) ())
+       ;; This case only happens when there are no optional arguments
+       (case-lambda
+         [(base ... . rest-id)
+          (core ... base ... . rest)])]
+      [(_ (core ...) ([opt-id opt-arg opt-arg?]) (base ...) (done-id ...) (rest-empty rest-id . rest) clauses)
+       ;; Handle the last optional argument and the rest args (if any)
+       ;; at the same time.
+       (case-lambda
+         [(base ...) (core ... base ... (a-false done-id) ... #f (a-false done-id) ... #f . rest-empty)]
+         [(base ... done-id ... opt-arg . rest-id)
+          (core ... base ... done-id ... opt-arg (a-true done-id) ... #t . rest)]
+         . clauses)]
+      [(_ (core ...) ([opt-id opt-arg opt-arg?] more ...) (base ...) (done-id ...) (rest-empty rest-id . rest) clauses)
+       ;; Handle just one optional argument, add it to the "done" sequence,
+       ;; and continue generating clauses for the remaining optional arguments.
+       (opt-cases (core ...) (more ...) (base ...) (done-id ... opt-id) (rest-empty rest-id . rest)
+                  ([(base ... done-id ... opt-arg)
+                    (core ... base ... 
+                          done-id ... opt-arg (a-false more) ... 
+                          (a-true done-id) ... #t (a-false more) ... . rest-empty)
+                    . clauses]))]))
+
+  ;; Helper macro:
+  ;; Similar to opt-cases, but just pass all arguments along to `fail'.
+  (define-syntax fail-opt-cases
+    (syntax-rules ()
+      [(_ (fail ...) () (base ...) () (rest-id . rest) ())
+       ;; This case only happens when there are no optional arguments
+       (case-lambda
+         [(base ... . rest-id)
+          (apply fail ... base ... rest)])]
+      [(_ (fail ...) (opt-id) (base ...) (done ...) (rest-id . rest) clauses)
+       ;; Handle the last optional argument and the rest args (if any)
+       ;; at the same time.
+       (case-lambda
+         [(base ...) (fail ... base ...)]
+         [(base ... done ... opt-id . rest-id) (apply fail ... base ... done ... opt-id rest)]
+         . clauses)]
+      [(_ (fail ...) (opt-id more ...) (base ...) (done ...) (rest-id . rest) clauses)
+       ;; Handle just one more optional argument:
+       (fail-opt-cases (fail ...) (more ...) (base ...) (done ... opt-id) (rest-id . rest)
+                       ([(base ... done ... opt-arg)
+                         (fail ... base ... done ... opt-arg)]
+                        . clauses))]))
+  
+  ;; Helper macros:
+  (define-syntax (a-false stx) #'#f)
+  (define-syntax (a-true stx) #'#t)
+  
+  ;; ----------------------------------------
+
+  ;; Helper macro:
+  ;; Walks through all arguments in order, shifting supplied
+  ;; optional values into the user-supplied binding, and
+  ;; evaluating default-value expressions when the optional
+  ;; value is not available. The binding order here is
+  ;; consistent with the original order of the arguments
+  ;; (where, e.g., an optional keyword argument might
+  ;; precede a required argument, so the required argument
+  ;; cannot be used to compute the default).
+  (define-syntax let-maybe
+    (syntax-rules (required)
+      [(_ () () () () () () body)
+       (let () body)]
+      [(_ ([id ignore #:plain] . more) kw-args kw-arg?s opt-args opt-arg?s (req-id . req-ids) . body)
+       (let ([id req-id])
+         (let-maybe more kw-args kw-arg?s opt-args opt-arg?s req-ids . body))]
+      [(_ ([id expr #:opt] . more)  kw-args kw-arg?s (opt-arg . opt-args) (opt-arg? . opt-arg?s) req-ids . body)
+       (let ([id (if opt-arg?
+                     opt-arg
+                     expr)])
+         (let-maybe more kw-args kw-arg?s opt-args opt-arg?s req-ids . body))]
+      [(_ ([id expr #:kw-req] . more)  (kw-arg . kw-args) kw-arg?s opt-args opt-arg?s req-ids . body)
+       (let ([id kw-arg])
+         (let-maybe more kw-args kw-arg?s opt-args opt-arg?s req-ids . body))]
+      [(_ ([id expr #:kw-opt] . more)  (kw-arg . kw-args) (kw-arg? . kw-arg?s) opt-args opt-arg?s req-ids . body)
+       (let ([id (if kw-arg?
+                     kw-arg
+                     expr)])
+         (let-maybe more kw-args kw-arg?s opt-args opt-arg?s req-ids . body))]
+      [(_ (id) () () () () (req-id) . body)
+       (let ([id req-id]) . body)]))
+
+  ;; ----------------------------------------
+  ;; `define' with keyword arguments
+  
+  ;; Not enough syntax checking here, yet.
+  ;; Also, the currying notation needs to be
+  ;; supported.
+  
+  (define-syntax (new-define stx)
+    (syntax-case stx ()
+      [(_ (id . formals) . body)
+       (identifier? #'id)
+       (syntax/loc stx (define id (new-lambda formals . body)))]
+      [(_ . rest)
+       (syntax/loc stx (define . rest))]))      
+  
+  ;; ----------------------------------------
+  ;; `#%app' with keyword arguments
+  
+  (define-syntax (new-app stx)
+    (let ([l (syntax->list stx)])
+      (if (not (and l
+                    (pair? (cdr l))
+                    (not (keyword? (cadr l)))
+                    (ormap (lambda (x) (keyword? (syntax-e x)))
+                           l)))
+          ;; simple or erroneous app:
+          (quasisyntax/loc stx
+            (#%app . #,(cdr (syntax-e stx))))
+          ;; keyword app (maybe)
+          (let ([exprs
+                 (let ([kw-ht (make-hash-table)])
+                   (let loop ([l (cddr l)])
+                     (cond
+                       [(null? l) null]
+                       [(keyword? (syntax-e (car l)))
+                        (when (hash-table-get kw-ht (syntax-e (car l)) #f)
+                          (raise-syntax-error
+                           'application
+                           "duplicate keyword in application"
+                           stx
+                           (car l)))
+                        (hash-table-put! kw-ht (syntax-e (car l)) #t)        
+                        (cond
+                          [(null? (cdr l))
+                           (raise-syntax-error
+                            'application
+                            "missing argument expression after keyword"
+                            stx
+                            (car l))]
+                          [(keyword? (cadr l))
+                           (raise-syntax-error
+                            'application
+                            "keyword in expression possition (immediately after another keyword)"
+                            stx
+                            (cadr l))]
+                          [else
+                           (cons (cadr l)
+                                 (loop (cddr l)))])]
+                       [else
+                        (cons (car l) (loop (cdr l)))])))])
+            (let ([ids (cons (or (syntax-local-infer-name stx)
+                                 'procedure)
+                             (generate-temporaries exprs))])
+              (let loop ([l (cdr l)]
+                         [ids ids]
+                         [bind-accum null]
+                         [arg-accum null]
+                         [kw-pairs null])
+                (cond
+                  [(null? l)
+                   (let* ([args (reverse arg-accum)]
+                          [sorted-kws (sort kw-pairs 
+                                            (lambda (a b)
+                                              (keyword<? (syntax-e (car a))
+                                                         (syntax-e (car b)))))]
+                          [lifted (syntax-local-lift-expression
+                                   #`(list-immutable #,@(map (lambda (p) #`(#%datum . #,(car p))) 
+                                                             sorted-kws)))]
+                          [cnt (+ 1 (length args))])
+                     (quasisyntax/loc stx
+                       (let #,(reverse bind-accum)
+                         ((keyword-procedure-extract #,lifted #,cnt #,(car args))
+                          #,lifted
+                          (list-immutable #,@(map cdr sorted-kws))
+                          . #,(cdr args)))))]
+                  [(keyword? (syntax-e (car l)))
+                   (loop (cddr l)
+                         (cdr ids)
+                         (cons (list (car ids) (cadr l)) bind-accum)
+                         arg-accum
+                         (cons (cons (car l) (car ids))
+                               kw-pairs))]
+                  [else (loop (cdr l)
+                              (cdr ids)
+                              (cons (list (car ids) (car l)) bind-accum)
+                              (cons (car ids) arg-accum)
+                              kw-pairs)])))))))
+  
+  ;; Checks given kws against expected. Result is
+  ;; (values missing-kw extra-kw), where both are #f if
+  ;; the arguments are ok.
+  (define (check-kw-args p kws)
+    (let loop ([kws kws]
+               [required (keyword-procedure-required p)]
+               [allowed (keyword-procedure-allowed p)])
+      (cond
+        [(null? kws)
+         (if (null? required)
+             (values #f #f)
+             (values (car required) #f))]
+        [(and (pair? required)
+              (eq? (car required) (car kws)))
+         (loop (cdr kws) (cdr required) (cdr allowed))]
+        [(not allowed) ; => all keywords are allowed
+         (loop (cdr kws) required #f)]
+        [(pair? allowed)
+         (if (eq? (car allowed) (car kws))
+             (loop (cdr kws) required (cdr allowed))
+             (loop kws required (cdr allowed)))]
+        [else (values #f (car kws))])))
+
+  ;; Extracts the procedure using the keyword-argument protocol.
+  ;; If `p' doesn't accept keywords, make up a procedure that
+  ;; reports an error.
+  (define (keyword-procedure-extract kws n p)
+    (if (and (keyword-procedure? p)
+             (procedure-arity-includes? (keyword-procedure-proc p) n)
+             (let-values ([(missing-kw extra-kw) (check-kw-args p kws)])
+               (and (not missing-kw) (not extra-kw))))
+        ;; Ok:
+        (keyword-procedure-proc p)
+        ;; Not ok:
+        (lambda (kws kw-args . args)
+          (let-values ([(missing-kw extra-kw)
+                        (if (keyword-procedure? p)
+                            (check-kw-args p kws)
+                            (values #f (car kws)))])
+            (let ([args-str
+                   ;; Hack to format arguments:
+                   (with-handlers ([exn:fail?
+                                    (lambda (exn)
+                                      (cadr (regexp-match #rx"other arguments were: (.*)$"
+                                                          (exn-message exn))))])
+                     (apply raise-type-error 'x "x" 0 'x
+                            (append (apply append (map list kws kw-args))
+                                    args)))])
+              (raise
+               (make-exn:fail:contract
+                (if extra-kw
+                    (if (keyword-procedure? p)
+                        (format 
+                         (string-append
+                          "procedure application: procedure: ~e;"
+                          " does not expect an argument with keyword ~a; arguments were: ~a")
+                         p
+                         extra-kw
+                         args-str)
+                        (format 
+                         (string-append
+                          "procedure application: expected a procedure that"
+                          " accepts keyword arguments, given ~e; arguments were: ~a")
+                         p
+                         args-str))
+                    (if missing-kw
+                        (format 
+                         (string-append
+                          "procedure application: procedure: ~e; requires"
+                          " an argument with keyword ~a, not supplied; arguments were: ~a")
+                         p
+                         missing-kw
+                         args-str)
+                        (format 
+                         (string-append
+                          "procedure application: no case matching ~a non-keyword"
+                          " arguments for: ~e; arguments were: ~a")
+                         (- n 2)
+                         p
+                         args-str)))
+                (current-continuation-marks)))))))))
diff --git a/collects/scribblings/reference/mz.ss b/collects/scribblings/reference/mz.ss
index c9f50a7165..c90783d8aa 100644
--- a/collects/scribblings/reference/mz.ss
+++ b/collects/scribblings/reference/mz.ss
@@ -5,6 +5,8 @@
            (lib "decode.ss" "scribble")
            (lib "kw.ss"))
 
+  (interaction-eval (require (lib "new-lambda.ss" "scribblings")))
+
   (provide (all-from (lib "manual.ss" "scribble"))
            (all-from (lib "eval.ss" "scribble")))
 
diff --git a/collects/scribblings/reference/procedures.scrbl b/collects/scribblings/reference/procedures.scrbl
index 1e21f9a0e7..163594ca45 100644
--- a/collects/scribblings/reference/procedures.scrbl
+++ b/collects/scribblings/reference/procedures.scrbl
@@ -1,10 +1,6 @@
 #reader(lib "docreader.ss" "scribble")
 @require["mz.ss"]
 
-@interaction-eval[(require (rename (lib "etc.ss") lambda opt-lambda))]
-@interaction-eval[(require (only (lib "etc.ss") keyword-apply
-                                                make-keyword-procedure))]
-
 @title[#:tag "mz:procedures"]{Procedures}
 
 @defproc[(procedure? [v any/c]) boolean]{ Returns @scheme[#t] if
@@ -30,27 +26,31 @@ is called in tail position with respect to the @scheme[apply] call.
 
 
 @defproc[(keyword-apply [proc procedure?] 
-                        [kw-lst (listof (cons/c keyword? any/c))] 
+                        [kw-lst (listof keyword?)]
+                        [kw-val-lst list?]
                         [v any/c] ... 
                         [lst list?])
          any]{
 
 @guideintro["guide:apply"]{@scheme[keyword-apply]}
 
-Like @scheme[apply], but @scheme[kw-lst] supplies by-keyword arguments
-in addition to the by-position arguments of the @scheme[v]s and
-@scheme[lst]. The given @scheme[kw-lst] must be sorted using
-@scheme[keyword<] on the @scheme[car] of each pair in the list, and no
-keyword can appear twice in the @scheme[car]s of @scheme[kw-lst]. The
+Like @scheme[apply], but @scheme[kw-lst] and @scheme[kw-val-lst]
+supply by-keyword arguments in addition to the by-position arguments
+of the @scheme[v]s and @scheme[lst]. The given @scheme[kw-lst] must be
+sorted using @scheme[keyword<], and no keyword can appear twice in
+@scheme[kw-lst], otherwise, the @exnraise[exn:fail:contract]. The
+given @scheme[kw-val-lst] must have the same length as
+@scheme[kw-lst], otherwise, the @exnraise[exn:fail:contract]. The
 given @scheme[proc] must accept all of the keywords in
-@scheme[kw-lst], and it must not require any other keywords;
-otherwise, the @exnraise[exn:fail:contract].
+@scheme[kw-lst], it must not require any other keywords, and it must
+accept as many by-position arguments as supplied via the @scheme[v]s
+and @scheme[lst]; otherwise, the @exnraise[exn:fail:contract].
 
 @defexamples[
 (define (f x #:y y #:z [z 10])
   (list x y z))
-(keyword-apply f '((#:y . 2)) '(1))
-(keyword-apply f '((#:y . 2) (#:z . 3)) '(1))
+(keyword-apply f '(#:y) '(2) '(1))
+(keyword-apply f '(#:y #:z) '(2 3) '(1))
 ]}
 
 @defproc[(procedure-arity [proc procedure?]) 
@@ -125,21 +125,27 @@ to mean that any keyword is accepted. The last result is as for
 are required.}
 
 @defproc[(make-keyword-procedure
-          [proc (((listof (cons/c keyword? any/c))) list? . ->* . any)])
+          [proc (((listof keyword?) list?) list? . ->* . any)]
+          [plain-proc procedure? (lambda args (apply proc null null args))])
          procedure?]{
 
-Returns a procedure that accepts any number of arguments and all
-keyword arguments (without requiring any keyword arguments). The
-resulting procedure calls @scheme[proc], supplying to @scheme[proc]
-all keyword arguments given in the original application as a list of
-keyword--value pairs, sorted by @scheme[keyword<] on the keywords. All
-by-position arguments supplied in the original application are
-supplied to @scheme[proc] after the list for keyword arguments.
+Returns a procedure that accepts all keyword arguments (without
+requiring any keyword arguments).
+
+When the result is called with keyword arguments, then @scheme[proc]
+is called; the first argument is a list of keywords sorted by
+@scheme[keyword<], the second argument is a parllel list containing a
+value for each keyword, and the remaining arguments are the
+by-position arguments.
+
+When the result is called without keyword arguments, then
+@scheme[plain-proc] is called. Furthermore, @scheme[procedure-arity]
+obtains its result frmo @scheme[plain-proc].
 
 @defexamples[
 (define show
-  (make-keyword-procedure (lambda (kw-args . rest)
-                            (list kw-args rest))))
+  (make-keyword-procedure (lambda (kws kw-args . rest)
+                            (list kws kw-args rest))))
 
 (show 1)
 (show #:init 0 1 2 3 #:extra 4)