[movitz-cvs] CVS update: movitz/compiler.lisp - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

4 Feb 2004

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv31935
Modified Files:
    compiler.lisp 
Log Message:
Factored out helper function ensure-pass1-funobj.
Date: Wed Feb  4 11:14:42 2004
Author: ffjeld
Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.13 movitz/compiler.lisp:1.14

--- movitz/compiler.lisp:1.13	Wed Feb  4 11:01:14 2004
+++ movitz/compiler.lisp	Wed Feb  4 11:14:42 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.13 2004/02/04 16:01:14 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.14 2004/02/04 16:14:42 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
@@ -182,8 +182,15 @@
    	(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)))
+
 (defun make-compiled-function-pass1-numarg-case (name lambda-list declarations form env top-level-p funobj)
-  (let* ((funobj (or funobj (make-instance 'movitz-funobj-pass1-numargs-case)))
+  (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1-numargs-case))
     (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))
@@ -204,11 +211,11 @@
    					    (append clause-declarations
    						    declarations)))))
           (make-compiled-function-body-pass1 funobj
-					 function-env
-					 (list* 'muerte.cl::block
-						(compute-function-block-name name)
-						clause-body)
-					 top-level-p)
+						  function-env
+						  (list* 'muerte.cl::block
+							 (compute-function-block-name name)
+							 clause-body)
+						  top-level-p)
           (push (cons numargs function-env)
    	     (function-envs funobj)))))
     funobj))
@@ -217,7 +224,7 @@
   "Returns funobj."
   (when (duplicatesp lambda-list)
     (error "There are duplicates in lambda-list ~S." lambda-list))
-  (let* ((funobj (or funobj (make-instance 'movitz-funobj-pass1)))
+  (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1))
     (funobj-env (make-local-movitz-environment env funobj :type 'funobj-env))
     (function-env (add-bindings-from-lambda-list
    		lambda-list

    