From 1c299e99dbc34a0e14836107df1897ba52bf64af Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 24 Feb 2019 13:40:34 -0700
Subject: [PATCH] add some missing `syntax-protect`s

Add `syntax-protect` to some macro expansions, especially macros in
contex where unsafe operations are imported, which means that a
combination of `local-expand` and `datum->syntaxa could provide access
to the unsafe bindings absent `syntax-protect`.
---
 racket/collects/racket/private/case.rkt       |  98 +++--
 .../racket/private/class-internal.rkt         | 393 ++++++++++--------
 racket/collects/racket/private/classidmap.rkt |   3 +-
 .../collects/racket/private/define-struct.rkt |   6 +-
 racket/collects/racket/private/for.rkt        | 281 +++++++------
 racket/collects/racket/private/promise.rkt    |   6 +-
 .../collects/racket/private/vector-wraps.rkt  |  72 ++--
 racket/collects/racket/unit.rkt               | 117 +++---
 8 files changed, 527 insertions(+), 449 deletions(-)

diff --git a/racket/collects/racket/private/case.rkt b/racket/collects/racket/private/case.rkt
index d55e9b01fe..6e75034f82 100644
--- a/racket/collects/racket/private/case.rkt
+++ b/racket/collects/racket/private/case.rkt
@@ -12,24 +12,29 @@
   (define-syntax (case stx)
     (syntax-case stx (else)
       ;; Empty case
-      [(_ v) (syntax/loc stx (#%expression (begin v (void))))]
+      [(_ v)
+       (syntax-protect
+        (syntax/loc stx (#%expression (begin v (void)))))]
       
       ;; Else-only case
       [(_ v [else e es ...])
-       (syntax/loc stx (#%expression (begin v (let-values () e es ...))))]
+       (syntax-protect
+        (syntax/loc stx (#%expression (begin v (let-values () e es ...)))))]
       
       ;; If we have a syntactically correct form without an 'else' clause,
       ;; add the default 'else' and try again.
       [(self v [(k ...) e1 e2 ...] ...)
-       (syntax/loc stx (self v [(k ...) e1 e2 ...] ... [else (void)]))]
+       (syntax-protect
+        (syntax/loc stx (self v [(k ...) e1 e2 ...] ... [else (void)])))]
       
       ;; The general case
       [(_ v [(k ...) e1 e2 ...] ... [else x1 x2 ...])
-       (if (< (length (syntax-e #'(k ... ...))) *sequential-threshold*)
-           (syntax/loc stx (let ([tmp v])
-                             (case/sequential tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))
-           (syntax/loc stx (let ([tmp v])
-                             (case/dispatch   tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...]))))]
+       (syntax-protect
+        (if (< (length (syntax-e #'(k ... ...))) *sequential-threshold*)
+            (syntax/loc stx (let ([tmp v])
+                              (case/sequential tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))
+            (syntax/loc stx (let ([tmp v])
+                              (case/dispatch   tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))))]
       
       ;; Error cases
       [(_ v clause ...)
@@ -83,23 +88,27 @@
   (define-syntax (case/sequential stx)
     (syntax-case stx (else)
       [(_ v [(k ...) es ...] arms ... [else xs ...])
-       #'(if (case/sequential-test v (k ...))
-             (let-values () es ...)
-             (case/sequential v arms ... [else xs ...]))]
+       (syntax-protect
+        #'(if (case/sequential-test v (k ...))
+              (let-values () es ...)
+              (case/sequential v arms ... [else xs ...])))]
       [(_ v [(k ...) es ...] [else xs ...])
-       #'(if (case/sequential-test v (k ...))
-             (let-values () es ...)
-             (let-values () xs ...))]
+       (syntax-protect
+        #'(if (case/sequential-test v (k ...))
+              (let-values () es ...)
+              (let-values () xs ...)))]
       [(_ v [else xs ...])
-       #'(let-values () xs ...)]))
+       (syntax-protect
+        #'(let-values () xs ...))]))
   
   (define-syntax (case/sequential-test stx)
-    (syntax-case stx ()
-      [(_ v ())         #'#f]
-      [(_ v (k))        #`(equal? v 'k)]
-      [(_ v (k ks ...)) #`(if (equal? v 'k)
-                              #t
-                              (case/sequential-test v (ks ...)))]))
+    (syntax-protect
+     (syntax-case stx ()
+       [(_ v ())         #'#f]
+       [(_ v (k))        #`(equal? v 'k)]
+       [(_ v (k ks ...)) #`(if (equal? v 'k)
+                               #t
+                               (case/sequential-test v (ks ...)))])))
   
   ;; Triple-dispatch case:
   ;; (1) From the type of the value to a type-specific mechanism for
