commit 29210ae5f1ea7989d86f2ad5672d39973640e71b (patch) parent 2327624edd8346a593cf0b06f03682f58ddafc76 Author: Alex Karle <alex@alexkarle.com> Date: Fri, 18 Nov 2022 17:38:59 -0500 refactor: Update for-loop extraction and desugaring to use composition This updates the for loop parser to go from a bunch of if-trees to a bunch of functions, each taking the previous values as input, which results in a very flat tree (dare I say more testable too?). Diffstat:
M | parser.scm | | | 67 | ++++++++++++++++++++++++++++++++++++------------------------------- |
1 file changed, 36 insertions(+), 31 deletions(-)
diff --git a/parser.scm b/parser.scm @@ -144,38 +144,43 @@ (values (make-while-stmt cond-expr body-stmt) toks2)))) (define (parse-for-statement tokens) + (define (extract-init toks) + (cond ((top-type? toks 'SEMICOLON) + (values '() (cdr toks))) + ((top-type? toks 'VAR) + (parse-var-decl (cdr toks))) + (else (parse-expression-statement toks)))) + (define (extract-cond toks) + (cond ((top-type? toks 'SEMICOLON) + (values '() (cdr toks))) + (else (parse-expression '() toks)))) + (define (extract-incr toks) + (assert-type! toks 'SEMICOLON "Expected ';' after loop condition") + (cond ((top-type? (cdr toks) 'RIGHT_PAREN) + (values '() (cddr toks))) + (else (parse-expression '() (cdr toks))))) + (define (extract-body toks) + (assert-type! toks 'RIGHT_PAREN "Expected ')' after for clauses") + (parse-statement (cdr toks))) + (define (body-append-incr body incr) + (if (null? incr) + body + (make-block (list body (make-expr-stmt incr))))) + (define (body-to-while body conde) + (if (null? conde) + (make-while-stmt (make-literal #t) body) + (make-while-stmt conde body))) + (define (while-add-init while init) + (if (null? init) + while + (make-block (list init while)))) (assert-type! tokens 'LEFT_PAREN "Expected '(' after 'for'") - (let-values (((init toks) - (cond ((top-type? (cdr tokens) 'SEMICOLON) - (values '() (cddr tokens))) - ((top-type? (cdr tokens) 'VAR) - (parse-var-decl (cddr tokens))) - (else (parse-expression-statement (cdr tokens)))))) - (let-values (((conde toks2) - (cond ((top-type? toks 'SEMICOLON) - (values '() toks)) - (else (parse-expression '() toks))))) - (assert-type! toks2 'SEMICOLON "Expected ';' after loop condition") - (let-values (((incr toks3) - (cond ((top-type? (cdr toks2) 'RIGHT_PAREN) - (values '() (cdr toks2))) - (else (parse-expression '() (cdr toks2)))))) - (assert-type! toks3 'RIGHT_PAREN "Expected ')' after for clauses") - (let-values (((body toks4) (parse-statement (cdr toks3)))) - ;; TODO: refactor. I seem to like to "transform" variables - ;; by just repeatedly let-binding new versions instead of - ;; using set! --> maybe use composed functions? - (let ((incr-body - (if (null? incr) - body - (make-block (list body (make-expr-stmt incr)))))) - (let ((cond-body - (if (null? conde) - (make-while-stmt (make-literal #t) incr-body) - (make-while-stmt conde incr-body)))) - (if (null? init) - (values cond-body toks4) - (values (make-block (list init cond-body)) toks4))))))))) + (let*-values (((init t1) (extract-init (cdr tokens))) + ((conde t2) (extract-cond t1)) + ((incr t3) (extract-incr t2)) + ((body t4) (extract-body t3))) + (values (while-add-init (body-to-while (body-append-incr body incr) conde) init) + t4))) (define (parse-block tokens)