Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-19 05:39:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Use different tags for raised objects and raised errors

Browse source 
The behaviour for raising an error (error message irritants) and
objects (raise object) are different in r7rs. So tag error objects
differently, and adjust the raised object handling to handle
the raised object instead of a list containing the raised object.

This should resolve issue #556.
This commit is contained in:
Yorick Hardy 2025-02-16 11:56:20 +02:00
parent d6357c9808
commit 924911569f
2 changed files with 23 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
runtime.c
View file

@ -708,22 +708,27 @@ object Cyc_default_exception_handler(void *data, object _, int argc,
int is_msg = 1;
fprintf(stderr, "Error: ");
if ((err == NULL) || is_value_type(err) || type_of(err) != pair_tag) {
if ((err == NULL) || is_value_type(err) || type_of(err) != pair_tag || !Cyc_is_symbol(car(err))) {
Cyc_display(data, err, stderr);
} else {
// Error is list of form (type arg1 ... argn)
err = cdr(err); // skip type field
for (; (err != NULL); err = cdr(err)) { // output with no enclosing parens
if (is_msg && is_object_type(car(err)) && type_of(car(err)) == string_tag) {
is_msg = 0;
Cyc_display(data, car(err), stderr);
if (cdr(err)) {
fprintf(stderr, ": ");
if (strncmp(((symbol) car(err))->desc, "error", 10) == 0) {
// Error is list of form (type arg1 ... argn)
err = cdr(err); // skip type field
for (; (err != NULL); err = cdr(err)) { // output with no enclosing parens
if (is_msg && is_object_type(car(err)) && type_of(car(err)) == string_tag) {
is_msg = 0;
Cyc_display(data, car(err), stderr);
if (cdr(err)) {
fprintf(stderr, ": ");
}
} else {
Cyc_write(data, car(err), stderr);
fprintf(stderr, " ");
}
} else {
Cyc_write(data, car(err), stderr);
fprintf(stderr, " ");
}
} else {
fprintf(stderr, "raised object: ");
Cyc_display(data, cdr(err), stderr);
}
}

9
scheme/base.sld
View file

@ -1251,13 +1251,16 @@
(define error-object-message car)
(define error-object-irritants cdr)
(define (error msg . args)
(raise (cons msg args)))
(raise-error (cons msg args)))
(define (raise obj)
((Cyc-current-exception-handler)
(cons 'raised (if (pair? obj) obj (list obj)))))
(cons 'raised obj)))
(define (raise-continuable obj)
((Cyc-current-exception-handler)
(cons 'continuable (if (pair? obj) obj (list obj)))))
(cons 'continuable obj)))
(define (raise-error obj)
((Cyc-current-exception-handler)
(cons 'error obj)))
;; A simpler exception handler based on the one from Bigloo:
;; https://www-sop.inria.fr/indes/fp/Bigloo/doc/bigloo-17.html#g20889
;(define (with-handler handler body)