From e707b64db1ba82c58c3f18989a69aca4790107f1 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 30 Jul 2016 21:39:12 -0600
Subject: [PATCH] adjust `class` expansion patterns to be more flexible

Accomodate a potential changes to `syntax-parameterize`
and the way it's use by `class`, where the changes
mostly introduce some `#%expression` wrappers.
---
 .../typecheck/check-class-unit.rkt            | 24 ++++++++++++++-----
 1 file changed, 18 insertions(+), 6 deletions(-)

diff --git a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
index e7a3d34e..26d04627 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
@@ -107,16 +107,20 @@
            #:with private-field-names #'(private-fields ...)))
 
 (define-syntax-class initializer-body
-  #:literals (letrec-values let-values)
+  #:literals (letrec-values let-values #%expression)
   #:attributes (val)
   (pattern (letrec-values _ body:initializer-body)
            #:with val #'body.val)
   (pattern (let-values _ body:initializer-body)
            #:with val #'body.val)
+  (pattern (#%expression body:initializer-body)
+           #:with val #'body.val)
   (pattern (letrec-values _ e:expr ...)
            #:with val #'(e ...))
   (pattern (let-values _ e:expr ...)
-           #:with val #'(e ...)))
+           #:with val #'(e ...))
+  (pattern (#%expression e)
+           #:with val #'(e)))
 
 (define-syntax-class initializer-class
   #:literals (#%plain-lambda)
@@ -131,7 +135,7 @@
            #:with initializer-args-id #'init-args))
 
 (define-syntax-class make-methods-body
-  #:literals (let-values letrec-values #%plain-app values)
+  #:literals (let-values letrec-values #%plain-app #%expression values)
   #:attributes (initializer-body initializer-self-id
                 initializer-args-id)
   (pattern (letrec-values _
@@ -142,7 +146,8 @@
              augride:expr
              :initializer-class)))
   (pattern (let-values () :make-methods-body))
-  (pattern (letrec-values () :make-methods-body)))
+  (pattern (letrec-values () :make-methods-body))
+  (pattern (#%expression :make-methods-body)))
 
 (define-syntax-class make-methods-class
   #:literals (let-values #%plain-lambda)
@@ -151,7 +156,12 @@
   (pattern (#%plain-lambda
             (local-accessor:id local-mutator:id local-method-or-field:id ...)
             (let-values ([(field-name:id) accessor-or-mutator] ...)
-              :make-methods-body))))
+              :make-methods-body)))
+  (pattern (#%plain-lambda
+            (local-accessor:id local-mutator:id local-method-or-field:id ...)
+            (let-values ()
+              (let-values ([(field-name:id) accessor-or-mutator] ...)
+                :make-methods-body)))))
 
 (define-syntax-class core-class-expansion
   #:literals (let-values letrec-syntaxes+values #%plain-app quote)
@@ -1437,7 +1447,7 @@
                        (syntax->list stx-list))))
   (syntax-parse form
     #:literals (let-values letrec-values #%plain-app
-                #%plain-lambda)
+                #%plain-lambda #%expression)
     [stx
      #:when (accessor #'stx)
      (list form)]
@@ -1450,6 +1460,8 @@
      (recur-on-all #'(e ...))]
     [(#%plain-lambda (x ...) e ...)
      (recur-on-all #'(e ...))]
+    [(#%expression e)
+     (recur-on-all #'(e))]
     [_ '()]))
 
 ;; setup-pubment-defaults : Listof<Symbol> Hash Hash -> Void