src/base/defobsolete.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Declaring forms as obsolete.
   4 ;;;
   5
   6 (in-package :iolib.base)
   7
   8 (define-condition deprecation-warning (style-warning)
   9   ((function-name :initarg :function-name :reader deprecation-warning-function-name)
  10    (type :initarg :type :reader deprecation-warning-type)
  11    (reason :initarg :reason :reader deprecation-warning-reason))
  12   (:report (lambda (condition stream)
  13              (format stream "~A is an obsolete ~A~@[; ~A~]"
  14                      (deprecation-warning-function-name condition)
  15                      (deprecation-warning-type condition)
  16                      (deprecation-warning-reason condition))))
  17   (:documentation "Warning signaled at compile-time indicating that a certain function has been deprecated."))
  18
  19 (defun setf-function-name-p (function-name)
  20   ;; FIXME: This would be better written using pattern matching
  21   (and (consp function-name)
  22        (eql 'setf (first function-name))
  23        (symbolp (second function-name))
  24        (null (cddr function-name))))
  25
  26 (defun function-name-p (function-name)
  27   "Returns T if FUNCTION-NAME is a legal function name:
  28 a symbol or a list (CL:SETF symbol)."
  29   (or (symbolp function-name)
  30       (setf-function-name-p function-name)))
  31
  32 (deftype function-name ()
  33   "A legal function name: a symbol or a list (CL:SETF symbol)."
  34   `(or symbol (and cons (satisfies setf-function-name-p))))
  35
  36 (defun signal-obsolete (function-name reason type action)
  37   (funcall (ecase action
  38              (:warn #'warn)
  39              (:error #'error))
  40            'deprecation-warning :function-name function-name
  41            :type type :reason reason))
  42
  43 (defmacro defobsolete (function-name reason &key (type "function") (action :warn))
  44   "Declare the function denoted by FUNCTION-NAME as obsolete. REASON must
  45 either be a string or the name of a function to be used as alternative.
  46 ACTION chooses the function used to signal the deprecation warning:
  47 if :WARN then CL:WARN will be used, if :ERROR then CL:ERROR."
  48   (check-type function-name function-name "a legal function name")
  49   (check-type reason (or function-name string) "a legal function name or a string")
  50   (check-type type (or symbol string))
  51   (check-type action (member :warn :error))
  52   (when (function-name-p reason)
  53     (setf reason (format nil "use ~A instead." reason)))
  54   `(define-compiler-macro ,function-name (&whole whole &rest args)
  55      (declare (ignore args))
  56      (signal-obsolete ',function-name ,reason ',type ,action)
  57      whole))