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

[Frode Vatvedt Fjeld]

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

Modified Files:
	los-closette-compiler.lisp 
Log Message:
Changed structure-class and defstruct so as to be better integrated
with the MOP. This means that the slot-value accessor should now work
on structure-objects.

Date: Mon Apr 19 18:38:22 2004
Author: ffjeld

Index: movitz/losp/muerte/los-closette-compiler.lisp
diff -u movitz/losp/muerte/los-closette-compiler.lisp:1.11 movitz/losp/muerte/los-closette-compiler.lisp:1.12
--- movitz/losp/muerte/los-closette-compiler.lisp:1.11	Sun Feb 15 08:17:55 2004
+++ movitz/losp/muerte/los-closette-compiler.lisp	Mon Apr 19 18:38:22 2004
@@ -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.11 2004/02/15 13:17:55 ffjeld Exp $
+;;;; $Id: los-closette-compiler.lisp,v 1.12 2004/04/19 22:38:22 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -611,13 +611,13 @@
 					    :direct-superclasses direct-superclasses)
       class))
 
-  (defun movitz-make-instance (metaclass &rest all-keys)
-    ;; (warn "movitz-make-instance: ~S ~S" metaclass all-keys)
-    (when (symbolp metaclass)
-      (setf metaclass (movitz-find-class metaclass)))
-    (if (eq metaclass (movitz-find-class 'funcallable-standard-class nil))
-	(apply 'movitz-make-instance-funcallable metaclass all-keys)
-      (let ((instance (std-allocate-instance metaclass)))
+  (defun movitz-make-instance (class &rest all-keys)
+    ;; (warn "movitz-make-instance: ~S ~S" class all-keys)
+    (when (symbolp class)
+      (setf class (movitz-find-class class)))
+    (if (eq class (movitz-find-class 'funcallable-standard-class nil))
+	(apply 'movitz-make-instance-funcallable class all-keys)
+      (let ((instance (std-allocate-instance class)))
 	(dolist (slot (class-slots (movitz-class-of instance)))
 	  (let ((slot-name (slot-definition-name slot)))
 	    (multiple-value-bind (init-key init-value foundp)