diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 054d21795..6fad85adc 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -1,6 +1,6 @@
 ;;;; -*-scheme-*-
 ;;;;
-;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010-2021
+;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010-2022
 ;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -278,11 +278,6 @@
                         `((line . ,(sourcev-line sourcev))
                           (column . ,(sourcev-column sourcev))))))
 
-    (define (decorate-source e s)
-      (when (and s (supports-source-properties? e))
-        (set-source-properties! e (sourcev->alist s)))
-      e)
-
     (define (maybe-name-value! name val)
       (if (lambda? val)
           (let ((meta (lambda-meta val)))
@@ -1366,9 +1361,11 @@
                       ;; need lambda here...
                       (values 'define-form (wrap #'name w mod)
                               (wrap e w mod)
-                              (decorate-source
+                              (source-wrap
                                (cons #'lambda (wrap #'(args e1 e2 ...) w mod))
-                               s)
+                               empty-wrap
+                               s
+                               #f)
                               empty-wrap s mod))
                      ((_ name)
                       (id? #'name)
@@ -1514,13 +1511,14 @@
     ;; possible.
     (define expand-macro
       (lambda (p e r w s rib mod)
+        (define (decorate-source x)
+          (source-wrap x empty-wrap s #f))
         (define rebuild-macro-output
           (lambda (x m)
             (cond ((pair? x)
-                   (decorate-source 
+                   (decorate-source
                     (cons (rebuild-macro-output (car x) m)
-                          (rebuild-macro-output (cdr x) m))
-                    s))
+                          (rebuild-macro-output (cdr x) m))))
                   ((syntax? x)
                    (let ((w (syntax-wrap x)))
                      (let ((ms (wrap-marks w)) (ss (wrap-subst w)))
@@ -1544,15 +1542,16 @@
                 
                   ((vector? x)
                    (let* ((n (vector-length x))
-                          (v (decorate-source (make-vector n) s)))
+                          (v (make-vector n)))
                      (do ((i 0 (fx+ i 1)))
                          ((fx= i n) v)
                        (vector-set! v i
-                                    (rebuild-macro-output (vector-ref x i) m)))))
+                                    (rebuild-macro-output (vector-ref x i) m)))
+                     (decorate-source v)))
                   ((symbol? x)
                    (syntax-violation #f "encountered raw symbol in macro output"
                                      (source-wrap e w (wrap-subst w) mod) x))
-                  (else (decorate-source x s)))))
+                  (else (decorate-source x)))))
         (with-fluids ((transformer-environment
                        (lambda (k) (k e r w s rib mod))))
           (rebuild-macro-output (p (source-wrap e (anti-mark w) s mod))
@@ -1997,7 +1996,10 @@
 
     (define (strip x)
       (define (annotate proc datum)
-        (decorate-source datum (proc x)))
+        (let ((s (proc x)))
+          (when (and s (supports-source-properties? datum))
+            (set-source-properties! datum (sourcev->alist s)))
+          datum))
       (cond
        ((syntax? x)
         (annotate syntax-sourcev (strip (syntax-expression x))))