Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Introspection and procedures returning info about the runtime

(defn describe/closure (c i)
      :cat :compiler
      :internal
      (when c
            (if (= c root-closure)
                (fmt "{i}# <root environment>")
                (do (def data (closure/data c))
                    (def l (:length data))
                  (cat (int (or i 0)) "# "
                       (string/write c)
                       " - "
                       (resolve '*module* c)
                       " - "
                       (if (< l 16)
                           (string/write data)
                           "-+- Very big tree structure -+-"))))))

(defn print/stacktrace (trace)
      (def i -1)
      (try (fn (e) "#<Error-in-Stacktrace>")
           (-> trace
               (map (fn (c) (describe/closure c (inc! i))))
               (join "\r\n"))))

(def print/error (let*
                   (defn print/error/wrap (i v)
                         (try (fn (e) "#<Error>")
                              (case i
                                    (0 v)
                                    (2 (string/write v))
                                    (3 (print/stacktrace v))
                                    (otherwise (string v)))))

                   (defn print/error/iter (error i)
                         (if error
                             (cons (print/error/wrap i (car error))
                                   (print/error/iter (cdr error) (+ 1 i)))
                             (cons "" #nil)))

                   (defn print/error (error)
                         "Display ERROR in a nice, human readable way"
                         (print (join (print/error/iter error 0) "\r\n")))))

(defn closure/documentation (o)
      (:meta o :documentation))

(defn closure/cat (o)
      (or (:meta o :cat) :unsorted))

(defn closure/name (o)
      (if (procedure? o)
          (or (:meta o :name)
              (closure/name (closure/parent o)))
          'unknown))

(def describe (let*
                (defn describe/thing (o)
                      "Describe a specific value O"
                      (def documentation (closure/documentation o))
                      (def name (closure/name o))
                      (pfmt "({}" (closure/name o))
                      (def arguments (closure/arguments o))
                      (if (pair? arguments)
                          (doseq (arg arguments (println ")"))
                                 (when arg (pfmt " {arg}")))
                          (pfmt " . {arguments})"))
                      (pfmtln "\n{documentation}")
                      #nil)

                (defn describe/string (a)
                      "Descibe whatever value string A resolves to"
                      (describe/thing (resolve (string->symbol a))))

                (defn describe (fun) "Describe FUN, if there is documentation available"
                      (if (string? fun)
                          (describe/string fun)
                          (describe/thing fun)))))

(def root-closure (current-closure))

(defmacro deftest l #nil) ; Tests should be skipped when compiling

(defmacro comment body
          "Does nothing, mainly used for commenting out
          parts of an expression, but having the sub expressions
          be available so you can use them easily via nujel-mode."
          :cat :documentation
          (deftest #f (let ((x #f)) (comment (set! x #t)) x))

          #nil)