wingo pushed a commit to branch main
in repository guile.
commit 83449a8683abee5b71961f7fe891f3b8c894e14b
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Nov 23 12:30:36 2023 +0100
prompts avoid introducing throw; fixup peval test
* test-suite/tests/peval.test ("partial evaluation"): Fix to expect
raise-type-error from dynwind peval. Update prompt expectation
similarly.
* module/language/tree-il/primitives.scm (call-with-prompt): Use
raise-type-error.
---
module/language/tree-il/primitives.scm | 9 +++------
test-suite/tests/peval.test | 4 ++--
2 files changed, 5 insertions(+), 8 deletions(-)
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index 22a89063d..153c602b2 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -727,12 +727,9 @@
src '() #f 'args #f '() (list args)
(primcall apply handler (make-lexical-ref #f 'args args))
#f)))
- (primcall throw
- (const 'wrong-type-arg)
- (const "call-with-prompt")
- (const "Wrong type (expecting procedure): ~S")
- (primcall list handler)
- (primcall list handler))))))))
+ (primcall raise-type-error
+ (const #("call-with-prompt" 3 "procedure"))
+ handler)))))))
(else #f)))
(define-primitive-expander! 'abort-to-prompt*
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 8a8f0124a..4b03c9ea0 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1144,7 +1144,7 @@
(let (tmp tmp) (_ _) ((toplevel foo) (toplevel baz))
(seq (seq (if (primcall thunk? (lexical tmp _))
(call (lexical tmp _))
- (primcall throw . _))
+ (primcall raise-type-error . _))
(primcall wind (lexical tmp _) (lexical tmp _)))
(let (tmp) (_) ((toplevel bar))
(seq (seq (primcall unwind)
@@ -1234,7 +1234,7 @@
(primcall apply
(lexical handler _)
(lexical args _))))))
- (primcall throw . _))))
+ (primcall raise-type-error . _))))
(pass-if-peval
;; `while' without `break' or `continue' has no prompts and gets its
