(define
  lua-tx
  (fn
    (node)
    (cond
      ((= node nil) nil)
      ((not (= (type-of node) "list")) node)
      (else (lua-tx-dispatch (first node) node)))))

(define
  lua-tx-dispatch
  (fn
    (tag node)
    (cond
      ((= tag (quote lua-num)) (nth node 1))
      ((= tag (quote lua-str)) (nth node 1))
      ((= tag (quote lua-nil)) nil)
      ((= tag (quote lua-true)) true)
      ((= tag (quote lua-false)) false)
      ((= tag (quote lua-name)) (make-symbol (nth node 1)))
      ((= tag (quote lua-vararg))
        (error "lua-transpile: ... not yet supported"))
      ((= tag (quote lua-binop)) (lua-tx-binop node))
      ((= tag (quote lua-unop)) (lua-tx-unop node))
      ((= tag (quote lua-call)) (lua-tx-call node))
      ((= tag (quote lua-method-call)) (lua-tx-method-call node))
      ((= tag (quote lua-field)) (lua-tx-field node))
      ((= tag (quote lua-index)) (lua-tx-index node))
      ((= tag (quote lua-table)) (lua-tx-table node))
      ((= tag (quote lua-function)) (lua-tx-function node))
      ((= tag (quote lua-block)) (lua-tx-block node))
      ((= tag (quote lua-local)) (lua-tx-local node))
      ((= tag (quote lua-assign)) (lua-tx-assign node))
      ((= tag (quote lua-if)) (lua-tx-if node))
      ((= tag (quote lua-while)) (lua-tx-while node))
      ((= tag (quote lua-repeat)) (lua-tx-repeat node))
      ((= tag (quote lua-for-num)) (lua-tx-for-num node))
      ((= tag (quote lua-do)) (lua-tx-do node))
      ((= tag (quote lua-break)) (quote lua-break-marker))
      ((= tag (quote lua-return)) (lua-tx-return node))
      ((= tag (quote lua-call-stmt)) (lua-tx (nth node 1)))
      ((= tag (quote lua-local-function)) (lua-tx-local-function node))
      ((= tag (quote lua-function-decl)) (lua-tx-function-decl node))
      (else (error (str "lua-transpile: unknown node " tag))))))

(define
  lua-tx-binop
  (fn
    (node)
    (let
      ((op (nth node 1))
        (a (lua-tx (nth node 2)))
        (b (lua-tx (nth node 3))))
      (cond
        ((= op "+") (list (make-symbol "lua-add") a b))
        ((= op "-") (list (make-symbol "lua-sub") a b))
        ((= op "*") (list (make-symbol "lua-mul") a b))
        ((= op "/") (list (make-symbol "lua-div") a b))
        ((= op "%") (list (make-symbol "lua-mod") a b))
        ((= op "^") (list (make-symbol "lua-pow") a b))
        ((= op "..") (list (make-symbol "lua-concat") a b))
        ((= op "==") (list (make-symbol "lua-eq") a b))
        ((= op "~=") (list (make-symbol "lua-neq") a b))
        ((= op "<") (list (make-symbol "lua-lt") a b))
        ((= op "<=") (list (make-symbol "lua-le") a b))
        ((= op ">") (list (make-symbol "lua-gt") a b))
        ((= op ">=") (list (make-symbol "lua-ge") a b))
        ((= op "and")
          (list
            (make-symbol "let")
            (list (list (make-symbol "_la") a))
            (list
              (make-symbol "if")
              (list (make-symbol "lua-truthy?") (make-symbol "_la"))
              b
              (make-symbol "_la"))))
        ((= op "or")
          (list
            (make-symbol "let")
            (list (list (make-symbol "_la") a))
            (list
              (make-symbol "if")
              (list (make-symbol "lua-truthy?") (make-symbol "_la"))
              (make-symbol "_la")
              b)))
        (else (error (str "lua-transpile: unknown binop " op)))))))

(define
  lua-tx-unop
  (fn
    (node)
    (let
      ((op (nth node 1)) (e (lua-tx (nth node 2))))
      (cond
        ((= op "-") (list (make-symbol "lua-neg") e))
        ((= op "not")
          (list (make-symbol "not") (list (make-symbol "lua-truthy?") e)))
        ((= op "#") (list (make-symbol "lua-len") e))
        (else (error (str "lua-transpile: unknown unop " op)))))))

