[movitz-cvs] CVS update: movitz/compiler.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	compiler.lisp 
Log Message:
Changed ensure-pass1-funobj definition and usage, now utilizing
init-args.

Date: Thu Feb  5 06:02:39 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.15 movitz/compiler.lisp:1.16
--- movitz/compiler.lisp:1.15	Thu Feb  5 05:45:20 2004
+++ movitz/compiler.lisp	Thu Feb  5 06:02:39 2004
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.15 2004/02/05 10:45:20 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.16 2004/02/05 11:02:39 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -178,23 +178,25 @@
 		      (= 1 (length optional-vars))
 		      (null key-vars)
 		      (not rest-var))
-		 'make-compiled-function-pass1)
+		 'make-compiled-function-pass1-1req1opt)
 		(t 'make-compiled-function-pass1))
 	       name lambda-list declarations form env top-level-p funobj))))
 
 (defun ensure-pass1-funobj (funobj class &rest init-args)
   "If funobj is nil, return a fresh funobj of class.
 Otherwise coerce funobj to class."
-  (if funobj
-      (apply #'change-class funobj class init-args)
-    (apply #'make-instance class init-args)))
+  (apply #'reinitialize-instance
+	 (if funobj
+	     (change-class funobj class)
+	   (make-instance class))
+	 init-args))
 
 (defun make-compiled-function-pass1-numarg-case (name lambda-list declarations form env top-level-p funobj)
-  (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1-numargs-case))
+  (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1-numargs-case
+				      :name name
+				      :lambda-list (movitz-read (lambda-list-simplify lambda-list))))
 	 (funobj-env (make-local-movitz-environment env funobj :type 'funobj-env)))
-    (setf (movitz-funobj-name funobj) name
-	  (movitz-funobj-lambda-list funobj) (movitz-read (lambda-list-simplify lambda-list))
-	  (funobj-env funobj) funobj-env
+    (setf (funobj-env funobj) funobj-env
 	  (function-envs funobj) nil)
     (loop for (numargs lambda-list . clause-body) in (cdr (caddr form))
 	do (when (duplicatesp lambda-list)
@@ -232,7 +234,9 @@
   "Returns funobj."
   (when (duplicatesp lambda-list)
     (error "There are duplicates in lambda-list ~S." lambda-list))
-  (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1))
+  (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1
+				      :name name
+				      :lambda-list (movitz-read (lambda-list-simplify lambda-list))))
 	 (funobj-env (make-local-movitz-environment env funobj :type 'funobj-env))
 	 (function-env (add-bindings-from-lambda-list
 			lambda-list
@@ -240,9 +244,7 @@
 						       :type 'function-env
 						       :declaration-context :funobj
 						       :declarations declarations))))
-    (setf (movitz-funobj-name funobj) name
-	  (movitz-funobj-lambda-list funobj) (movitz-read (lambda-list-simplify lambda-list))
-	  (funobj-env funobj) funobj-env
+    (setf (funobj-env funobj) funobj-env
 	  (function-envs funobj) (list (cons 'muerte.cl::t function-env)))
     (multiple-value-bind (arg-init-code need-normalized-ecx-p)
 	(make-function-arguments-init funobj function-env)