base/defobsolete.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-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   (and (eq 'setf (first function-name))
  21        (null (cddr function-name))))
  22
  23 (defun function-name-p (function-name)
  24   "Returns T if FUNCTION-NAME is a legal function name:
  25 a symbol or a list (CL:SETF symbol)."
  26   (or (symbolp function-name)
  27       (and (consp function-name)
  28            (setf-function-name-p function-name))))
  29
  30 (deftype function-name ()
  31   "A legal function name: a symbol or a list (CL:SETF symbol)."
  32   `(or symbol (and cons (satisfies setf-function-name-p))))
  33
  34 (defun signal-obsolete (function-name reason type action)
  35   (funcall (ecase action
  36              (:warn #'warn)
  37              (:error #'error))
  38            'deprecation-warning :function-name function-name
  39            :type type :reason reason))
  40
  41 (defmacro defobsolete (function-name reason &key (type "function") (action :warn))
  42   "Declare the function denoted by FUNCTION-NAME as obsolete. REASON must
  43 either be a string or the name of a function to be used as alternative.
  44 ACTION chooses the function used to signal the deprecation warning:
  45 if :WARN then CL:WARN will be used, if :ERROR then CL:ERROR."
  46   (check-type function-name function-name "a legal function name")
  47   (check-type reason (or function-name string) "a legal function name or a string")
  48   (check-type type (or symbol string))
  49   (check-type action (member :warn :error))
  50   (when (function-name-p reason)
  51     (setf reason (format nil "use ~A instead." reason)))
  52   `(define-compiler-macro ,function-name (&whole whole &rest args)
  53      (declare (ignore args))
  54      (signal-obsolete ',function-name ,reason ',type ,action)
  55      whole))