Permalink
Browse files

* clean up: (signal (make-condition ...)) => (signal ...)

  • Loading branch information...
1 parent ed41fcb commit c6b4fd560b3295aebbb53676494d97bcdf4d93ca @stassats stassats committed Aug 4, 2012
Showing with 108 additions and 115 deletions.
  1. +1 −0 ChangeLog
  2. +17 −18 swank-abcl.lisp
  3. +1 −1 swank-allegro.lisp
  4. +9 −10 swank-ccl.lisp
  5. +16 −16 swank-clisp.lisp
  6. +11 −13 swank-cmucl.lisp
  7. +15 −16 swank-corman.lisp
  8. +1 −1 swank-ecl.lisp
  9. +6 −6 swank-rpc.lisp
  10. +17 −18 swank-sbcl.lisp
  11. +10 −12 swank-scl.lisp
  12. +4 −4 swank.lisp
View
@@ -4,6 +4,7 @@
sb-debug::resolve-stack-top-hint instead of just
sb-debug:*stack-top-hint*, because now it can contain things other
than just frames.
+ * clean up: (signal (make-condition ...)) => (signal ...)
2012-07-13 Helmut Eller <heller@common-lisp.net>
View
@@ -414,24 +414,23 @@
;; filter condition signaled more than once.
(unless (member condition *abcl-signaled-conditions*)
(push condition *abcl-signaled-conditions*)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity :warning
- :message (format nil "~A" condition)
- :location (cond (*buffer-name*
- (make-location
- (list :buffer *buffer-name*)
- (list :offset *buffer-start-position* 0)))
- (loc
- (destructuring-bind (file . pos) loc
- (make-location
- (list :file (namestring (truename file)))
- (list :position (1+ pos)))))
- (t
- (make-location
- (list :file (namestring *compile-filename*))
- (list :position 1)))))))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (format nil "~A" condition)
+ :location (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :offset *buffer-start-position* 0)))
+ (loc
+ (destructuring-bind (file . pos) loc
+ (make-location
+ (list :file (namestring (truename file)))
+ (list :position (1+ pos)))))
+ (t
+ (make-location
+ (list :file (namestring *compile-filename*))
+ (list :position 1))))))))
(defimplementation swank-compile-file (input-file output-file
load-p external-format
View
@@ -341,7 +341,7 @@
`(satisfies redefinition-p))
(defun signal-compiler-condition (&rest args)
- (signal (apply #'make-condition 'compiler-condition args)))
+ (apply #'signal 'compiler-condition args))
(defun handle-compiler-warning (condition)
(declare (optimize (debug 3) (speed 0) (space 0)))
View
@@ -158,16 +158,15 @@
(defun handle-compiler-warning (condition)
"Resignal a ccl:compiler-warning as swank-backend:compiler-warning."
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :message (compiler-warning-short-message condition)
- :source-context nil
- :severity (compiler-warning-severity condition)
- :location (source-note-to-source-location
- (ccl:compiler-warning-source-note condition)
- (lambda () "Unknown source")
- (ccl:compiler-warning-function-name condition)))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :message (compiler-warning-short-message condition)
+ :source-context nil
+ :severity (compiler-warning-severity condition)
+ :location (source-note-to-source-location
+ (ccl:compiler-warning-source-note condition)
+ (lambda () "Unknown source")
+ (ccl:compiler-warning-function-name condition))))
(defgeneric compiler-warning-severity (condition))
(defmethod compiler-warning-severity ((c ccl:compiler-warning)) :warning)
View
@@ -627,10 +627,10 @@ Execute BODY with NAME's function slot set to FUNCTION."
(list :error "No error location available")))))
(defun signal-compiler-warning (cstring args severity orig-fn)
- (signal (make-condition 'compiler-condition
- :severity severity
- :message (apply #'format nil cstring args)
- :location (compiler-note-location)))
+ (signal 'compiler-condition
+ :severity severity
+ :message (apply #'format nil cstring args)
+ :location (compiler-note-location))
(apply orig-fn cstring args))
(defun c-warn (cstring &rest args)
@@ -641,13 +641,13 @@ Execute BODY with NAME's function slot set to FUNCTION."
(signal-compiler-warning cstring args :style-warning *orig-c-style-warn*)))
(defun c-error (&rest args)
- (signal (make-condition 'compiler-condition
- :severity :error
- :message (apply #'format nil
- (if (= (length args) 3)
- (cdr args)
- args))
- :location (compiler-note-location)))
+ (signal 'compiler-condition
+ :severity :error
+ :message (apply #'format nil
+ (if (= (length args) 3)
+ (cdr args)
+ args))
+ :location (compiler-note-location))
(apply *orig-c-error* args))
(defimplementation call-with-compilation-hooks (function)
@@ -659,11 +659,11 @@ Execute BODY with NAME's function slot set to FUNCTION."
(defun handle-notification-condition (condition)
"Handle a condition caused by a compiler warning."
- (signal (make-condition 'compiler-condition
- :original-condition condition
- :severity :warning
- :message (princ-to-string condition)
- :location (compiler-note-location))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (princ-to-string condition)
+ :location (compiler-note-location)))
(defimplementation swank-compile-file (input-file output-file
load-p external-format
View
@@ -373,7 +373,7 @@ specific functions.")
(cond ((zerop (length string))
(return-from sis/in
(if eof-errorp
- (error (make-condition 'end-of-file :stream stream))
+ (error 'end-of-file :stream stream)
eof-value)))
(t
(setf buffer string)
@@ -475,15 +475,14 @@ NIL if we aren't compiling from a buffer.")
(signal-compiler-condition condition context))))
(defun signal-compiler-condition (condition context)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity (severity-for-emacs condition)
- :message (compiler-condition-message condition)
- :source-context (compiler-error-context context)
- :location (if (read-error-p condition)
- (read-error-location condition)
- (compiler-note-location context)))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :message (compiler-condition-message condition)
+ :source-context (compiler-error-context context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context))))
(defun severity-for-emacs (condition)
"Return the severity of CONDITION."
@@ -1586,9 +1585,8 @@ A utility for debugging DEBUG-FUNCTION-ARGLIST."
(kernel:*current-level* 0))
(handler-bind ((di::unhandled-condition
(lambda (condition)
- (error (make-condition
- 'sldb-condition
- :original-condition condition)))))
+ (error 'sldb-condition
+ :original-condition condition))))
(unwind-protect
(progn
#+(or)(sys:scrub-control-stack)
View
@@ -347,22 +347,21 @@
;; FIXME
(defimplementation call-with-compilation-hooks (FN)
(handler-bind ((error (lambda (c)
- (signal (make-condition
- 'compiler-condition
- :original-condition c
- :severity :warning
- :message (format nil "~A" c)
- :location
- (cond (*buffer-name*
- (make-location
- (list :buffer *buffer-name*)
- (list :offset *buffer-position* 0)))
- (*compile-filename*
- (make-location
- (list :file *compile-filename*)
- (list :position 1)))
- (t
- (list :error "No location"))))))))
+ (signal 'compiler-condition
+ :original-condition c
+ :severity :warning
+ :message (format nil "~A" c)
+ :location
+ (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :offset *buffer-position* 0)))
+ (*compile-filename*
+ (make-location
+ (list :file *compile-filename*)
+ (list :position 1)))
+ (t
+ (list :error "No location")))))))
(funcall fn)))
(defimplementation swank-compile-file (input-file output-file
View
@@ -221,7 +221,7 @@
(defvar *buffer-start-position*)
(defun signal-compiler-condition (&rest args)
- (signal (apply #'make-condition 'compiler-condition args)))
+ (apply #'signal 'compiler-condition args))
#-ecl-bytecmp
(defun handle-compiler-message (condition)
View
@@ -32,17 +32,17 @@
(let ((packet (read-packet stream)))
(handler-case (values (read-form packet package))
(reader-error (c)
- (error (make-condition 'swank-reader-error
- :packet packet :cause c))))))
+ (error 'swank-reader-error
+ :packet packet :cause c)))))
(defun read-packet (stream)
(let* ((length (parse-header stream))
(octets (read-chunk stream length)))
(handler-case (swank-backend:utf8-to-string octets)
(error (c)
- (error (make-condition 'swank-reader-error
- :packet (asciify octets)
- :cause c))))))
+ (error 'swank-reader-error
+ :packet (asciify octets)
+ :cause c)))))
(defun asciify (packet)
(with-output-to-string (*standard-output*)
@@ -62,7 +62,7 @@
(cond ((= count length)
buffer)
((zerop count)
- (error (make-condition 'end-of-file :stream stream)))
+ (error 'end-of-file :stream stream))
(t
(error "Short read: length=~D count=~D" length count)))))
View
@@ -463,24 +463,23 @@ information."
(sb-c::find-error-context nil))))
(defun signal-compiler-condition (condition context)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity (etypecase condition
- (sb-ext:compiler-note :note)
- (sb-c:compiler-error :error)
- (reader-error :read-error)
- (error :error)
- #+#.(swank-backend:with-symbol redefinition-warning
- sb-kernel)
- (sb-kernel:redefinition-warning
- :redefinition)
- (style-warning :style-warning)
- (warning :warning))
- :references (condition-references condition)
- :message (brief-compiler-message-for-emacs condition)
- :source-context (compiler-error-context context)
- :location (compiler-note-location condition context))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (etypecase condition
+ (sb-ext:compiler-note :note)
+ (sb-c:compiler-error :error)
+ (reader-error :read-error)
+ (error :error)
+ #+#.(swank-backend:with-symbol redefinition-warning
+ sb-kernel)
+ (sb-kernel:redefinition-warning
+ :redefinition)
+ (style-warning :style-warning)
+ (warning :warning))
+ :references (condition-references condition)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
+ :location (compiler-note-location condition context)))
(defun real-condition (condition)
"Return the encapsulated condition or CONDITION itself."
View
@@ -498,15 +498,14 @@
(signal-compiler-condition condition context))))
(defun signal-compiler-condition (condition context)
- (signal (make-condition
- 'compiler-condition
- :original-condition condition
- :severity (severity-for-emacs condition)
- :message (brief-compiler-message-for-emacs condition)
- :source-context (compiler-error-context context)
- :location (if (read-error-p condition)
- (read-error-location condition)
- (compiler-note-location context)))))
+ (signal 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :message (brief-compiler-message-for-emacs condition)
+ :source-context (compiler-error-context context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context))))
(defun severity-for-emacs (condition)
"Return the severity of 'condition."
@@ -1354,9 +1353,8 @@ Signal an error if no constructor can be found."
(kernel:*current-level* 0))
(handler-bind ((di::unhandled-condition
(lambda (condition)
- (error (make-condition
- 'sldb-condition
- :original-condition condition)))))
+ (error 'sldb-condition
+ :original-condition condition))))
(funcall debugger-loop-fn))))
(defun frame-down (frame)
View
@@ -291,8 +291,8 @@ Backend code should treat the connection structure as opaque.")
(:report (lambda (c s) (princ (swank-error.condition c) s)))
(:documentation "Condition which carries a backtrace."))
-(defun make-swank-error (condition &optional (backtrace (safe-backtrace)))
- (make-condition 'swank-error :condition condition :backtrace backtrace))
+(defun signal-swank-error (condition &optional (backtrace (safe-backtrace)))
+ (error 'swank-error :condition condition :backtrace backtrace))
(defvar *debug-on-swank-protocol-error* nil
"When non-nil invoke the system debugger on errors that were
@@ -879,7 +879,7 @@ if the file doesn't exist; otherwise the first line of the file."
"Read an S-expression from STREAM using the SLIME protocol."
(log-event "decode-message~%")
(without-slime-interrupts
- (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+ (handler-bind ((error #'signal-swank-error))
(handler-case (read-message stream *swank-io-package*)
(swank-reader-error (c)
`(:reader-error ,(swank-reader-error.packet c)
@@ -889,7 +889,7 @@ if the file doesn't exist; otherwise the first line of the file."
"Write an S-expression to STREAM using the SLIME protocol."
(log-event "encode-message~%")
(without-slime-interrupts
- (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+ (handler-bind ((error #'signal-swank-error))
(write-message message *swank-io-package* stream))))

0 comments on commit c6b4fd5

Please sign in to comment.