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@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)