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

Clean up how exceptions "pack" objects

Browse source
This commit is contained in:
Justin Ethier 2015-06-12 21:02:26 -04:00
parent 955b58b1a5
commit 1e5d16de25
2 changed files with 9 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
runtime.c
View file

@ -167,6 +167,8 @@ object Cyc_exception_handler_stack = nil;
object Cyc_default_exception_handler(int argc, closure _, object err) { object Cyc_default_exception_handler(int argc, closure _, object err) {
printf("Error: "); printf("Error: ");
// TODO: error should be a list of form (type arg1 ... argn)
// want to ignore type and display args without enclosing parens
Cyc_display_va(1, err); Cyc_display_va(1, err);
printf("\n"); printf("\n");
exit(1); exit(1);
@ -185,14 +187,14 @@ object Cyc_current_exception_handler() {
void Cyc_rt_raise(object err) { void Cyc_rt_raise(object err) {
make_cons(c2, err, nil); make_cons(c2, err, nil);
make_cons(c1, boolean_f, &c2); make_cons(c1, boolean_f, &c2);
make_cons(c0, &c1, nil); // TODO: seems broken? make_cons(c0, &c1, nil);
apply(nil, Cyc_current_exception_handler(), &c0); apply(nil, Cyc_current_exception_handler(), &c0);
// Should never get here // Should never get here
fprintf(stderr, "Internal error in Cyc_rt_raise\n"); fprintf(stderr, "Internal error in Cyc_rt_raise\n");
exit(1); exit(1);
} }
void Cyc_rt_raise2(const char *msg, object err) { void Cyc_rt_raise2(const char *msg, object err) {
make_string(s, err); make_string(s, msg);
make_cons(c3, err, nil); make_cons(c3, err, nil);
make_cons(c2, &s, &c3); make_cons(c2, &s, &c3);
make_cons(c1, boolean_f, &c2); make_cons(c1, boolean_f, &c2);

8
scheme/base.sld
View file

@ -294,9 +294,11 @@
(define (error msg . args) (define (error msg . args)
(raise (cons msg args))) (raise (cons msg args)))
(define (raise obj) (define (raise obj)
((Cyc-current-exception-handler) (list 'raised obj))) ((Cyc-current-exception-handler)
(cons 'raised (if (pair? obj) obj (list obj)))))
(define (raise-continuable obj) (define (raise-continuable obj)
((Cyc-current-exception-handler) (list 'continuable obj))) ((Cyc-current-exception-handler)
(cons 'continuable (if (pair? obj) obj (list obj)))))
(define (with-exception-handler handler thunk) (define (with-exception-handler handler thunk)
(let ((result #f) (let ((result #f)
(my-handler (my-handler
@ -306,7 +308,7 @@
(equal? (car obj) 'continuable)))) (equal? (car obj) 'continuable))))
;; Unregister this handler since it is no longer needed ;; Unregister this handler since it is no longer needed
(Cyc-remove-exception-handler) (Cyc-remove-exception-handler)
(set! result (handler (cadr obj))) ;; Actual handler (set! result (handler (cdr obj))) ;; Actual handler
(if continuable? (if continuable?
result result
(error "exception handler returned")))))) (error "exception handler returned"))))))