X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fkernel.lisp;h=c0e455715395b6a7f38b9dc688070faf0da546d8;hb=7f1e94ae961a198e00daf281eb1dc858e5b2dcc7;hp=6eb57810226f75254cca193b915f3fa17b9d7574;hpb=df871446529da0e83d670f35a9566c11d814be32;p=sbcl.git

diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp
index 6eb5781..c0e4557 100644
--- a/src/code/kernel.lisp
+++ b/src/code/kernel.lisp
@@ -87,6 +87,48 @@
 (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)))))
+
 ;;; Extract the arglist from the function header FUNC.
 (defun %simple-fun-arglist (func)
   (%simple-fun-arglist func))
@@ -98,6 +140,9 @@
 (defun %simple-fun-name (func)
   (%simple-fun-name func))
 
+(defun (setf %simple-fun-name) (new-value func)
+  (setf (%simple-fun-name func) new-value))
+
 ;;; Extract the type from the function header FUNC.
 (defun %simple-fun-type (func)
   (%simple-fun-type func))
@@ -129,7 +174,7 @@
   (declare (closure closure))
   (let (values)
     (do-closure-values (elt closure)
-      (push elt closure))
+      (push elt values))
     (nreverse values)))
 
 ;;; Extract the function from CLOSURE.