Initial version of (raise-continuable)

This commit is contained in:
Justin Ethier 2015-03-19 22:20:12 -04:00
parent b55077ae1d
commit 1d5409b4ae
3 changed files with 18 additions and 14 deletions

View file

@ -434,7 +434,7 @@
((eq? p 'apply) "apply")
((eq? p '%halt) "__halt")
((eq? p 'exit) "__halt")
((eq? p 'raise) "Cyc_raise")
((eq? p 'Cyc-current-exception-handler) "Cyc_current_exception_handler")
((eq? p 'Cyc-add-exception-handler) "Cyc_add_exception_handler")
((eq? p 'Cyc-remove-exception-handler) "Cyc_remove_exception_handler")
((eq? p 'error) "Cyc_error")

View file

@ -495,13 +495,8 @@ static object Cyc_remove_exception_handler(){
}
// END TODO
static object Cyc_raise(object err) {
//function_type fnc = (function_type) car(exception_handler_stack);
//mclosure0(clo, fnc);
//(fnc)(2, &clo, &clo, err);
object clo = car(exception_handler_stack);
((closure)clo)->fn(2, clo, clo, err);
return nil;
static object Cyc_current_exception_handler() {
return car(exception_handler_stack);
}
/* END exception handler */

View file

@ -69,14 +69,23 @@
(foldr (lambda (x y) (cons (func x) y)) '() lst))
(define (not x) (if x #f #t))
(define (reverse lst) (foldl cons '() lst))
(define (raise obj)
((Cyc-current-exception-handler) (list 'raised obj)))
(define (raise-continuable obj)
((Cyc-current-exception-handler) (list 'continuable obj)))
(define (with-exception-handler handler thunk)
(let ((my-handler
(lambda (obj)
(let ((result #f)
(continuable? (and (pair? obj)
(equal? (car obj) 'continuable))))
;; Unregister this handler since it is no longer needed
(Cyc-remove-exception-handler)
(handler obj) ;; Actual handler
;; TODO: unless obj is continuable, then return above result:
(error "exception handler returned"))))
(set! result (handler (cadr obj))) ;; Actual handler
(if continuable?
result
(error "exception handler returned"))))))
;; TODO: cond-expand below, since it uses Cyc functions?
;; probably no need since this is part of internal lib
(Cyc-add-exception-handler my-handler)
@ -532,7 +541,7 @@
%halt
error
exit
raise
Cyc-current-exception-handler
Cyc-add-exception-handler
Cyc-remove-exception-handler
cons