50 lines
1.4 KiB
Scheme
50 lines
1.4 KiB
Scheme
|
;;; extremly simple restartable conditions with SRFI-34/35
|
||
|
|
|
||
|
|
;;; This file is part of the Scheme Untergrund Library.
|
||
|
|
|
||
|
|
;;; Copyright (c) 2004 by Eric Knauel.
|
||
|
|
;;; For copyright information, see the file COPYING which comes with
|
||
|
|
;;; the distribution.
|
||
|
|
|
||
|
|
;;; Example:
|
||
|
|
|
||
|
|
;;; (define-condition-type &harmless &condition
|
||
|
|
;;; harmless-condition?)
|
||
|
|
;;;
|
||
|
|
;;; (with-exception-handler
|
||
|
|
;;; (lambda (c)
|
||
|
|
;;; (cond
|
||
|
|
;;; ((harmless-condition? c)
|
||
|
|
;;; (display "Oops!")
|
||
|
|
;;; (newline)
|
||
|
|
;;; (restart c))
|
||
|
|
;;; (else
|
||
|
|
;;; (error (condition-message c)))))
|
||
|
|
;;; (lambda ()
|
||
|
|
;;; (display "Everything ok.")
|
||
|
|
;;; (newline)
|
||
|
|
;;; (raise-restartable (condition (&harmless)))
|
||
|
|
;;; (display "Never mind.")
|
||
|
|
;;; (newline)
|
||
|
|
;;; (raise-restartable (condition (&message (message "Ouch!"))))))
|
||
|
|
|
||
|
|
(define-condition-type &restartable-condition &condition
|
||
|
|
restartable-condition?
|
||
|
|
(cont restartable-condition-cont))
|
||
|
|
|
||
|
|
(define-syntax raise-restartable
|
||
|
|
(syntax-rules ()
|
||
|
|
((raise-restartable %obj)
|
||
|
|
(call-with-current-continuation
|
||
|
|
(lambda (restart-cont)
|
||
|
|
(raise
|
||
|
|
(make-compound-condition
|
||
|
|
(condition (&restartable-condition (cont restart-cont))) %obj)))))))
|
||
|
|
|
||
|
|
(define-syntax restart
|
||
|
|
(syntax-rules ()
|
||
|
|
((restart %condition)
|
||
|
|
(if (restartable-condition? %condition)
|
||
|
|
((condition-ref (extract-condition %condition &restartable-condition) 'cont) 'ignored)
|
||
|
|
(raise (condition (&message (message "not a restartable condition"))))))))
|