mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

catch' in terms of condition-case'

Browse source 
* 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.
This commit is contained in:
BT Templeton 2011-08-12 15:57:17 -04:00
parent ce9b7cc22c
commit 8fb678718c
1 changed files with 16 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

37
module/language/elisp/boot.el
View file

@ -125,24 +125,6 @@
nil))) nil)))
(,loop)))) (,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) (defmacro unwind-protect (bodyform &rest unwindforms)
`(funcall (@ (guile) dynamic-wind) `(funcall (@ (guile) dynamic-wind)
#'(lambda () nil) #'(lambda () nil)
@ -202,9 +184,6 @@
definition))) definition)))
definition) definition)
(defun throw (tag value)
(funcall (@ (guile) throw) 'elisp-exception tag value))
(defun load (file) (defun load (file)
(funcall (@ (system base compile) compile-file) (funcall (@ (system base compile) compile-file)
file file
@ -475,4 +454,20 @@
(put 'wrong-type-argument 'error-conditions '(wrong-type-argument error)) (put 'wrong-type-argument 'error-conditions '(wrong-type-argument error))
(put 'invalid-function 'error-conditions '(invalid-function error)) (put 'invalid-function 'error-conditions '(invalid-function error))
(put 'no-catch 'error-conditions '(no-catch 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)))