[movitz-cvs] CVS update: movitz/special-operators.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	special-operators.lisp 
Log Message:
Changed the implementation of structs a bit: Keep the length encoded
as a fixnum (in 16 bits), and name them by their class metaobject
rather than the symbol name.

Date: Fri Jul 23 18:30:32 2004
Author: ffjeld

Index: movitz/special-operators.lisp
diff -u movitz/special-operators.lisp:1.31 movitz/special-operators.lisp:1.32
--- movitz/special-operators.lisp:1.31	Tue Jul 20 05:40:07 2004
+++ movitz/special-operators.lisp	Fri Jul 23 18:30:32 2004
@@ -8,7 +8,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Nov 24 16:22:59 2000
 ;;;;                
-;;;; $Id: special-operators.lisp,v 1.31 2004/07/20 12:40:07 ffjeld Exp $
+;;;; $Id: special-operators.lisp,v 1.32 2004/07/24 01:30:32 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -249,7 +249,12 @@
 						       :form nil))
 						   (list exit-label)))))))))))))
 					     
-		  
+(define-special-operator compile-time-find-class (&all all &form form)
+  (destructuring-bind (class-name)
+      (cdr form)
+    (compiler-call #'compile-form-unprotected
+      :form (muerte::movitz-find-class class-name)
+      :forward all)))
 	     
 (define-special-operator make-named-function (&form form &env env)
   (destructuring-bind (name formals declarations docstring body)
@@ -296,7 +301,11 @@
 The valid parameters are~{ ~S~}."
 					    parameter proto-name
 					    (mapcar #'movitz-print (movitz-funobj-const-list funobj-proto)))
-				       do (setf (car (member parameter c)) (movitz-read value)))
+					  (setf (car (member parameter c))
+					    (if (and (consp value)
+						     (eq :movitz-find-class (car value)))
+						(muerte::movitz-find-class (cadr value))
+					      (movitz-read value))))
 				   c))))
       (setf (movitz-funobj-symbolic-name funobj) function-name)
       (setf (movitz-env-named-function function-name) funobj)