[armedbear-cvs] r14254 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Mon Nov 26 11:38:28 2012
New Revision: 14254

Log:
Fix (documentation symbol 'function) when symbol names a generic function

- fixes #270

Modified:
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	Mon Nov 26 11:38:25 2012	(r14253)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Mon Nov 26 11:38:28 2012	(r14254)
@@ -5670,6 +5670,7 @@
             LispObject doc = object.getDocumentation(docType);
             if (doc == NIL) {
                 if (docType == Symbol.FUNCTION && object instanceof Symbol) {
+                    // Generic functions are handled at lisp-level, not here
                     LispObject function = object.getSymbolFunction();
                     if (function != null)
                         doc = function.getDocumentation(docType);
@@ -5692,6 +5693,7 @@
                                   LispObject documentation)
 
         {
+            // Generic functions are handled at lisp-level, not here
             object.setDocumentation(docType, documentation);
             return documentation;
         }

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Nov 26 11:38:25 2012	(r14253)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Nov 26 11:38:28 2012	(r14254)
@@ -3340,7 +3340,14 @@
   (%set-documentation x doc-type new-value))
 
 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
-  (%documentation x 'function))
+  (if (typep (fdefinition x) 'generic-function)
+      (documentation (fdefinition x) doc-type)
+      (%documentation x doc-type)))
+
+(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function)))
+  (if (typep (fdefinition x) 'generic-function)
+      (setf (documentation (fdefinition x) 'function) new-value)
+      (%set-documentation x 'function new-value)))
 
 (defmethod documentation ((x symbol) (doc-type (eql 'type)))
   (let ((class (find-class x nil)))