commit 3b16bd0775d48d882d8adbc9108d369a43431570 (patch)
parent 415557bdff9d34b562c8b8c17dbe6467a54420e5
Author: Alex Karle <alex@alexkarle.com>
Date: Fri, 18 Nov 2022 15:05:46 -0500
refactor: Allow top-type? to take in symbol or list
Might as well use dynamic typing to its fullest!
Diffstat:
| M | parser.scm | | | 72 | +++++++++++++++++++++++++++++++++++++----------------------------------- |
1 file changed, 37 insertions(+), 35 deletions(-)
diff --git a/parser.scm b/parser.scm
@@ -80,35 +80,37 @@
;; helper to check if first is of types
(define (top-type? tokens types)
- (memq (token-type (car tokens)) types))
+ (if (symbol? types)
+ (eq? (token-type (car tokens)) types)
+ (memq (token-type (car tokens)) types)))
(define (parse-declaration tokens)
- (if (top-type? tokens '(VAR))
+ (if (top-type? tokens 'VAR)
(parse-var-decl (cdr tokens))
(parse-statement tokens)))
(define (parse-var-decl tokens)
- (if (top-type? tokens '(IDENTIFIER))
+ (if (top-type? tokens 'IDENTIFIER)
(let-values (((init toks)
- (if (top-type? (cdr tokens) '(EQUAL))
+ (if (top-type? (cdr tokens) 'EQUAL)
(parse-expression '() (cddr tokens))
(values '() (cdr tokens)))))
- (if (top-type? toks '(SEMICOLON))
+ (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")))
(define (parse-statement tokens)
- (cond ((top-type? tokens '(PRINT))
+ (cond ((top-type? tokens 'PRINT)
(parse-print-statement (cdr tokens)))
- ((top-type? tokens '(FOR))
+ ((top-type? tokens 'FOR)
(parse-for-statement (cdr tokens)))
- ((top-type? tokens '(IF))
+ ((top-type? tokens 'IF)
(parse-if-statement (cdr tokens)))
- ((top-type? tokens '(WHILE))
+ ((top-type? tokens 'WHILE)
(parse-while-statement (cdr tokens)))
- ((top-type? tokens '(LEFT_BRACE))
+ ((top-type? tokens 'LEFT_BRACE)
(let-values (((stmts toks) (parse-block (cdr tokens))))
;; TODO: return the block record instead of stmts? Not the
;; way the book does it but seems cleaner :thinking:
@@ -118,7 +120,7 @@
;; Used for print and expr statements, which have the same formula
(define (parse-generic-stmt tokens maker)
(let-values (((expr toks) (parse-expression '() tokens)))
- (if (top-type? toks '(SEMICOLON))
+ (if (top-type? toks 'SEMICOLON)
(values (maker expr) (cdr toks))
(if in-repl
(values (maker expr) toks)
@@ -132,35 +134,35 @@
(parse-generic-stmt tokens make-expr-stmt))
(define (parse-while-statement tokens)
- (if (not (top-type? tokens '(LEFT_PAREN)))
+ (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)))
+ (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))))))
(define (parse-for-statement tokens)
;; TODO: how do we simplify this many parse-err! asserts / parse passes?
- (if (not (top-type? tokens '(LEFT_PAREN)))
+ (if (not (top-type? tokens 'LEFT_PAREN))
(parse-err! tokens "Expected '(' after 'for'")
(let-values (((init toks)
- (cond ((top-type? (cdr tokens) '(SEMICOLON))
+ (cond ((top-type? (cdr tokens) 'SEMICOLON)
(values '() (cddr tokens)))
- ((top-type? (cdr tokens) '(VAR))
+ ((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))
+ (cond ((top-type? toks 'SEMICOLON)
(values '() toks))
(else (parse-expression '() toks)))))
- (if (not (top-type? toks2 '(SEMICOLON)))
+ (if (not (top-type? toks2 'SEMICOLON))
(parse-err! toks2 "Expected ';' after loop condition")
(let-values (((incr toks3)
- (cond ((top-type? (cdr toks2) '(RIGHT_PAREN))
+ (cond ((top-type? (cdr toks2) 'RIGHT_PAREN)
(values '() (cdr toks2)))
(else (parse-expression '() (cdr toks2))))))
- (if (not (top-type? toks3 '(RIGHT_PAREN)))
+ (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
@@ -181,9 +183,9 @@
(define (parse-block tokens)
(let loop ((stmts '()) (toks tokens))
- (if (top-type? toks '(RIGHT_BRACE))
+ (if (top-type? toks 'RIGHT_BRACE)
(values stmts (cdr toks))
- (if (top-type? toks '(EOF))
+ (if (top-type? toks 'EOF)
(parse-err! toks "expected '}' after block")
(let-values (((decl rest) (parse-declaration toks)))
;; TODO: can we do this with cons instead of append?
@@ -192,20 +194,20 @@
(loop (append stmts (list decl)) rest))))))
(define (parse-if-statement tokens)
- (if (not (top-type? tokens '(LEFT_PAREN)))
+ (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)))
+ (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))
+ (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)))
- (if (top-type? t2 '(EQUAL))
+ (if (top-type? t2 'EQUAL)
(let-values (((e3 t3) (parse-assignment e2 (cdr t2))))
(if (variable? e2)
(values (make-assignment (variable-name e2) e3) t3)
@@ -262,22 +264,22 @@
(define (parse-primary expr toks)
(let ((top (car toks)) (rest (cdr toks)))
(cond
- ((top-type? toks '(FALSE)) (values (make-literal #f) rest))
- ((top-type? toks '(TRUE)) (values (make-literal #t) rest))
- ((top-type? toks '(NIL)) (values (make-literal '()) rest))
+ ((top-type? toks 'FALSE) (values (make-literal #f) rest))
+ ((top-type? toks 'TRUE) (values (make-literal #t) rest))
+ ((top-type? toks 'NIL) (values (make-literal ') rest))
((top-type? toks '(NUMBER STRING))
(values (make-literal (token-literal top)) rest))
- ((top-type? toks '(IDENTIFIER)) (values (make-variable top) rest))
- ((top-type? toks '(LEFT_PAREN))
+ ((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))
+ (if (top-type? t2 'RIGHT_PAREN)
(values (make-grouping e2) (cdr t2))
(parse-err! t2 "Expected ')'"))))
(else (parse-err! toks "Unknown token")))))
(define (parse-err! toks msg)
(let ((top (car toks)))
- (if (top-type? toks '(EOF))
+ (if (top-type? toks 'EOF)
(fname-err! (format "~A:~A ~A" (token-line top) "Error at end." msg))
(fname-err! (format "~A:~A ~A. ~A"
(token-line top)
@@ -292,7 +294,7 @@
(define (synchronize tokens)
(cond
((null? tokens) '())
- ((top-type? tokens '(SEMICOLON)) (cdr tokens))
+ ((top-type? tokens 'SEMICOLON) (cdr tokens))
((top-type? tokens '(CLASS FUN VAR FOR IF WHILE PRINT RETURN)) tokens)
(else (synchronize (cdr tokens)))))
@@ -300,7 +302,7 @@
;; Loop through declarations, starting with tokens BUT using call/cc
;; to bookmark the loop so we can synchronize on parse-err!
(let loop ((toks (call/cc (lambda (cc) (set! parser-sync cc) tokens))))
- (if (and (not (null? toks)) (not (top-type? toks '(EOF))))
+ (if (and (not (null? toks)) (not (top-type? toks 'EOF)))
(let-values (((expr rest) (parse-declaration toks)))
(cons expr (loop rest)))
'())))
