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 &optional args)
  12       alias
  13     (assert (member namespace *namespaces*) (namespace)
  14             "Namespace ~A does not exist" namespace)
  15     (make-alias namespace original new-name args)))
  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 args))
  26
  27 (defnamespace function
  28   "The namespace of ordinary and generic functions.")
  29
  30 (defmethod make-alias ((namespace (eql 'function))
  31                        original alias args)
  32   `(defun ,alias ,args
  33      (,original ,@args)))
  34
  35 (defnamespace macro
  36   "The namespace of macros.")
  37
  38 (defmethod make-alias ((namespace (eql 'macro))
  39                        original alias args)
  40   (alexandria:with-gensyms (args)
  41     `(setf (macro-function ',alias)
  42            (lambda (&rest ,args)
  43              (apply (macro-function ',original) ,args)))))
  44
  45 (defnamespace special
  46   "The namespace of special variables.")
  47
  48 (defmethod make-alias ((namespace (eql 'special))
  49                        original alias args)
  50   `(define-symbol-macro ,alias ,original))
  51
  52 (defnamespace constant
  53   "The namespace of special variables.")
  54
  55 (defmethod make-alias ((namespace (eql 'constant))
  56                        original alias args)
  57   `(define-symbol-macro ,alias ,original))