(define
  lua-tx-call
  (fn
    (node)
    (let
      ((fn-ast (nth node 1)) (args (nth node 2)))
      (cons (lua-tx fn-ast) (map lua-tx args)))))

(define
  lua-tx-method-call
  (fn
    (node)
    (let
      ((obj (lua-tx (nth node 1)))
        (name (nth node 2))
        (args (nth node 3)))
      (cons
        (list (make-symbol "lua-get") obj name)
        (cons obj (map lua-tx args))))))

(define
  lua-tx-field
  (fn
    (node)
    (list (make-symbol "lua-get") (lua-tx (nth node 1)) (nth node 2))))

(define
  lua-tx-index
  (fn
    (node)
    (list
      (make-symbol "lua-get")
      (lua-tx (nth node 1))
      (lua-tx (nth node 2)))))

(define
  lua-tx-table
  (fn
    (node)
    (let
      ((fields (rest node)))
      (cons (make-symbol "lua-make-table") (map lua-tx-table-field fields)))))

(define
  lua-tx-table-field
  (fn
    (f)
    (cond
      ((= (first f) (quote lua-pos))
        (list (make-symbol "list") "pos" (lua-tx (nth f 1))))
      ((= (first f) (quote lua-kv))
        (list
          (make-symbol "list")
          "kv"
          (lua-tx (nth f 1))
          (lua-tx (nth f 2))))
      (else (error "lua-transpile: unknown table field")))))

(define
  lua-tx-function
  (fn
    (node)
    (let
      ((params (nth node 1))
        (is-vararg (nth node 2))
        (body (nth node 3)))
      (let
        ((sym-params (map make-symbol params)))
        (list (make-symbol "fn") sym-params (lua-tx body))))))

(define
  lua-tx-block
  (fn
    (node)
    (let
      ((stmts (rest node)))
      (cond
        ((= (len stmts) 0) nil)
        ((= (len stmts) 1) (lua-tx (first stmts)))
        (else (cons (make-symbol "begin") (map lua-tx stmts)))))))

(define
  lua-tx-local
  (fn
    (node)
    (let
      ((names (nth node 1)) (exps (nth node 2)))
      (cond
        ((= (len names) 1)
          (list
            (make-symbol "define")
            (make-symbol (first names))
            (if (> (len exps) 0) (lua-tx (first exps)) nil)))
        (else
          (cons (make-symbol "begin") (lua-tx-local-pairs names exps 0)))))))

(define
  lua-tx-local-pairs
  (fn
    (names exps i)
    (if
      (>= i (len names))
      (list)
      (cons
        (list
          (make-symbol "define")
          (make-symbol (nth names i))
          (if (< i (len exps)) (lua-tx (nth exps i)) nil))
        (lua-tx-local-pairs names exps (+ i 1))))))

(define
  lua-tx-assign
  (fn
    (node)
    (let
      ((lhss (nth node 1)) (rhss (nth node 2)))
      (cond
        ((= (len lhss) 1)
          (lua-tx-single-assign (first lhss) (lua-tx (first rhss))))
        (else
          (cons (make-symbol "begin") (lua-tx-assign-pairs lhss rhss 0)))))))

(define
  lua-tx-assign-pairs
  (fn
    (lhss rhss i)
    (if
      (>= i (len lhss))
      (list)
      (cons
        (lua-tx-single-assign
          (nth lhss i)
          (if (< i (len rhss)) (lua-tx (nth rhss i)) nil))
        (lua-tx-assign-pairs lhss rhss (+ i 1))))))

(define
  lua-tx-single-assign
  (fn
    (lhs rhs)
    (cond
      ((= (first lhs) (quote lua-name))
        (list (make-symbol "set!") (make-symbol (nth lhs 1)) rhs))
      ((= (first lhs) (quote lua-field))
        (list
          (make-symbol "lua-set!")
          (lua-tx (nth lhs 1))
          (nth lhs 2)
          rhs))
      ((= (first lhs) (quote lua-index))
        (list
          (make-symbol "lua-set!")
          (lua-tx (nth lhs 1))
          (lua-tx (nth lhs 2))
          rhs))
      (else (error "lua-transpile: bad assignment target")))))

(define
  lua-tx-if
  (fn
    (node)
    (let
      ((cnd (lua-tx (nth node 1)))
        (then-body (lua-tx (nth node 2)))
        (elseifs (nth node 3))
        (else-body (nth node 4)))
      (if
        (and (= (len elseifs) 0) (= else-body nil))
        (list
          (make-symbol "when")
          (list (make-symbol "lua-truthy?") cnd)
          then-body)
        (lua-tx-if-cond cnd then-body elseifs else-body)))))

