Permalink
Browse files

Add restarts directly to THROW and SIGNAL.

  • Loading branch information...
manuel committed Mar 20, 2012
1 parent dca031c commit d22e0d41df13f72c3889d51e234cabf79e63c914
Showing with 38 additions and 13 deletions.
  1. +34 −11 conditions.virtua
  2. +1 −1 examples/conditions-example.virtua
  3. +3 −1 test.virtua
View
@@ -1,5 +1,16 @@
;; -*- LISP -*-
+(provide (Condition
+ Error
+ Warning
+ Restart
+ Simple-Error
+ catch
+ handle
+ throw
+ signal
+ default-handler)
+
(defclass Condition)
(defclass Error (Condition))
(defclass Warning (Condition))
@@ -17,21 +28,21 @@
(:constructor make-handlers-frame (parent-option handlers-list)))
(defclass Handler ()
- (condition-class
+ (matcher-function
handler-function)
- (:constructor make-handler (condition-class handler-function)))
+ (:constructor make-handler (matcher-function handler-function)))
(defun handler-matches-condition? (handler condition)
- (instance? condition (.condition-class handler)))
+ ((.matcher-function handler) condition))
(defun call-with-handlers (thunk handlers-list)
(fluid-let (*handlers-frame-option*
(just (make-handlers-frame *handlers-frame-option* handlers-list)))
(thunk)))
-(defgeneric signal (condition))
+(defgeneric signal-internal (condition))
-(defmethod signal ((condition Condition))
+(defmethod signal-internal ((condition Condition))
(defun signal-frame (frame-option)
(if-option (frame frame-option)
(progn
@@ -43,11 +54,11 @@
(default-handler condition)))
(signal-frame *handlers-frame-option*))
-(defmethod signal ((message String))
- (signal (make-simple-error message)))
+(defmethod signal-internal ((message String))
+ (signal-internal (make-simple-error message)))
-(defun throw (x)
- (signal x)
+(defun throw-internal (x)
+ (signal-internal x)
(invoke-debugger x))
(defgeneric default-handler (condition))
@@ -66,8 +77,9 @@
(defmacro handle (expr . handlers) env
(call-with-handlers (lambda () (eval expr env))
(map (lambda (h)
- (let ((((c v) . exprs) h))
- (make-handler (eval c env)
+ (let ((((c v . ac) . exprs) h))
+ (make-handler (lambda (condition)
+ (instance? condition (eval c env)))
(eval (list* lambda (list v) exprs) env))))
handlers)))
@@ -81,3 +93,14 @@
(list* lambda () exprs)))))
handlers))
env)))))
+
+(defmacro signal-with-restarts (raiser condition . restarts) env
+ (eval (list* catch (list raiser condition) restarts) env))
+
+(defmacro throw condition-and-restarts env
+ (apply (wrap signal-with-restarts) (list* throw-internal condition-and-restarts) env))
+
+(defmacro signal condition-and-restarts env
+ (apply (wrap signal-with-restarts) (list* signal-internal condition-and-restarts) env))
+
+) ; edivorp
@@ -14,7 +14,7 @@
(defun get-val ()
(if-option (val *val-option*)
val
- (catch (throw (make-no-val-error))
+ (throw (make-no-val-error)
((Use-Val-Restart r) (.val r)))))
(defun set-val (new-val)
View
@@ -186,7 +186,9 @@
;;;; Conditions
-;(assert (= 12 (call-with-handler (lambda #ignore #t) (lambda #ignore 12) (lambda () (signal "foo")))))
+(assert (= (handle (throw "foo" ((Restart r) 12))
+ ((Simple-Error e) (throw (make-instance Restart))))
+ 12))
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation

0 comments on commit d22e0d4

Please sign in to comment.