Racket Exception Implementation
#lang racket | |
(define *handlers* (list)) | |
(define (push-handler proc) | |
(set! *handlers* (cons proc *handlers*))) | |
(define (pop-handler) | |
(let ((h (car *handlers*))) | |
(set! *handlers* ( cdr *handlers*)) | |
h)) | |
(define (throw . x) | |
(if (pair? *handlers*) | |
(apply (pop-handler) x) | |
(apply error x))) | |
(define-syntax catch | |
(syntax-rules () | |
((_ [handler ...] exp1 ...) | |
(call/cc (lambda (exit) | |
; ; install the handler | |
(push-handler (lambda (ex) | |
; ; rewrite the handler with a Pattern Matching Expression that rethrow the exception in the default case | |
(exit (match ex handler ... [_ (throw ex)])))) | |
(let ((res ; ; evaluate the body | |
(begin exp1 ...))) | |
; ok : discard the handler | |
(pop-handler) | |
res )))))) | |
(struct throwable ()) | |
(struct exception throwable (message)) | |
;; TESTS | |
;; redefine error to test throw... | |
(define (error . x) (apply displayln x)) | |
;; Simple Test Case | |
(throw (exception "CiaoBao")) ;; Displays #<exception> | |
;; Simple Catch Test Case | |
(catch ([(exception "bao") (displayln "ciao")]) | |
(throw (exception "bao"))) ;; Displays "ciao" | |
;; Not so simple Nested Catch Statement | |
(catch ([(exception "bao") (displayln "ciao")]) | |
(catch ([(exception "ciao") (displayln "bao")] | |
[(throwable) (displayln "throwable")]) | |
(throw (exception "bao")))) ;; Displays "throwable" | |
;; Simple Pattern Matching | |
(catch ([(exception _) (displayln "bao")]) | |
(throw (exception "ciao"))) ;; Displays "bao" | |
;; Intermediate Pattern Matching | |
(catch ([(exception message) (displayln message)]) | |
(throw (exception "Not so stupid message"))) ;; Displays "Not so stupid message" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment