lua/parser tweaks

* module/language/lua/parser.scm (define-record, define-ast): Simplify
  these macros.
  (make-parser): A number of small idiomatic changes.

module/language/lua/parser.scm

@@ -26,16 +26,13 @@
 ;; compiling the source.
 
 (define-module (language lua parser)
-
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-8)
   #:use-module (srfi srfi-9)
   #:use-module (rnrs control)
-
   #:use-module (language lua common)
   #:use-module (language lua lexer)
   #:use-module (language lua runtime)
-
   #:export (make-parser read-lua))
 
 ;; Implicitly named records
@@ -43,16 +40,17 @@
     ((define-record
       (lambda (stx)
         (define (id template-id . rest)
-          (datum->syntax template-id (string->symbol (apply string-append (map (lambda (x) (if (string? x) x (symbol->string (syntax->datum x)))) rest)))))
+          (datum->syntax template-id
+                         (apply symbol-append (map syntax->datum rest))))
         (syntax-case stx ()
           ((_ name field ...)
            (with-syntax
-               ((constructor (id #'name "make-" #'name))
-                (predicate (id #'name #'name "?"))
+               ((constructor (id #'name 'make- #'name))
+                (predicate (id #'name #'name '?))
                ((setter ...)
-                (map (lambda (x) (id #'name #'name "-" x "!")) #'(field ...)))
+                (map (lambda (x) (id #'name #'name '- x '!)) #'(field ...)))
                ((getter ...)
-                (map (lambda (x) (id #'name #'name "-" x)) #'(field ...))))
+                (map (lambda (x) (id #'name #'name '- x)) #'(field ...))))
 
              #'(begin
                  (define-record-type name
@@ -71,11 +69,12 @@
      (define-ast
       (lambda (stx)
         (define (id template-id . rest)
-          (datum->syntax template-id (string->symbol (apply string-append (map (lambda (x) (if (string? x) x (symbol->string (syntax->datum x)))) rest)))))
+          (datum->syntax template-id
+                         (apply symbol-append (map syntax->datum rest))))
 
         (syntax-case stx ()
           ((_ "aux" name field ...)
-           #`(define-record #,(id #'name "ast-" #'name) #,(id #'name "src") field ...))
+           #`(define-record #,(id #'name 'ast- #'name) #,(id #'name 'src) field ...))
 
           ((_ (name field ...) ...)
            #`(begin
@@ -123,17 +122,19 @@
   "Returns true if TOKEN denotes the end of a grammatical chunk."
   (or (memq token '(#:else #:elseif #:end #:until)) (eof-object? token)))
 
+(define *special-tokens*
+  '(#\. #\( #\) #\, #\- #\< #\; #\+ #\{ #\} #\[ #\] #\: #\#
+    #:function #:end #:if #:return #:elseif #:then #:else #:true #:false
+    #:nil #:== #:~= #:= #\> #:>= #:<= #:local #:dots #:break #:do #:in))
+
 (define (token/type t)
-  (cond ((number? t) 'NUMBER)
+  (cond
+   ((number? t) 'NUMBER)
    ((eof-object? t) 'EOS)
    ((symbol? t) 'NAME)
    ((string? t) 'STRING)
-        (else
-         (case t
-           ((#\. #\( #\) #\, #\- #\< #\; #\+ #\{ #\} #\[ #\] #\: #\#
-#:function #:end #:if #:return #:elseif #:then #:else #:true #:false
-#:nil #:== #:~= #:= #\> #:>= #:<= #:local #:dots #:break #:do #:in) t)
-           (else (error 'TOKEN/TYPE t))))))
+   ((memv t *special-tokens*) t)
+   (else (error 'TOKEN/TYPE t))))
 
 ;; infix operator parsing
 (define (binary-operator? t)
@@ -161,22 +162,37 @@
 
 (define (make-lua-assignment left right)
   "Generate an assignment from a variable and an expression"
-  (cond ((ast-global-ref? left)
-         (make-ast-global-set (ast-global-ref-src left) (ast-global-ref-name left) right))
+  (cond
+   ((ast-global-ref? left)
+    (make-ast-global-set (ast-global-ref-src left)
+                         (ast-global-ref-name left)
+                         right))
    ((ast-local-ref? left)
-         (make-ast-local-set (ast-local-ref-src left) (ast-local-ref-name left) (ast-local-ref-gensym left) right))
+    (make-ast-local-set (ast-local-ref-src left)
+                        (ast-local-ref-name left)
+                        (ast-local-ref-gensym left)
+                        right))
    ((ast-table-ref? left)
-         (make-ast-table-set (ast-table-ref-src left) (ast-table-ref-table left) (ast-table-ref-key left) right))
+    (make-ast-table-set (ast-table-ref-src left)
+                        (ast-table-ref-table left)
+                        (ast-table-ref-key left)
+                        right))
    (else
     (error 'MAKE-LUA-ASSIGNMENT "should not happen"))))
 
 (define (wrap-expression-in-environment src e x)
   "Wrap an expression in an enclosing lexical environment if necessary"
-  (let* ((bindings (map cdr (environment-bindings e)))
-         (locals (filter-map (lambda (b) (if (eq? (binding-type b) 'local) b #f)) bindings)))
+  (let ((locals (filter-map (lambda (binding)
+                              (let ((b (cdr binding)))
+                                (and (eq? (binding-type b) 'local) b)))
+                            (environment-bindings e))))
     (if (null? locals)
         x
-        (make-ast-local-block src (map binding-name locals) (map binding-gensym locals) (map (lambda (c) *nil-literal*) locals) x))))
+        (make-ast-local-block src
+                              (map binding-name locals)
+                              (map binding-gensym locals)
+                              (map (lambda (c) *nil-literal*) locals)
+                              x))))
 
 ;;;;; PARSER
 
@@ -216,7 +232,9 @@
   (define (environment-define! name type)
     "Define a new variable with NAME and TYPE"
     (if (not (member name (environment-bindings environment)))
-        (environment-bindings! environment (alist-cons name
+        (environment-bindings!
+         environment
+         (acons name
                 (make-binding
                  name
                  (gensym (string-append " " (symbol->string name)))
@@ -227,35 +245,24 @@
   ;; because Lua allows global variables to be referenced without being
   ;; predefined
 
-  (define (environment-lookup-aux name . e)
+  (define* (environment-lookup-aux name #:optional (e environment))
     "Given a variable's NAME, look up its binding."
-    (set! e (if (null? e) environment (car e )))
-    (if e
-        (let ((binding (assq-ref (environment-bindings e) name)))
-          (if binding
-              binding
-              (environment-lookup-aux name (environment-parent e))))
-        #f))
+    (and e (or (assq-ref (environment-bindings e) name)
+               (environment-lookup-aux name (environment-parent e)))))
   
   (define (environment-lookup-gensym name)
     "Given a variable's NAME, look up its gensym"
-    (define binding (environment-lookup-aux name))
-    (if binding
-        (binding-gensym binding)
-        #f))
+    (and=> (environment-lookup-aux name) binding-gensym))
   
   (define (environment-lookup-type name)
     "Given a variable's NAME, look up its global"
-    (define binding (environment-lookup-aux name))
-    (if binding
-        (binding-type binding)
-        #f))
+    (and=> (environment-lookup-aux name) binding-type))
 
   (define (resolve-ref src name)
     "Determine whether a variable reference is global or local"
-    (let* ((binding (environment-lookup-gensym name)))
-      (if binding
-          (make-ast-local-ref src name binding)
+    (let ((sym (environment-lookup-gensym name)))
+      (if sym
+          (make-ast-local-ref src name sym)
           (make-ast-global-ref src name))))
 
   ;;;;; LEXER INTERACTION
@@ -270,7 +277,7 @@
 
   (define-syntax advance!
     (syntax-rules ()
-      ((_ x) (begin (advance-aux) x))
+      ((_ x) (let ((t x)) (advance-aux) t))
       ((_) (advance-aux))))
 
   (define (assert-token-type type)
@@ -280,9 +287,7 @@
 
   (define (maybe-skip-next! c)
     "Skip a token"
-    (if (equal? token c)
-        (advance! #t)
-        #f))
+    (and (equal? token c) (advance! #t)))
 
   (define (enforce-next! expect)
     "Throw an error if the current token is not the expected token"
@@ -292,34 +297,32 @@
   ;;;;; GRAMMAR
 
   ;; single-name -> NAME
-  (define (single-name . return-src?)
-    (define save token)
-    (define src (get-source-info))
+  (define (single-name)
+    (let ((save token))
       (assert-token-type 'NAME)
       (advance!)
-    (if (not (null? return-src?))
-        (values src save)
       save))
 
   ;; single-variable -> single-name
   (define (single-variable)
-    (receive (src save)
-             (single-name #:return-src #t)
+    (let* ((src (get-source-info))
+           (save (single-name)))
       (resolve-ref src save)))
 
   ;; application-arguments -> '(' [ expression-list ] ')' | STRING | TABLE
   (define (application-arguments)
-    (cond ((eq? (token/type token) 'STRING)
-           (let* ((string token))
+    (case (token/type token)
+      ((STRING)
+       (let ((string token))
          (advance!)
          (list (make-ast-literal #f string))))
-          ((eq? token #\{)
+      ((#\{)
        ;; TODO: table constructor
        ;; '('
        (list (table-literal)))
-          ((eq? token #\()
+      ((#\()
        (advance!)
-           (if (eq? token #\))
+       (if (eqv? token #\))
            ;; ')'
            (advance! '())
            ;; [ expression-list ]
@@ -327,75 +330,73 @@
              ;; ')'
              (enforce-next! #\))
              arguments)))
-           (else (error 'APPLICATION-ARGUMENTS "should not happen"))))
+      (else
+       (error 'APPLICATION-ARGUMENTS "should not happen"))))
 
   ;; prefix-expression -> NAME | '(' expression ')'
   (define (prefix-expression)
-    (cond
+    (case (token/type token)
       ;; NAME
-      ((eq? (token/type token) 'NAME) (single-variable))
+      ((NAME) (single-variable))
       ;; '('
-      ((eq? token #\()
-       (begin
+      ((#\()
        (advance!)
        ;; expression
-         (let* ((save (expression)))
+       (let ((save (expression)))
          ;; ')'
          (enforce-next! #\))
          ;; finished
-           save)))
+         save))
       (else (syntax-error (get-source-info) "unexpected symbol ~a" token))))
 
   ;; index -> '[' expression ']'
   (define (index)
     (enforce-next! #\[)
-    (let* ((indice (expression)))
+    (let ((index (expression)))
       (enforce-next! #\])
-      indice))
+      index))
 
   ;; field-selector -> '.' NAME
   (define (field-selector src prefix)
-    (make-ast-table-ref src prefix (make-ast-literal src (symbol->string (single-name)))))
+    (make-ast-table-ref src prefix
+                        (make-ast-literal src (symbol->string (single-name)))))
 
   ;; primary-expression -> prefix-expression { field-selector [ application-arguments ] | index | application-arguments }
   (define (primary-expression)
-    (define src (get-source-info))
+    (let ((src (get-source-info)))
       ;; prefix-expression
-    (define prefix (prefix-expression))
-    (let lp ((expr prefix))
+      (let lp ((expr (prefix-expression)))
         (case (token/type token)
           ;; field-selector
           ((#\.) (advance!) (lp (field-selector src expr)))
           ;; index
-          ((#\[)
-           (let* ((indice (index)))
-             (lp (make-ast-table-ref src expr indice))))
+          ((#\[) (lp (make-ast-table-ref src expr (index))))
           ;; ':' NAME application-arguments
           ((#\:)
            (advance!)
-           (assert-token-type 'NAME)
-           (let* ((name (single-name)))
-             (lp
-              (make-ast-function-call src
-              (make-ast-table-ref src expr (make-ast-literal src (symbol->string name)))
-              (cons expr (application-arguments))))))
+           ;; FIXME: double-evaluation of expr
+           (let* ((name (single-name))
+                  (args (application-arguments)))
+             (lp (make-ast-function-call
+                  src
+                  (make-ast-table-ref
+                   src expr (make-ast-literal src (symbol->string name)))
+                  (cons expr args)))))
           ;; application-arguments
           ((#\( STRING #\{)
            (lp (make-ast-function-call src expr (application-arguments))))
-          (else expr))))
+          (else expr)))))
 
   ;; expression-statement -> function | assignment
   (define (expression-statement)
-    (define primary (primary-expression))
+    (let ((primary (primary-expression)))
       (if (ast-function-call? primary)
           primary
-        (assignment primary)))
-
+          (assignment primary))))
 
   ;; record-field -> (NAME | index) '=' expression
   (define (record-field)
-    (let* ((indice
-            (cond
+    (let* ((index (cond
                    ;; NAME
                    ((eq? (token/type token) 'NAME)
                     (let ((tmp (make-ast-literal #f (symbol->string token))))
@@ -403,13 +404,12 @@
                       tmp))
                    ;; index
                    (else (index))))
-           (value
-            (begin
+           (value (begin
                     ;; '='
                     (enforce-next! #:=)
                     ;; expression
                     (expression))))
-      (values indice value)))
+      (values index value)))
 
   ;; field -> expression | record-field
   (define (field)
@@ -425,63 +425,59 @@
   ;; field-separator -> ',' | ';'
   ;; table-fields -> [ field { field-separator field } [ field-separator ] ]
   (define (table-fields src)
-    (if (eq? token #\})
-        '()
-        (let loop ((implicit-indice 1)
+    (let loop ((implicit-index 1)
                (tree '()))
-          (if (eq? token #\})
+      (if (eqv? token #\})
           (reverse! tree)
-              (receive
-               (indice expr)
-               (field)
+          (receive (index expr) (field)
             ;; field-separator
             (maybe-skip-next! #\,)
             (maybe-skip-next! #\;)
-
             (loop
-                (if (not indice) (+ implicit-indice 1) implicit-indice)
+             (if (not index) (+ implicit-index 1) implicit-index)
              (cons
-                 (cons (or indice (make-ast-literal src implicit-indice)) expr)
-                 tree)))))))
+              (cons (or index (make-ast-literal src implicit-index)) expr)
+              tree))))))
 
   ;; table-literal -> '{' table-fields '}'
   (define (table-literal)
-    (define src (get-source-info))
+    (let ((src (get-source-info)))
       ;; '{'
       (enforce-next! #\{)
-    ;; bind the table to a temporary variable with LET as it's needed in order to initialize the table
-    (let* ((result (make-ast-table-literal src (table-fields src))))
-      result
+      ;; bind the table to a temporary variable with LET as it's needed
+      ;; in order to initialize the table
+      (let ((result (make-ast-table-literal src (table-fields src))))
         (enforce-next! #\})
-      result))
+        result)))
 
   ;; parameter-list -> [ parameter { ',' parameter } ]
   (define (parameter-list function-name)
-    (if (eq? token #\))
-        (values '() #f)
     (let lp ((parameters '()))
-          ;; parameter
-          (let* ((parameters
-                  (if (eq? (token/type token) 'NAME)
-                      (append! parameters (list token))
-                      (if (eq? token #:dots)
-                          (values parameters #f)
-                          (syntax-error (get-source-info) "expected either a name or ... in the parameter list of '~a', but got ~a" function-name token))))
-                 (last-token token))
+      (case (token/type token)
+        ((NAME)
+         (let ((parameters (cons token parameters)))
            (advance!)
-            (if (eq? token #\,)
-                (if (eq? last-token #:dots)
-                    (syntax-error (get-source-info) "expected ')' after ... in the parameter list of '~a'" function-name)
-                    (advance! (lp parameters)))
-                (values parameters (eq? last-token #:dots)))))))
+           (if (maybe-skip-next! #\,)
+               (lp parameters)
+               (values (reverse! parameters) #f))))
+        ((#\))
+         (values (reverse! parameters) #f))
+        ((#:dots)
+         (advance!)
+         (values (reverse! parameters) #t))
+        (else
+         (syntax-error
+          (get-source-info)
+          "expected either a name or ... in the parameter list of '~a', but got ~a"
+          function-name token)))))
 
   ;; function-body -> '(' parameter-list ')' chunk END
-  (define* (function-body #:optional (src (get-source-info)) (implicit-self? #f) (name 'anonymous))
+  (define* (function-body #:optional (src (get-source-info)) (implicit-self? #f)
+                          (name 'anonymous))
     ;; '('
     (enforce-next! #\()
     ;; parameter-list
-    (receive (parameters variable-arguments?)
-             (parameter-list name)
+    (receive (parameters variable-arguments?) (parameter-list name)
       (let* ((old-vararg-function *vararg-function*))
         (set! *vararg-function* variable-arguments?)
         (enforce-next! #\))
@@ -494,10 +490,17 @@
         (let* ((body (chunk))
                (parameter-gensyms (map environment-lookup-gensym parameters))
                (result
-                       (make-ast-function src (if (eq? name 'anonymous) #f name)
-                                          (if implicit-self? (append parameters '(self)) parameters)
-                                          (if implicit-self? (append parameter-gensyms (list (environment-lookup-gensym 'self))) parameter-gensyms)
-                                          variable-arguments? (if (null? body) *void-literal* body))))
+                (make-ast-function
+                 src (if (eq? name 'anonymous) #f name)
+                 (if implicit-self?
+                     (append parameters '(self))
+                     parameters)
+                 (if implicit-self?
+                     (append parameter-gensyms
+                             (list (environment-lookup-gensym 'self)))
+                     parameter-gensyms)
+                 variable-arguments?
+                 (if (null? body) *void-literal* body))))
           (leave-environment!)
           ;; END
           (enforce-next! #:end)
@@ -515,60 +518,48 @@
 
   ;; simple-expression -> (nil | true | false | NUMBER | STRING) | table-literal | FUNCTION function-body
   (define (simple-expression)
-    (define src (get-source-info))
-    (receive
-     (advance? result)
+    (let ((src (get-source-info)))
       (case (token/type token)
         ;; (nil | true | false | NUMBER | STRING)
-       ((#:true #:false #:nil NUMBER STRING)
-        (values
-          #t
-          (make-ast-literal
-           src
-           (cond ((eq? token #:true) #t)
-                 ((eq? token #:false) #f)
-                 ((eq? token #:nil) #nil)
-                 (else token)))))
+        ((#:nil) (advance! (make-ast-literal src #nil)))
+        ((#:true) (advance! (make-ast-literal src #t)))
+        ((#:false) (advance! (make-ast-literal src #f)))
+        ((NUMBER STRING) (advance! (make-ast-literal src token)))
         ;; table-literal
-       ((#\{) (values #f (table-literal)))
+        ((#\{) (table-literal))
         ;; ...
         ((#:dots)
          (unless *vararg-function*
            (syntax-error src "cannot use '...' outside of a variable arguments function"))
-        (values #t (make-ast-variable-arguments src)))
+         (advance! (make-ast-variable-arguments src)))
         ;; FUNCTION function-body
-       ((#:function) (advance!) (values #f (function-body src)))
+        ((#:function) (advance!) (function-body src))
         ;; primary-expression
-       (else (values #f (primary-expression))))
-     (if advance?
-         (advance!))
-     result))
+        (else (primary-expression)))))
 
   ;; subexpression -> (simple-expression | unary-operator subexpression) { binary-operator subexpression }
   (define (subexpression limit)
-    (define left)
-    ;; test for preceding unary operator
-    (set! left
+    (let loop ((left
                 ;; (simple-expression | unary-operator subexpression)
                 (if (unary-operator? token)
                     ;; unary-operator subexpression
                     (let* ((src (get-source-info))
                            (operator token))
                       (advance!)
-            (make-ast-unary-operation src operator (subexpression *unary-priority*)))
+                      (make-ast-unary-operation
+                       src operator (subexpression *unary-priority*)))
                     ;; simple-expression
                     ;; note: simple-expression may advance the current token
-          (simple-expression)))
-
-    (let loop ((left left))
+                    (simple-expression))))
       ;; { binary-operator subexpression }
       (if (and (binary-operator? token) (> (priority token) limit))
           (let* ((src (get-source-info))
                  (operator token))
             (advance!)
+            (loop (make-ast-binary-operation
+                   src operator left
                    ;; read next expression with higher priorities
-            (let* ((right (subexpression (priority operator))))
-              (loop (make-ast-binary-operation src operator left right))))
+                   (subexpression (priority operator)))))
           ;; finished
           left)))
 
@@ -578,30 +569,32 @@
 
   ;; while-statement -> WHILE expression DO chunk END
   (define (while-statement)
-    (define src (get-source-info))
+    (let ((src (get-source-info)))
       ;; WHILE
       (advance!)
       ;; expression
-    (let* ((condition (expression)))
+      (let ((condition (expression)))
         ;; DO
         (enforce-next! #:do)
         ;; chunk
-      (let* ((body (chunk)))
+        (let ((body (chunk)))
           ;; END
           (enforce-next! #:end)
-        (make-ast-while-loop src condition body))))
+          (make-ast-while-loop src condition body)))))
 
   ;; return-statement -> RETURN expression-list
   (define (return-statement)
-    (define src (get-source-info))
-
+    (let ((src (get-source-info)))
       ;; RETURN
       (advance!)
-
-    (make-ast-return src (if (or (end-of-chunk? token) (eq? token #\;))
+      (make-ast-return src
+                       (if (or (end-of-chunk? token) (eqv? token #\;))
                            *void-literal*
-                         (expression-list))))
+                           (expression-list)))))
 
+  ;; FIXME: does a left-to-right assignment, so x, y = y, x probably
+  ;; doesn't work. Also does not appear to handle the x, y = foo() case.
+  ;;
   (define (parse-assignment src left right)
     ;; and then parses it, branching to handle overflows on either side if necessary
     (make-ast-sequence
@@ -640,20 +633,17 @@
 
     ;; so this function accumulates the entire assignment
     (let* ((src (get-source-info))
-           (left (let loop ((x first)
-                            (tree '()))
-                   (set! tree (cons x tree))
-                   (if (eq? token #\,)
-                       (advance! (loop (primary-expression) tree))
+           (left (let loop ((tree (list first)))
+                   (if (eqv? token #\,)
+                       (begin
+                         (advance!)
+                         (loop (cons (primary-expression) tree)))
                        (reverse! tree))))
 
            (right (begin
                     (enforce-next! #:=)
                     (expression-list))))
-      (parse-assignment src left right)
-
-      ) ; let*
-    ) ; assignment
+      (parse-assignment src left right)))
 
   ;; then-chunk -> (IF | ELSEIF) expression THEN chunk
   (define (then-chunk)
@@ -664,82 +654,78 @@
       ;; THEN
       (enforce-next! #:then)
       ;; chunk
-      (let* ((body (chunk)))
-        (values condition body))))
+      (values condition (chunk))))
 
   ;; if-statement -> then-chunk { then-chunk } [ELSE chunk] END
   (define (if-statement)
-    (define if-src (get-source-info))
-    (define x
-      (receive (test then)
-               (then-chunk)
-               (make-ast-condition
-                if-src test then
+    (let ((src (get-source-info)))
+      (receive (test then) (then-chunk)
+        (let ((x (make-ast-condition
+                  src test then
                   (let lp ()
-                  (define src (get-source-info))
+                    (let ((src (get-source-info)))
                       (if (eq? token #:elseif)
-                      (receive (test then)
-                               (then-chunk)
+                          (receive (test then) (then-chunk)
                             (make-ast-condition src test then (lp)))
                           (if (eq? token #:else)
-                          (advance! (chunk))
-                          *void-literal*))))))
+                              (begin (advance!) (chunk))
+                              *void-literal*)))))))
           (enforce-next! #:end)
-    x)
+          x))))
   
   ;; repeat-statement -> REPEAT chunk UNTIL expression
   (define (repeat-statement)
-    (define src (get-source-info))
+    (let ((src (get-source-info)))
       ;; REPEAT
       (advance!)
       ;; chunk
-    (let* ((body (chunk)))
+      (let ((body (chunk)))
         ;; UNTIL
         (enforce-next! #:until)
         ;; expression
-      (let* ((condition (expression)))
+        (let ((condition (expression)))
           (make-ast-while-loop
            src
            (make-ast-unary-operation src 'not condition)
-         body))))
+           body)))))
 
   ;; function-statement -> FUNCTION NAME { field-selector } [ ':' NAME ] function-body
   (define (function-statement)
-    (define src (get-source-info))
+    (let* ((src (get-source-info))
            ;; FUNCTION NAME
-    (define name (advance! (single-name)))
-
+           (name (begin (advance!) (single-name))))
       (receive (prefix type)
           (let lp ((last-expr (resolve-ref src name)))
-               (if (eq? token #\.)
+            (if (eqv? token #\.)
                 ;; { '.' NAME }
-                   (let* ((name (advance! (single-name))))
+                (let ((name (begin (advance!) (single-name))))
                   (if (eq? token #\()
                       (values (cons name last-expr) 'table-function)
                       (lp (make-ast-table-ref src last-expr name))))
                 ;; [ ':' NAME ]
-                   (if (eq? token #\:)
-                       (let* ((name (advance! (single-name))))
+                (if (eqv? token #\:)
+                    (let ((name (begin (advance!) (single-name))))
                       (values (cons name last-expr) 'table-method))
                     (values last-expr 'function))))
-             (define body (function-body src (eq? type 'table-method) name))
+        (let ((body (function-body src (eq? type 'table-method) name)))
           (case type
             ((table-function table-method)
-                (make-ast-table-set src (cdr prefix) (make-ast-literal src (symbol->string (car prefix))) body))
-               ((function) (make-lua-assignment prefix body))
-               (else (error 'FUNCTION-STATEMENT "should not happen")))))
+             (make-ast-table-set
+              src (cdr prefix)
+              (make-ast-literal src (symbol->string (car prefix))) body))
+            ((function)
+             (make-lua-assignment prefix body))
+            (else (error 'FUNCTION-STATEMENT "should not happen")))))))
 
   ;; local-statement -> LOCAL NAME { ',' NAME } [ '=' expression-list ]
   (define (local-statement)
-    (define src (get-source-info))
+    (let ((src (get-source-info)))
       ;; LOCAL
       ;; (already advanced by calling function)
-
       (let lp ((names '()))
         ;; NAME
         (assert-token-type 'NAME)
-      (set! names (cons token names))
-      (advance!)
+        (let ((names (advance! (cons token names))))
           (if (maybe-skip-next! #\,)
               ;; { ',' NAME }
               (lp names)
@@ -747,123 +733,104 @@
                 (for-each (lambda (n) (environment-define! n 'local)) names)
                 (if (maybe-skip-next! #:=)
                     ;; [ '=' expression-list ]
-                (let* ((left (map (lambda (x) (resolve-ref src x)) names))
-                       (right (expression-list)))
-                  (parse-assignment src left (reverse! right)))
-                ;; otherwise, it's not a declaration, not an assignment, and evaluates to nothing
-                *void-literal*)))))
+                    (let ((left (map (lambda (x) (resolve-ref src x))
+                                     (reverse! names))))
+                      (parse-assignment src left (expression-list)))
+                    ;; otherwise, it's not a declaration, not an
+                    ;; assignment, and evaluates to nothing
+                    *void-literal*)))))))
 
   (define (local-function-statement)
     (assert-token-type 'NAME)
-    (let* ((name token))
+    (let ((name token))
       (environment-define! name 'local)
       (advance!)
-      (make-ast-local-set (get-source-info) name (environment-lookup-gensym name) (function-body))))
+      (make-ast-local-set (get-source-info) name
+                          (environment-lookup-gensym name)
+                          (function-body))))
 
   ;; for-body
   (define (for-body)
     (enforce-next! #:do)
-    (let* ((body (chunk)))
+    (let ((body (chunk)))
       (enforce-next! #:end)
       body))
 
   ;; numeric-for -> FOR NAME '=' expression ',' expression ',' expression DO chunk END
   (define (numeric-for src name)
-    (define step *default-for-step*)
-    (advance!)
     (enforce-next! #:=)
     (enter-environment!)
     (environment-define! name 'local)
-    (let* ((initial (expression)))
+    (let ((initial (expression)))
       (enforce-next! #\,)
-      (let* ((limit (expression)))
-        (when (eq? token #\,)
-          (advance!)
-          (set! step (expression)))
-        (let* ((result (make-ast-numeric-for-loop src name initial limit step (for-body))))
+      (let* ((limit (expression))
+             (step (if (maybe-skip-next! #\,)
+                       (expression)
+                       *default-for-step*))
+             (result (make-ast-numeric-for-loop src name initial limit step
+                                                (for-body))))
         (leave-environment!)
-          result))))
+        result)))
 
   ;; list-for -> FOR NAME { ',' NAME } IN expression-list DO chunk END
   (define (list-for src name)
-    (let* ((names
-            (let lp ((names (list name)))
-              (advance!)
-              (if (eq? token #\,)
-                  (begin
-                    (advance!)
-                    (assert-token-type 'NAME)
-                    (lp (cons token names)))
+    (let ((names (let lp ((names (list name)))
+                   (if (maybe-skip-next! #\,)
+                       (lp (cons (single-name) names))
                        (reverse! names)))))
       (enforce-next! #:in)
-      (let* ((exps (expression-list)))
+      (let ((exps (expression-list)))
         (enforce-next! #:do)
         (for-each
          (lambda (name)
            (environment-define! name 'hidden))
          names)
-        (let* ((body (chunk)))
+        (let ((body (chunk)))
           (enforce-next! #:end)
-          (make-ast-list-for-loop src names (map environment-lookup-gensym names) exps body)))))
+          (make-ast-list-for-loop
+           src names (map environment-lookup-gensym names) exps body)))))
 
   ;; for-statement -> FOR (numeric-for | list-for) END
   (define (for-statement)
-    (define src (get-source-info))
+    (let ((src get-source-info))
       (enforce-next! #:for)
-    (assert-token-type 'NAME)
-    (let* ((name token)
-           (result
-            (begin
-              (lookahead!)
-              (if (eq? token2 #:=)
+      (let ((name (single-name)))
+        (if (eq? token #:=)
             (numeric-for src name)
-                  (if (memv token2 '(#:in #\,))
+            (if (memv token '(#:in #\,))
                 (list-for src name)
                 (syntax-error src "expected = or in after for variable"))))))
-      result))
 
   ;; break-statement -> BREAK
   (define (break-statement)
+    (let ((src (get-source-info)))
       (enforce-next! #:break)
-    (make-ast-break (get-source-info)))
+      (make-ast-break src)))
 
   ;; statement
   (define (statement)
     (case token
       ((#\;) (advance!) (statement))
       ;; statement -> return
-      ((#:return #:break)
-       (values
-         #t
-         (case token
-           ((#:return) (return-statement))
-           ((#:break) (break-statement)))))
-      ((#:if #:function #:do #:while #:repeat #:local #:for)
-       (values
-         #f
-          (case token
-            ((#:repeat) (repeat-statement))
-            ((#:while) (while-statement))
-            ((#:if) (if-statement))
-            ((#:function) (function-statement))
-            ((#:local)
-             (advance!)
-             (if (maybe-skip-next! #:function)
-                 (local-function-statement)
-                 (local-statement)))
-            ((#:for) (for-statement))
-            ((#:do)
-             (begin
-               (advance!)
-               (let* ((body (chunk)))
+      ((#:return) (values #t (return-statement)))
+      ((#:break) (values #t (break-statement)))
+      ((#:repeat) (values #f (repeat-statement)))
+      ((#:while) (values #f (while-statement)))
+      ((#:if) (values #f (if-statement)))
+      ((#:function) (values #f (function-statement)))
+      ((#:local) (advance!) (if (maybe-skip-next! #:function)
+                                (values #f (local-function-statement))
+                                (values #f (local-statement))))
+      ((#:for) (values #f (for-statement)))
+      ((#:do) (advance!) (let ((body (chunk)))
                            (enforce-next! #:end)
-                 body))))))
+                           (values #f body)))
       ;; statement -> function | assignment
       (else (values #f (expression-statement)))))
 
   ;; chunk -> { statement [ ';' ] }
   (define (chunk)
-    (define src (get-source-info))
+    (let ((src (get-source-info)))
       (let loop ((is-last (end-of-chunk? token))
                  (tree '()))
         (if is-last
@@ -873,10 +840,8 @@
                src
                environment
                (make-ast-sequence src (reverse! tree))))
-        (receive
-         (is-last node)
-         (statement)
-         (loop (or (end-of-chunk? token) is-last) (cons node tree))))))
+            (receive (is-last node) (statement)
+              (loop (or (end-of-chunk? token) is-last) (cons node tree)))))))
 
   (initialize-lua-lexer! port get-source-info lexer)
 
@@ -888,5 +853,4 @@
   chunk)
 
 (define (read-lua port)
-  (define parser (make-parser port))
-  (parser))
+  ((make-parser port)))