(assign uniq-counter 0)

(assign mac-expand

(fn (names macfn expr)
    (cond macfn
          (handle-error
           (fn (errors traces)
               (error "expanding" (inspect expr) "with" macfn))
           (fn ()
               (pre-compile-with names (apply macfn (cdr expr)))))
          expr)))

(assign macs (hash))

(assign pre-compile-each

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

(assign pre-compile-msg

(fn (src compiled)
    compiled))

(assign pre-compile-raw

(fn (names expr)
    (cond (pair? expr)
          (cond (eq? (car expr) 'quote)
                expr
                (cond (isa 'symbol (car expr))
                  (pre-compile-each
                    names
                    (mac-expand names
                      (hash-get names
                        (car expr))
                      expr))
                  (pre-compile-each
                    names
                    expr)))
          expr)))

(assign pre-compile-debug

(fn (names expr)
    (pre-compile-msg expr
                     (pre-compile-raw names
                                      expr))))

(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 (expr)
    (pre-compile-with macs expr)))

;; this is the entry point for the interpreter ; we need to reset uniq-counter for each new expression ;; (for performance purposes only - to ensure identical nydp code produces identical ruby code) ; but ;; we can’t reset uniq-counter in the middle of pre-compiling an expression, otherwise @uniq@ won’t be ;; even slightly unique any more (assign pre-compile-new-expression

(fn (expr)
    (assign uniq-counter 0)
    (pre-compile-with macs expr)))

; 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-build-cons (a b)

(cond b
      (list 'cons a b)
      (list 'cons a)))

(def qq-skip-unquote-splicing (arg rest level)

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

(def qq-handle-quasiquote (arg rest level)

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

(def qq-handle-unquote (arg rest level)

(qq-build-cons
      (qq-maybe-unquote arg level)
      (qq-quasiquote rest level)))

(def qq-unquote-recurse (arg rest level)

(qq-build-cons
      (qq-quasiquote arg level)
      (qq-quasiquote rest level)))

(def qq-handle-plain (arg rest level)

(qq-build-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)))