diff options
author | BT Templeton <bpt@hcoop.net> | 2011-08-12 15:57:17 -0400 |
---|---|---|
committer | BT Templeton <bpt@hcoop.net> | 2012-02-03 18:53:50 -0500 |
commit | 8fb678718ca38089d873a3d91ab9530e9bb7f15f (patch) | |
tree | 42545d26fd316aa54946d00885ce38395961c0d6 /module/language/elisp | |
parent | ce9b7cc22c19da07f3cdc686797cfbc5e92961ee (diff) | |
download | guile-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/language/elisp')
-rw-r--r-- | module/language/elisp/boot.el | 37 |
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))) |