Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains some high level functions/macros, mainly abstacting the low level
;;; interface to the compiler

(defn compile* (source environment)
      "Compile SOURCE so it can be evaluated/applied"
      :internal
      (-> (macroexpand* source environment)
          (constant-fold environment)
          (backend environment)))

(defn compile/do* (source environment)
      :internal
      (if (pair? source)
          (compile* (cons do source) environment)
          source))

(defmacro compile (source)
          :internal
          "Compile SOURCE so it can be evaluated/applied"
          `(compile* ~source (current-closure)))

(defn meta/parse/body (name args body)
      :internal
      (def source body)
      (while (and (not (last? source))
                  (or (not= (:type-name (car source))
                            :pair)
                      (= (caar source) 'deftest)))
        (cdr! source))
      (def meta {:name name})
      (while body
        (def v (car body))
        (case (:type-name v)
              (:pair (if (= (car v) 'deftest)
                         (set! meta :tests (cons (cdr v) (ref meta :tests)))
                         (set! body #nil)))
              (:string (set! meta :documentation (cat (:string (ref meta :documentation))
                                                                 "\n"
                                                                 v)))
              (:keyword (case v
                              (:inline (set! meta v #t)
                                       (set! meta :source source))
                              (:related (set! meta :related (cons (cadr body) (ref meta :related)))
                                        (cdr! body))
                              (:export-as (set! meta :export (cadr body))
                                          (cdr! body))
                              (:cat (set! meta :cat (cadr body))
                                    (cdr! body))
                              (otherwise (set! meta v #t)))))
        (cdr! body))
      (when (ref meta :documentation)
        (set! meta :documentation (-> (ref meta :documentation)
                                           (split "\n")
                                           (map trim)
                                           (join "\n")
                                           (trim))))
      (return meta))

(defmacro defmacro (name args . body)
          "Define a new macro"
          `(def ~name (macro* '~args
                              ~(meta/parse/body name args body)
                              '~(compile/do* body (current-closure)))))

(defn fn/check (args body)
      :cat :compiler
      :internal
      (when-not args (exception :type-error "Every function needs an argument list" args))
      (while args
        (when-not (or (symbol? args)
                      (pair? args))
                  (exception :type-error "Wrong type for argument list" args))
        (cdr! args))
      (when-not body (exception :type-error "Every function needs a body" body)))

(defmacro fn (args . body)
          "Define an anonymous function"
          (fn/check args body)
          `(fn* '~args
                ~(meta/parse/body 'anonymous args body)
                '~(compile/do* body (current-closure))))

(defmacro defn (name args . body)
          "Define a new function"
          (fn/check args body)
          (def fn-meta (meta/parse/body name args body))
          (def def-form `(def ~name (fn* '~args
                           ~fn-meta
                           '~(compile/do* body (current-closure)))))
          (if (ref fn-meta :export)
              (list 'export (if (symbol? (ref fn-meta :export))
                                (ref fn-meta :export)
                                name) def-form)
              def-form))

(defn eval-in (env form)
      "Compile and immediatly evaluate the result directly in environment"
      (mutable-eval* (compile* form env) env))

(defmacro eval (expr)
          "Compile, Evaluate and then return the result of EXPR"
          `(bytecode-eval* (compile ~expr) (current-closure)))

(defmacro typecheck/only (v t)
          `(when-not (= (:type-name ~v) ~t)
                     (exception :type-error ~(fmt "Expected a value of type {t}") ~v)))

(def gensym (let ((gensym/counter 0))
                 (defn gensym (prefix)
                       (inc! gensym/counter)
                       (:symbol (cat prefix "ΓεnΣym-" gensym/counter)))))