[movitz-cvs] CVS update: movitz/losp/muerte/los-closette-compiler.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Sun Aug 21 13:47:54 UTC 2005
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 at 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))
More information about the Movitz-cvs
mailing list