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)])))]))
(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)
"illegal specification"
(string-append "illegal specification: " (car xtras)))
@ -91,14 +92,17 @@
[(or (free-identifier=? (caar spec) kw)
(free-identifier=? (caar spec) kw-alt))
; (syntax->list (cdar spec))
(datum->syntax
#f
(for/list ([i (syntax->list (cdar 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))])))
(if r
(let ([f (third s)])
(if (procedure-arity-includes? f 2)
(f r `',(car r))
(f r `',(car (syntax->list r)))
(f r)))
(fourth s)))
Spec))