diff --git a/src/base/defalias.lisp b/src/base/defalias.lisp index 4e40af010d498004669c478fa789970a44222610..3ad9da6c76a8dc523fd9fde3af5e9f92c38d360e 100644 --- a/src/base/defalias.lisp +++ b/src/base/defalias.lisp @@ -12,15 +12,19 @@ alias (assert (member namespace *namespaces*) (namespace) "Namespace ~A does not exist" namespace) - (make-alias namespace original new-name))) + `(progn + ,@(make-alias namespace original new-name) + ',new-name))) (defmacro defnamespace (namespace &optional docstring) (check-type namespace symbol) (check-type docstring (or null string)) `(progn (pushnew ',namespace *namespaces*) - (handler-bind ((warning #'muffle-warning)) - (setf (documentation ',namespace 'namespace) ,docstring)))) + ,@(when docstring + `((handler-bind ((warning #'muffle-warning)) + (setf (documentation ',namespace 'namespace) ,docstring)))) + ',namespace)) (defgeneric make-alias (namespace original alias)) @@ -29,62 +33,56 @@ (defmethod make-alias ((namespace (eql 'function)) original alias) - `(progn - (setf (fdefinition ',alias) - (fdefinition ',original)) - (setf (documentation ',alias 'function) - (documentation ',original 'function)) - (defalias (compiler-macro ,alias) ,original))) + `((setf (fdefinition ',alias) + (fdefinition ',original)) + (setf (documentation ',alias 'function) + (documentation ',original 'function)) + (defalias (compiler-macro ,alias) ,original))) (defnamespace macro "The namespace of macros.") (defmethod make-alias ((namespace (eql 'macro)) original alias) - `(progn - (setf (macro-function ',alias) - (macro-function ',original)) - (setf (documentation ',alias 'function) - (documentation ',original 'function)))) + `((setf (macro-function ',alias) + (macro-function ',original)) + (setf (documentation ',alias 'function) + (documentation ',original 'function)))) (defnamespace compiler-macro "The namespace of compiler macros.") (defmethod make-alias ((namespace (eql 'compiler-macro)) original alias) - `(progn - (setf (compiler-macro-function ',alias) - (compiler-macro-function ',original)) - (setf (documentation ',alias 'compiler-macro) - (documentation ',original 'compiler-macro)))) + `((setf (compiler-macro-function ',alias) + (compiler-macro-function ',original)) + (setf (documentation ',alias 'compiler-macro) + (documentation ',original 'compiler-macro)))) (defnamespace special "The namespace of special variables.") (defmethod make-alias ((namespace (eql 'special)) original alias) - `(progn - (define-symbol-macro ,alias ,original) - (setf (documentation ',alias 'variable) - (documentation ',original 'variable)))) + `((define-symbol-macro ,alias ,original) + (setf (documentation ',alias 'variable) + (documentation ',original 'variable)))) (defnamespace constant "The namespace of constant variables.") (defmethod make-alias ((namespace (eql 'constant)) original alias) - `(progn - (define-symbol-macro ,alias ,original) - (setf (documentation ',alias 'variable) - (documentation ',original 'variable)))) + `((define-symbol-macro ,alias ,original) + (setf (documentation ',alias 'variable) + (documentation ',original 'variable)))) (defnamespace class "The namespace of classes.") (defmethod make-alias ((namespace (eql 'class)) original alias) - `(progn - (setf (find-class ,alias) - (find-class ,original)) - (setf (documentation ',alias 'type) - (documentation ',original 'type)))) + `((setf (find-class ,alias) + (find-class ,original)) + (setf (documentation ',alias 'type) + (documentation ',original 'type))))