[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv11667

Modified Files:
	los-closette.lisp 
Log Message:
Added function funcallable-instance-function, and removed some warnings.

Date: Thu Feb 26 06:40:44 2004
Author: ffjeld

Index: movitz/losp/muerte/los-closette.lisp
diff -u movitz/losp/muerte/los-closette.lisp:1.4 movitz/losp/muerte/los-closette.lisp:1.5
--- movitz/losp/muerte/los-closette.lisp:1.4	Wed Feb 18 09:40:58 2004
+++ movitz/losp/muerte/los-closette.lisp	Thu Feb 26 06:40:44 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Jul 23 14:29:10 2002
 ;;;;                
-;;;; $Id: los-closette.lisp,v 1.4 2004/02/18 14:40:58 ffjeld Exp $
+;;;; $Id: los-closette.lisp,v 1.5 2004/02/26 11:40:44 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -186,9 +186,13 @@
   (check-type funcallable-instance standard-gf-instance)
   (check-type function function)
   (setf-movitz-accessor (funcallable-instance movitz-funobj-standard-gf standard-gf-function)
-		     function)
+			function)
   (values))
 
+(defun funcallable-instance-function (funcallable-instance)
+  (check-type funcallable-instance standard-gf-instance)
+  (movitz-accessor funcallable-instance movitz-funobj-standard-gf standard-gf-function))
+
 (defun instance-slot-p (slot)
   (eq (slot-definition-allocation slot) :instance))
 
@@ -535,9 +539,9 @@
       (push (cons (car active-specializers)
 		  emfun)
 	    (std-gf-classes-to-emf-table gf))
-      (when (< 5 (length (std-gf-classes-to-emf-table gf)))
-	(warn "method cache size for ~S: ~D"
-	      gf (length (std-gf-classes-to-emf-table gf))))
+;;;      (when (< 5 (length (std-gf-classes-to-emf-table gf)))
+;;;	(warn "method cache size for ~S: ~D"
+;;;	      gf (length (std-gf-classes-to-emf-table gf))))
       (apply emfun (car arg0-list) optional-args))))
 
 (defun cached-lookup-failed-map10 (gf &rest arg01-class01-optionals)
@@ -560,9 +564,9 @@
       (push (cons (cadr active-specializers)
 		  emfun)
 	    (std-gf-classes-to-emf-table gf))
-      (when (< 4 (length (std-gf-classes-to-emf-table gf)))
-	(warn "method cache size for ~S: ~D"
-	      gf (length (std-gf-classes-to-emf-table gf))))
+;;;      (when (< 4 (length (std-gf-classes-to-emf-table gf)))
+;;;	(warn "method cache size for ~S: ~D"
+;;;	      gf (length (std-gf-classes-to-emf-table gf))))
       (apply emfun (car arg01-list) (cadr arg01-list) optional-args))))
 
 (defun cached-lookup-failed-map11 (gf &rest args)
@@ -573,9 +577,9 @@
 		 (second active-specializers)
 		 emfun)
 	  (std-gf-classes-to-emf-table gf))
-    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
-      (warn "method cache size for ~S: ~D"
-	    gf (length (std-gf-classes-to-emf-table gf))))
+;;;    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
+;;;      (warn "method cache size for ~S: ~D"
+;;;	    gf (length (std-gf-classes-to-emf-table gf))))
     (apply emfun args)))
 
 (defun cached-lookup-failed-map101 (gf &rest args)
@@ -586,9 +590,9 @@
 		 (third active-specializers)
 		 emfun)
 	  (std-gf-classes-to-emf-table gf))
-    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
-      (warn "method cache size for ~S: ~D"
-	    gf (length (std-gf-classes-to-emf-table gf))))
+;;;    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
+;;;      (warn "method cache size for ~S: ~D"
+;;;	    gf (length (std-gf-classes-to-emf-table gf))))
     (apply emfun args)))
 
 (defun cached-lookup-failed-map111 (gf &rest args)
@@ -600,9 +604,9 @@
 		 (third active-specializers)
 		 emfun)
 	  (std-gf-classes-to-emf-table gf))
-    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
-      (warn "method cache size for ~S: ~D"
-	    gf (length (std-gf-classes-to-emf-table gf))))
+;;;    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
+;;;      (warn "method cache size for ~S: ~D"
+;;;	    gf (length (std-gf-classes-to-emf-table gf))))
     (apply emfun args)))
 
 (defun cached-lookup-failed-map1111 (gf &rest args)
@@ -615,9 +619,9 @@
 		 (fourth active-specializers)
 		 emfun)
 	  (std-gf-classes-to-emf-table gf))
-    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
-      (warn "method cache size for ~S: ~D"
-	    gf (length (std-gf-classes-to-emf-table gf))))
+;;;    (when (< 4 (length (std-gf-classes-to-emf-table gf)))
+;;;      (warn "method cache size for ~S: ~D"
+;;;	    gf (length (std-gf-classes-to-emf-table gf))))
     (apply emfun args)))
 
 (defun discriminating-function-map1-no-eqls (&edx gf arg0 &rest optional-args)