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

rschlatte at common-lisp.net rschlatte at common-lisp.net
Tue Aug 14 20:02:17 UTC 2012


Author: rschlatte
Date: Tue Aug 14 13:02:16 2012
New Revision: 14088

Log:
Tell compile, set-function-definition about funcallable objects

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   trunk/abcl/src/org/armedbear/lisp/precompiler.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue Aug 14 12:33:04 2012	(r14087)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue Aug 14 13:02:16 2012	(r14088)
@@ -7492,7 +7492,7 @@
         environment)
     (unless (and (consp definition) (eq (car definition) 'LAMBDA))
       (let ((function definition))
-        (when (typep definition 'standard-generic-function)
+        (when (typep definition 'mop:funcallable-standard-object)
           (setf function (mop::funcallable-instance-function function)))
         (multiple-value-setq
             (expression environment)

Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	Tue Aug 14 12:33:04 2012	(r14087)
+++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	Tue Aug 14 13:02:16 2012	(r14088)
@@ -1069,7 +1069,7 @@
     (sys::%set-arglist new (sys::arglist old))
     (when (macro-function name)
       (setf new (make-macro name new)))
-    (if (typep old 'standard-generic-function)
+    (if (typep old 'mop:funcallable-standard-object)
         (mop:set-funcallable-instance-function old new)
         (setf (fdefinition name) new))))
 
@@ -1180,4 +1180,4 @@
 
 (export '(precompile))
 
-;;(provide "PRECOMPILER")
\ No newline at end of file
+;;(provide "PRECOMPILER")




More information about the armedbear-cvs mailing list