(assign mac-expand (fn (names macfn expr)
  (cond macfn
        (pre-compile-with names
                          (apply macfn (cdr expr)))
        expr)))

(assign macs (hash))

(assign pre-compile-expr
        (fn (names expr)
            (mac-expand names
                        (hash-get names (car expr))
                        expr)))

(assign pre-compile-each
        (fn (names args)
            (cond args
                  (cond (pair? args)
                        (cons (pre-compile-with names
                                                (car args))
                              (pre-compile-each names
                                                (cdr args)))
                        args))))

(assign pre-compile-msg
        (fn (src compiled)
            (p "pre-compile" src "\n  -> " compiled)
            compiled))

(assign pre-compile-raw
        (fn (names arg)
            (cond (pair? arg)
                  (cond (eq? (car arg) 'quote)
                        arg
                        (pre-compile-each names
                                          (pre-compile-expr names arg)))
                  arg)))

(assign pre-compile-debug
        (fn (names arg)
            (pre-compile-msg arg
                             (pre-compile-raw names
                                              arg))))

(assign debug-pre-compile
        (fn (arg)
            (assign pre-compile-with
                    (cond arg
                          pre-compile-debug
                          pre-compile-raw))))

(debug-pre-compile nil)

; builtin pre-compile does nothing; override here to provide macro-expansion
(assign pre-compile
        (fn (arg)
            (pre-compile-with macs arg)))

; we override this later to provide argument deconstruction
(hash-set macs 'fun
          (fn args (cons 'fn args)))

; we override this later to provide automatic documentation
(hash-set macs 'def
          (fn (name args . body)
              (list 'assign
                    name
                    (+ (list 'fun args)
                       body))))

(def qq-handle-unquote-splicing (arg rest level)
     (cond (eq? level 0)
           (qq-do-unquote-splicing arg rest level)
           (qq-skip-unquote-splicing arg rest level)))

(def qq-do-unquote-splicing (arg rest level)
     (cond rest
           (list '+
                 (pre-compile arg)
                 (qq-quasiquote rest level))
           arg))

(def qq-skip-unquote-splicing (arg rest level)
     (list 'cons
           (list 'list ''unquote-splicing (qq-quasiquote arg (- level 1)))
           (qq-quasiquote rest level)))

(def qq-handle-quasiquote (arg rest level)
     (list 'cons
           (list 'list ''quasiquote (qq-quasiquote arg (+ level 1)))
           (qq-quasiquote rest level)))

(def qq-handle-unquote (arg rest level)
     (list 'cons
           (qq-maybe-unquote arg level)
           (qq-quasiquote rest level)))

(def qq-unquote-recurse (arg rest level)
        (list 'cons
              (qq-quasiquote arg level)
              (qq-quasiquote rest level)))

(def qq-handle-plain (arg rest level)
     (list 'cons
           (list 'quote arg)
           (qq-quasiquote rest level)))

(def qq-unquote? (arg rest level)
     (cond (pair? arg)
           (cond (eq? (car arg) 'unquote)
                 (qq-handle-unquote (cadr arg) rest level)
                 (cond (eq? (car arg) 'unquote-splicing)
                       (qq-handle-unquote-splicing (cadr arg) rest level)
                       (cond (eq? (car arg) 'quasiquote)
                             (qq-handle-quasiquote (cadr arg) rest level)
                             (qq-unquote-recurse arg rest level))))
           (qq-handle-plain arg rest level)))

(def qq-maybe-unquote (xs level)
     (cond (eq? level 0)
           (pre-compile xs)
           (list 'list ''unquote (qq-quasiquote xs (- level 1)))))

(def qq-quasiquote (things level)
  (cond things
        (cond (pair? things)
              (cond (eq? (car things) 'unquote)
                    (qq-maybe-unquote (cadr things) level)
                    (cond (eq? (car things) 'unquote-splicing)
                          (qq-handle-unquote-splicing (cadr things) nil level)
                          (cond (eq? (car things) 'quasiquote)
                                (list 'list ''quasiquote (qq-quasiquote (cdr things) (+ level 1)))
                                (qq-unquote? (car things) (cdr things) level))))
              (list 'quote things))
        nil))

(hash-set macs 'quasiquote
          (fn (arg) (qq-quasiquote arg 0)))

(hash-set macs 'do
          (fn args
              `((fn nil ,@args))))