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

squash! mescc: Fix switch statements' fallthrough --support mes

This commit is contained in:
Janneke Nieuwenhuizen 2023-09-16 08:19:00 +02:00
parent 1ec88d0109
commit ef4f4bb25a
1 changed files with 27 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
module/mescc/compile.scm
View File

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