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
  16 ;; underlying implementation report the line and column position for
  17 ;; us. Unfortunately this way the message from simple-error is not
  18 ;; displayed, unless there's special support for that in the
  19 ;; implementation. But even then it's still inspectable from the
  20 ;; debugger...
  21 (define-condition simple-reader-error
  22     #-sbcl(reader-error simple-error)
  23     #+sbcl(sb-int:simple-reader-error)
  24   ())
  25
  26 (defun simple-reader-error (stream message &rest args)
  27   (error 'simple-reader-error
  28          :stream stream
  29          :format-control message
  30          :format-arguments args))
  31
  32 (define-condition simple-parse-error (simple-error parse-error)
  33   ())
  34
  35 (defun simple-parse-error (message &rest args)
  36   (error 'simple-parse-error
  37          :format-control message
  38          :format-arguments args))
  39
  40 (define-condition simple-program-error (simple-error program-error)
  41   ())
  42
  43 (defun simple-program-error (message &rest args)
  44   (error 'simple-program-error
  45          :format-control message
  46          :format-arguments args))
  47
  48 (defmacro ignore-some-conditions ((&rest conditions) &body body)
  49   "Similar to CL:IGNORE-ERRORS but the (unevaluated) CONDITIONS
  50 list determines which specific conditions are to be ignored."
  51   `(handler-case
  52        (progn ,@body)
  53      ,@(loop for condition in conditions collect
  54              `(,condition (c) (values nil c)))))
  55
  56 (defmacro unwind-protect-case ((&optional abort-flag) protected-form &body clauses)
  57   "Like CL:UNWIND-PROTECT, but you can specify the circumstances that
  58 the cleanup CLAUSES are run.
  59
  60 ABORT-FLAG is the name of a variable that will be bound to T in
  61 CLAUSES if the PROTECTED-FORM aborted preemptively, and to NIL
  62 otherwise.
  63
  64 Examples:
  65
  66   (unwind-protect-case ()
  67        (protected-form)
  68      (:normal (format t \"This is only evaluated if PROTECTED-FORM executed normally.~%\"))
  69      (:abort  (format t \"This is only evaluated if PROTECTED-FORM aborted preemptively.~%\"))
  70      (:always (format t \"This is evaluated in either case.~%\")))
  71
  72   (unwind-protect-case (aborted-p)
  73        (protected-form)
  74      (:always (perform-cleanup-if aborted-p)))
  75 "
  76   (check-type abort-flag (or null symbol))
  77   (let ((gflag (gensym "FLAG+")))
  78     `(let ((,gflag t))
  79        (unwind-protect (multiple-value-prog1 ,protected-form (setf ,gflag nil))
  80          (let ,(and abort-flag `((,abort-flag ,gflag)))
  81            ,@(loop for (cleanup-kind . forms) in clauses
  82                    collect (ecase cleanup-kind
  83                              (:normal `(when (not ,gflag) ,@forms))
  84                              (:abort  `(when ,gflag ,@forms))
  85                              (:always `(progn ,@forms)))))))))