Login
7 branches 0 tags
Ben (X13/Arch) Some comments 27729b7 12 months ago 1242 Commits
nujel / stdlib / meta.nuj
;;; 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)
      :internal
      (when c
            (if (= c root-closure)
                (fmt "{i}# <root environment>")
                (do (def data (:data c))
                    (def l (:length data))
                  (cat (int (or i 0)) "# "
                       (string/write c)
                       " - "
                       (ref c :*module*)
                       " - "
                       (if (< l 8)
                           (:cut (string/write data) 0 120)
                           "-+- 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 (: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 (: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 (ref (current-closure) (: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 profile form
          (def t (gensym))
          `(let ((~t (time/milliseconds))) (do ~@form) (efmtln "Took {}ms" (- (time/milliseconds) ~t))))

(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

          #nil)