@@ -109,29 +118,30 @@
   (define-syntax (case/dispatch stx)
     (syntax-case stx (else)
       [(_ v [(k ...) es ...] ... [else xs ...])
-       #`(let ([index
-                #,(let* ([ks  (partition-constants #'((k ...) ...))]
-                         [exp #'0]
-                         [exp (if (null? (consts-other ks))
-                                  exp
-                                  (dispatch-other #'v (consts-other ks) exp))]
-                         [exp (if (null? (consts-char ks))
-                                  exp
-                                  #`(if (char? v)
-                                        #,(dispatch-char #'v (consts-char ks))
-                                        #,exp))]
-                         [exp (if (null? (consts-symbol ks))
-                                  exp
-                                  #`(if #,(test-for-symbol #'v (consts-symbol ks))
-                                        #,(dispatch-symbol #'v (consts-symbol ks) #'0)
-                                        #,exp))]
-                         [exp (if (null? (consts-fixnum ks))
-                                  exp
-                                  #`(if (fixnum? v)
-                                        #,(dispatch-fixnum #'v (consts-fixnum ks))
-                                        #,exp))])
-                    exp)])
-           #,(index-binary-search #'index #'([xs ...] [es ...] ...)))]))
+       (syntax-protect
+        #`(let ([index
+                 #,(let* ([ks  (partition-constants #'((k ...) ...))]
+                          [exp #'0]
+                          [exp (if (null? (consts-other ks))
+                                   exp
+                                   (dispatch-other #'v (consts-other ks) exp))]
+                          [exp (if (null? (consts-char ks))
+                                   exp
+                                   #`(if (char? v)
+                                         #,(dispatch-char #'v (consts-char ks))
+                                         #,exp))]
+                          [exp (if (null? (consts-symbol ks))
+                                   exp
+                                   #`(if #,(test-for-symbol #'v (consts-symbol ks))
+                                         #,(dispatch-symbol #'v (consts-symbol ks) #'0)
+                                         #,exp))]
+                          [exp (if (null? (consts-fixnum ks))
+                                   exp
+                                   #`(if (fixnum? v)
+                                         #,(dispatch-fixnum #'v (consts-fixnum ks))
+                                         #,exp))])
+                     exp)])
+            #,(index-binary-search #'index #'([xs ...] [es ...] ...))))]))
 
     
   (begin-for-syntax
diff --git a/racket/collects/racket/private/class-internal.rkt b/racket/collects/racket/private/class-internal.rkt
index 4cae922419..b4bbf6c175 100644
--- a/racket/collects/racket/private/class-internal.rkt
+++ b/racket/collects/racket/private/class-internal.rkt
@@ -32,52 +32,53 @@
          ;; needed for Typed Racket
          (protect-out do-make-object find-method/who))
 (define-syntax (provide-public-names stx)
-  (datum->syntax
-   stx
-   '(provide class class* class/derived
-            define-serializable-class define-serializable-class*
-            class? 
-            mixin
-            interface interface* interface?
-            object% object? externalizable<%> printable<%> writable<%> equal<%>
-            object=? object-or-false=? object=-hash-code
-            new make-object instantiate
-            send send/apply send/keyword-apply send* send+ dynamic-send
-            class-field-accessor class-field-mutator with-method
-            get-field set-field! field-bound? field-names
-            dynamic-get-field dynamic-set-field!
-            private* public*  pubment*
-            override* overment*
-            augride* augment*
-            public-final* override-final* augment-final*
-            define/private define/public define/pubment
-            define/override define/overment
-            define/augride define/augment
-            define/public-final define/override-final define/augment-final
-            define-local-member-name define-member-name 
-            member-name-key generate-member-key 
-            member-name-key? member-name-key=? member-name-key-hash-code
-            generic make-generic send-generic
-            is-a? subclass? implementation? interface-extension?
-            object-interface object-info object->vector
-            object-method-arity-includes?
-            method-in-interface? interface->method-names class->interface class-info
-            (struct-out exn:fail:object)
-            make-primitive-class
-            class/c ->m ->*m ->dm case->m object/c instanceof/c
-            dynamic-object/c
-            class-seal class-unseal
-           
-           ;; "keywords":
-            private public override augment
-            pubment overment augride
-            public-final override-final augment-final
-            field init init-field init-rest
-            rename-super rename-inner inherit inherit/super inherit/inner inherit-field
-            this this% super inner
-            super-make-object super-instantiate super-new
-            inspect absent abstract)
-   stx))
+  (class-syntax-protect
+   (datum->syntax
+    stx
+    '(provide class class* class/derived
+              define-serializable-class define-serializable-class*
+              class? 
+              mixin
+              interface interface* interface?
+              object% object? externalizable<%> printable<%> writable<%> equal<%>
+              object=? object-or-false=? object=-hash-code
+              new make-object instantiate
+              send send/apply send/keyword-apply send* send+ dynamic-send
+              class-field-accessor class-field-mutator with-method
+              get-field set-field! field-bound? field-names
+              dynamic-get-field dynamic-set-field!
+              private* public*  pubment*
+              override* overment*
+              augride* augment*
+              public-final* override-final* augment-final*
+              define/private define/public define/pubment
+              define/override define/overment
+              define/augride define/augment
+              define/public-final define/override-final define/augment-final
+              define-local-member-name define-member-name 
+              member-name-key generate-member-key 
+              member-name-key? member-name-key=? member-name-key-hash-code
+              generic make-generic send-generic
+              is-a? subclass? implementation? interface-extension?
+              object-interface object-info object->vector
+              object-method-arity-includes?
+              method-in-interface? interface->method-names class->interface class-info
+              (struct-out exn:fail:object)
+              make-primitive-class
+              class/c ->m ->*m ->dm case->m object/c instanceof/c
+              dynamic-object/c
+              class-seal class-unseal
+              
+              ;; "keywords":
+              private public override augment
+              pubment overment augride
+              public-final override-final augment-final
+              field init init-field init-rest
+              rename-super rename-inner inherit inherit/super inherit/inner inherit-field
+              this this% super inner
+              super-make-object super-instantiate super-new
+              inspect absent abstract)
+    stx)))
 
 ;;--------------------------------------------------------------------
 ;;  keyword setup
@@ -104,9 +105,10 @@
                                  (if (identifier? e)
                                      e
                                      (syntax-property e 'taint-mode 'transparent)))])
-       (syntax-property (syntax/loc stx (internal-id elem ...))
-                        'taint-mode
-                        'transparent))]))
+       (class-syntax-protect
+        (syntax-property (syntax/loc stx (internal-id elem ...))
+                         'taint-mode
+                         'transparent)))]))
 
 (define-syntax provide-renaming-class-keyword
   (syntax-rules ()
@@ -140,9 +142,10 @@
   (syntax-case stx ()
     [(_ elem ...)
      (with-syntax ([internal-id internal-id])
-       (syntax-property (syntax/loc stx (internal-id elem ...))
-                        'taint-mode
-                        'transparent))]))
+       (class-syntax-protect
+        (syntax-property (syntax/loc stx (internal-id elem ...))
+                         'taint-mode
+                         'transparent)))]))
 
 (define-syntax provide-naming-class-keyword
   (syntax-rules ()
@@ -1530,6 +1533,7 @@
                                                          #'(current-inspector))]
                                           [deserialize-id-expr deserialize-id-expr]
                                           [private-field-names private-field-names])
+                              (class-syntax-protect
                               (add-decl-props
                               (quasisyntax/loc stx
                                 (detect-field-unsafe-undefined
@@ -1712,7 +1716,7 @@
                                    ;; Extra argument added here by `detect-field-unsafe-undefined`
                                    #; check-undef?
                                    ;; Not primitive:
-                                   #f))))))))))))))))
+                                   #f)))))))))))))))))
     
     ;; The class* and class entry points:
     (values
@@ -1772,36 +1776,39 @@
                                           #`((runtime-require (submod "." deserialize-info))
                                              (module+ deserialize-info (provide #,deserialize-name-info)))
                                           #'())])
-         #'(begin
-             (define-values (name deserialize-name-info)
-               (class/derived orig-stx [name
-                                        super-expression 
-                                        (interface-expr ...)
-                                        #'deserialize-name-info]
-                              defn-or-expr ...))
-             provision ...)))]))
+         (class-syntax-protect
+          #'(begin
+              (define-values (name deserialize-name-info)
+                (class/derived orig-stx [name
+                                         super-expression 
+                                         (interface-expr ...)
+                                         #'deserialize-name-info]
+                  defn-or-expr ...))
+              provision ...))))]))
 
 (define-syntax (define-serializable-class* stx)
   (syntax-case stx ()
     [(_ name super-expression (interface-expr ...)
         defn-or-expr ...)
      (with-syntax ([orig-stx stx])
-       #'(-define-serializable-class orig-stx
-                                     name
-                                     super-expression
-                                     (interface-expr ...)
-                                     defn-or-expr ...))]))
+       (class-syntax-protect
+        #'(-define-serializable-class orig-stx
+                                      name
+                                      super-expression
+                                      (interface-expr ...)
+                                      defn-or-expr ...)))]))
 
 (define-syntax (define-serializable-class stx)
   (syntax-case stx ()
     [(_ name super-expression
         defn-or-expr ...)
      (with-syntax ([orig-stx stx])
-       #'(-define-serializable-class orig-stx
-                                     name
-                                     super-expression
-                                     ()
-                                     defn-or-expr ...))]))
+       (class-syntax-protect
+        #'(-define-serializable-class orig-stx
+                                      name
+                                      super-expression
+                                      ()
+                                      defn-or-expr ...)))]))
 
 (define-syntaxes (private* public* pubment* override* overment* augride* augment*
                            public-final* override-final* augment-final*)
@@ -1833,11 +1840,12 @@
                     (with-syntax ([(name ...) (map car name-exprs)]
                                   [(expr ...) (map cdr name-exprs)]
                                   [decl-form decl-form])
-                      (syntax
-                       (begin
-                         (decl-form name ...)
-                         (define name expr)
-                         ...)))))])))])
+                      (class-syntax-protect
+                       (syntax
+                        (begin
+                          (decl-form name ...)
+                          (define name expr)
+                          ...))))))])))])
     (values
      (mk 'private* (syntax private))
      (mk 'public* (syntax public))
@@ -1863,10 +1871,11 @@
                 "use of a class keyword is not in a class top-level"
                 stx))
              (let-values ([(id rhs) (normalize-definition stx #'lambda #f #t)])
-               (quasisyntax/loc stx
-                 (begin
-                   (#,decl-form #,id)
-                   (define #,id #,rhs))))))])
+               (class-syntax-protect
+                (quasisyntax/loc stx
+                  (begin
+                    (#,decl-form #,id)
+                    (define #,id #,rhs)))))))])
     (values
      (mk #'private)
      (mk #'public)
@@ -1910,11 +1919,12 @@
                               (define-syntaxes (id ...)
                                 (values (make-private-name (quote-syntax id) (quote-syntax gen-id))
                                         ...)))])
-               (syntax/loc stx
-                 (begin
-                   (define-values (gen-id ...)
-                     (values (generate-local-member-name 'id) ...))
-                   stx-defs))))))]))
+               (class-syntax-protect
+                (syntax/loc stx
+                  (begin
+                    (define-values (gen-id ...)
+                      (values (generate-local-member-name 'id) ...))
+                    stx-defs)))))))]))
 
 (define-syntax (define-member-name stx)
   (syntax-case stx ()
@@ -1932,9 +1942,10 @@
                         (define-syntax id
                           (make-private-name (quote-syntax id) 
                                              ((syntax-local-certifier) (quote-syntax member-name)))))])
-         #'(begin
-             (define member-name (check-member-key 'id expr))
-             stx-def)))]))
+         (class-syntax-protect
+          #'(begin
+              (define member-name (check-member-key 'id expr))
+              stx-def))))]))
 
 (define (generate-local-member-name id)
   (string->uninterned-symbol
@@ -1965,7 +1976,8 @@
     [(_ id)
      (identifier? #'id)
      (with-syntax ([id (localize #'id)])
-       (syntax/loc stx (make-member-key `id)))]
+       (class-syntax-protect
+        (syntax/loc stx (make-member-key `id))))]
     [(_ x)
      (raise-syntax-error
       #f
@@ -3087,15 +3099,15 @@ An example
          (with-syntax ([name (datum->syntax #f name #f)]
                        [(var ...) (map localize vars)]
                        [((v c) ...) (filter (λ (p) (cadr p)) (map list vars ctcs))])
-           (syntax/loc
-               stx
-             (compose-interface
-              'name
-              (list interface-expr ...)
-              `(var ...)
-              (make-immutable-hash (list (cons 'v c) ...))
-              (list prop ...)
-              (list prop-val ...)))))])))
+           (class-syntax-protect
+            (syntax/loc stx
+              (compose-interface
+               'name
+               (list interface-expr ...)
+               `(var ...)
+               (make-immutable-hash (list (cons 'v c) ...))
+               (list prop ...)
+               (list prop-val ...))))))])))
 
 (define-syntax (_interface stx)
   (syntax-case stx ()
@@ -3310,8 +3322,9 @@ An example
   (syntax-case stx ()
     [(_ cls (id arg) ...)
      (andmap identifier? (syntax->list (syntax (id ...))))
-     (quasisyntax/loc stx
-       (instantiate cls () (id arg) ...))]
+     (class-syntax-protect
+      (quasisyntax/loc stx
+        (instantiate cls () (id arg) ...)))]
     [(_ cls (id arg) ...)
      (for-each (lambda (id)
                  (unless (identifier? id)
@@ -3334,21 +3347,24 @@ An example
      (syntax-case stx ()
              [id
               (identifier? #'id)
-              (quasisyntax/loc stx
-                (make-object/proc (current-contract-region)))]
+              (class-syntax-protect
+               (quasisyntax/loc stx
+                 (make-object/proc (current-contract-region))))]
              [(_ class arg ...)
-              (quasisyntax/loc stx
-                (do-make-object
-                 (current-contract-region)
-                 class (list arg ...) (list)))]
+              (class-syntax-protect
+               (quasisyntax/loc stx
+                 (do-make-object
+                  (current-contract-region)
+                  class (list arg ...) (list))))]
              [(_) (raise-syntax-error 'make-object "expected class" stx)]))))
 
 (define-syntax (instantiate stx)
   (syntax-case stx ()
     [(form class (arg ...) . x)
      (with-syntax ([orig-stx stx])
-       (quasisyntax/loc stx 
-         (-instantiate do-make-object orig-stx #t (class) (list arg ...) . x)))]))
+       (class-syntax-protect
+        (quasisyntax/loc stx 
+          (-instantiate do-make-object orig-stx #t (class) (list arg ...) . x))))]))
 
 ;; Helper; used by instantiate and super-instantiate
 (define-syntax -instantiate
@@ -3358,12 +3374,13 @@ An example
        (andmap identifier? (syntax->list (syntax (kw ...))))
        (with-syntax ([(kw ...) (map localize (syntax->list (syntax (kw ...))))]
                      [(blame ...) (if (syntax-e #'first?) #'((current-contract-region)) null)])
-         (syntax/loc stx
-           (do-make-object blame ...
-                           maker-arg ...
-                           args
-                           (list (cons `kw arg)
-                                 ...))))]
+         (class-syntax-protect
+          (syntax/loc stx
+            (do-make-object blame ...
+                            maker-arg ...
+                            args
+                            (list (cons `kw arg)
+                                  ...)))))]
       [(_ super-make-object orig-stx first? (make-arg ...) args kwarg ...)
        ;; some kwarg must be bad:
        (for-each (lambda (kwarg)
@@ -3744,22 +3761,23 @@ An example
              (set! let-bindings (cons #`[#,var #,x] let-bindings))]))
         (set! arg-list (reverse arg-list))
         (set! let-bindings (reverse let-bindings))
-        
-        (syntax-property
-         (quasisyntax/loc stx
-          (let*-values ([(sym) (quasiquote (unsyntax (localize name)))]
-                        [(receiver) (unsyntax obj)]
-                        [(method) (find-method/who '(unsyntax form) receiver sym)])
-            (let (#,@(if kw-args
-                         (list #`[kw-arg-tmp #,(cadr kw-args)])
-                         (list))
-                  #,@let-bindings)
-              (unsyntax
-               (make-method-call-to-possibly-wrapped-object
-                stx kw-args/var arg-list rest-arg?
-                #'sym #'method #'receiver
-                (quasisyntax/loc stx (find-method/who '(unsyntax form) receiver sym)))))))
-         'feature-profile:send-dispatch #t)))
+
+        (class-syntax-protect
+         (syntax-property
+          (quasisyntax/loc stx
+            (let*-values ([(sym) (quasiquote (unsyntax (localize name)))]
+                          [(receiver) (unsyntax obj)]
+                          [(method) (find-method/who '(unsyntax form) receiver sym)])
+              (let (#,@(if kw-args
+                           (list #`[kw-arg-tmp #,(cadr kw-args)])
+                           (list))
+                    #,@let-bindings)
+                (unsyntax
+                 (make-method-call-to-possibly-wrapped-object
+                  stx kw-args/var arg-list rest-arg?
+                  #'sym #'method #'receiver
+                  (quasisyntax/loc stx (find-method/who '(unsyntax form) receiver sym)))))))
+          'feature-profile:send-dispatch #t))))
     
     (define (core-send apply? kws?)
       (lambda (stx)
@@ -3830,18 +3848,19 @@ An example
 (define-syntax (send* stx)
   (syntax-case stx ()
     [(form obj clause ...)
-     (quasisyntax/loc stx
-       (let* ([o obj])
-         (unsyntax-splicing
-          (map
-           (lambda (clause-stx)
-             (syntax-case clause-stx ()
-               [(meth . args)
-                (quasisyntax/loc stx
-                  (send o meth . args))]
-               [_ (raise-syntax-error
-                   #f "bad method call" stx clause-stx)]))
-           (syntax->list (syntax (clause ...)))))))]))
+     (class-syntax-protect
+      (quasisyntax/loc stx
+        (let* ([o obj])
+          (unsyntax-splicing
+           (map
+            (lambda (clause-stx)
+              (syntax-case clause-stx ()
+                [(meth . args)
+                 (quasisyntax/loc stx
+                   (send o meth . args))]
+                [_ (raise-syntax-error
+                    #f "bad method call" stx clause-stx)]))
+            (syntax->list (syntax (clause ...))))))))]))
 
 ;; functional chained send
 (define-syntax (send+ stx)
@@ -3850,10 +3869,12 @@ An example
     (pattern [name:id . args]))
   (syntax-parse stx
     [(_ obj:expr clause-0:send-clause clause:send-clause ...)
-     (quasisyntax/loc stx
-       (let ([o (send obj clause-0.name . clause-0.args)])
-         (send+ o clause ...)))]
-    [(_ obj:expr) (syntax/loc stx obj)]))
+     (class-syntax-protect
+      (quasisyntax/loc stx
+        (let ([o (send obj clause-0.name . clause-0.args)])
+          (send+ o clause ...))))]
+    [(_ obj:expr) (class-syntax-protect
+                   (syntax/loc stx obj))]))
 
 ;; find-method/who : symbol[top-level-form/proc-name]
 ;;                   any[object] 
@@ -4019,17 +4040,18 @@ An example
             [flat-stx (if proper? args-stx (flatten-args args-stx))])
        (with-syntax ([(gen obj)
                       (generate-temporaries (syntax (generic object)))])
-         (quasisyntax/loc stx
-           (let* ([obj object]
-                  [gen generic])
-             ;(check-generic gen)
-             (unsyntax
-              (make-method-call-to-possibly-wrapped-object
-               stx #f flat-stx (not proper?)
-               #'(generic-name gen) 
-               #'((generic-applicable gen) obj) 
-               #'obj
-               #'((generic-applicable gen) obj)))))))]))
+         (class-syntax-protect
+          (quasisyntax/loc stx
+            (let* ([obj object]
+                   [gen generic])
+              ;(check-generic gen)
+              (unsyntax
+               (make-method-call-to-possibly-wrapped-object
+                stx #f flat-stx (not proper?)
+                #'(generic-name gen) 
+                #'((generic-applicable gen) obj) 
+                #'obj
+                #'((generic-applicable gen) obj))))))))]))
 
 (define (check-generic gen)
   (unless (generic? gen)
@@ -4050,7 +4072,8 @@ An example
                      name))
                   (with-syntax ([name (localize name)]
                                 [make make])
-                    (syntax/loc stx (make class-expr `name))))]
+                    (class-syntax-protect
+                     (syntax/loc stx (make class-expr `name)))))]
                [(_ class-expr)
                 (raise-syntax-error
                  #f
@@ -4067,7 +4090,8 @@ An example
     [(_ name obj val)
      (identifier? #'name)
      (with-syntax ([localized (localize #'name)])
-       (syntax/loc stx (set-field!/proc `localized obj val)))]
+       (class-syntax-protect
+        (syntax/loc stx (set-field!/proc `localized obj val))))]
     [(_ name obj val)
      (raise-syntax-error
       'set-field! "expected a field name as first argument"
@@ -4121,7 +4145,8 @@ An example
     [(_ name obj)
      (identifier? (syntax name))
      (with-syntax ([localized (localize (syntax name))])
-       (syntax/loc stx (get-field/proc `localized obj)))]
+       (class-syntax-protect
+        (syntax/loc stx (get-field/proc `localized obj))))]
     [(_ name obj)
      (raise-syntax-error
       'get-field "expected a field name as first argument"
@@ -4175,7 +4200,8 @@ An example
     [(_ name obj)
      (identifier? (syntax name))
      (with-syntax ([localized (localize (syntax name))])
-       (syntax (field-bound?/proc `localized obj)))]
+       (class-syntax-protect
+        (syntax (field-bound?/proc `localized obj))))]
     [(_ name obj)
      (raise-syntax-error
       'field-bound? "expected a field name as first argument"
@@ -4223,19 +4249,20 @@ An example
        (with-syntax ([(method ...) (generate-temporaries ids)]
                      [(method-obj ...) (generate-temporaries ids)]
                      [(name ...) (map localize names)])
-         (syntax/loc stx (let-values ([(method method-obj)
-                                       (let ([obj obj-expr])
-                                         (values (find-method/who 'with-method obj `name)
-                                                 obj))]
-                                      ...)
-                           (letrec-syntaxes+values ([(id) (make-with-method-map
-                                                           (quote-syntax set!)
-                                                           (quote-syntax id)
-                                                           (quote-syntax method)
-                                                           (quote-syntax method-obj))]
-                                                    ...)
-                             ()
-                             body0 body1 ...)))))]
+         (class-syntax-protect
+          (syntax/loc stx (let-values ([(method method-obj)
+                                        (let ([obj obj-expr])
+                                          (values (find-method/who 'with-method obj `name)
+                                                  obj))]
+                                       ...)
+                            (letrec-syntaxes+values ([(id) (make-with-method-map
+                                                            (quote-syntax set!)
+                                                            (quote-syntax id)
+                                                            (quote-syntax method)
+                                                            (quote-syntax method-obj))]
+                                                     ...)
+                                                    ()
+                              body0 body1 ...))))))]
     ;; Error cases:
     [(_ (clause ...) . body)
      (begin
@@ -4783,16 +4810,16 @@ An example
                             (λ (super%)
                               (check-mixin-super mixin-name super% (list from-ids ...))
                               class-expr))])
-             
              ;; Finally, build the complete mixin expression:
-             (syntax/loc stx
-               (let ([from-ids from] ...)
-                 (let ([to-ids to] ...)
-                   (check-mixin-from-interfaces (list from-ids ...))
-                   (check-mixin-to-interfaces (list to-ids ...))
-                   (check-interface-includes (list (quasiquote super-vars) ...)
-                                             (list from-ids ...))
-                   mixin-expr)))))))]))
+             (class-syntax-protect
+              (syntax/loc stx
+                (let ([from-ids from] ...)
+                  (let ([to-ids to] ...)
+                    (check-mixin-from-interfaces (list from-ids ...))
+                    (check-mixin-to-interfaces (list to-ids ...))
+                    (check-interface-includes (list (quasiquote super-vars) ...)
+                                              (list from-ids ...))
+                    mixin-expr))))))))]))
 
 (define externalizable<%>
   (_interface () externalize internalize))
diff --git a/racket/collects/racket/private/classidmap.rkt b/racket/collects/racket/private/classidmap.rkt
index 5ca2ad921e..7de2bc30e8 100644
--- a/racket/collects/racket/private/classidmap.rkt
+++ b/racket/collects/racket/private/classidmap.rkt
@@ -466,4 +466,5 @@
                       make-method-call-to-possibly-wrapped-object
                       do-localize make-private-name
                       generate-super-call generate-inner-call
-                      generate-class-expand-context class-top-level-context?))
+                      generate-class-expand-context class-top-level-context?
+                      class-syntax-protect))
diff --git a/racket/collects/racket/private/define-struct.rkt b/racket/collects/racket/private/define-struct.rkt
index 973421d8c7..9e13a56977 100644
--- a/racket/collects/racket/private/define-struct.rkt
+++ b/racket/collects/racket/private/define-struct.rkt
@@ -515,8 +515,10 @@
                                                    (if (struct-type? the-super)
                                                        the-super
                                                        (check-struct-type 'fm the-super)))))]
-                       [prune (lambda (stx) (identifier-prune-lexical-context stx
-                                                                              (list (syntax-e stx) '#%top)))]
+                       [prune (lambda (stx)
+                                (syntax-protect
+                                 (identifier-prune-lexical-context stx
+                                                                   (list (syntax-e stx) '#%top))))]
                        [reflect-name-expr (if reflect-name-expr
                                               (syntax-case reflect-name-expr (quote)
                                                 [(quote id)
diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt
index c8b2750e43..7e952c22ce 100644
--- a/racket/collects/racket/private/for.rkt
+++ b/racket/collects/racket/private/for.rkt
@@ -1442,20 +1442,23 @@
          (cond
           [(null? l) 
            ;; No #:break form
-           #'(inner-recur fold-vars (let-values () expr ...) (if final?-id break-k next-k))]
+           (syntax-protect
+            #'(inner-recur fold-vars (let-values () expr ...) (if final?-id break-k next-k)))]
           [(eq? '#:break (syntax-e (car l)))
            ;; Found a #:break form
-           #`(let-values ()
-               #,@(reverse pre-accum)
-               (if #,(cadr l)
-                   break-k
-                   (push-under-break inner-recur fold-vars #,(cddr l) next-k break-k final?-id)))]
+           (syntax-protect
+            #`(let-values ()
+                #,@(reverse pre-accum)
+                (if #,(cadr l)
+                    break-k
+                    (push-under-break inner-recur fold-vars #,(cddr l) next-k break-k final?-id))))]
           [(eq? '#:final (syntax-e (car l)))
            ;; Found a #:final form
-           #`(let-values ()
-               #,@(reverse pre-accum)
-               (let ([final? (or #,(cadr l) final?-id)])
-                 (push-under-break inner-recur fold-vars #,(cddr l) next-k break-k final?)))]
+           (syntax-protect
+            #`(let-values ()
+                #,@(reverse pre-accum)
+                (let ([final? (or #,(cadr l) final?-id)])
+                  (push-under-break inner-recur fold-vars #,(cddr l) next-k break-k final?))))]
           [else (loop (cdr l) (cons (car l) pre-accum))]))]))
 
   (define-syntax (for/foldX/derived stx)
@@ -1465,15 +1468,18 @@
           expr1 expr ...)
        (if (syntax-e #'inner-recur)
            ;; General, non-nested-loop approach:
-           #`(let ([fold-var fold-init] ...)
-               (push-under-break inner-recur (fold-var ...) [expr1 expr ...] next-k break-k final?-id))
+           (syntax-protect
+            #`(let ([fold-var fold-init] ...)
+                (push-under-break inner-recur (fold-var ...) [expr1 expr ...] next-k break-k final?-id)))
            ;; Nested-loop approach (which is slightly faster when it works):
-           #`(let ([fold-var fold-init] ...)
-               (let-values ([(fold-var ...) (let () expr1 expr ...)])
-                 (values fold-var ...))))]
+           (syntax-protect
+            #`(let ([fold-var fold-init] ...)
+                (let-values ([(fold-var ...) (let () expr1 expr ...)])
+                  (values fold-var ...)))))]
       ;; Switch-to-emit case (no more clauses to generate):
       [(_ [orig-stx inner-recur nested? #f binds] fold-bind next-k break-k final?-id () . body)
-       #`(for/foldX/derived [orig-stx inner-recur nested? #t binds] fold-bind next-k break-k final?-id () . body)]
+       (syntax-protect
+        #`(for/foldX/derived [orig-stx inner-recur nested? #t binds] fold-bind next-k break-k final?-id () . body))]
       ;; Emit case:
       [(_ [orig-stx inner-recur nested? #t binds] ([fold-var fold-init] ...) next-k break-k final?-id rest expr1 . body)
        (with-syntax ([(([outer-binding ...]
@@ -1484,37 +1490,38 @@
                         pre-guard
                         post-guard
                         [loop-arg ...]) ...) (reverse (syntax->list #'binds))])
-         (quasisyntax/loc #'orig-stx
-           (let-values (outer-binding ... ...)
-             outer-check ...
-             #,(quasisyntax/loc #'orig-stx
-                 (let for-loop ([fold-var fold-init] ...
-                                loop-binding ... ...)
-                   (if (and pos-guard ...)
-                       (let-values (inner-binding ... ...)
-                         (if (and pre-guard ...)
-                             #,(if (syntax-e #'inner-recur)
-                                   ;; The general non-nested-loop approach:
-                                   #'(let ([post-guard-var (lambda (fold-var ...) (and post-guard ...))])
-                                       (for/foldX/derived [orig-stx inner-recur nested? #f ()]
-                                                          ([fold-var fold-var] ...)
-                                                          (if (post-guard-var fold-var ...)
-                                                              (for-loop fold-var ... loop-arg ... ...)
-                                                              next-k)
-                                                          break-k final?-id
-                                                          rest expr1 . body))
-                                   ;; The specialized nested-loop approach, which is
-                                   ;; slightly faster when it works:
-                                   #'(let-values ([(fold-var ...)
-                                                   (for/foldX/derived [orig-stx inner-recur nested? #f ()]
-                                                                      ([fold-var fold-var] ...)
-                                                                      next-k break-k final?-id
-                                                                      rest expr1 . body)])
-                                       (if (and post-guard ... (not final?-id))
-                                           (for-loop fold-var ... loop-arg ... ...)
-                                           next-k)))
-                             next-k))
-                       next-k))))))]
+         (syntax-protect
+          (quasisyntax/loc #'orig-stx
+            (let-values (outer-binding ... ...)
+              outer-check ...
+              #,(quasisyntax/loc #'orig-stx
+                  (let for-loop ([fold-var fold-init] ...
+                                                      loop-binding ... ...)
+                    (if (and pos-guard ...)
+                        (let-values (inner-binding ... ...)
+                          (if (and pre-guard ...)
+                              #,(if (syntax-e #'inner-recur)
+                                    ;; The general non-nested-loop approach:
+                                    #'(let ([post-guard-var (lambda (fold-var ...) (and post-guard ...))])
+                                        (for/foldX/derived [orig-stx inner-recur nested? #f ()]
+                                                           ([fold-var fold-var] ...)
+                                                           (if (post-guard-var fold-var ...)
+                                                               (for-loop fold-var ... loop-arg ... ...)
+                                                               next-k)
+                                                           break-k final?-id
+                                                           rest expr1 . body))
+                                    ;; The specialized nested-loop approach, which is
+                                    ;; slightly faster when it works:
+                                    #'(let-values ([(fold-var ...)
+                                                    (for/foldX/derived [orig-stx inner-recur nested? #f ()]
+                                                                       ([fold-var fold-var] ...)
+                                                                       next-k break-k final?-id
+                                                                       rest expr1 . body)])
+                                        (if (and post-guard ... (not final?-id))
+                                            (for-loop fold-var ... loop-arg ... ...)
+                                            next-k)))
+                              next-k))
+                        next-k)))))))]
       ;; Bad body cases:
       [(_ [orig-stx . _] fold-bind next-k break-k final?-id ())
        (raise-syntax-error
@@ -1524,43 +1531,49 @@
         #f "bad syntax (illegal use of `.') after sequence bindings" #'orig-stx)]
       ;; Guard case, no pending emits:
       [(_ [orig-stx inner-recur nested? #f ()] ([fold-var fold-init] ...) next-k break-k final?-id (#:when expr . rest) . body)
-       #'(let ([fold-var fold-init] ...)
-           (if expr
-               (for/foldX/derived [orig-stx inner-recur nested? #f ()]
-                                  ([fold-var fold-var] ...) next-k break-k final?-id rest . body)
-               next-k))]
+       (syntax-protect
+        #'(let ([fold-var fold-init] ...)
+            (if expr
+                (for/foldX/derived [orig-stx inner-recur nested? #f ()]
+                                   ([fold-var fold-var] ...) next-k break-k final?-id rest . body)
+                next-k)))]
       ;; Negative guard case, no pending emits:
       [(_ [orig-stx inner-recur nested? #f ()] ([fold-var fold-init] ...) next-k break-k final?-id (#:unless expr . rest) . body)
-       #'(let ([fold-var fold-init] ...)
-           (if expr
-               (if final?-id break-k next-k)
-               (for/foldX/derived [orig-stx inner-recur nested? #f ()]
-                                  ([fold-var fold-var] ...) next-k break-k final?-id rest . body)))]
+       (syntax-protect
+        #'(let ([fold-var fold-init] ...)
+            (if expr
+                (if final?-id break-k next-k)
+                (for/foldX/derived [orig-stx inner-recur nested? #f ()]
+                                   ([fold-var fold-var] ...) next-k break-k final?-id rest . body))))]
       ;; Break case, no pending emits:
       [(_ [orig-stx inner-recur nested? #f ()] ([fold-var fold-init] ...) next-k break-k final?-id (#:break expr . rest) . body)
-       #'(let ([fold-var fold-init] ...)
-           (if expr
-               break-k
-               (for/foldX/derived [orig-stx inner-recur nested? #f ()]
-                                  ([fold-var fold-var] ...) next-k break-k final?-id rest . body)))]
+       (syntax-protect
+        #'(let ([fold-var fold-init] ...)
+            (if expr
+                break-k
+                (for/foldX/derived [orig-stx inner-recur nested? #f ()]
+                                   ([fold-var fold-var] ...) next-k break-k final?-id rest . body))))]
       ;; Final case, no pending emits:
       [(_ [orig-stx inner-recur nested? #f ()] ([fold-var fold-init] ...) next-k break-k final?-id (#:final expr . rest) . body)
-       #'(let ([fold-var fold-init] ...)
-           (let ([final? (or expr final?-id)])
-             (for/foldX/derived [orig-stx inner-recur nested? #f ()]
-                                ([fold-var fold-var] ...) next-k break-k final? rest . body)))]
+       (syntax-protect
+        #'(let ([fold-var fold-init] ...)
+            (let ([final? (or expr final?-id)])
+              (for/foldX/derived [orig-stx inner-recur nested? #f ()]
+                                 ([fold-var fold-var] ...) next-k break-k final? rest . body))))]
       ;; Keyword case, pending emits need to be flushed first
       [(frm [orig-stx inner-recur nested? #f binds] ([fold-var fold-init] ...) next-k break-k final?-id (kw expr . rest) . body)
        (or (eq? (syntax-e #'kw) '#:when)
            (eq? (syntax-e #'kw) '#:unless)
            (eq? (syntax-e #'kw) '#:break)
            (eq? (syntax-e #'kw) '#:final))
-       #'(frm [orig-stx inner-recur nested? #t binds] ([fold-var fold-init] ...) next-k break-k final?-id (kw expr . rest) . body)]
+       (syntax-protect
+        #'(frm [orig-stx inner-recur nested? #t binds] ([fold-var fold-init] ...) next-k break-k final?-id (kw expr . rest) . body))]
       ;; Convert single-value form to multi-value form:
       [(_ [orig-stx inner-recur nested? #f binds] fold-bind next-k break-k final?-id ([id rhs] . rest) . body)
        (identifier? #'id)
-       #'(for/foldX/derived [orig-stx inner-recur nested? #f binds] fold-bind next-k break-k final?-id
-                            ([(id) rhs] . rest) . body)]
+       (syntax-protect
+        #'(for/foldX/derived [orig-stx inner-recur nested? #f binds] fold-bind next-k break-k final?-id
+                             ([(id) rhs] . rest) . body))]
       ;; If we get here in single-value mode, then it's a bad clause:
       [(_ [orig-stx inner-recur #f #f nested? #f binds] fold-bind next-k break-k final?-id (clause . rest) . body)
        (raise-syntax-error
@@ -1587,28 +1600,32 @@
        ;; non-nested loop approach to implement them:
        (ormap (lambda (s) (or (eq? '#:break (syntax-e s)) (eq? '#:final (syntax-e s))))
               (syntax->list #'(clause ... expr ...)))
-       #'(for/foldX/derived [orig-stx inner-recur/fold nested? #f ()] fold-bind done-k done-k #f (clause ...) expr ...)]
+       (syntax-protect
+        #'(for/foldX/derived [orig-stx inner-recur/fold nested? #f ()] fold-bind done-k done-k #f (clause ...) expr ...))]
       [(_ [orig-stx nested?] fold-bind done-k . rest)
        ;; Otherwise, allow compilation as nested loops, which can be slightly faster:
-       #'(for/foldX/derived [orig-stx #f nested? #f ()] fold-bind done-k done-k #f . rest)]))
+       (syntax-protect
+        #'(for/foldX/derived [orig-stx #f nested? #f ()] fold-bind done-k done-k #f . rest))]))
 
   (define-syntax (for/fold/derived stx)
     (syntax-case stx ()
       [(_ orig-stx ([fold-var finid-init] ... #:result result-expr) . rest)
        (check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
-       (syntax/loc #'orig-stx
-         (let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #f]
-                                        ([fold-var finid-init] ...)
-                                        (values* fold-var ...)
-                                        . rest)])
-           result-expr))]
+       (syntax-protect
+        (syntax/loc #'orig-stx
+          (let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #f]
+                                         ([fold-var finid-init] ...)
+                                         (values* fold-var ...)
+                                         . rest)])
+            result-expr)))]
       [(_ orig-stx ([fold-var finid-init] ...) . rest)
        (check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
-       (syntax/loc #'orig-stx
-         (for/foldX/derived/final [orig-stx #f]
-           ([fold-var finid-init] ...)
-           (values* fold-var ...)
-           . rest))]
+       (syntax-protect
+        (syntax/loc #'orig-stx
+          (for/foldX/derived/final [orig-stx #f]
+            ([fold-var finid-init] ...)
+            (values* fold-var ...)
+            . rest)))]
       [(_ orig-stx (bindings ...) . rst)
        (raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
       [(_ orig-stx . rst)
@@ -1618,19 +1635,21 @@
     (syntax-case stx ()
       [(_ orig-stx ([fold-var finid-init] ... #:result result-expr) . rest)
        (check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
-       (syntax/loc #'orig-stx
-         (let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #t]
-                                        ([fold-var finid-init] ...)
-                                        (values* fold-var ...)
-                                        . rest)])
-           result-expr))]
+       (syntax-protect
+        (syntax/loc #'orig-stx
+          (let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #t]
+                                         ([fold-var finid-init] ...)
+                                         (values* fold-var ...)
+                                         . rest)])
+            result-expr)))]
       [(_ orig-stx ([fold-var finid-init] ...) . rest)
        (check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
-       (syntax/loc #'orig-stx
-         (for/foldX/derived/final [orig-stx #t]
-           ([fold-var finid-init] ...)
-           (values* fold-var ...)
-           . rest))]
+       (syntax-protect
+        (syntax/loc #'orig-stx
+          (for/foldX/derived/final [orig-stx #t]
+            ([fold-var finid-init] ...)
+            (values* fold-var ...)
+            . rest)))]
       [(_ orig-stx (bindings ...) . rst)
        (raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
       [(_ orig-stx . rst)
@@ -1721,10 +1740,12 @@
 
   (define-syntax (for/fold stx)
     (syntax-case stx ()
-      [(_ . rest) (quasisyntax/loc stx (for/fold/derived #,stx . rest))]))
+      [(_ . rest) (syntax-protect
+                   (quasisyntax/loc stx (for/fold/derived #,stx . rest)))]))
   (define-syntax (for*/fold stx)
     (syntax-case stx ()
-      [(_ . rest) (quasisyntax/loc stx (for*/fold/derived #,stx . rest))]))
+      [(_ . rest) (syntax-protect
+                   (quasisyntax/loc stx (for*/fold/derived #,stx . rest)))]))
 
   (define-for-variants (for for*)
     ()
@@ -1755,20 +1776,21 @@
        (with-syntax ([orig-stx orig-stx]
                      [for_/fold/derived for_/fold/derived-stx]
                      [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))])
-         (syntax/loc stx
-           (let-values ([(vec i)
-                         (for_/fold/derived
-                          orig-stx
-                          ([vec (make-vector 16)]
-                           [i 0])
-                          (for-clause ...) 
-                          middle-body ...
-                          (let ([new-vec (if (eq? i (unsafe-vector*-length vec))
-                                             (grow-vector vec)
-                                             vec)])
-                            (unsafe-vector*-set! new-vec i (let () last-body ...))
-                            (values new-vec (unsafe-fx+ i 1))))])
-             (shrink-vector vec i))))]
+         (syntax-protect
+          (syntax/loc stx
+            (let-values ([(vec i)
+                          (for_/fold/derived
+                           orig-stx
+                           ([vec (make-vector 16)]
+                            [i 0])
+                           (for-clause ...) 
+                           middle-body ...
+                           (let ([new-vec (if (eq? i (unsafe-vector*-length vec))
+                                              (grow-vector vec)
+                                              vec)])
+                             (unsafe-vector*-set! new-vec i (let () last-body ...))
+                             (values new-vec (unsafe-fx+ i 1))))])
+              (shrink-vector vec i)))))]
       [(_ #:length length-expr #:fill fill-expr (for-clause ...) body ...)
        (with-syntax ([orig-stx orig-stx]
                      [(limited-for-clause ...)
@@ -1801,20 +1823,21 @@
                      [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))]
                      [for_/vector for_/vector-stx]
                      [for_/fold/derived for_/fold/derived-stx])
-         (syntax/loc stx
-           (let ([len length-expr])
-             (unless (exact-nonnegative-integer? len)
-               (raise-argument-error 'for_/vector "exact-nonnegative-integer?" len))
-             (let ([v (make-vector len fill-expr)])
-               (unless (zero? len)
-                 (for_/fold/derived
-                  orig-stx 
-                  ([i 0])
-                  (limited-for-clause ...)
-                  middle-body ...
-                  (unsafe-vector*-set! v i (let () last-body ...))
-                  (unsafe-fx+ 1 i)))
-               v))))]
+         (syntax-protect
+          (syntax/loc stx
+            (let ([len length-expr])
+              (unless (exact-nonnegative-integer? len)
+                (raise-argument-error 'for_/vector "exact-nonnegative-integer?" len))
+              (let ([v (make-vector len fill-expr)])
+                (unless (zero? len)
+                  (for_/fold/derived
+                   orig-stx 
+                   ([i 0])
+                   (limited-for-clause ...)
+                   middle-body ...
+                   (unsafe-vector*-set! v i (let () last-body ...))
+                   (unsafe-fx+ 1 i)))
+                v)))))]
       [(_ #:length length-expr (for-clause ...) body ...)
        (for_/vector #'(fv #:length length-expr #:fill 0 (for-clause ...) body ...) 
                     orig-stx for_/vector-stx for_/fold/derived-stx wrap-all?)]))
@@ -1849,12 +1872,14 @@
               (values* (alt-reverse id) ...)))))
     (syntax-case stx ()
       [(_ (id ... #:result result-expr) bindings expr1 expr ...)
-       #`(let-values ([(id ...)
-                       #,(do-without-result-clause
-                          #'(_ (id ...) bindings expr1 expr ...))])
-           result-expr)]
+       (syntax-protect
+        #`(let-values ([(id ...)
+                        #,(do-without-result-clause
+                           #'(_ (id ...) bindings expr1 expr ...))])
+            result-expr))]
       [(_ (id ...) bindings expr1 expr ...)
-       (do-without-result-clause stx)]))
+       (syntax-protect
+        (do-without-result-clause stx))]))
 
   (define-syntax (for/lists stx) (do-for/lists #'for/fold/derived stx))
   (define-syntax (for*/lists stx) (do-for/lists #'for*/fold/derived stx))
diff --git a/racket/collects/racket/private/promise.rkt b/racket/collects/racket/private/promise.rkt
index c854f1052d..de71ab53f3 100644
--- a/racket/collects/racket/private/promise.rkt
+++ b/racket/collects/racket/private/promise.rkt
@@ -7,7 +7,7 @@
            '#%unsafe)
 (#%provide force promise? promise-forced? promise-running?
            ;; provided to create extensions
-           (struct promise ()) pref pset! prop:force reify-result
+           (struct promise ()) (protect pref pset!) prop:force reify-result
            promise-forcer
            promise-printer
            (struct running ()) (struct reraise ())
@@ -249,7 +249,7 @@
 ;;   X = (force (lazy X)) = (force (lazy (lazy X))) = (force (lazy^n X))
 (#%provide (rename lazy* lazy))
 (define lazy make-composable-promise)
-(define-syntax (lazy* stx) (make-delayer stx #'lazy '()))
+(define-syntax (lazy* stx) (syntax-protect (make-delayer stx #'lazy '())))
 
 ;; Creates a (generic) promise that does not compose
 ;;   X = (force (delay X)) = (force (lazy (delay X)))
@@ -261,7 +261,7 @@
 ;; but provided for regular delay/force uses.)
 (#%provide (rename delay* delay))
 (define delay make-promise)
-(define-syntax (delay* stx) (make-delayer stx #'delay '()))
+(define-syntax (delay* stx) (syntax-protect (make-delayer stx #'delay '())))
 
 ;; For simplicity and efficiency this code uses thunks in promise values for
 ;; exceptions: this way, we don't need to tag exception values in some special
diff --git a/racket/collects/racket/private/vector-wraps.rkt b/racket/collects/racket/private/vector-wraps.rkt
index 473cd76369..51888a01b1 100644
--- a/racket/collects/racket/private/vector-wraps.rkt
+++ b/racket/collects/racket/private/vector-wraps.rkt
@@ -62,23 +62,24 @@
           (with-syntax ([orig-stx orig-stx]
                         [for_/fold/derived for_/fold/derived-stx]
                         [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))])
-            (syntax/loc stx
-              (let-values ([(vec i)
-                            (for_/fold/derived
-                             orig-stx
-                             ([vec (make-fXvector 16)]
-                              [i 0])
-                             (for-clause ...) 
-                             middle-body ...
-                             (let ([new-vec (if (eq? i (unsafe-fXvector-length vec))
-                                                (grow-fXvector vec)
-                                                vec)])
-                               (let ([elem (let () last-body ...)])
-                                 (if (fX? elem)
-                                     (unsafe-fXvector-set! new-vec i elem)
-                                     (not-an-fX 'for*/fXvector elem)))
-                               (values new-vec (unsafe-fx+ i 1))))])
-                (shrink-fXvector vec i))))]
+            (syntax-protect
+             (syntax/loc stx
+               (let-values ([(vec i)
+                             (for_/fold/derived
+                              orig-stx
+                              ([vec (make-fXvector 16)]
+                               [i 0])
+                              (for-clause ...) 
+                              middle-body ...
+                              (let ([new-vec (if (eq? i (unsafe-fXvector-length vec))
+                                                 (grow-fXvector vec)
+                                                 vec)])
+                                (let ([elem (let () last-body ...)])
+                                  (if (fX? elem)
+                                      (unsafe-fXvector-set! new-vec i elem)
+                                      (not-an-fX 'for*/fXvector elem)))
+                                (values new-vec (unsafe-fx+ i 1))))])
+                 (shrink-fXvector vec i)))))]
          [(for*/fXvector #:length length-expr #:fill fill-expr (for-clause ...) body ...)
           (with-syntax ([orig-stx orig-stx]
                         [(limited-for-clause ...)
@@ -111,24 +112,25 @@
                         [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))]
                         [for_/fXvector for_/fXvector-stx]
                         [for_/fold/derived for_/fold/derived-stx])
-            (syntax/loc stx
-              (let ([len length-expr])
-                (unless (exact-nonnegative-integer? len)
-                  (raise-argument-error 'for_/fXvector "exact-nonnegative-integer?" len))
-                (let ([fill fill-expr])
-                  (let ([v (make-fXvector len fill)])
-                    (unless (zero? len)
-                      (for_/fold/derived
-                       orig-stx 
-                       ([i 0])
-                       (limited-for-clause ...)
-                       middle-body ...
-                       (let ([elem (let () last-body ...)])
-                         (if (fX? elem)
-                             (unsafe-fXvector-set! v i elem)
-                             (not-an-fX 'for*/vector elem)))
-                       (unsafe-fx+ 1 i)))
-                    v)))))]
+            (syntax-protect
+             (syntax/loc stx
+               (let ([len length-expr])
+                 (unless (exact-nonnegative-integer? len)
+                   (raise-argument-error 'for_/fXvector "exact-nonnegative-integer?" len))
+                 (let ([fill fill-expr])
+                   (let ([v (make-fXvector len fill)])
+                     (unless (zero? len)
+                       (for_/fold/derived
+                        orig-stx 
+                        ([i 0])
+                        (limited-for-clause ...)
+                        middle-body ...
+                        (let ([elem (let () last-body ...)])
+                          (if (fX? elem)
+                              (unsafe-fXvector-set! v i elem)
+                              (not-an-fX 'for*/vector elem)))
+                        (unsafe-fx+ 1 i)))
+                     v))))))]
          [(_ #:length length-expr (for-clause ...) body ...)
           (for_/fXvector #'(fv #:length length-expr #:fill fXzero (for-clause ...) body ...) 
                          orig-stx for_/fXvector-stx for_/fold/derived-stx wrap-all?)]))
diff --git a/racket/collects/racket/unit.rkt b/racket/collects/racket/unit.rkt
index 6a27cb289e..ab1baa7f51 100644
--- a/racket/collects/racket/unit.rkt
+++ b/racket/collects/racket/unit.rkt
@@ -51,17 +51,19 @@
      (begin
        (check-id #'name)
        (check-id #'arg)
-       #'(define-syntax name
-           (make-set!-transformer
-            (make-signature-form (λ (arg ignored) . val))))))
+       (syntax-protect
+        #'(define-syntax name
+            (make-set!-transformer
+             (make-signature-form (λ (arg ignored) . val)))))))
     ((_ (name arg intro-arg) . val)
      (begin
        (check-id #'name)
        (check-id #'arg)
        (check-id #'intro-arg)
-       #'(define-syntax name
-           (make-set!-transformer
-            (make-signature-form (λ (arg intro-arg) . val))))))
+       (syntax-protect
+        #'(define-syntax name
+            (make-set!-transformer
+             (make-signature-form (λ (arg intro-arg) . val)))))))
     ((_ . l)
      (let ((l (checked-syntax->list stx)))
        (unless (>= 3 (length l))
@@ -981,7 +983,8 @@
                      [(icount ...) (map
                                     (lambda (import) (length (car import)))
                                     import-sigs)])
-         (values 
+         (values
+          (syntax-protect
           (intro
            (quasisyntax/loc (error-syntax)
             (make-unit
@@ -1033,7 +1036,7 @@
                     (unit-export ((export-key ...)
                                   (vector-immutable (λ () (check-not-unsafe-undefined (unbox eloc) 'int-evar))
                                                     ...))
-                                 ...))))))))
+                                 ...)))))))))
           import-tagged-sigids
           export-tagged-sigids
           dep-tagged-sigids))))))
@@ -1358,7 +1361,8 @@
                              orig-export-tagged-infos)]
                        [name (syntax-local-infer-name (error-syntax))]
                        [form (syntax-e (stx-car (error-syntax)))])
-           (values 
+           (values
+            (syntax-protect
             (quasisyntax/loc (error-syntax)
               (let ([unit-tmp unit-exp])
                 (check-unit unit-tmp 'form)
@@ -1390,7 +1394,7 @@
                                                    orig-export-tagged-infos
                                                    orig-export-sigs
                                                    export-tagged-infos
-                                                   export-sigs))))))))
+                                                   export-sigs)))))))))
             import-tagged-sigids
             export-tagged-sigids
             dep-tagged-sigids)))))))
@@ -1649,6 +1653,7 @@
               ;; created via compound-unit/infer. Only the `inferred` dependencies
               ;; will appear in this syntax property, when no inference occurs the property
               ;; will contain an empty list.
+              (syntax-protect
               (syntax-property
                (quasisyntax/loc (error-syntax)
                  (let ([deps '()]
@@ -1676,7 +1681,7 @@
                'unit:inferred-init-depends
                (build-init-depend-property
                 static-dep-info
-                (map syntax-e (syntax->list #'((import-tag . import-sigid) ...)))))
+                (map syntax-e (syntax->list #'((import-tag . import-sigid) ...))))))
               (map syntax-e (syntax->list #'((import-tag . import-sigid) ...)))
               (map syntax-e (syntax->list #'((export-tag . export-sigid) ...)))
               static-dep-info))))))
@@ -1816,9 +1821,10 @@
        (with-syntax ((((int-id . ext-id) ...) int+ext-ids)
                      ((def-name ...) (generate-temporaries (map car int+ext-ids))))
          (values
-          #'(:unit (import) (export (rename export-spec (def-name int-id) ...))
-                   (define def-name int-id)
-                   ...)
+          (syntax-protect
+           #'(:unit (import) (export (rename export-spec (def-name int-id) ...))
+                    (define def-name int-id)
+                    ...))
           null
           (list (cadr tagged-export-sig))
           '()))))))
@@ -1853,17 +1859,18 @@
                          (((etag . esig) ...) e)
                          (((deptag . depsig) ...) d)
                          (contracted? contracted?))
-             (quasisyntax/loc (error-syntax)
-               (begin
-                 (define u #,exp)
-                 (define-syntax name
-                   (make-set!-transformer
-                    (make-unit-info (quote-syntax u)
-                                    (list (cons 'itag (quote-syntax isig)) ...)
-                                    (list (cons 'etag (quote-syntax esig)) ...)
-                                    (list (cons 'deptag (quote-syntax depsig)) ...)
-                                    (quote-syntax name)
-                                    contracted?)))))))))
+             (syntax-protect
+              (quasisyntax/loc (error-syntax)
+                (begin
+                  (define u #,exp)
+                  (define-syntax name
+                    (make-set!-transformer
+                     (make-unit-info (quote-syntax u)
+                                     (list (cons 'itag (quote-syntax isig)) ...)
+                                     (list (cons 'etag (quote-syntax esig)) ...)
+                                     (list (cons 'deptag (quote-syntax depsig)) ...)
+                                     (quote-syntax name)
+                                     contracted?))))))))))
       ((_)
        (raise-stx-err err-msg)))))
 
@@ -1899,21 +1906,22 @@
                       (map check-helper tagged-export-infos))
                      (form (stx-car (error-syntax))))
          (values
-          #`(let ([unit-tmp unit-exp])
-              #,(syntax/loc #'unit-exp
-                  (check-unit unit-tmp 'form))
-              #,(syntax/loc #'unit-exp
-                  (check-sigs unit-tmp 
-                              (vector-immutable
-                               (cons 'import-name
-                                     (vector-immutable import-keys ...))
-                               ...)
-                              (vector-immutable
-                               (cons 'export-name
-                                     (vector-immutable export-keys ...))
-                               ...)
-                              'form))
-              unit-tmp)
+          (syntax-protect
+           #`(let ([unit-tmp unit-exp])
+               #,(syntax/loc #'unit-exp
+                   (check-unit unit-tmp 'form))
+               #,(syntax/loc #'unit-exp
+                   (check-sigs unit-tmp 
+                               (vector-immutable
+                                (cons 'import-name
+                                      (vector-immutable import-keys ...))
+                                ...)
+                               (vector-immutable
+                                (cons 'export-name
+                                      (vector-immutable export-keys ...))
+                                ...)
+                               'form))
+               unit-tmp))
           tagged-import-sigids
           tagged-export-sigids
           tagged-dep-sigids))))))
@@ -1976,9 +1984,10 @@
                                         (export (export-tagged-sig-id [e.x e.c] ...) ...)
                                         dep
                                         #,@splicing-body-contract)))])
-                       (values 
-                        (syntax/loc stx
-                          (contract unit-contract new-unit '(unit name) (current-contract-region) (quote name) (quote-srcloc name)))
+                       (values
+                        (syntax-protect
+                         (syntax/loc stx
+                           (contract unit-contract new-unit '(unit name) (current-contract-region) (quote name) (quote-srcloc name))))
                         isigs esigs deps))))]
                 [(ic:import-clause/contract ec:export-clause/contract dep:dep-clause . bexps)
                  (build-unit/contract
@@ -2350,9 +2359,10 @@
            (with-syntax ([u units]
                          [(esig ...) esig]
                          [(isig ...) isig])
-             (if define?
-                 (syntax/loc (error-syntax) (define-values/invoke-unit u (import isig ...) (export esig ...)))
-                 (syntax/loc (error-syntax) (invoke-unit u (import isig ...))))))]
+             (syntax-protect
+              (if define?
+                  (syntax/loc (error-syntax) (define-values/invoke-unit u (import isig ...) (export esig ...)))
+                  (syntax/loc (error-syntax) (invoke-unit u (import isig ...)))))))]
         [(list? units)
          (let-values ([(isig esig) (imps/exps-from-units units exports)])
            (with-syntax ([(new-unit) (generate-temporaries '(new-unit))]
@@ -2366,13 +2376,14 @@
                                                  (export esig ...)
                                                  (link unit ...))))])
                                 u)])
-               (if define?
-                   (syntax/loc (error-syntax)
-                     (define-values/invoke-unit u
-                       (import isig ...) (export esig ...)))
-                   (syntax/loc (error-syntax)
-                     (invoke-unit u
-                                  (import isig ...)))))))]
+               (syntax-protect
+                (if define?
+                    (syntax/loc (error-syntax)
+                      (define-values/invoke-unit u
+                        (import isig ...) (export esig ...)))
+                    (syntax/loc (error-syntax)
+                      (invoke-unit u
+                                   (import isig ...))))))))]
         ;; just for error handling
         [else (lookup-def-unit units)]))