elisp I/O

[bpt/guile.git] / module / language / elisp / boot.el

diff --git a/module/language/elisp/boot.el b/module/language/elisp/boot.el
index a183b89..bec32b5 100644 (file)
--- a/module/language/elisp/boot.el
+++ b/module/language/elisp/boot.el
@@ -442,11 +442,14 @@
                 'elisp-condition
                 #'(lambda () ,bodyform)
                 #'(lambda (,key ,error-symbol ,data)
+                    (declare (lexical ,key ,error-symbol ,data))
                     (let ((,conditions
                            (get ,error-symbol 'error-conditions))
                           ,@(if var
                                 `((,var (cons ,error-symbol ,data)))
                               '()))
+                      (declare (lexical ,conditions
+                                        ,@(if var `(,var) '())))
                       (cond ,@(mapcar #'handler->cond-clause handlers)
                             (t (signal ,error-symbol ,data)))))))))
 
@@ -456,18 +459,37 @@
 (put 'no-catch 'error-conditions '(no-catch error))
 (put 'throw 'error-conditions '(throw))
 
+(defvar %catch nil)
+
 (defmacro catch (tag &rest body)
   (let ((tag-value (make-symbol "tag-value"))
         (c (make-symbol "c"))
         (data (make-symbol "data")))
     `(let ((,tag-value ,tag))
+       (declare (lexical ,tag-value))
        (condition-case ,c
-           (progn ,@body)
+           (let ((%catch t))
+             ,@body)
          (throw
           (let ((,data (cdr ,c)))
+            (declare (lexical ,data))
             (if (eq (car ,data) ,tag-value)
                 (car (cdr ,data))
-              (signal 'throw ,data))))))))
+              (apply #'throw ,data))))))))
 
 (defun throw (tag value)
-  (signal 'throw (list tag value)))
+  (signal (if %catch 'throw 'no-catch) (list tag value)))
+
+;;; I/O
+
+(defun princ (object)
+  (funcall (@ (guile) display) object))
+
+(defun print (object)
+  (funcall (@ (guile) write) object))
+
+(defun terpri ()
+  (funcall (@ (guile) newline)))
+
+(defun format* (stream string &rest args)
+  (apply (@ (guile) format) stream string args))