+(declaim (ftype (sfunction (symbol &optional (or null lexenv))
+ (values (member nil :function :macro :special-form)
+ boolean
+ list))
+ function-information))
+(defun function-information (name &optional env)
+ "Return information about the function NAME in the lexical environment ENV.
+Note that the global function binding may differ from the local one.
+
+This function returns three values. The first indicates the type of
+function definition or binding:
+
+ NIL
+ There is no apparent definition for NAME.
+
+ :FUNCTION
+ NAME refers to a function.
+
+ :MACRO
+ NAME refers to a macro.
+
+ :SPECIAL-FORM
+ NAME refers to a special operator. If the name refers to both a
+ macro and a special operator, the macro takes precedence.
+
+The second value is true if NAME is bound locally.
+
+The third value is an alist describing the declarations that apply to
+the function NAME. Standard declaration specifiers that may appear in
+CARS of the alist include:
+
+ DYNAMIC-EXTENT
+ If the CDR is T, NAME has been declared DYNAMIC-EXTENT. If the CDR
+ is NIL, the alist element may be omitted.
+
+ INLINE
+ The CDR is one of the symbols INLINE, NOTINLINE, or NIL, to
+ indicate if the function has been declared INLINE or NOTINLINE. If
+ the CDR is NIL the alist element may be omitted.
+
+ FTYPE
+ The CDR is the type specifier associated with NAME, or the symbol
+ FUNCTION if there is functional type declaration or proclamation
+ associated with NAME. If the CDR is FUNCTION the alist element may
+ be omitted."
+ (let* ((*lexenv* (or env (make-null-lexenv)))
+ (fun (lexenv-find name funs))
+ binding localp ftype dx inlinep)
+ (etypecase fun
+ (sb-c::leaf
+ (let ((env-type (or (lexenv-find fun type-restrictions)
+ *universal-fun-type*)))
+ (setf binding :function
+ ftype (if (eq :declared (sb-c::leaf-where-from fun))
+ (type-intersection (sb-c::leaf-type fun)
+ env-type)
+ env-type)
+ dx (sb-c::leaf-dynamic-extent fun))
+ (etypecase fun
+ (sb-c::functional
+ (setf localp t
+ inlinep (sb-c::functional-inlinep fun)))
+ (sb-c::defined-fun
+ ;; Inlined known functions.
+ (setf localp nil
+ inlinep (sb-c::defined-fun-inlinep fun))))))
+ (cons
+ (setf binding :macro
+ localp t))
+ (null
+ (case (info :function :kind name)
+ (:macro
+ (setf binding :macro
+ localp nil))
+ (:special-form
+ (setf binding :special-form
+ localp nil))
+ (:function
+ (setf binding :function
+ localp nil
+ ftype (when (eq :declared (info :function :where-from name))
+ (info :function :type name))
+ inlinep (info :function :inlinep name))))))
+ (values binding
+ localp
+ (let (alist)
+ (when (and ftype (neq *universal-fun-type* ftype))
+ (push (cons 'ftype (type-specifier ftype)) alist))
+ (ecase inlinep
+ ((:inline :maybe-inline) (push (cons 'inline 'inline) alist))
+ (:notinline (push (cons 'inline 'notinline) alist))
+ ((nil)))
+ (when dx (push (cons 'dynamic-extent t) alist))
+ alist))))
+