1
0
mirror of https://github.com/janet-lang/janet synced 2024-12-25 07:50:27 +00:00

Expose the built-in debugger in more places.

This commit is contained in:
Calvin Rose 2022-06-10 15:23:15 -05:00
parent 55c34cd84f
commit a5b66029d3
2 changed files with 64 additions and 45 deletions

View File

@ -2,6 +2,10 @@
All notable changes to this project will be documented in this file.
## Unreleased - ???
- `dofile` will now start a debugger on errors if the environment it is passed has `:debug` set.
- Add `debugger-on-status` function, which can be passed to `run-context` to start a debugger on
abnormal fiber signals.
- Allow running scripts with the `-d` flag to use the built-in debugger on errors and breakpoints.
- Add `raw-native`, `native-lookup`, and `native-close` for interfacing with dynamic libraries.
- Add mutexes (locks) and reader-writer locks to ev module for thread coordination.
- Add `parse-all` as a generalization of the `parse` function.

View File

@ -2746,6 +2746,49 @@
(get r 0)
v))))
(def debugger-env
"An environment that contains dot prefixed functions for debugging."
@{})
(defn debugger-on-status
"Create a function that can be passed to `run-context`'s `:on-status`
argument that will drop into a debugger on errors."
[env &opt level is-repl]
(default level 1)
(defn enter-debugger
[f x]
(def nextenv (make-env env))
(put nextenv :fiber f)
(put nextenv :debug-level level)
(put nextenv :signal x)
(merge-into nextenv debugger-env)
(defn debugger-chunks [buf p]
(def status (:state p :delimiters))
(def c ((:where p) 0))
(def prpt (string "debug[" level "]:" c ":" status "> "))
(getline prpt buf nextenv))
(print "entering debug[" level "] - (quit) to exit")
(flush)
(run-context
{:chunks debugger-chunks
:on-status (debugger-on-status nextenv (+ 1 level) true)
:env nextenv})
(print "exiting debug[" level "]")
(flush)
(nextenv :resume-value))
(fn [f x]
(def fs (fiber/status f))
(if (= :dead fs)
(when is-repl
(put env '_ @{:value x})
(printf (get env :pretty-format "%q") x)
(flush))
(do
(debug/stacktrace f x "")
(eflush)
(if (get env :debug) (enter-debugger f x))))))
(defn dofile
``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander,
:source, :evaluator, :read, and :parser are passed through to the underlying
@ -2802,9 +2845,12 @@
(debug/stacktrace f x "")
(eflush)
(os/exit 1))
(put env :exit true)
(set exit-error x)
(set exit-fiber f)))
(if (get env :debug)
((debugger-on-status env) f x)
(do
(put env :exit true)
(set exit-error x)
(set exit-fiber f)))))
:evaluator evaluator
:expander expander
:read read
@ -3448,10 +3494,6 @@
(set res (debug/step (.fiber))))
res)
(def debugger-env
"An environment that contains dot prefixed functions for debugging."
@{})
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
@ -3479,43 +3521,9 @@
":"
(:state p :delimiters) "> ")
buf env)))
(defn make-onsignal
[e level]
(defn enter-debugger
[f x]
(def nextenv (make-env env))
(put nextenv :fiber f)
(put nextenv :debug-level level)
(put nextenv :signal x)
(merge-into nextenv debugger-env)
(defn debugger-chunks [buf p]
(def status (:state p :delimiters))
(def c ((:where p) 0))
(def prpt (string "debug[" level "]:" c ":" status "> "))
(getline prpt buf nextenv))
(print "entering debug[" level "] - (quit) to exit")
(flush)
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
(print "exiting debug[" level "]")
(flush)
(nextenv :resume-value))
(fn [f x]
(def fs (fiber/status f))
(if (= :dead fs)
(do
(put e '_ @{:value x})
(printf (get e :pretty-format "%q") x)
(flush))
(do
(debug/stacktrace f x "")
(eflush)
(if (e :debug) (enter-debugger f x))))))
(run-context {:env env
:chunks chunks
:on-status (or onsignal (make-onsignal env 1))
:on-status (or onsignal (debugger-on-status env 1 true))
:parser parser
:read read
:source :repl}))
@ -3682,10 +3690,17 @@
(defn- run-main
[env subargs arg]
(if-let [entry (in env 'main)
(when-let [entry (in env 'main)
main (or (get entry :value) (in (get entry :ref) 0))]
(let [thunk (compile [main ;subargs] env arg)]
(if (function? thunk) (thunk) (error (thunk :error))))))
(def guard (if (get env :debug) :ydt :y))
(defn wrap-main [&]
(main ;subargs))
(def f (fiber/new wrap-main guard))
(fiber/setenv f env)
(while (fiber/can-resume? f)
(def res (resume f))
(when (not= :dead (fiber/status f))
((debugger-on-status env) f res)))))
(defdyn *args*
"Dynamic bindings that will contain command line arguments at program start.")