Add debugger to the core repl.

Debugger functions are prefixed by periods.

CHANGELOG.md

@@ -2,6 +2,8 @@
 All notable changes to this project will be documented in this file.
 
 ## Unreleased - ???
+- Add debugger to core. The debugger functions are only available
+  in a debug repl, and are prefixed by a `.`.
 - Add `sort-by` and `sorted-by` to core.
 - Support UTF-8 escapes in strings via `\uXXXX` or `\UXXXXXX`.
 - Add `math/erf`

examples/debugger.janet

@@ -1,20 +1,18 @@
 ###
 ### A useful debugger library for Janet. Should be used
-### inside a debug repl.
+### inside a debug repl. This has been moved into the core.
 ###
 
 (defn .fiber
   "Get the current fiber being debugged."
   []
-  (if-let [entry (dyn '_fiber)]
+  (dyn :fiber))
-    (entry :value)
-    (dyn :fiber)))
 
 (defn .stack
   "Print the current fiber stack"
   []
   (print)
-  (debug/stacktrace (.fiber) "")
+  (with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
   (print))
 
 (defn .frame

janet.1

@@ -96,6 +96,10 @@ Delete everything before the cursor on the input line.
 .BR Ctrl\-W
 Delete one word before the cursor.
 
+.TP 16
+.BR Ctrl\-G
+Show documentation for the current symbol under the cursor.
+
 .TP 16
 .BR Alt\-B/Alt\-F
 Move cursor backwards and forwards one word.
@@ -148,6 +152,12 @@ Read raw input from stdin and forgo prompt history and other readline-like featu
 Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
 arguments are executed before later ones.
 
+.TP
+.BR \-d
+Enable debug mode. On all terminating signals as well the debug signal, this will
+cause the debugger to come up in the REPL. Same as calling (setdyn :debug true) in a
+default repl.
+
 .TP
 .BR \-n
 Disable ANSI colors in the repl. Has no effect if no repl is run.

src/boot/boot.janet

@@ -2269,6 +2269,157 @@
   [& modules]
   ~(do ,;(map |~(,import* ,(string $) :prefix "") modules)))
 
+###
+###
+### Debugger
+###
+###
+
+(defn .fiber
+  "Get the current fiber being debugged."
+  []
+  (dyn :fiber))
+
+(defn .stack
+  "Print the current fiber stack"
+  []
+  (print)
+  (with-dyns [:err-color false] (debug/stacktrace (.fiber) ""))
+  (print))
+
+(defn .frame
+  "Show a stack frame"
+  [&opt n]
+  (def stack (debug/stack (.fiber)))
+  (in stack (or n 0)))
+
+(defn .fn
+  "Get the current function"
+  [&opt n]
+  (in (.frame n) :function))
+
+(defn .slots
+  "Get an array of slots in a stack frame"
+  [&opt n]
+  (in (.frame n) :slots))
+
+(defn .slot
+  "Get the value of the nth slot."
+  [&opt nth frame-idx]
+  (in (.slots frame-idx) (or nth 0)))
+
+(defn .disasm
+  "Gets the assembly for the current function."
+  [&opt n]
+  (def frame (.frame n))
+  (def func (frame :function))
+  (disasm func))
+
+(defn .bytecode
+  "Get the bytecode for the current function."
+  [&opt n]
+  ((.disasm n) 'bytecode))
+
+(defn .ppasm
+  "Pretty prints the assembly for the current function"
+  [&opt n]
+  (def frame (.frame n))
+  (def func (frame :function))
+  (def dasm (disasm func))
+  (def bytecode (dasm 'bytecode))
+  (def pc (frame :pc))
+  (def sourcemap (dasm 'sourcemap))
+  (var last-loc [-2 -2])
+  (print "\n  function:   " (dasm 'name) " [" (in dasm 'source "") "]")
+  (when-let [constants (dasm 'constants)]
+    (printf "  constants:  %.4q" constants))
+  (printf "  slots:      %.4q\n" (frame :slots))
+  (def padding (string/repeat " " 20))
+  (loop [i :range [0 (length bytecode)]
+         :let [instr (bytecode i)]]
+    (prin (if (= (tuple/type instr) :brackets) "*" " "))
+    (prin (if (= i pc) "> " "  "))
+    (prinf "%.20s" (string (string/join (map string instr) " ") padding))
+    (when sourcemap
+      (let [[sl sc] (sourcemap i)
+            loc [sl sc]]
+        (when (not= loc last-loc)
+          (set last-loc loc)
+          (prin " # line " sl ", column " sc))))
+    (print))
+  (print))
+
+(defn .source
+  "Show the source code for the function being debugged."
+  [&opt n]
+  (def frame (.frame n))
+  (def s (frame :source))
+  (def all-source (slurp s))
+  (print "\n" all-source "\n"))
+
+(defn .breakall
+  "Set breakpoints on all instructions in the current function."
+  [&opt n]
+  (def fun (.fn n))
+  (def bytecode (.bytecode n))
+  (for i 0 (length bytecode)
+    (debug/fbreak fun i))
+  (print "Set " (length bytecode) " breakpoints in " fun))
+
+(defn .clearall
+  "Clear all breakpoints on the current function."
+  [&opt n]
+  (def fun (.fn n))
+  (def bytecode (.bytecode n))
+  (for i 0 (length bytecode)
+    (debug/unfbreak fun i))
+  (print "Cleared " (length bytecode) " breakpoints in " fun))
+
+(defn .break
+  "Set breakpoint at the current pc."
+  []
+  (def frame (.frame))
+  (def fun (frame :function))
+  (def pc (frame :pc))
+  (debug/fbreak fun pc)
+  (print "Set breakpoint in " fun " at pc=" pc))
+
+(defn .clear
+  "Clear the current breakpoint"
+  []
+  (def frame (.frame))
+  (def fun (frame :function))
+  (def pc (frame :pc))
+  (debug/unfbreak fun pc)
+  (print "Cleared breakpoint in " fun " at pc=" pc))
+
+(defn .next
+  "Go to the next breakpoint."
+  [&opt n]
+  (var res nil)
+  (for i 0 (or n 1)
+    (set res (resume (.fiber))))
+  res)
+
+(defn .nextc
+  "Go to the next breakpoint, clearing the current breakpoint."
+  [&opt n]
+  (.clear)
+  (.next n))
+
+(defn .step
+  "Execute the next n instructions."
+  [&opt n]
+  (var res nil)
+  (for i 0 (or n 1)
+    (set res (debug/step (.fiber))))
+  res)
+
+(def- debugger-keys (filter (partial string/has-prefix? ".") (keys _env)))
+(def- debugger-env @{})
+(each k debugger-keys (put debugger-env k (_env k)) (put _env k nil))
+(put _env 'debugger-keys nil)
+
 ###
 ###
 ### REPL
@@ -2301,6 +2452,7 @@
       (put nextenv :fiber f)
       (put nextenv :debug-level level)
       (put nextenv :signal x)
+      (merge-into nextenv debugger-env)
       (debug/stacktrace f x)
       (eflush)
       (defn debugger-chunks [buf p]
@@ -2327,6 +2479,8 @@
                 :on-status (or onsignal (make-onsignal env 1))
                 :source "repl"}))
 
+(put _env 'debugger-env nil)
+
 ###
 ###
 ### CLI Tool Main
@@ -2370,6 +2524,7 @@
   (var *handleopts* true)
   (var *exit-on-error* true)
   (var *colorize* true)
+  (var *debug* false)
   (var *compile-only* false)
 
   (if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
@@ -2385,6 +2540,7 @@
   -v : Print the version string
   -s : Use raw stdin instead of getline like functionality
   -e code : Execute a string of janet
+  -d : Set the debug flag in the repl
   -r : Enter the repl after running all scripts
   -p : Keep on executing if there is a top level error (persistent)
   -q : Hide prompt, logo, and repl output (quiet)
@@ -2417,7 +2573,8 @@
      "e" (fn [i &]
            (set *no-file* false)
            (eval-string (in args (+ i 1)))
-           2)})
+           2)
+     "d" (fn [&] (set *debug* true) 1)})
 
   (defn- dohandler [n i &]
     (def h (in handlers n))
@@ -2476,6 +2633,7 @@
       (file/flush stdout)
       (file/read stdin :line buf))
     (def env (make-env))
+    (if *debug* (put env :debug true))
     (def getter (if *raw-stdin* getstdin getline))
     (defn getchunk [buf p]
       (getter (prompter p) buf env))