Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-07 05:06:36 +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

7
runtime.c
View file

@ -708,9 +708,10 @@ object Cyc_default_exception_handler(void *data, object _, int argc,
int is_msg = 1; int is_msg = 1;
fprintf(stderr, "Error: "); 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); Cyc_display(data, err, stderr);
} else { } else {
if (strncmp(((symbol) car(err))->desc, "error", 10) == 0) {
// Error is list of form (type arg1 ... argn) // Error is list of form (type arg1 ... argn)
err = cdr(err); // skip type field err = cdr(err); // skip type field
for (; (err != NULL); err = cdr(err)) { // output with no enclosing parens for (; (err != NULL); err = cdr(err)) { // output with no enclosing parens
@ -725,6 +726,10 @@ object Cyc_default_exception_handler(void *data, object _, int argc,
fprintf(stderr, " "); fprintf(stderr, " ");
} }
} }
} else {
fprintf(stderr, "raised object: ");
Cyc_display(data, cdr(err), stderr);
}
} }
fprintf(stderr, "\nCall history, most recent first:\n"); fprintf(stderr, "\nCall history, most recent first:\n");

9
scheme/base.sld
View file

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