Changeset 338

Timestamp:

Jan 19, 2004, 4:40:07 PM (21 years ago)

Author:

Gary Byers

Message:

PARSE-DEFGENERIC allows multiple DECLARE forms, passes them as :DECLARATIONS
option.
HANDLER-BIND a little less jumpy.

File:

• trunk/ccl/lib/macros.lisp (modified) (6 diffs)

trunk/ccl/lib/macros.lisp

@@ -252 +252 @@
                                      `(',condition ,fn))
                                    (list `',condition
-                                         `(require-type ,handler 'function)))))
+                                         `,handler))))
                            clauses))
         (cluster (gensym)))    
@@ -1707 +1707 @@
   (let ((method-combination '(standard))
         (generic-function-class 'standard-generic-function)
-        options methods option-keywords method-class)
+        options declarations methods option-keywords method-class)
     (flet ((bad-option (o)
              (signal-program-error "Bad option: ~s to ~s." o 'defgeneric)))
@@ -1715 +1715 @@
           (if (eq keyword :method)
             (push `(,defmethod ,function-name ,@(%cdr o)) methods)
-            (cond ((memq keyword (prog1 option-keywords (push keyword option-keywords)))
+            (cond ((and (not (eq keyword 'declare))
+                        (memq keyword (prog1 option-keywords (push keyword option-keywords))))             
                    (signal-program-error "Duplicate option: ~s to ~s" keyword 'defgeneric))
                   ((eq keyword :method-name)    ; used by generic-flet
@@ -1729 +1730 @@
                    (setq generic-function-class (%cadr o)))
                   ((eq keyword 'declare)
-                   (push (list :declare (cdr o)) options))
+                   (push (cadr o) declarations))
                   ((eq keyword :argument-precedence-order)
                    (dolist (arg (cdr o))
@@ -1747 +1748 @@
       (dolist (m methods)
         (push `(:method-class ,method-class) (cddr m))))
+    (when declarations
+      (setq options `((:declarations ,declarations ,@options))))
     (values method-combination generic-function-class options methods)))
 
@@ -2573 +2576 @@
 
 (defmacro with-terminal-input (&body body)
-  (let* ((old-owner (gensym)))
-    `(let* ((,old-owner (%request-terminal-input)))
+  (let* ((got-it (gensym)))
+    `(let* ((,got-it (%request-terminal-input)))
       (unwind-protect
            (progn ,@body)
-        (%restore-terminal-input ,old-owner)))))
+        (if ,got-it (%restore-terminal-input))))))
 
 (defmacro do-unexhausted-lisp-threads ((thread) &body body)