[Openmcl-cvs-notifications] r15302 - in /trunk/source: level-1/l1-error-system.lisp lib/macros.lisp
gb at clozure.com
gb at clozure.com
Sat Apr 7 18:19:14 CDT 2012
Author: gb
Date: Sat Apr 7 18:19:14 2012
New Revision: 15302
Log:
Don't locally bind the names of globally-defined CL functions; we may
warn about that soon.
Modified:
trunk/source/level-1/l1-error-system.lisp
trunk/source/lib/macros.lisp
Modified: trunk/source/level-1/l1-error-system.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-error-system.lisp (original)
+++ trunk/source/level-1/l1-error-system.lisp Sat Apr 7 18:19:14 2012
@@ -1351,8 +1351,8 @@
=
=
(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* *stdou=
t*))
(terminal-io () *terminal-io*)
(standard-output () *standard-output*))
@@ -1362,8 +1362,8 @@
(check-error-global '*terminal-io* #'io-stream-p #'default-terminal-io)
(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-i=
o)
+ (check-error-global '*error-output* #'is-output-stream-p #'standard-outp=
ut)
+ (check-error-global '*trace-output* #'is-output-stream-p #'standard-outp=
ut))
+
Modified: trunk/source/lib/macros.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/macros.lisp (original)
+++ trunk/source/lib/macros.lisp Sat Apr 7 18:19:14 2012
@@ -443,7 +443,7 @@
(return-from ,error-return
(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. "))
(values type var body)))
@@ -452,7 +452,7 @@
(let ((block (gensym))
(cluster (gensym)))
(multiple-value-bind (type var body)
- (apply #'handler-case (car clauses))
+ (apply #'handler-case-aux (car clauses))
(if var
`(block ,block
((lambda ,var , at body)
@@ -475,7 +475,7 @@
(while clauses
(setq index (1+ index))
(multiple-value-bind (type var body)
- (apply #'handler-case (pop clauses))=
=
+ (apply #'handler-case-aux (pop claus=
es)) =
(push `',type handlers)
(push index handlers)
(when (null clauses) (setq index t))
@@ -2224,26 +2224,9 @@
;;; which tests *print-escape* ? Scary if so ...
=
(defmacro define-condition (name (&rest supers) (&rest slots) &body option=
s)
- "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] :DOCUMENTA=
TION
- 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 eit=
her
- 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 conditio=
n.
- If a string, the string is printed.
-
- Condition types are classes, but (as allowed by ANSI and not as describ=
ed in
- CLtL2) are neither STANDARD-OBJECTs nor STRUCTURE-OBJECTs. WITH-SLOTS a=
nd
- 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)
(docp nil)
More information about the Openmcl-cvs-notifications
mailing list