From ed5a4ff619e81f6653086e6ec1e31cf517c74cbc Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Thu, 6 Feb 2014 14:56:43 -0500
Subject: [PATCH] improve error message for bad attribute values   closes PR
 14340

---
 .../syntax/parse/private/residual.rkt         | 27 ++++++++++++++-----
 1 file changed, 21 insertions(+), 6 deletions(-)

diff --git a/racket/collects/syntax/parse/private/residual.rkt b/racket/collects/syntax/parse/private/residual.rkt
index 9438089da4..6f54d45e99 100644
--- a/racket/collects/syntax/parse/private/residual.rkt
+++ b/racket/collects/syntax/parse/private/residual.rkt
@@ -139,15 +139,13 @@
 ;; Checks that value is (listof^depth syntax); forces promises.
 ;; Slow path for attribute-mapping code, assumes value is not syntax-list^depth? already.
 (define (check/force-syntax-list^depth depth value0 source-id)
-  (define (bad)
-    (raise-syntax-error #f
-                        (format "attribute is bound to non-syntax value\n  value: ~e" value0)
-                        source-id))
+  (define (bad sub-depth sub-value)
+    (attribute-not-syntax-error depth value0 source-id sub-depth sub-value))
   (define (loop depth value)
     (cond [(promise? value)
            (loop depth (force value))]
           [(zero? depth)
-           (if (syntax? value) value (bad))]
+           (if (syntax? value) value (bad depth value))]
           [else (loop-list depth value)]))
   (define (loop-list depth value)
     (cond [(promise? value)
@@ -163,9 +161,26 @@
           [(null? value)
            null]
           [else
-           (bad)]))
+           (bad depth value)]))
   (loop depth value0))
 
+(define (attribute-not-syntax-error depth0 value0 source-id sub-depth sub-value)
+  (raise-syntax-error #f
+    (format (string-append "bad attribute value for syntax template"
+                           "\n  attribute value: ~e"
+                           "\n  expected for attribute: ~a"
+                           "\n  sub-value: ~e"
+                           "\n  expected for sub-value: ~a")
+            value0
+            (describe-depth depth0)
+            sub-value
+            (describe-depth sub-depth))
+    source-id))
+
+(define (describe-depth depth)
+  (cond [(zero? depth) "syntax"]
+        [else (format "list of depth ~s of syntax" depth)]))
+
 ;; syntax-list^depth? : nat any -> boolean
 ;; Returns true iff value is (listof^depth syntax).
 (define (syntax-list^depth? depth value)