andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

squash! mescc: Fix switch statements' fallthrough

This commit is contained in:
Janneke Nieuwenhuizen 2023-09-17 07:44:16 +02:00
parent 6ec2715f74
commit 98f37a5bdb
1 changed files with 21 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
module/mescc/compile.scm
View File

@ -1791,29 +1791,27 @@
(set! i (1+ i))) (set! i (1+ i)))
n)))) n))))
(define (flatten-cases c) (define (flatten-cases c)
(define (flatten-case case) (define (flatten-case o)
(pmatch case (pmatch o
((case ,test (case . ,body)) ((case ,test (case . ,body))
(append `((case ,test (expr-stmt))) (flatten-case `(case ,@body)))) (cons `(case ,test (expr-stmt)) (flatten-case `(case ,@body))))
((case ,test ,casebody (case . ,body)) ((case ,test ,case-body (case . ,body))
(append `((case ,test ,casebody)) (flatten-case `(case ,@body)))) (cons `(case ,test ,case-body) (flatten-case `(case ,@body))))
((default (case . ,body)) ((default (case . ,body))
(append `((default (expr-stmt))) (flatten-case `(case ,@body)))) (cons `(default (expr-stmt)) (flatten-case `(case ,@body))))
((default ,defbody (case . ,body)) ((default ,default-body (case . ,body))
(append `((default ,defbody)) (flatten-case `(case ,@body)))) (cons `(default ,default-body) (flatten-case `(case ,@body))))
((case ,test (default . ,body)) ((case ,test (default . ,body))
(append `((case ,test (expr-stmt))) (flatten-case `(default ,@body)))) (cons `(case ,test (expr-stmt)) (flatten-case `(default ,@body))))
((default ,rest) ((default ,rest)
(list case)) (list o))
((case ,test) ((case ,test)
(list case)) (list o))
((case ,test ,expr) ((case ,test ,expr)
(list case)) (list o))
(,s (list s)))) (,s (list s))))
(fold (lambda (x acc) (append acc (flatten-case x))) '() c)) (fold (lambda (x acc) (append acc (flatten-case x))) '() c))
(let* ((info (append-text info (ast->comment `(switch ,expr (compd-stmt (block-item-list (ellipsis))))))) (let* ((info (append-text info (ast->comment `(switch ,expr (compd-stmt (block-item-list (ellipsis)))))))
(statements (flatten-cases statements)) (statements (flatten-cases statements))