(define-condition simple-error (simple-condition error) ())
+;;; not specified by ANSI, but too useful not to have around.
+(define-condition simple-style-warning (simple-condition style-warning) ())
+
(define-condition storage-condition (serious-condition) ())
(define-condition type-error (error)
(reader-error-format-control condition)
(reader-error-format-arguments condition)))))))
\f
-;;;; various other (not specified by ANSI) CONDITIONs
-;;;;
-;;;; These might logically belong in other files; they're here, after
-;;;; setup of CONDITION machinery, only because that makes it easier to
-;;;; get cold init to work.
-
-(define-condition simple-style-warning (simple-condition style-warning) ())
-
-(define-condition values-type-error (type-error)
- ()
- (:report
- (lambda (condition stream)
- (format stream
- "~@<The values set ~2I~:_[~{~S~^ ~}] ~I~_is not of type ~2I~_~S.~:>"
- (type-error-datum condition)
- (type-error-expected-type condition)))))
-
-;;; KLUDGE: a condition for floating point errors when we can't or
-;;; won't figure out what type they are. (In FreeBSD and OpenBSD we
-;;; don't know how, at least as of sbcl-0.6.7; in Linux we probably
-;;; know how but the old code was broken by the conversion to POSIX
-;;; signal handling and hasn't been fixed as of sbcl-0.6.7.)
-;;;
-;;; FIXME: Perhaps this should also be a base class for all
-;;; floating point exceptions?
-(define-condition floating-point-exception (arithmetic-error)
- ((flags :initarg :traps
- :initform nil
- :reader floating-point-exception-traps))
- (:report (lambda (condition stream)
- (format stream
- "An arithmetic error ~S was signalled.~%"
- (type-of condition))
- (let ((traps (floating-point-exception-traps condition)))
- (if traps
- (format stream
- "Trapping conditions are: ~%~{ ~S~^~}~%"
- traps)
- (write-line
- "No traps are enabled? How can this be?"
- stream))))))
-
-(define-condition index-too-large-error (type-error)
- ()
- (:report
- (lambda (condition stream)
- (format stream
- "The index ~S is too large."
- (type-error-datum condition)))))
-
-(define-condition bounding-indices-bad-error (type-error)
- ((object :reader bounding-indices-bad-object :initarg :object))
- (:report
- (lambda (condition stream)
- (let* ((datum (type-error-datum condition))
- (start (car datum))
- (end (cdr datum))
- (object (bounding-indices-bad-object condition)))
- (etypecase object
- (sequence
- (format stream
- "The bounding indices ~S and ~S are bad for a sequence of length ~S."
- start end (length object)))
- (array
- ;; from WITH-ARRAY-DATA
- (format stream
- "The START and END parameters ~S and ~S are bad for an array of total size ~S."
- start end (array-total-size object))))))))
-
-(define-condition nil-array-accessed-error (type-error)
- ()
- (:report (lambda (condition stream)
- (declare (ignore condition))
- (format stream
- "An attempt to access an array of element-type ~
- NIL was made. Congratulations!"))))
-
-(define-condition io-timeout (stream-error)
- ((direction :reader io-timeout-direction :initarg :direction))
- (:report
- (lambda (condition stream)
- (declare (type stream stream))
- (format stream
- "I/O timeout ~(~A~)ing ~S"
- (io-timeout-direction condition)
- (stream-error-stream condition)))))
-
-(define-condition namestring-parse-error (parse-error)
- ((complaint :reader namestring-parse-error-complaint :initarg :complaint)
- (args :reader namestring-parse-error-args :initarg :args :initform nil)
- (namestring :reader namestring-parse-error-namestring :initarg :namestring)
- (offset :reader namestring-parse-error-offset :initarg :offset))
- (:report
- (lambda (condition stream)
- (format stream
- "parse error in namestring: ~?~% ~A~% ~V@T^"
- (namestring-parse-error-complaint condition)
- (namestring-parse-error-args condition)
- (namestring-parse-error-namestring condition)
- (namestring-parse-error-offset condition)))))
-
-(define-condition simple-package-error (simple-condition package-error) ())
-
-(define-condition reader-package-error (reader-error) ())
-
-(define-condition reader-eof-error (end-of-file)
- ((context :reader reader-eof-error-context :initarg :context))
- (:report
- (lambda (condition stream)
- (format stream
- "unexpected end of file on ~S ~A"
- (stream-error-stream condition)
- (reader-eof-error-context condition)))))
-
-(define-condition reader-impossible-number-error (reader-error)
- ((error :reader reader-impossible-number-error-error :initarg :error))
- (:report
- (lambda (condition stream)
- (let ((error-stream (stream-error-stream condition)))
- (format stream "READER-ERROR ~@[at ~W ~]on ~S:~%~?~%Original error: ~A"
- (file-position error-stream) error-stream
- (reader-error-format-control condition)
- (reader-error-format-arguments condition)
- (reader-impossible-number-error-error condition))))))
-
-(define-condition timeout (serious-condition) ())
-\f
;;;; special SBCL extension conditions
;;; an error apparently caused by a bug in SBCL itself
(:special-operator (format stream "Special Operator ~S" data))
(:macro (format stream "Macro ~S" data))
(:section (format stream "Section ~{~D~^.~}" data))
- (:glossary (format stream "Glossary Entry ~S" data)))))
+ (:glossary (format stream "Glossary entry for ~S" data))
+ (:issue (format stream "writeup for Issue ~A" data)))))
(:sbcl
(format stream "The SBCL Manual")
(format stream ", ")
(reference-condition simple-warning)
()
(:default-initargs
- :references (list '(:ansi-cl :function make-array)
- '(:ansi-cl :function upgraded-array-element-type))))
+ :references (list
+ '(:ansi-cl :function make-array)
+ '(:ansi-cl :function sb!xc:upgraded-array-element-type))))
(define-condition displaced-to-array-too-small-error
(reference-condition simple-error)
(define-condition extension-failure (reference-condition simple-error)
())
\f
+;;;; various other (not specified by ANSI) CONDITIONs
+;;;;
+;;;; These might logically belong in other files; they're here, after
+;;;; setup of CONDITION machinery, only because that makes it easier to
+;;;; get cold init to work.
+
+(define-condition values-type-error (type-error)
+ ()
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "~@<The values set ~2I~:_[~{~S~^ ~}] ~I~_is not of type ~2I~_~S.~:>"
+ (type-error-datum condition)
+ (type-error-expected-type condition)))))
+
+;;; KLUDGE: a condition for floating point errors when we can't or
+;;; won't figure out what type they are. (In FreeBSD and OpenBSD we
+;;; don't know how, at least as of sbcl-0.6.7; in Linux we probably
+;;; know how but the old code was broken by the conversion to POSIX
+;;; signal handling and hasn't been fixed as of sbcl-0.6.7.)
+;;;
+;;; FIXME: Perhaps this should also be a base class for all
+;;; floating point exceptions?
+(define-condition floating-point-exception (arithmetic-error)
+ ((flags :initarg :traps
+ :initform nil
+ :reader floating-point-exception-traps))
+ (:report (lambda (condition stream)
+ (format stream
+ "An arithmetic error ~S was signalled.~%"
+ (type-of condition))
+ (let ((traps (floating-point-exception-traps condition)))
+ (if traps
+ (format stream
+ "Trapping conditions are: ~%~{ ~S~^~}~%"
+ traps)
+ (write-line
+ "No traps are enabled? How can this be?"
+ stream))))))
+
+(define-condition index-too-large-error (type-error)
+ ()
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "The index ~S is too large."
+ (type-error-datum condition)))))
+
+(define-condition bounding-indices-bad-error (reference-condition type-error)
+ ((object :reader bounding-indices-bad-object :initarg :object))
+ (:report
+ (lambda (condition stream)
+ (let* ((datum (type-error-datum condition))
+ (start (car datum))
+ (end (cdr datum))
+ (object (bounding-indices-bad-object condition)))
+ (etypecase object
+ (sequence
+ (format stream
+ "The bounding indices ~S and ~S are bad ~
+ for a sequence of length ~S."
+ start end (length object)))
+ (array
+ ;; from WITH-ARRAY-DATA
+ (format stream
+ "The START and END parameters ~S and ~S are ~
+ bad for an array of total size ~S."
+ start end (array-total-size object)))))))
+ (:default-initargs
+ :references
+ (list '(:ansi-cl :glossary "bounding index designator")
+ '(:ansi-cl :issue "SUBSEQ-OUT-OF-BOUNDS:IS-AN-ERROR"))))
+
+(define-condition nil-array-accessed-error (reference-condition type-error)
+ ()
+ (:report (lambda (condition stream)
+ (declare (ignore condition))
+ (format stream
+ "An attempt to access an array of element-type ~
+ NIL was made. Congratulations!")))
+ (:default-initargs
+ :references (list '(:ansi-cl :function sb!xc:upgraded-array-element-type)
+ '(:ansi-cl :section (15 1 2 1))
+ '(:ansi-cl :section (15 1 2 2)))))
+
+(define-condition io-timeout (stream-error)
+ ((direction :reader io-timeout-direction :initarg :direction))
+ (:report
+ (lambda (condition stream)
+ (declare (type stream stream))
+ (format stream
+ "I/O timeout ~(~A~)ing ~S"
+ (io-timeout-direction condition)
+ (stream-error-stream condition)))))
+
+(define-condition namestring-parse-error (parse-error)
+ ((complaint :reader namestring-parse-error-complaint :initarg :complaint)
+ (args :reader namestring-parse-error-args :initarg :args :initform nil)
+ (namestring :reader namestring-parse-error-namestring :initarg :namestring)
+ (offset :reader namestring-parse-error-offset :initarg :offset))
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "parse error in namestring: ~?~% ~A~% ~V@T^"
+ (namestring-parse-error-complaint condition)
+ (namestring-parse-error-args condition)
+ (namestring-parse-error-namestring condition)
+ (namestring-parse-error-offset condition)))))
+
+(define-condition simple-package-error (simple-condition package-error) ())
+
+(define-condition reader-package-error (reader-error) ())
+
+(define-condition reader-eof-error (end-of-file)
+ ((context :reader reader-eof-error-context :initarg :context))
+ (:report
+ (lambda (condition stream)
+ (format stream
+ "unexpected end of file on ~S ~A"
+ (stream-error-stream condition)
+ (reader-eof-error-context condition)))))
+
+(define-condition reader-impossible-number-error (reader-error)
+ ((error :reader reader-impossible-number-error-error :initarg :error))
+ (:report
+ (lambda (condition stream)
+ (let ((error-stream (stream-error-stream condition)))
+ (format stream "READER-ERROR ~@[at ~W ~]on ~S:~%~?~%Original error: ~A"
+ (file-position error-stream) error-stream
+ (reader-error-format-control condition)
+ (reader-error-format-arguments condition)
+ (reader-impossible-number-error-error condition))))))
+
+(define-condition timeout (serious-condition) ())
+\f
;;;; restart definitions
(define-condition abort-failure (control-error) ()
:definition-source `((defgeneric ,fun-name) ,*load-pathname*)
initargs))
-;;; As per section 3.4.2 of the ANSI spec, generic function lambda
-;;; lists have some special limitations, which we check here.
+(define-condition generic-function-lambda-list-error
+ (reference-condition simple-program-error)
+ ()
+ (:default-initargs :references (list '(:ansi-cl :section (3 4 2)))))
+
(defun check-gf-lambda-list (lambda-list)
(flet ((ensure (arg ok)
(unless ok
- (error
- ;; (s/invalid/non-ANSI-conforming/ because the old PCL
- ;; implementation allowed this, so people got used to
- ;; it, and maybe this phrasing will help them to guess
- ;; why their program which worked under PCL no longer works.)
- "~@<non-ANSI-conforming argument ~S ~_in the generic function lambda list ~S~:>"
- arg lambda-list))))
+ (error 'generic-function-lambda-list-error
+ :format-control
+ "~@<invalid ~S ~_in the generic function lambda list ~S~:>"
+ :format-arguments (list arg lambda-list)))))
(multiple-value-bind (required optional restp rest keyp keys allowp
auxp aux morep more-context more-count)
(parse-lambda-list lambda-list)
(declare (ignore ignore1 ignore2 ignore3))
required-parameters))
+(define-condition specialized-lambda-list-error
+ (reference-condition simple-program-error)
+ ()
+ (:default-initargs :references (list '(:ansi-cl :section (3 4 3)))))
+
(defun parse-specialized-lambda-list
(arglist
&optional supplied-keywords (allowed-keywords '(&optional &rest &key &aux))
((eq arg '&aux)
(values nil arglist nil nil))
((memq arg lambda-list-keywords)
- ;; Now, since we try to conform to ANSI, non-standard
- ;; lambda-list-keywords should be treated as errors.
+ ;; non-standard lambda-list-keywords are errors.
(unless (memq arg specialized-lambda-list-keywords)
- (error 'simple-program-error
+ (error 'specialized-lambda-list-error
:format-control "unknown specialized-lambda-list ~
keyword ~S~%"
:format-arguments (list arg)))
;; no multiple &rest x &rest bla specifying
(when (memq arg supplied-keywords)
- (error 'simple-program-error
+ (error 'specialized-lambda-list-error
:format-control "multiple occurrence of ~
specialized-lambda-list keyword ~S~%"
:format-arguments (list arg)))
;; And no placing &key in front of &optional, either.
(unless (memq arg allowed-keywords)
- (error 'simple-program-error
+ (error 'specialized-lambda-list-error
:format-control "misplaced specialized-lambda-list ~
keyword ~S~%"
:format-arguments (list arg)))
(not (or (null (cadr lambda-list))
(memq (cadr lambda-list)
specialized-lambda-list-keywords)))))
- (error 'simple-program-error
+ (error 'specialized-lambda-list-error
:format-control
"in a specialized-lambda-list, excactly one ~
variable must follow &REST.~%"
projects / sbcl.git / commitdiff