(define
  lua-tx-if-cond
  (fn
    (cnd then-body elseifs else-body)
    (let
      ((clauses (cons (list (list (make-symbol "lua-truthy?") cnd) then-body) (map lua-tx-elseif elseifs))))
      (cons
        (make-symbol "cond")
        (if
          (= else-body nil)
          clauses
          (append
            clauses
            (list (list (make-symbol "else") (lua-tx else-body)))))))))

(define
  lua-tx-elseif
  (fn
    (pair)
    (list
      (list (make-symbol "lua-truthy?") (lua-tx (first pair)))
      (lua-tx (nth pair 1)))))

(define
  lua-tx-while
  (fn
    (node)
    (let
      ((cnd (lua-tx (nth node 1))) (body (lua-tx (nth node 2))))
      (list
        (make-symbol "let")
        (list)
        (list
          (make-symbol "define")
          (make-symbol "_while_loop")
          (list
            (make-symbol "fn")
            (list)
            (list
              (make-symbol "when")
              (list (make-symbol "lua-truthy?") cnd)
              (list
                (make-symbol "begin")
                body
                (list (make-symbol "_while_loop"))))))
        (list (make-symbol "_while_loop"))))))

(define
  lua-tx-repeat
  (fn
    (node)
    (let
      ((body (lua-tx (nth node 1))) (cnd (lua-tx (nth node 2))))
      (list
        (make-symbol "let")
        (list)
        (list
          (make-symbol "define")
          (make-symbol "_repeat_loop")
          (list
            (make-symbol "fn")
            (list)
            (list
              (make-symbol "begin")
              body
              (list
                (make-symbol "when")
                (list
                  (make-symbol "not")
                  (list (make-symbol "lua-truthy?") cnd))
                (list (make-symbol "_repeat_loop"))))))
        (list (make-symbol "_repeat_loop"))))))

(define
  lua-tx-for-num
  (fn
    (node)
    (let
      ((name (nth node 1))
        (start (lua-tx (nth node 2)))
        (stop (lua-tx (nth node 3)))
        (step-ast (nth node 4))
        (body (lua-tx (nth node 5))))
      (let
        ((step (if (= step-ast nil) 1 (lua-tx step-ast))))
        (list
          (make-symbol "let")
          (list
            (list (make-symbol "_for_stop") stop)
            (list (make-symbol "_for_step") step))
          (list (make-symbol "define") (make-symbol name) start)
          (list
            (make-symbol "define")
            (make-symbol "_for_loop")
            (list
              (make-symbol "fn")
              (list)
              (list
                (make-symbol "when")
                (list
                  (make-symbol "lua-for-continue?")
                  (make-symbol name)
                  (make-symbol "_for_stop")
                  (make-symbol "_for_step"))
                (list
                  (make-symbol "begin")
                  body
                  (list
                    (make-symbol "set!")
                    (make-symbol name)
                    (list
                      (make-symbol "+")
                      (make-symbol name)
                      (make-symbol "_for_step")))
                  (list (make-symbol "_for_loop"))))))
          (list (make-symbol "_for_loop")))))))

(define lua-tx-do (fn (node) (lua-tx (nth node 1))))

(define
  lua-tx-return
  (fn
    (node)
    (let
      ((exps (nth node 1)))
      (cond
        ((= (len exps) 0) nil)
        ((= (len exps) 1) (lua-tx (first exps)))
        (else (cons (make-symbol "list") (map lua-tx exps)))))))

(define
  lua-tx-local-function
  (fn
    (node)
    (let
      ((name (nth node 1)) (func (nth node 2)))
      (list (make-symbol "define") (make-symbol name) (lua-tx func)))))

(define
  lua-tx-function-decl
  (fn
    (node)
    (let
      ((target (nth node 1)) (func (nth node 2)))
      (cond
        ((= (first target) (quote lua-name))
          (list
            (make-symbol "define")
            (make-symbol (nth target 1))
            (lua-tx func)))
        ((= (first target) (quote lua-field))
          (list
            (make-symbol "lua-set!")
            (lua-tx (nth target 1))
            (nth target 2)
            (lua-tx func)))
        (else (error "lua-transpile: bad function decl target"))))))

(define lua-transpile (fn (src) (lua-tx (lua-parse src))))

(define
  lua-eval-ast
  (fn (src) (let ((sx (lua-transpile src))) (eval-expr sx))))