+(defun fun-subtype (function)
+ (fun-subtype function))
+(defun (setf fun-subtype) (type function)
+ (setf (fun-subtype function) type))
+
+;;;; SIMPLE-FUN and accessors
+
+(declaim (inline simple-fun-p))
+(defun simple-fun-p (object)
+ (= sb!vm:simple-fun-header-widetag (widetag-of object)))
+
+(deftype simple-fun ()
+ '(satisfies simple-fun-p))
+
+(defun %simple-fun-doc (simple-fun)
+ (declare (simple-fun simple-fun))
+ (let ((info (%simple-fun-info simple-fun)))
+ (cond ((typep info '(or null string))
+ info)
+ ((simple-vector-p info)
+ nil)
+ ((consp info)
+ (car info))
+ (t
+ (bug "bogus INFO for ~S: ~S" simple-fun info)))))
+
+(defun (setf %simple-fun-doc) (doc simple-fun)
+ (declare (type (or null string) doc)
+ (simple-fun simple-fun))
+ (let ((info (%simple-fun-info simple-fun)))
+ (setf (%simple-fun-info simple-fun)
+ (cond ((typep info '(or null string))
+ doc)
+ ((simple-vector-p info)
+ (if doc
+ (cons doc info)
+ info))
+ ((consp info)
+ (if doc
+ (cons doc (cdr info))
+ (cdr info)))
+ (t
+ (bug "bogus INFO for ~S: ~S" simple-fun info))))))
+
+(defun %simple-fun-xrefs (simple-fun)
+ (declare (simple-fun simple-fun))
+ (let ((info (%simple-fun-info simple-fun)))
+ (cond ((typep info '(or null string))
+ nil)
+ ((simple-vector-p info)
+ info)
+ ((consp info)
+ (cdr info))
+ (t
+ (bug "bogus INFO for ~S: ~S" simple-fun info)))))