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

Modified Files: los-closette-compiler.lisp Log Message: Some minor code cleanups.

Date: Sun Aug 21 15:47:53 2005 Author: ffjeld

Index: movitz/losp/muerte/los-closette-compiler.lisp diff -u movitz/losp/muerte/los-closette-compiler.lisp:1.17 movitz/losp/muerte/los-closette-compiler.lisp:1.18 --- movitz/losp/muerte/los-closette-compiler.lisp:1.17 Thu May 5 17:17:35 2005 +++ movitz/losp/muerte/los-closette-compiler.lisp Sun Aug 21 15:47:53 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Thu Aug 29 13:15:11 2002 ;;;; -;;;; $Id: los-closette-compiler.lisp,v 1.17 2005/05/05 15:17:35 ffjeld Exp $ +;;;; $Id: los-closette-compiler.lisp,v 1.18 2005/08/21 13:47:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -28,8 +28,6 @@ (define-compile-time-variable *the-position-of-standard-effective-slots* nil) (define-compile-time-variable *the-class-standard-class* nil)

-(defvar *the-effective-slot-positions* nil) - (eval-when (:compile-toplevel) ; extends to EOF

(defvar *classes-with-old-slot-definitions* nil) @@ -521,18 +519,17 @@ val)))

(defun (setf std-slot-value) (value instance slot-name) - (setq slot-name (translate-program slot-name :cl :muerte.cl)) - (let* ((location (slot-location (movitz-class-of instance) slot-name)) + (let* ((location (slot-location (movitz-class-of instance) + (translate-program slot-name :cl :muerte.cl))) (slots (std-instance-slots instance))) (setf (svref slots location) (muerte::translate-program value :cl :muerte.cl))))

- (defun movitz-slot-value (object slot-name) - (setq slot-name (translate-program slot-name :cl :muerte.cl)) - (std-slot-value object slot-name)) + (defun movitz-slot-vale (object slot-name) + (std-slot-value object (translate-program slot-name :cl :muerte.cl)))

(defun (setf movitz-slot-value) (new-value object slot-name) - (setq slot-name (translate-program slot-name :cl :muerte.cl)) - (setf (std-slot-value object slot-name) new-value)) + (setf (std-slot-value object (translate-program slot-name :cl :muerte.cl)) + new-value))

(defun std-slot-exists-p (instance slot-name) (not (null (find slot-name (class-slots (movitz-class-of instance)) @@ -577,27 +574,6 @@ :name name all-keys))) (setf (movitz-find-class name) class))))) -;;; (when old-class -;;; -;;; (let ( -;;; (cond -;;; (old-class -;;; (setf (std-instance-class old-class) (std-instance-class new-class) -;;; (std-instance-slots old-class) (std-instance-slots new-class) -;;; (std-instance-class new-class) (movitz::movitz-read 'dead-class-instance!) -;;; (std-instance-slots new-class) (movitz::movitz-read 'dead-class-instance!) -;;; (class-precedence-list old-class) (std-compute-class-precedence-list old-class)) -;;; (let ((supers (class-direct-superclasses old-class))) -;;; (dolist (superclass supers) -;;; (setf (class-direct-subclasses superclass) -;;; (delete new-class (class-direct-subclasses superclass))) -;;; (pushnew old-class (class-direct-subclasses superclass)))) -;;; old-class) -;;; ((not old-class) -;;; (setf (movitz-find-class name) new-class) -;;; new-class))))) - -;;;

(defun movitz-make-instance-funcallable (metaclass &rest all-keys &key name direct-superclasses direct-slots &allow-other-keys) (declare (ignore all-keys)) @@ -1134,7 +1110,7 @@ (generic-function-lambda-list gf) lambda-list (generic-function-methods gf) () (generic-function-method-class gf) method-class - (generic-function-method-combination gf) (symbol-value '*the-standard-method-combination*)) + (generic-function-method-combination gf) *the-standard-method-combination*) (finalize-generic-function gf) gf))