commit 2327624edd8346a593cf0b06f03682f58ddafc76 (patch)
parent 3b16bd0775d48d882d8adbc9108d369a43431570
Author: Alex Karle <alex@alexkarle.com>
Date: Fri, 18 Nov 2022 15:16:37 -0500
refactor: Add `assert-type!` to avoid many `(if (top-type?))` trees
This is a nice readability enhancement. It's safe since assert-type!
calls parse-err! which in turn call/cc's its way to safety (aborting
the current parse.
Diffstat:
| M | parser.scm | | | 124 | ++++++++++++++++++++++++++++++++++++++----------------------------------------- |
1 file changed, 59 insertions(+), 65 deletions(-)
diff --git a/parser.scm b/parser.scm
@@ -85,21 +85,24 @@
(memq (token-type (car tokens)) types)))
+(define (assert-type! toks types msg)
+ (if (not (top-type? toks types))
+ (parse-err! toks msg)))
+
+
(define (parse-declaration tokens)
(if (top-type? tokens 'VAR)
(parse-var-decl (cdr tokens))
(parse-statement tokens)))
(define (parse-var-decl tokens)
- (if (top-type? tokens 'IDENTIFIER)
- (let-values (((init toks)
- (if (top-type? (cdr tokens) 'EQUAL)
- (parse-expression '() (cddr tokens))
- (values '() (cdr tokens)))))
- (if (top-type? toks 'SEMICOLON)
- (values (make-var-stmt (car tokens) init) (cdr toks))
- (parse-err! toks "Expected ';' after variable declaration")))
- (parse-err! tokens "expected variable name")))
+ (assert-type! tokens 'IDENTIFIER "expected variable name")
+ (let-values (((init toks)
+ (if (top-type? (cdr tokens) 'EQUAL)
+ (parse-expression '() (cddr tokens))
+ (values '() (cdr tokens)))))
+ (assert-type! toks 'SEMICOLON "Expected ';' after variable declaration")
+ (values (make-var-stmt (car tokens) init) (cdr toks))))
(define (parse-statement tokens)
(cond ((top-type? tokens 'PRINT)
@@ -134,51 +137,45 @@
(parse-generic-stmt tokens make-expr-stmt))
(define (parse-while-statement tokens)
- (if (not (top-type? tokens 'LEFT_PAREN))
- (parse-err! tokens "Expected '(' after 'while'")
- (let-values (((cond-expr toks) (parse-expression '() (cdr tokens))))
- (if (not (top-type? toks 'RIGHT_PAREN))
- (parse-err! toks "Expected ')' after while condition")
- (let-values (((body-stmt toks2) (parse-statement (cdr toks))))
- (values (make-while-stmt cond-expr body-stmt) toks2))))))
+ (assert-type! tokens 'LEFT_PAREN "Expected '(' after 'while'")
+ (let-values (((cond-expr toks) (parse-expression '() (cdr tokens))))
+ (assert-type! toks 'RIGHT_PAREN "Expected ')' after while condition")
+ (let-values (((body-stmt toks2) (parse-statement (cdr toks))))
+ (values (make-while-stmt cond-expr body-stmt) toks2))))
(define (parse-for-statement tokens)
- ;; TODO: how do we simplify this many parse-err! asserts / parse passes?
- (if (not (top-type? tokens 'LEFT_PAREN))
- (parse-err! tokens "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)))))
- (if (not (top-type? toks2 'SEMICOLON))
- (parse-err! toks2 "Expected ';' after loop condition")
- (let-values (((incr toks3)
- (cond ((top-type? (cdr toks2) 'RIGHT_PAREN)
- (values '() (cdr toks2)))
- (else (parse-expression '() (cdr toks2))))))
- (if (not (top-type? toks3 'RIGHT_PAREN))
- (parse-err! toks3 "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))))))))))))
+ (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)))))))))
(define (parse-block tokens)
@@ -194,16 +191,14 @@
(loop (append stmts (list decl)) rest))))))
(define (parse-if-statement tokens)
- (if (not (top-type? tokens 'LEFT_PAREN))
- (parse-err! tokens "Expected '(' after 'if'")
- (let-values (((cond-expr toks) (parse-expression '() (cdr tokens))))
- (if (not (top-type? toks 'RIGHT_PAREN))
- (parse-err! toks "Expected ')' after if condition")
- (let-values (((then-stmt toks2) (parse-statement (cdr toks))))
- (if (top-type? toks2 'ELSE)
- (let-values (((else-stmt toks3) (parse-statement (cdr toks2))))
- (values (make-if-stmt cond-expr then-stmt else-stmt) toks3))
- (values (make-if-stmt cond-expr then-stmt '()) toks2)))))))
+ (assert-type! tokens 'LEFT_PAREN "Expected '(' after 'if'")
+ (let-values (((cond-expr toks) (parse-expression '() (cdr tokens))))
+ (assert-type! toks 'RIGHT_PAREN "Expected ')' after if condition")
+ (let-values (((then-stmt toks2) (parse-statement (cdr toks))))
+ (if (top-type? toks2 'ELSE)
+ (let-values (((else-stmt toks3) (parse-statement (cdr toks2))))
+ (values (make-if-stmt cond-expr then-stmt else-stmt) toks3))
+ (values (make-if-stmt cond-expr then-stmt '()) toks2)))))
(define (parse-assignment expr toks)
(let-values (((e2 t2) (parse-or expr toks)))
@@ -272,9 +267,8 @@
((top-type? toks 'IDENTIFIER) (values (make-variable top) rest))
((top-type? toks 'LEFT_PAREN)
(let-values (((e2 t2) (parse-expression expr rest)))
- (if (top-type? t2 'RIGHT_PAREN)
- (values (make-grouping e2) (cdr t2))
- (parse-err! t2 "Expected ')'"))))
+ (assert-type! t2 'RIGHT_PAREN "Expected ')'")
+ (values (make-grouping e2) (cdr t2))))
(else (parse-err! toks "Unknown token")))))
(define (parse-err! toks msg)
