Changeset 15302

Timestamp:

Apr 7, 2012, 4:19:14 PM (13 years ago)

Author:

Gary Byers

Message:

Don't locally bind the names of globally-defined CL functions; we may
warn about that soon.

Location:

trunk/source

Files:

• level-1/l1-error-system.lisp (modified) (2 diffs)
• lib/macros.lisp (modified) (4 diffs)

trunk/source/level-1/l1-error-system.lisp

@@ -1352 +1352 @@
 
 (flet ((io-stream-p (x) (and (streamp x) (eq (stream-direction x) :io)))
-       (input-stream-p (x) (and (streamp x) (input-stream-p x)))
-       (output-stream-p (x) (and (streamp x) (output-stream-p x)))
+       (is-input-stream-p (x) (and (streamp x) (input-stream-p x)))
+       (is-output-stream-p (x) (and (streamp x) (output-stream-p x)))
        (default-terminal-io () (make-echoing-two-way-stream *stdin* *stdout*))
        (terminal-io () *terminal-io*)
@@ -1363 +1363 @@
   (check-error-global '*query-io* #'io-stream-p #'terminal-io)
   (check-error-global '*debug-io* #'io-stream-p #'terminal-io)
-  (check-error-global '*standard-input* #'input-stream-p #'terminal-io)
-  (check-error-global '*standard-output* #'output-stream-p #'terminal-io)
-  (check-error-global '*error-output* #'output-stream-p #'standard-output)
-  (check-error-global '*trace-output* #'output-stream-p #'standard-output))
-
+  (check-error-global '*standard-input* #'is-input-stream-p #'terminal-io)
+  (check-error-global '*standard-output* #'is-output-stream-p #'terminal-io)
+  (check-error-global '*error-output* #'is-output-stream-p #'standard-output)
+  (check-error-global '*trace-output* #'is-output-stream-p #'standard-output))
+

trunk/source/lib/macros.lisp

@@ -444 +444 @@
                 (handler-case (return-from ,normal-return ,form)
                   ,@(remove no-error-clause clauses)))))))
-      (flet ((handler-case (type var &rest body)
+      (flet ((handler-case-aux (type var &rest body)
                (when (eq type :no-error)
                  (signal-program-error "Duplicate :no-error clause. "))
@@ -453 +453 @@
                  (cluster (gensym)))
              (multiple-value-bind (type var body)
-                                  (apply #'handler-case (car clauses))
+                                  (apply #'handler-case-aux (car clauses))
                (if var
                  `(block ,block
@@ -476 +476 @@
                  (setq index (1+ index))
                  (multiple-value-bind (type var body)
-                                      (apply #'handler-case (pop clauses))                   
+                                      (apply #'handler-case-aux (pop clauses))                   
                    (push `',type handlers)
                    (push index handlers)
@@ -2225 +2225 @@
 
 (defmacro define-condition (name (&rest supers) (&rest slots) &body options)
-  "DEFINE-CONDITION Name (Parent-Type*) (Slot-Spec*) Option*
-   Define NAME as a condition type. This new type inherits slots and its
-   report function from the specified PARENT-TYPEs. A slot spec is a list of:
-     (slot-name :reader <rname> :initarg <iname> {Option Value}*
-
-   The DEFINE-CLASS slot options :ALLOCATION, :INITFORM, [slot] :DOCUMENTATION
-   and :TYPE and the overall options :DEFAULT-INITARGS and
-   [type] :DOCUMENTATION are also allowed.
-
-   The :REPORT option is peculiar to DEFINE-CONDITION. Its argument is either
-   a string or a two-argument lambda or function name. If a function, the
-   function is called with the condition and stream to report the condition.
-   If a string, the string is printed.
-
-   Condition types are classes, but (as allowed by ANSI and not as described in
-   CLtL2) are neither STANDARD-OBJECTs nor STRUCTURE-OBJECTs. WITH-SLOTS and
-   SLOT-VALUE may not be used on condition objects."
-  ; If we could tell what environment we're being expanded in, we'd
-  ; probably want to check to ensure that all supers name conditions
-  ; in that environment.
+  ;; If we could tell what environment we're being expanded in, we'd
+  ;; probably want to check to ensure that all supers name conditions
+  ;; in that environment.
   (let ((classopts nil)
         (duplicate nil)