suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improve error message for bad attribute values

Browse Source 
closes PR 14340
This commit is contained in:
Ryan Culpepper 2014-02-06 14:56:43 -05:00
parent 8133559442
commit ed5a4ff619
1 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
racket/collects/syntax/parse/private/residual.rkt
View File

@ -139,15 +139,13 @@
;; Checks that value is (listof^depth syntax); forces promises. ;; Checks that value is (listof^depth syntax); forces promises.
;; Slow path for attribute-mapping code, assumes value is not syntax-list^depth? already. ;; 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 (check/force-syntax-list^depth depth value0 source-id)
(define (bad) (define (bad sub-depth sub-value)
(raise-syntax-error #f (attribute-not-syntax-error depth value0 source-id sub-depth sub-value))
(format "attribute is bound to non-syntax value\n value: ~e" value0)
source-id))
(define (loop depth value) (define (loop depth value)
(cond [(promise? value) (cond [(promise? value)
(loop depth (force value))] (loop depth (force value))]
[(zero? depth) [(zero? depth)
(if (syntax? value) value (bad))] (if (syntax? value) value (bad depth value))]
[else (loop-list depth value)])) [else (loop-list depth value)]))
(define (loop-list depth value) (define (loop-list depth value)
(cond [(promise? value) (cond [(promise? value)
@ -163,9 +161,26 @@
[(null? value) [(null? value)
null] null]
[else [else
(bad)])) (bad depth value)]))
(loop depth value0)) (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 ;; syntax-list^depth? : nat any -> boolean
;; Returns true iff value is (listof^depth syntax). ;; Returns true iff value is (listof^depth syntax).
(define (syntax-list^depth? depth value) (define (syntax-list^depth? depth value)