mirror of
				https://github.com/janet-lang/janet
				synced 2025-10-30 23:23:07 +00:00 
			
		
		
		
	Expose an easy to use debugger function.
				
					
				
			This commit is contained in:
		| @@ -2,6 +2,7 @@ | ||||
| All notable changes to this project will be documented in this file. | ||||
|  | ||||
| ## Unreleased - ??? | ||||
| - Add `debugger` - an easy to use debugger function that just takes a fiber. | ||||
| - `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. | ||||
|   | ||||
| @@ -2750,32 +2750,40 @@ | ||||
|   "An environment that contains dot prefixed functions for debugging." | ||||
|   @{}) | ||||
|  | ||||
| (var- debugger-on-status-var nil) | ||||
|  | ||||
| (defn debugger | ||||
|   "Run a repl-based debugger on a fiber. Optionally pass in a level | ||||
|   to differentiate nested debuggers." | ||||
|   [fiber &opt level] | ||||
|   (default level 1) | ||||
|   (def nextenv (make-env (fiber/getenv fiber))) | ||||
|   (put nextenv :fiber fiber) | ||||
|   (put nextenv :debug-level level) | ||||
|   (put nextenv :signal (fiber/last-value fiber)) | ||||
|   (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-var nextenv (+ 1 level) true) | ||||
|      :env nextenv}) | ||||
|   (print "exiting debug[" level "]") | ||||
|   (flush) | ||||
|   (nextenv :resume-value)) | ||||
|  | ||||
| (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." | ||||
|   argument that will drop into a debugger on errors. The debugger will | ||||
|   only start on abmnormal signals if the env table has the `:debug` dyn | ||||
|   set to a truthy value." | ||||
|   [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) | ||||
| @@ -2786,8 +2794,9 @@ | ||||
|       (do | ||||
|         (debug/stacktrace f x "") | ||||
|         (eflush) | ||||
|         (if (get env :debug) (enter-debugger f x)))))) | ||||
|         (if (get env :debug) (debugger f level)))))) | ||||
|  | ||||
| (set debugger-on-status-var debugger-on-status) | ||||
|  | ||||
| (defn dofile | ||||
|   ``Evaluate a file, file path, or stream and return the resulting environment. :env, :expander, | ||||
| @@ -3697,8 +3706,9 @@ | ||||
|       (main ;subargs)) | ||||
|     (def f (fiber/new wrap-main guard)) | ||||
|     (fiber/setenv f env) | ||||
|     (var res nil) | ||||
|     (while (fiber/can-resume? f) | ||||
|       (def res (resume f)) | ||||
|       (set res (resume f res)) | ||||
|       (when (not= :dead (fiber/status f)) | ||||
|         ((debugger-on-status env) f res))))) | ||||
|  | ||||
|   | ||||
		Reference in New Issue
	
	Block a user
	 Calvin Rose
					Calvin Rose