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

Make print-backtrace-and-exception/knots more reliable

Browse source 
Catch failures in the Guile code for printing backtraces, and print
the partial backtrace, plus the backtrace of the exception that
happened.
This commit is contained in:
Christopher Baines 2026-01-09 15:31:54 +00:00
parent 4642f7c7d2
commit 991a5f6961
1 changed files with 70 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

47
knots.scm
View file

@ -67,19 +67,10 @@
(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)))
(_
(make-stack #t))))
(stack-len
(define (get-string port stack)
(define stack-len
(stack-length stack))
(error-string
(call-with-output-string
(lambda (port)
(let ((knots-stacks
(map knots-exception-stack
(filter knots-exception?
@ -126,5 +117,35 @@
stack-len
3))))
'%exception
(list exn)))))))
(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 (get-output-string string-port)
port)
(close-output-port string-port)
(display "\n\n" port)
(backtrace port)
(simple-format
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 error-string port)))