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

[defun display/error/wrap [i text]
       [cond [[== i 0] [ansi-red text]]
             [[== i 1] [string text]]
             [[== i 2] [ansi-yellow [str/write text]]]
             [[== i 3] [describe/closure text]]
             [#t text]]]

[defun display/error/iter [error i]
       [if error
           [cons [display/error/wrap i [car error]]
                 [display/error/iter [cdr error] [+ 1 i]]]
           [cons "" #nil]]]

[defun display/error [error]
                "Display ERROR in a nice, human readable way"
                [display [join [display/error/iter error 0] "\r\n"]]]

[defun describe/thing [o]
       "Describe a specific value O"
       [def doc [closure o]]
       [cat [str/write [doc :arguments]] " - " [doc :documentation]]]

[defun describe/string [a]
       "Descibe whatever value string A resolves to"
       [describe/thing [resolve [str->sym a]]]]

[defun describe [fun] "Describe FUN, if there is documentation available"
       [if [string? fun]
           [describe/string fun]
           [describe/thing fun]]]

[defun mem []
       "Return some pretty printed memory usage information"
       [def info [memory-info]]
       [cat [ansi-white  "Memory Info"] "\n"
            [ansi-green  "Values:   "] [getf info :value]   "\n"
            [ansi-blue   "Closures: "] [getf info :closure] "\n"
            [ansi-red    "Arrays:   "] [getf info :array]   "\n"
            [ansi-yellow "STrings:  "] [getf info :string]  "\n"
            [ansi-pink   "Symbols:  "] [getf info :symbol] "\n"
            ansi-reset]]

[defun symbol-table [off len environment]
       "Return a list of LEN symbols defined in ENVIRONMENT starting at OFF"
       [when-not environment [set! environment root-closure]]
       [when-not off [set! off 0]]
       [when-not len [set! len 9999999]]
       [sublist [environment [symbol-table*]] off [+ off len] #nil]]

[defun arg-list [f]
        "Return the Argument list of f which can be a Native Function or a Lambda"
        [cond [[lambda? f] [reduce cat [map [\ [a] [" " [car a]]] [cl-data f]]]]
              [[native? f] [reduce cat [map [\ [a] [" " a]] [car [cl-data f]]]]]
              [#t ""]]]

[def gensym/counter 0]
[defun gensym []
       [set! gensym/counter [+ 1 gensym/counter]]
       [str->sym ["ΓεnΣym-" gensym/counter]]]

[def root-closure [current-closure]]