- (declare (type function fun))
- (let* ((fun (%simple-fun-self fun))
- (name (%fun-name fun))
- (code (sb!di::fun-code-header fun))
- (info (sb!kernel:%code-debug-info code)))
- (if info
- (let ((source (first (sb!c::compiled-debug-info-source info))))
- (cond ((and (eq (sb!c::debug-source-from source) :lisp)
- (eq (sb!c::debug-source-info source) fun))
- (values (svref (sb!c::debug-source-name source) 0)
- nil
- name))
- ;; FIXME: shouldn't these two clauses be the other way
- ;; round? Using VALID-FUNCTION-NAME-P to see if we
- ;; want to find an inline-expansion?
- ((stringp name)
- (values nil t name))
- (t
- (let ((exp (fun-name-inline-expansion name)))
- (if exp
- (values exp nil name)
- (values nil t name))))))
- (values nil t name))))
+ (declare (type function fun))
+ (etypecase fun
+ #!+sb-eval
+ (sb!eval:interpreted-function
+ (let ((name (sb!eval:interpreted-function-name fun))
+ (lambda-list (sb!eval:interpreted-function-lambda-list fun))
+ (body (sb!eval:interpreted-function-body fun)))
+ (values `(lambda ,lambda-list ,@body)
+ t name)))
+ (function
+ (let* ((fun (%simple-fun-self (%fun-fun fun)))
+ (name (%fun-name fun))
+ (code (sb!di::fun-code-header fun))
+ (info (sb!kernel:%code-debug-info code)))
+ (if info
+ (let ((source (sb!c::debug-info-source info)))
+ (cond ((and (sb!c::debug-source-form source)
+ (eq (sb!c::debug-source-function source) fun))
+ (values (sb!c::debug-source-form source)
+ nil
+ name))
+ ((legal-fun-name-p name)
+ (let ((exp (fun-name-inline-expansion name)))
+ (values exp (not exp) name)))
+ (t
+ (values nil t name))))
+ (values nil t name))))))
+
+(defun closurep (object)
+ (= sb!vm:closure-header-widetag (widetag-of object)))
+
+(defun %fun-fun (function)
+ (declare (function function))
+ (case (widetag-of function)
+ (#.sb!vm:simple-fun-header-widetag
+ function)
+ (#.sb!vm:closure-header-widetag
+ (%closure-fun function))
+ (#.sb!vm:funcallable-instance-header-widetag
+ (%fun-fun (funcallable-instance-fun function)))))
+
+(defun %closure-values (object)
+ (declare (function object))
+ (loop for index from 0
+ below (- (get-closure-length object) (1- sb!vm:closure-info-offset))
+ collect (%closure-index-ref object index)))
+
+(defun %fun-lambda-list (object)
+ (%simple-fun-arglist (%fun-fun object)))