29210ae5f1ea7989d86f2ad5672d39973640e71b — Alex Karle 1 year, 3 months ago 2327624
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?).
1 files changed, 36 insertions(+), 31 deletions(-)

M parser.scm
M parser.scm => parser.scm +36 -31
@@ 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)
	(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)
	(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)
		     (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)

(define (parse-block tokens)