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

fix reporting for some syntactic misuses of syntax-case

Browse Source 
svn: r18662
This commit is contained in:
Matthew Flatt 2010-03-29 20:39:42 +00:00
parent baab09fc1b
commit 25ede3dc50
3 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/scheme/private/stxcase-scheme.ss
View File

@ -29,7 +29,7 @@
(-define-syntax syntax-rules
(lambda (stx)
(syntax-case** syntax-rules #t stx () free-identifier=?
((_ (k ...) ((keyword . pattern) template) ...)
((sr (k ...) ((keyword . pattern) template) ...)
(andmap identifier? (syntax->list (syntax (k ...))))
(begin
(for-each (lambda (id)
@ -42,19 +42,19 @@
(syntax->list (syntax (keyword ...))))
(syntax/loc stx
(lambda (x)
(syntax-case** _ #t x (k ...) free-identifier=?
(syntax-case** sr #t x (k ...) free-identifier=?
((_ . pattern) (syntax/loc x template))
...))))))))
(-define-syntax syntax-id-rules
(lambda (x)
(syntax-case** syntax-id-rules #t x () free-identifier=?
((_ (k ...) (pattern template) ...)
((sidr (k ...) (pattern template) ...)
(andmap identifier? (syntax->list (syntax (k ...))))
(syntax/loc x
(make-set!-transformer
(lambda (x)
(syntax-case** _ #t x (k ...) free-identifier=?
(syntax-case** sidr #t x (k ...) free-identifier=?
(pattern (syntax/loc x template))
...))))))))

2
collects/scheme/private/stxcase.ss
View File

@ -273,7 +273,7 @@
(<= 2 (length (stx->list clause)) 3))
(raise-syntax-error
(syntax-e who)
"bad clause"
"expected a clause containing a pattern, an optional guard expression, and an expression"
clause)))
clauses)
(let ([patterns (map stx-car clauses)]

8
collects/scheme/private/stxloc.ss
View File

@ -10,15 +10,15 @@
(-define-syntax syntax-case*
(lambda (stx)
(syntax-case** #f #t stx () free-identifier=?
[(_ stxe kl id=? clause ...)
(syntax (syntax-case** _ #f stxe kl id=? clause ...))])))
[(sc stxe kl id=? clause ...)
(syntax (syntax-case** sc #f stxe kl id=? clause ...))])))
;; Regular syntax-case
(-define-syntax syntax-case
(lambda (stx)
(syntax-case** #f #t stx () free-identifier=?
[(_ stxe kl clause ...)
(syntax (syntax-case** _ #f stxe kl free-identifier=? clause ...))])))
[(sc stxe kl clause ...)
(syntax (syntax-case** sc #f stxe kl free-identifier=? clause ...))])))
(-define (relocate loc stx)
(if (or (syntax-source loc)