;;;;****************************************************************************

;;; Function Introspection Functions [SBCL specific]

(defun function-type (symbol)
  "Return the SBCL function type of SYMBOL (:generic, :macro or :function)."
  (case (type-of (fdefinition symbol))
    (standard-generic-function :generic-function)
    (function
     (if (macro-p symbol)
	 :macro
	 :function))))

(defun macro-p (symbol)
  "Return t if SYMBOL is a macro and nil otherwise."
  (if (macro-function symbol)
      t
      nil))

(defun function-definition-source (symbol &rest method-specializers)
  "Return the SBCL definition source of the function associated with SYMBOL."
  (case (function-type symbol)
    (:generic-function
     (if (null method-specializers)
	 (sb-introspect:find-definition-source (fdefinition symbol))
	 (let ((method (find-method (fdefinition symbol) nil (mapcar #'find-class method-specializers))))
	   (sb-introspect:find-definition-source method))))
    (:macro (sb-introspect:find-definition-source (macro-function symbol)))
    (:function (sb-introspect:find-definition-source (fdefinition symbol)))))

(defun function-pathname (symbol &rest method-specializers)
  "Return the pathname of the file storing the source of SYMBOL."
  (when (null symbol)
    (error "Null SYMBOL supplied into FUNCTION-PATHNAME."))
  (let ((definition-source (apply #'function-definition-source symbol method-specializers)))
    (sb-introspect:definition-source-pathname definition-source)))

(defun function-filename (symbol &rest method-specializers)
  "Return the file name (without extension) of the file storing the source of SYMBOL as a string."
  (when (null symbol)
    (error "Null SYMBOL supplied into FUNCTION-FILENAME."))
  (let ((definition-source (apply #'function-definition-source symbol method-specializers)))
    (pathname-name (sb-introspect:definition-source-pathname definition-source))))