[cl-store-cvs] CVS update: cl-store/clisp/.cvsignore cl-store/clisp/fix-clisp.lisp

Sean Ross sross at common-lisp.net
Tue Aug 17 11:12:42 UTC 2004


Update of /project/cl-store/cvsroot/cl-store/clisp
In directory common-lisp.net:/tmp/cvs-serv9569/clisp

Modified Files:
	fix-clisp.lisp 
Added Files:
	.cvsignore 
Log Message:
Changelog 2004-07-29

Date: Tue Aug 17 04:12:42 2004
Author: sross



Index: cl-store/clisp/fix-clisp.lisp
diff -u cl-store/clisp/fix-clisp.lisp:1.2 cl-store/clisp/fix-clisp.lisp:1.3
--- cl-store/clisp/fix-clisp.lisp:1.2	Fri May 21 07:14:41 2004
+++ cl-store/clisp/fix-clisp.lisp	Tue Aug 17 04:12:42 2004
@@ -2,6 +2,8 @@
 ;; See the file LICENCE for licence information.
 
 (in-package :cl-store)
+(declaim (optimize (speed 3) (safety 0) (debug 0)))
+
 ;; this is such a pain.
 
 (defgeneric slot-definition-name (slot))
@@ -11,7 +13,9 @@
   (aref slot 0))
 
 (defmethod slot-definition-allocation ((slot vector))
-  (aref slot 4))
+  (if (keywordp (aref slot 4))
+      :instance
+      :class))
 
 
 (defun compute-slots (class)
@@ -48,17 +52,17 @@
 
 (defun add-methods-for-class (class vals)
   (let ((readers (mappend #'(lambda (x)
-                             (second (member :readers x)))
-                         vals))
+                              (second (member :readers x)))
+                          vals))
         (writers (mappend #'(lambda (x)
                               (second (member :writers x)))
                           vals)))
     (loop for x in readers do
-      (eval `(defmethod ,x ((clos::object ,class))
-               (slot-value clos::object ',x))))
+          (eval `(defmethod ,x ((clos::object ,class))
+                  (slot-value clos::object ',x))))
     (loop for x in writers do
-      (eval `(defmethod ,x (clos::new-value (clos::object ,class))
-               (setf (slot-value clos::object ',x) clos::new-value))))
+          (eval `(defmethod ,x (clos::new-value (clos::object ,class))
+                  (setf (slot-value clos::object ',x) clos::new-value))))
     (find-class class)))
 
-;; EOF
+;; EOF
\ No newline at end of file





More information about the Cl-store-cvs mailing list