DEFNAMESPACE and DEFALIAS now return the defined name

diff --git a/src/base/defalias.lisp b/src/base/defalias.lisp
index 4e40af0..3ad9da6 100644 (file)
--- 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))))