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

rschlatte at common-lisp.net rschlatte at common-lisp.net
Sun Jul 8 10:57:24 UTC 2012


Author: rschlatte
Date: Sun Jul  8 03:57:21 2012
New Revision: 13996

Log:
Small cleanup of atomic-defgeneric

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

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Thu Jul  5 12:06:57 2012	(r13995)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Sun Jul  8 03:57:21 2012	(r13996)
@@ -2798,16 +2798,17 @@
 
 Note: the user should really use the (:method ..) method description
 way of defining methods; there's not much use in atomically defining
-generic functions without providing sensible behaviour..."
+generic functions without providing sensible behaviour."
   (let ((temp-sym (gensym)))
     `(progn
        (defgeneric ,temp-sym , at rest)
        (let ((gf (symbol-function ',temp-sym)))
-         (setf ,(if (and (consp function-name)
-                         (eq (car function-name) 'setf))
-                    `(get ',(second function-name) 'setf-function)
-                  `(symbol-function ',function-name)) gf)
+         ;; FIXME (rudi 2012-07-08): fset gets the source location info
+         ;; to charpos 23 always (but (setf fdefinition) leaves the
+         ;; outdated source position in place, which is even worse).
+         (fset ',function-name gf)
          (%set-generic-function-name gf ',function-name)
+         (fmakunbound ',temp-sym)
          gf))))
 
 (defmacro redefine-class-forwarder (name slot &optional body-alist)




More information about the armedbear-cvs mailing list