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

View File

@ -1791,29 +1791,27 @@
(set! i (1+ i)))
n))))
(define (flatten-cases c)
(define (flatten-case case)
(pmatch case
((case ,test (case . ,body))
(append `((case ,test (expr-stmt))) (flatten-case `(case ,@body))))
((case ,test ,casebody (case . ,body))
(append `((case ,test ,casebody)) (flatten-case `(case ,@body))))
((default (case . ,body))
(append `((default (expr-stmt))) (flatten-case `(case ,@body))))
((default ,defbody (case . ,body))
(append `((default ,defbody)) (flatten-case `(case ,@body))))
((case ,test (default . ,body))
(append `((case ,test (expr-stmt))) (flatten-case `(default ,@body))))
((default ,rest)
(list case))
((case ,test)
(list case))
((case ,test ,expr)
(list case))
(,s (list s))))
(fold (lambda (x acc) (append acc (flatten-case x))) '() c))
(define (flatten-cases c)
(define (flatten-case o)
(pmatch o
((case ,test (case . ,body))
(cons `(case ,test (expr-stmt)) (flatten-case `(case ,@body))))
((case ,test ,case-body (case . ,body))
(cons `(case ,test ,case-body) (flatten-case `(case ,@body))))
((default (case . ,body))
(cons `(default (expr-stmt)) (flatten-case `(case ,@body))))
((default ,default-body (case . ,body))
(cons `(default ,default-body) (flatten-case `(case ,@body))))
((case ,test (default . ,body))
(cons `(case ,test (expr-stmt)) (flatten-case `(default ,@body))))
((default ,rest)
(list o))
((case ,test)
(list o))
((case ,test ,expr)
(list o))
(,s (list s))))
(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)))))))
(statements (flatten-cases statements))