X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-misc.lisp;h=365bfaaa8c658f24b00805c98b483b58abc53217;hb=dafa18aa6bd65fe2129a32b0e827141684bb159a;hp=1440394ce4ded7c727bd23d90ed442edd8734dd0;hpb=df871446529da0e83d670f35a9566c11d814be32;p=sbcl.git

diff --git a/src/code/target-misc.lisp b/src/code/target-misc.lisp
index 1440394..365bfaa 100644
--- a/src/code/target-misc.lisp
+++ b/src/code/target-misc.lisp
@@ -36,8 +36,11 @@
     (sb!eval:interpreted-function
      (let ((name (sb!eval:interpreted-function-name fun))
            (lambda-list (sb!eval:interpreted-function-lambda-list fun))
+           (declarations (sb!eval:interpreted-function-declarations fun))
            (body (sb!eval:interpreted-function-body fun)))
-       (values `(lambda ,lambda-list ,@body)
+       (values `(lambda ,lambda-list
+                  ,@(when declarations `((declare ,@declarations)))
+                  ,@body)
                t name)))
     (function
      (let* ((fun (%simple-fun-self (%fun-fun fun)))
@@ -113,15 +116,23 @@
      (setf (%simple-fun-name (%fun-fun function)) new-value)))
   new-value)
 
-(defun %fun-doc (x)
-  ;; FIXME: This business of going through %FUN-NAME and then globaldb
-  ;; is the way CMU CL did it, but it doesn't really seem right.
-  ;; When/if weak hash tables become supported again, using a weak
-  ;; hash table to maintain the object/documentation association would
-  ;; probably be better.
-  (let ((name (%fun-name x)))
-    (when (and name (typep name '(or symbol cons)))
-      (values (info :function :documentation name)))))
+(defun %fun-doc (function)
+  (typecase function
+    #!+sb-eval
+    (sb!eval:interpreted-function
+     (sb!eval:interpreted-function-documentation function))
+    (t
+     (%simple-fun-doc (%fun-fun function)))))
+
+(defun (setf %fun-doc) (new-value function)
+  (declare (type (or null string) new-value))
+  (typecase function
+    #!+sb-eval
+    (sb!eval:interpreted-function
+     (setf (sb!eval:interpreted-function-documentation function) new-value))
+    ((or simple-fun closure)
+     (setf (%simple-fun-doc (%fun-fun function)) new-value)))
+  new-value)
 
 ;;; various environment inquiries