Plaster

(defgeneric define-alias (alias original alias-type) (:documentation "Define the symbol ALIAS as another name for ORIGINAL.") (:method (alias (original symbol) (alias-type t)) (declare (ignore alias #-excl original)) (error "We don't know how to make an alias for a ~S yet." alias-type)) (:method (alias (original symbol) (alias-type (eql 'compiler-macro))) "Make an alias for a compiler macro." (setf (compiler-macro-function alias) (compiler-macro-function original) (documentation alias 'compiler-macro) (documentation original 'compiler-macro))) (:method (alias (original symbol) (alias-type (eql 'macro))) "Make an alias for a macro." (setf (macro-function alias) (macro-function original) (documentation alias 'function) (documentation original 'function))) (:method (alias (original symbol) (alias-type (eql 'variable))) "Make an alias for a variable." (define-symbol-macro alias original) (setf (documentation alias 'variable) (documentation original 'variable))) (:method (alias (original symbol) (alias-type (eql 'function))) "Make an alias for a function." (setf (fdefinition alias) (fdefinition original) (documentation alias 'function) (documentation original 'function)) (define-alias alias original 'compiler-macro)) (:method (alias (original package) alias-type) "Make a alias for a package by adding new nicknames for it." (declare (ignore alias-type)) (let* ((pkg (find-package original)) (new-nicks (cons alias (package-nicknames pkg)))) ;; Hopefully this trick works on most implementations. (rename-package original (package-name original) new-nicks))) (:method (alias (original symbol) (alias-type (eql 'class))) (define-alias alias (find-class original) alias-type)) (:method (alias (original standard-class) alias-type) "Make a alias for a standard class." (declare (ignore alias-type)) (setf (find-class alias) original (documentation alias 'type) (documentation original 'type)))) (defun defalias (alias original &optional alias-type) "Define ALIAS as another name for ORIGINAL. ALIAS should be a symbol. ORIGINAL is something that a define-alias method is defined for." (when (not (symbolp alias)) (error "ALIAS must be a symbol." )) (typecase original (symbol (cond ((fboundp original) ;; Functions or macros (or methods lambda's ...) (cond ((macro-function original) (define-alias alias original 'macro)) ((symbol-function original) (define-alias alias original 'function)) ;; (t (error "~s is fbound but isn't a function or macro?" original)) )) ((find-class original) ;; symbols that denote class types or structure types (typecase (find-class original) (structure-class (define-alias alias original 'structure)) (standard-class (define-alias alias original 'class)) (t (define-alias alias original alias-type)))) (t ;; Anything else is assumed to be a variable (define-alias alias original 'variable)))) ;; If there was a way to get the name: ;;(function (define-alias alias original 'function)) (package (define-alias alias original 'package)) (structure-class (define-alias alias original 'structure)) (standard-class (define-alias alias original 'class)) (t (define-alias alias original alias-type))))