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

track disappeared-use for case's else

Browse Source 
Closes #3363
This commit is contained in:
sorawee 2020-08-29 05:21:05 -07:00 committed by GitHub
parent 754211eead
commit 6a685f52c6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 22 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
racket/collects/racket/private/case.rkt
View File

@ -6,20 +6,25 @@
(#%require '#%paramz '#%unsafe "qq-and-or.rkt" "cond.rkt" "define.rkt" "fixnum.rkt" (#%require '#%paramz '#%unsafe "qq-and-or.rkt" "cond.rkt" "define.rkt" "fixnum.rkt"
(for-syntax '#%kernel "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt" (for-syntax '#%kernel "define-et-al.rkt" "qq-and-or.rkt" "cond.rkt"
"stxcase-scheme.rkt" "stxcase-scheme.rkt"
"qqstx.rkt" "define.rkt" "sort.rkt" "fixnum.rkt")) "qqstx.rkt" "define.rkt" "sort.rkt" "fixnum.rkt"
"stx.rkt"))
(#%provide case) (#%provide case)
(define-syntax (case stx) (define-syntax (case stx)
(syntax-case stx (else) (syntax-case stx ()
;; Empty case ;; Empty case
[(_ v) [(_ v)
(syntax-protect (syntax-protect
(syntax/loc stx (#%expression (begin v (void)))))] (syntax/loc stx (#%expression (begin v (void)))))]
;; Else-only case ;; Else-only case
[(_ v [else e es ...]) [(_ v [maybe-else e es ...])
(and (identifier? #'maybe-else) (free-identifier=? #'else #'maybe-else))
(syntax-property
(syntax-protect (syntax-protect
(syntax/loc stx (#%expression (begin v (let-values () e es ...)))))] (syntax/loc stx (#%expression (begin v (let-values () e es ...)))))
'disappeared-use
(list (syntax-local-introduce #'maybe-else)))]
;; If we have a syntactically correct form without an 'else' clause, ;; If we have a syntactically correct form without an 'else' clause,
;; add the default 'else' and try again. ;; add the default 'else' and try again.
@ -28,13 +33,17 @@
(syntax/loc stx (self v [(k ...) e1 e2 ...] ... [else (void)])))] (syntax/loc stx (self v [(k ...) e1 e2 ...] ... [else (void)])))]
;; The general case ;; The general case
[(_ v [(k ...) e1 e2 ...] ... [else x1 x2 ...]) [(_ v [(k ...) e1 e2 ...] ... [maybe-else x1 x2 ...])
(and (identifier? #'maybe-else) (free-identifier=? #'else #'maybe-else))
(syntax-property
(syntax-protect (syntax-protect
(if (< (length (syntax-e #'(k ... ...))) *sequential-threshold*) (if (< (length (syntax-e #'(k ... ...))) *sequential-threshold*)
(syntax/loc stx (let ([tmp v]) (syntax/loc stx (let ([tmp v])
(case/sequential tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...]))) (case/sequential tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))
(syntax/loc stx (let ([tmp v]) (syntax/loc stx (let ([tmp v])
(case/dispatch tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))))] (case/dispatch tmp [(k ...) e1 e2 ...] ... [else x1 x2 ...])))))
'disappeared-use
(list (syntax-local-introduce #'maybe-else)))]
;; Error cases ;; Error cases
[(_ v clause ...) [(_ v clause ...)