diff --git a/scheme/last-revision b/scheme/last-revision index a84d4e6..24c937d 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1470 +1471 diff --git a/scheme/psyntax.expander.ss b/scheme/psyntax.expander.ss index 5ec91b7..9bb2c8a 100644 --- a/scheme/psyntax.expander.ss +++ b/scheme/psyntax.expander.ss @@ -1588,13 +1588,7 @@ ((_ (lits ...) (pat* tmp*) ...) (begin - (unless (for-all - (lambda (x) - (and (id? x) - (not (free-id=? x (scheme-stx '...))) - (not (free-id=? x (scheme-stx '_))))) - lits) - (stx-error e "invalid literals")) + (verify-literals lits e) (bless `(lambda (x) (syntax-case x ,lits ,@(map (lambda (pat tmp) @@ -2295,6 +2289,17 @@ (lambda (x) (and (id? x) (free-id=? x (scheme-stx '...))))) + (define underscore? + (lambda (x) + (and (id? x) (free-id=? x (scheme-stx '_))))) + + (define (verify-literals lits expr) + (for-each + (lambda (x) + (when (or (not (id? x)) (ellipsis? x) (underscore? x)) + (syntax-violation #f "invalid literal" expr x))) + lits)) + (define syntax-case-transformer (let () (define build-dispatch-call @@ -2391,8 +2396,7 @@ (syntax-match e () ((_ expr (keys ...) clauses ...) (begin - (unless (for-all (lambda (x) (and (id? x) (not (ellipsis? x)))) keys) - (stx-error e "invalid literals")) + (verify-literals keys e) (let ((x (gen-lexical 'tmp))) (let ((body (gen-syntax-case x keys clauses r mr))) (build-application no-source