~akarle/fisl

2327624edd8346a593cf0b06f03682f58ddafc76 — Alex Karle 1 year, 3 months ago 3b16bd0
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.
1 files changed, 59 insertions(+), 65 deletions(-)

M parser.scm
M parser.scm => parser.scm +59 -65
@@ 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)