cbaines/guile-knots
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Handle %stacks not being a pair

Browse source 
Not sure when this would happen, but guard against it.
This commit is contained in:
Christopher Baines 2025-05-15 09:25:30 +01:00
parent 8c63ed7b4e
commit 7ba77010ae
4 changed files with 53 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

13
knots.scm
View file

@ -67,11 +67,14 @@
(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)))))
(let* ((stack
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(make-stack #t
0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t))))
(error-string
(call-with-output-string
(lambda (port)

42
knots/parallelism.scm
View file

@ -52,15 +52,18 @@
(lambda ()
(with-exception-handler
(lambda (exn)
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(let ((stack (make-stack #t
0 prompt-tag
0 (and prompt-tag 1))))
(raise-exception
(make-exception
exn
(make-knots-exception stack)))))))
(let ((stack
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(make-stack #t
0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t)))))
(raise-exception
(make-exception
exn
(make-knots-exception stack)))))
(lambda ()
(call-with-values
(lambda ()
@ -255,15 +258,18 @@
(lambda ()
(with-exception-handler
(lambda (exn)
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(let ((stack (make-stack #t
0 prompt-tag
0 (and prompt-tag 1))))
(raise-exception
(make-exception
exn
(make-knots-exception stack)))))))
(let ((stack
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(make-stack #t
0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t)))))
(raise-exception
(make-exception
exn
(make-knots-exception stack)))))
(lambda ()
(call-with-values
(lambda ()

15
knots/resource-pool.scm
View file

@ -923,15 +923,18 @@ available. Return the resource once PROC has returned."
(lambda ()
(with-exception-handler
(lambda (exn)
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(let ((stack (make-stack #t
0 prompt-tag
0 (and prompt-tag 1))))
(let ((stack
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(make-stack #t
0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t)))))
(raise-exception
(make-exception
exn
(make-knots-exception stack)))))))
(make-knots-exception stack)))))
(lambda ()
(proc resource))))
#:unwind? #t))

21
knots/thread-pool.scm
View file

@ -251,15 +251,18 @@ arguments of the thread pool procedure."
proc)
(with-exception-handler
(lambda (exn)
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(let ((stack (make-stack #t
0 prompt-tag
0 (and prompt-tag 1))))
(raise-exception
(make-exception
exn
(make-knots-exception stack)))))))
(let ((stack
(match (fluid-ref %stacks)
((stack-tag . prompt-tag)
(make-stack #t
0 prompt-tag
0 (and prompt-tag 1)))
(_
(make-stack #t)))))
(raise-exception
(make-exception
exn
(make-knots-exception stack)))))
(lambda ()
(call-with-values
(lambda ()