Start trying to improve exceptions and backtraces

When using knots utilities.

knots.scm

@@ -1,11 +1,21 @@
 (define-module (knots)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 suspendable-ports)
   #:use-module (fibers conditions)
+  #:use-module (system repl debug)
   #:export (call-with-default-io-waiters
 
             wait-when-system-clock-behind
 
-            call-with-sigint))
+            call-with-sigint
+
+            &knots-exception
+            make-knots-exception
+            knots-exception?
+            knots-exception-stack
+
+            print-backtrace-and-exception/knots))
 
 (define (call-with-default-io-waiters thunk)
   (parameterize
@@ -37,3 +47,63 @@
             (sigaction SIGINT (car handler) (cdr handler))
             ;; restore original C handler.
             (sigaction SIGINT #f))))))
+
+(define &knots-exception
+  (make-exception-type '&knots-exception
+                       &exception
+                       '(stack)))
+
+(define make-knots-exception
+  (record-constructor &knots-exception))
+
+(define knots-exception?
+  (record-predicate &knots-exception))
+
+(define knots-exception-stack
+  (exception-accessor
+   &knots-exception
+   (record-accessor &knots-exception 'stack)))
+
+(define* (print-backtrace-and-exception/knots
+          exn
+          #:key (port (current-error-port)))
+  (let* ((stack (match (fluid-ref %stacks)
+                  ((stack-tag . prompt-tag)
+                   (make-stack #t
+                               0 prompt-tag
+                               0 (and prompt-tag 1)))))
+         (error-string
+          (call-with-output-string
+            (lambda (port)
+              (let ((knots-stacks
+                     (map knots-exception-stack
+                          (filter knots-exception?
+                                  (simple-exceptions exn)))))
+
+                (let ((stack-vec
+                       (stack->vector stack)))
+                  (print-frames (list->vector
+                                 (drop
+                                  (vector->list stack-vec)
+                                  6))
+                                port
+                                #:count (stack-length stack)))
+                (for-each
+                 (lambda (stack)
+                   (let ((stack-vec
+                          (stack->vector stack)))
+                     (print-frames (list->vector
+                                    (drop
+                                     (vector->list stack-vec)
+                                     3))
+                                   port
+                                   #:count (stack-length stack))))
+                 knots-stacks)
+                (print-exception
+                 port
+                 (if (null? knots-stacks)
+                     (stack-ref stack 1)
+                     (stack-ref (last knots-stacks) 3))
+                 '%exception
+                 (list exn)))))))
+    (display error-string port)))