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

fix bug in error reporting

Browse Source
This commit is contained in:
Matthias Felleisen 2014-08-18 21:15:35 -04:00
parent 0b35ec71a8
commit 9696095ada
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/htdp-pkgs/htdp-lib/2htdp/private/clauses-spec-and-process.rkt
View File

@ -49,7 +49,8 @@
[_ (err tag p)])))])) [_ (err tag p)])))]))
(define (err spec p . xtras) (define (err spec p . xtras)
(raise-syntax-error (cadr spec) (define x (cadr spec))
(raise-syntax-error (if (syntax? x) (syntax-e x) x)
(if (null? xtras) (if (null? xtras)
"illegal specification" "illegal specification"
(string-append "illegal specification: " (car xtras))) (string-append "illegal specification: " (car xtras)))
@ -91,14 +92,17 @@
[(or (free-identifier=? (caar spec) kw) [(or (free-identifier=? (caar spec) kw)
(free-identifier=? (caar spec) kw-alt)) (free-identifier=? (caar spec) kw-alt))
; (syntax->list (cdar spec)) ; (syntax->list (cdar spec))
(datum->syntax
#f
(for/list ([i (syntax->list (cdar spec))]) (for/list ([i (syntax->list (cdar spec))])
(define n (string->symbol (format "~a handler" (syntax-e (caar spec))))) (define n (string->symbol (format "~a handler" (syntax-e (caar spec)))))
(syntax-property i 'inferred-name n))] (syntax-property i 'inferred-name n))
(cdar spec))]
[else (loop (cdr spec))]))) [else (loop (cdr spec))])))
(if r (if r
(let ([f (third s)]) (let ([f (third s)])
(if (procedure-arity-includes? f 2) (if (procedure-arity-includes? f 2)
(f r `',(car r)) (f r `',(car (syntax->list r)))
(f r))) (f r)))
(fourth s))) (fourth s)))
Spec)) Spec))