conditions.lisp

   1 (in-package :alexandria)
   2
   3 (defun required-argument (&optional name)
   4   "Signals an error for a missing argument of NAME. Intended for
   5 use as an initialization form for structure and class-slots, and
   6 a default value for required keyword arguments."
   7   (error "Required argument ~@[~S ~]missing." name))
   8
   9 (define-condition simple-style-warning (style-warning simple-warning)
  10   ())
  11
  12 (defun simple-style-warning (message &rest args)
  13   (warn 'simple-style-warning :format-control message :format-arguments args))
  14
  15 ;; We don't specify a :report for simple-reader-error to let the underlying
  16 ;; implementation report the line and column position for us. Unfortunately
  17 ;; this way the message from simple-error is not displayed, but it's still
  18 ;; inspectable from the debugger.
  19 (define-condition simple-reader-error (reader-error simple-error)
  20   ())
  21
  22 (defun simple-reader-error (stream message &rest args)
  23   (error 'simple-reader-error
  24          :stream stream
  25          :format-control message
  26          :format-arguments args))
  27
  28 (define-condition simple-parse-error (simple-error parse-error)
  29   ())
  30
  31 (defun simple-parse-error (message &rest args)
  32   (error 'simple-parse-error
  33          :format-control message
  34          :format-arguments args))
  35
  36 (defmacro ignore-some-conditions ((&rest conditions) &body body)
  37   "Similar to CL:IGNORE-ERRORS but the (unevaluated) CONDITIONS
  38 list determines which specific conditions are to be ignored."
  39   `(handler-case
  40        (progn ,@body)
  41      ,@(loop for condition in conditions collect
  42              `(,condition (c) (values nil c)))))
  43
  44 (defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
  45   "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
  46 the cleanup CLAUSES are run.
  47
  48 ABORT-FLAG is the name of a variable that will be bound to T in
  49 CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
  50 otherwise.
  51
  52 Examples:
  53
  54   (unwind-protect-case ()
  55        (protected-form)
  56      (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
  57      (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
  58      (:always (format t \"This is evaluated in either case.~%\")))
  59
  60   (unwind-protect-case (aborted-p)
  61        (protected-form)
  62      (:always (perform-cleanup-if aborted-p)))
  63 "
  64   (check-type abort-flag (or null symbol))
  65   (let ((gflag (gensym "FLAG+")))
  66     `(let ((,gflag t))
  67        (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
  68          (let ,(and abort-flag `((,abort-flag ,gflag)))
  69            ,@(loop for (cleanup-kind . forms) in clauses
  70                    collect (ecase cleanup-kind
  71                              (:normal `(when (not ,gflag) ,@forms))
  72                              (:abort  `(when ,gflag ,@forms))
  73                              (:always `(progn ,@forms)))))))))