~akarle/fisl

3b16bd0775d48d882d8adbc9108d369a43431570 — Alex Karle 1 year, 4 months ago 415557b
refactor: Allow top-type? to take in symbol or list

Might as well use dynamic typing to its fullest!
1 files changed, 37 insertions(+), 35 deletions(-)

M parser.scm
M parser.scm => parser.scm +37 -35
@@ 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)))
      '())))