src/base/defalias.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Creating aliases in CL namespaces
   4 ;;;
   5
   6 (in-package :iolib.base)
   7
   8 (defvar *namespaces* nil)
   9
  10 (defmacro defalias (alias original)
  11   (destructuring-bind (namespace new-name)
  12       alias
  13     (assert (member namespace *namespaces*) (namespace)
  14             "Namespace ~A does not exist" namespace)
  15     (make-alias namespace original new-name)))
  16
  17 (defmacro defnamespace (namespace &optional docstring)
  18   (check-type namespace symbol)
  19   (check-type docstring (or null string))
  20   `(progn
  21      (pushnew ',namespace *namespaces*)
  22      (handler-bind ((warning #'muffle-warning))
  23        (setf (documentation ',namespace 'namespace) ,docstring))))
  24
  25 (defgeneric make-alias (namespace original alias))
  26
  27 (defnamespace function
  28   "The namespace of ordinary and generic functions.")
  29
  30 (defmethod make-alias ((namespace (eql 'function))
  31                        original alias)
  32   `(progn
  33      (setf (fdefinition ',alias)
  34            (fdefinition ',original))
  35      (setf (documentation ',alias 'function)
  36            (documentation ',original 'function))))
  37
  38 (defnamespace macro
  39   "The namespace of macros.")
  40
  41 (defmethod make-alias ((namespace (eql 'macro))
  42                        original alias)
  43   `(progn
  44      (setf (macro-function ',alias)
  45            (macro-function ',original))
  46      (setf (documentation ',alias 'function)
  47            (documentation ',original 'function))))
  48
  49 (defnamespace special
  50   "The namespace of special variables.")
  51
  52 (defmethod make-alias ((namespace (eql 'special))
  53                        original alias)
  54   `(progn
  55      (define-symbol-macro ,alias ,original)
  56      (setf (documentation ',alias 'variable)
  57            (documentation ',original 'variable))))
  58
  59 (defnamespace constant
  60   "The namespace of special variables.")
  61
  62 (defmethod make-alias ((namespace (eql 'constant))
  63                        original alias)
  64   `(progn
  65      (define-symbol-macro ,alias ,original)
  66      (setf (documentation ',alias 'variable)
  67            (documentation ',original 'variable))))