cbaines/guile-knots
1
Fork 0
Code Issues 1 Pull requests Activity Actions

Rework the backtrace handling
All checks were successful
/ test (push) Successful in 6s
Details

Browse source 
Try and improve the print-backtrace-and-exception/knots output, be
selective about the stack frames which are shown to try and produce
some useful output which reflects user code and hide the
&knots-exceptions.

This commit also introduces a bunch of tests scripts that produce
output from print-backtrace-and-exception/knots, to help test this
code in different situations.
This commit is contained in:
Christopher Baines 2026-03-20 19:11:03 +00:00
parent 92c2fe46e7
commit b3fa4d069b
21 changed files with 957 additions and 118 deletions
Download patch file Download diff file Expand all files Collapse all files

125
knots.scm
View file

@ -19,6 +19,7 @@
(define-module (knots)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-43)
#:use-module (ice-9 match)
#:use-module (ice-9 threads)
#:use-module (ice-9 binary-ports)
@ -27,7 +28,14 @@
#:use-module (fibers)
#:use-module (fibers channels)
#:use-module (fibers conditions)
#:use-module (system repl debug)
#:use-module (ice-9 format)
#:use-module (knots backtraces)
#:re-export (&knots-exception
make-knots-exception
knots-exception?
knots-exception-stack
print-backtrace-and-exception/knots)
#:export (call-with-default-io-waiters
wait-when-system-clock-behind
@ -38,13 +46,6 @@
simple-format/knots
format/knots
&knots-exception
make-knots-exception
knots-exception?
knots-exception-stack
print-backtrace-and-exception/knots
call-with-temporary-thread
spawn-fiber/knots))
@ -176,114 +177,6 @@ without buffering."
(current-output-port)
port)))))
(define &knots-exception
(make-exception-type '&knots-exception
&exception
'(stack)))
(define make-knots-exception
(record-constructor &knots-exception))
(define knots-exception?
(exception-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)))
(define (get-string port stack)
(define stack-len
(stack-length stack))
(let ((knots-stacks
(map knots-exception-stack
(filter knots-exception?
(simple-exceptions exn)))))
(let* ((stack-vec
(stack->vector stack))
(stack-vec-length
(vector-length stack-vec)))
(print-frames (list->vector
(drop
(vector->list stack-vec)
(if (< stack-vec-length 5)
0
4)))
port
#:count (stack-length stack)))
(for-each
(lambda (stack)
(let* ((stack-vec
(stack->vector stack))
(stack-vec-length
(vector-length stack-vec)))
(print-frames (list->vector
(drop
(vector->list stack-vec)
(if (< stack-vec-length 4)
0
3)))
port
#:count (stack-length stack))))
knots-stacks)
(print-exception
port
(if (null? knots-stacks)
(stack-ref stack
(if (< stack-len 4)
stack-len
4))
(let* ((stack (last knots-stacks))
(stack-len (stack-length stack)))
(stack-ref stack
(if (< stack-len 3)
stack-len
3))))
'%exception
(list exn))))
(let* ((stack
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(make-stack #t
0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t))))
(string-port
(open-output-string))
(error-string
(with-exception-handler
(lambda (exn)
(display/knots (get-output-string string-port)
port)
(close-output-port string-port)
(display/knots "\n\n" port)
(let* ((stack (make-stack #t))
(backtrace
(call-with-output-string
(lambda (port)
(display-backtrace stack port)
(newline port)))))
(display/knots backtrace))
(simple-format/knots
port
"\nexception in print-backtrace-and-exception/knots: ~A\n"
exn)
(raise-exception exn))
(lambda ()
(get-string string-port stack)
(let ((str (get-output-string string-port)))
(close-output-port string-port)
str)))))
(display/knots error-string port)))
(define* (spawn-fiber/knots thunk #:optional scheduler #:key parallel?)
"Spawn a fiber to run THUNK, with knots exception handling.