diff --git a/collects/syntax/module-reader.ss b/collects/syntax/module-reader.ss
index 10aae4dff3..4b6cc36f86 100644
--- a/collects/syntax/module-reader.ss
+++ b/collects/syntax/module-reader.ss
@@ -7,61 +7,66 @@
 (require (for-syntax scheme/base))
 
 (define-syntax (provide-module-reader stx)
-  (syntax-case stx ()
-    [(_ lib body ...)
-     (let ([key-args '()])
-       (define (err str [sub #f])
-         (raise-syntax-error 'syntax/module-reader str sub))
-       (define -body
-         (let loop ([body (syntax->list #'(body ...))])
-           (if (not (and (pair? body)
-                         (pair? (cdr body))
-                         (keyword? (syntax-e (car body)))))
-             (datum->syntax stx body stx)
-             (let* ([k (car body)] [k* (syntax-e k)] [v (cadr body)])
-               (cond
-                 [(assq k* key-args) (err (format "got two ~s keywords" k*) k)]
-                 [(not (memq k* '(#:read #:read-syntax #:wrapper1 #:wrapper2
-                                  #:whole-body-readers?)))
-                  (err "got an unknown keyword" (car body))]
-                 [else (set! key-args (cons (cons k* v) key-args))
-                       (loop (cddr body))])))))
-       (define (get kwd [dflt #f])
-         (cond [(assq kwd key-args) => cdr] [else dflt]))
-       (unless (equal? (and (assq '#:read key-args) #t)
-                       (and (assq '#:read-syntax key-args) #t))
+  (define (construct-reader lib body)
+    (define (err str [sub #f])
+      (raise-syntax-error 'syntax/module-reader str sub))
+    (define-syntax-rule (keywords -body [kwd var default] ... [checks ...])
+      (begin
+        (define var #f) ...
+        (define -body
+          (let loop ([body body])
+            (if (not (and (pair? body)
+                          (pair? (cdr body))
+                          (keyword? (syntax-e (car body)))))
+              (datum->syntax stx body stx)
+              (let* ([k (car body)] [k* (syntax-e k)] [v (cadr body)])
+                (case k*
+                  [(kwd) (if var
+                           (err (format "got two ~s keywords" k*) k)
+                           (begin (set! var v) (loop (cddr body))))]
+                  ...
+                  [else (err "got an unknown keyword" (car body))])))))
+        checks ...
+        (set! var (or var default)) ...))
+    (keywords -body
+              [#:read        ~read        #'read]
+              [#:read-syntax ~read-syntax #'read-syntax]
+              [#:wrapper1    ~wrapper1    #'#f]
+              [#:wrapper2    ~wrapper2    #'#f]
+              [#:whole-body-readers? ~whole-body-readers? #'#f]
+      [(unless (equal? (and ~read #t) (and ~read-syntax #t))
          (err "must specify either both #:read and #:read-syntax, or none"))
-       (when (and (assq '#:whole-body-readers? key-args)
-                  (not (assq '#:read key-args)))
-         (err "got a #:whole-body-readers? without #:read and #:read-syntax"))
-       (quasisyntax/loc stx
-         (#%module-begin
-          #,@-body
-          (#%provide (rename *read read) (rename *read-syntax read-syntax))
-          (define-values (*read *read-syntax)
-            (let* ([rd  #,(get '#:read #'read)]
-                   [rds #,(get '#:read-syntax #'read-syntax)]
-                   [w1  #,(get '#:wrapper1 #'#f)]
-                   [w2  #,(get '#:wrapper2 #'#f)]
-                   [w2  (cond [(not w2) (lambda (in r _) (r in))]
-                              [(procedure-arity-includes? w2 3) w2]
-                              [else (lambda (in r _) (w2 in r))])]
-                   [base 'lib]
-                   [whole? #,(get '#:whole-body-readers? #'#f)])
-              (values
-               (lambda (in modpath line col pos)
-                 (w2 in
-                     (lambda (in)
-                       (wrap-internal base in rd whole?
-                                      w1 #f modpath #f line col pos))
-                     #f))
-               (lambda (src in modpath line col pos)
-                 (w2 in
-                     (lambda (in)
-                       (wrap-internal
-                        base in (lambda (in) (rds src in)) whole?
-                        w1 #t modpath src line col pos))
-                     #t))))))))]))
+       (when (and ~whole-body-readers? (not (and ~read ~read-syntax)))
+         (err "got a #:whole-body-readers? without #:read and #:read-syntax"))])
+    (quasisyntax/loc stx
+      (#%module-begin
+       #,@-body
+       (#%provide (rename *read read) (rename *read-syntax read-syntax))
+       (define-values (*read *read-syntax)
+         (let* ([rd  #,~read]
+                [rds #,~read-syntax]
+                [w1  #,~wrapper1]
+                [w2  #,~wrapper2]
+                [w2  (cond [(not w2) (lambda (in r _) (r in))]
+                           [(procedure-arity-includes? w2 3) w2]
+                           [else (lambda (in r _) (w2 in r))])]
+                [base '#,lib]
+                [whole? #,~whole-body-readers?])
+           (values
+            (lambda (in modpath line col pos)
+              (w2 in
+                  (lambda (in)
+                    (wrap-internal base in rd whole?
+                                   w1 #f modpath #f line col pos))
+                  #f))
+            (lambda (src in modpath line col pos)
+              (w2 in
+                  (lambda (in)
+                    (wrap-internal base in (lambda (in) (rds src in)) whole?
+                                   w1 #t modpath src line col pos))
+                  #t))))))))
+  (syntax-case stx ()
+    [(_ lib body ...) (construct-reader #'lib (syntax->list #'(body ...)))]))
 
 (define (wrap-internal lib port read whole? wrapper stx?
                        modpath src line col pos)