summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorBT Templeton <bpt@hcoop.net>2011-08-12 15:57:17 -0400
committerBT Templeton <bpt@hcoop.net>2012-02-03 18:53:50 -0500
commit8fb678718ca38089d873a3d91ab9530e9bb7f15f (patch)
tree42545d26fd316aa54946d00885ce38395961c0d6 /module
parentce9b7cc22c19da07f3cdc686797cfbc5e92961ee (diff)
downloadguile-8fb678718ca38089d873a3d91ab9530e9bb7f15f.tar.gz
`catch' in terms of `condition-case'
* module/language/elisp/boot.el (throw): Define an `error-conditions' property for this symbol. (catch): Define in terms of `condition-case' instead of using Guile exceptions directly. (throw): Signal a `throw' condition instead of throwing a Guile exception directly.
Diffstat (limited to 'module')
-rw-r--r--module/language/elisp/boot.el37
1 files changed, 16 insertions, 21 deletions
diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el
index cf22265e2..a183b89e4 100644
--- a/module/language/elisp/boot.el
+++ b/module/language/elisp/boot.el
@@ -125,24 +125,6 @@
nil)))
(,loop))))
-(defmacro catch (tag &rest body)
- (let* ((temp (make-symbol "catch-temp"))
- (elisp-key (make-symbol "catch-elisp-key"))
- (key (make-symbol "catch-key"))
- (value (make-symbol "catch-value")))
- `(let ((,temp ,tag))
- (declare (lexical ,temp))
- (funcall (@ (guile) catch)
- 'elisp-exception
- #'(lambda () ,@body)
- #'(lambda (,key ,elisp-key ,value)
- (if (eq ,elisp-key ,temp)
- ,value
- (funcall (@ (guile) throw)
- ,key
- ,elisp-key
- ,value)))))))
-
(defmacro unwind-protect (bodyform &rest unwindforms)
`(funcall (@ (guile) dynamic-wind)
#'(lambda () nil)
@@ -202,9 +184,6 @@
definition)))
definition)
-(defun throw (tag value)
- (funcall (@ (guile) throw) 'elisp-exception tag value))
-
(defun load (file)
(funcall (@ (system base compile) compile-file)
file
@@ -475,4 +454,20 @@
(put 'wrong-type-argument 'error-conditions '(wrong-type-argument error))
(put 'invalid-function 'error-conditions '(invalid-function error))
(put 'no-catch 'error-conditions '(no-catch error))
+(put 'throw 'error-conditions '(throw))
+
+(defmacro catch (tag &rest body)
+ (let ((tag-value (make-symbol "tag-value"))
+ (c (make-symbol "c"))
+ (data (make-symbol "data")))
+ `(let ((,tag-value ,tag))
+ (condition-case ,c
+ (progn ,@body)
+ (throw
+ (let ((,data (cdr ,c)))
+ (if (eq (car ,data) ,tag-value)
+ (car (cdr ,data))
+ (signal 'throw ,data))))))))
+(defun throw (tag value)
+ (signal 'throw (list tag value)))