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