Common lisp 錯誤處理練習

case vs bind.lisp

(define-condition div-by-zero ()
  ((message :initarg :message
            :accessor message
            :initform ""
            :type 'string))
  (:report (lambda (c s) (format s "Can not div by zero: ~A~&" (message c)))))

(defun prompt (message)
  (format t message)
  (read))

(defun div (a b)
  (if (/= b 0)
      (/ a b)
      (restart-case (error 'div-by-zero :message "Message (div a b)")
        (use-my-value (value)
          :report "Use Other Value as by."
          :interactive (lambda nil (list (prompt "Input Other Value to Use: ")))
          (setf b value)
          (/ a b))
        (return-my-value (value)
          :report "Return Value."
          :interactive (lambda nil (list (prompt "Return Value: ")))
          value))))

(format t "(div 1 0) => ~A~& " (div 1 0))
(format t "Handler value: ~A~&"
        (handler-bind ((div-by-zero (lambda (c)
                                (format t "Orz:~A~&" (message c)))))
          (format t "value: ~A~&" (div 1 0))))

(format t "Handler value: ~A~&"
        (handler-bind ((div-by-zero (lambda (c)
                                      (format t "Orz:~A~&" (message c))
                                      (invoke-restart 'use-my-value 9))))
          (format t "value: ~A~&" (div 1 0))))

(format t "Handler value: ~A~&"
        (handler-bind ((div-by-zero (lambda (c)
                                      (format t "Orz:~A~&" (message c))
                                      (invoke-restart 'return-my-value 9))))
          (format t "value: ~A~&" (div 1 0))))

(format t "Handler value: ~A~&"
        (handler-case (format t "value: ~A~&" (div 1 0))
          (div-by-zero (c) (format t "Orz:~A~&" (message c) (div 1 11)))))

;; (defun rdiv (a b)
;;   (restart-bind
;;       ((use-my-value1 (lambda (value)
;;                     (setf b value)
;;                     (values b))
;;                   :report-function (lambda (s) (format s "Use value as div by." ))
;;                   :interactive-function (lambda nil
;;                                           (format t "Input Return Value: ")
;;                                           (list (read))))
;;        (return-my-value1 (lambda (value)
;;                        value)
;;                      :report-function (lambda (s) (format s "Return Value"))))
;;     (div a b)))

;; (defun sdiv (a b)
;;   (handler-bind
;;       ((div-by-zero (lambda (c)
;;                       (format t "Handler DIV-BY-ZERO:~A~&" (message c))
;;                       (invoke-restart 'use-my-value1 7))))
;;     (rdiv a b)))

;; (format t "(sdiv 1 0) => ~A~&" (sdiv 1 0))

;; (defun sdiv1 (a b)
;;   (handler-case (rdiv a b)
;;     (div-by-zero (c) (format t "Handler DIV-BY-ZERO:~A~&" (message c))
;;       (rdiv a 9))))

;; (format t "(sdiv1 1 0) => ~A~&" (sdiv1 1 0))

try-condition.lisp

(define-condition my-warning (warning)
  ((message :initarg :message
            :reader get-message))
  (:documentation "This is my test condition-warning.")
  (:report (lambda (this-condition steam)
             (format steam "[Warning] Oh Oh, ~A" (get-message this-condition)))))


(defun test-my-warning nil
  (error 'my-warning :message "This is a Test"))

(handler-case
    (with-simple-restart (continue "Just continue.....")
      (test-my-warning))
  (warning (condition) (progn
                       (when (typep condition 'my-warning)
                         (format t "This condition is my-warning, the message: ~A" (get-message condition)))
                       (continue)))) ;; to error condition
#|
(handler-case
    (with-simple-restart (abort1 "Just continue.....")
      (test-my-warning))
  (error (condition) (progn
                         (when (typep condition 'my-warning)
                           (format t "This condition is my-warning, the message: ~A" (get-message condition)))
                         (continue))))
|#

(defun test-my-warning nil
  (warn 'my-warning :message "This is a Test"))
(test-my-warning) ;; just warning


(define-condition my-error (error)
  ((message :initarg :message
            :reader get-message))
  (:documentation "This is my test condition-error.")
  (:report (lambda (this-condition output-steam)
             (format output-steam "[Error] for test. message: ~A" (get-message this-condition))))
  (:default-initargs . (:message "Default Message.")))

(defmethod get-message ((str string))
  str)

(defun test-my-error nil
  (warn 'my-error :message "the test my-error"))

(handler-case
    (test-my-error) ;; -> throw SIMPLE-TYPE-ERROR, because my-error not a warning, is a error.
  (simple-type-error (condition)
    (progn
      (format t "~%at [~A] condition, message: ~A~%" (type-of condition) condition)
      (continue))))

(defun test-my-error nil
  (error 'my-error))

(handler-case
    (test-my-error)
  (my-error (condition)
    (progn
      (format t "~%Test my-error, the message: ~A~%" (get-message condition))
      (continue))))


(defun test-more-restart nil
  (restart-case
      (restart-case
          (test-my-error)
        (restart1 ()
          :report "test Restart 1, Just continue"
          :interactive (lambda nil nil)
          (continue)))
    (restart2 ()
      :report "test Restart 2, Just continue"
      (continue))))

(handler-bind
    ((my-error #'(lambda (condition)
                   (format t "~%At [~A], message: ~A.~%" (type-of condition) (get-message condition))
                   (invoke-restart 'restart1))))
  (test-more-restart))

#| ;; can not find restart1.
(handler-case
    (test-more-restart)
  (my-error (condition)
    (format t "~%At [~A], message ~A~%" (type-of condition) (get-message condition))
    (invoke-restart 'restart1)))
|#

try-error-process.lisp

(defun super2 ()
  (restart-bind
      ((my-abort #'(lambda () (format t "~%restart~%")
                     (invoke-restart 'abort))
                 :report-function #'(lambda (s) (format s "report function"))
                 :interactive-function #'(lambda () (format t "~%restart this~%")(return-from super2) )
                 :test-function #'(lambda (c)(format t "~%c is:~A~%" (type-of c)) t)))
    (sub2)))

(defun super2-1()
  (restart-case
      (sub2)
    (my-abort (c)
      :report "report"
      :interactive (lambda () (format t "~%my-abort~%")(return-from super2-1)))))

(defun sub2 ()
  (error "test error"))

(super2)
(super2-1)

(defun super ()
  (let ((catch-value (catch 'abort
                       (sub) ;; some forms to do(eval)
                       )))
    (when catch-value
      (format t "~%Catch 'abort, the value: ~A~%" catch-value))))

(defun sub ()
  (throw 'abort 99))


(super)

(defun super1 ()
  (handler-case
      (sub1)
    (error (v) (format t "~%Error Value: ~A~%" v))))

(defun super1-1 ()
  (handler-bind
      ((error #'(lambda (v)
                  (format t "~%Error Value: ~A~%" v)
                  (invoke-restart 'abort)))
       (condition #'(lambda(v) (format t "~%Condition type: ~A~%" (type-of v))
                      (invoke-restart-interactively 'abort))))
    (sub1))))


(defun sub1 ()
  (error "test error"))

(super1)
(super1-1)

(defun trap-error-handler (condition)
  (format *error-output* "~&test:~A~&" condition)
  (throw 'trap-errors nil))

(defmacro trap-errors (&rest forms)
`(catch 'trap-errors
   (handler-bind ((error #'trap-error-handler))
     ,@forms)))

(list (trap-errors (signal "Foo.") 1)
(trap-errors (error  "Bar.") 2)
(+ 1 2))

try-restart.lisp

(define-condition my-type-error nil
  ((now-value :initarg :now-value
              :initarg :error-value
              :accessor error-value)
   (symbol :initarg :symbol
           :reader the-symbol))
  (:report (lambda (c s) (format s "~A Error Type, the value is: ~A; type:~A, but need fixnum" (the-symbol c) (error-value c) (type-of (error-value c))))))

(defun _add (a b)
  (when (not (typep a 'fixnum))
    (error 'my-type-error :error-value a :symbol 'a))
  (when (not (typep b 'fixnum))
    (error 'my-type-error :error-value b :symbol 'b))
  (+ a b))

(defun add (a b)
  (restart-case
      (_add a b)
    (my-use-value (new-value)
      :test (lambda (c) (when (and (typep c 'my-type-error)
                                   (eq 'a (the-symbol c))) t))
      :report (lambda (s) (format s "Use the value."))
      :interactive (lambda ()
                     (format t "Use Value: ")
                     (multiple-value-list (read)))
      (_add new-value b))
    (my-use-value (new-value)
      :test (lambda (c)
              (when (and (typep c 'my-type-error)
                         (eq 'b (the-symbol c)))
                t))
      :report "Use new B and return"
      :interactive (lambda ()
                     (format t "Use new B Value: ")
                     (multiple-value-list (read)))
      (_add a new-value))
    (use-value (value)
      :report "Use the value"
      value)
    (continue nil
      :report "return nil, and continue")))