From: William Harold Newman <william.newman@airmail.net>
Date: Tue, 28 Aug 2001 03:10:15 +0000 (+0000)
Subject: 0.pre7.21:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=34edf79303784e6293a14c7b40012d09a796a362;p=sbcl.git

0.pre7.21:
	..factored out some shared logic into
		%FUNCALL-IN-FOOMACROLET-LEXENV (though SYMBOL-MACROLET
		was left alone for now, since I had problems with it
		last time)
---

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 1d04deb..d061b64 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -2014,42 +2014,47 @@
       (ir1-convert-progn-body start cont forms)))
   (values))
 
+;;; common logic for MACROLET and SYMBOL-MACROLET
+;;;
+;;; Call DEFINITIONIZE on each element of DEFINITIONS to find its
+;;; in-lexenv representation, stuff the results into *LEXENV*, and
+;;; call FUN (with no arguments).
+(defun %funcall-in-foomacrolet-lexenv (definitionize definitions fun)
+  (declare (type function process-definitions-fun fun) (type list definitions))
+  (unless (= (length definitions)
+             (length (remove-duplicates definitions :key #'first)))
+    (compiler-style-warning "duplicate definitions in ~S" definitions))
+  (let* ((processed-definitions (mapcar definitionize definitions))
+         (*lexenv* (make-lexenv :functions processed-definitions)))
+    (funcall fun)))
+
 ;;; Tweak *LEXENV* to include the DEFINITIONS from a MACROLET, then
 ;;; call FUN (with no arguments).
 ;;;
 ;;; This is split off from the IR1 convert method so that it can be
 ;;; shared by the special-case top-level MACROLET processing code.
 (defun funcall-in-macrolet-lexenv (definitions fun)
-  (declare (type list definitions) (type function fun))
-  (let* ((whole (gensym "WHOLE"))
-	 (environment (gensym "ENVIRONMENT"))
-	 (processed-definitions
-	  (mapcar (lambda (definition)
-		    (unless (list-of-length-at-least-p definition 2)
-		      (compiler-error
-		       "The list ~S is too short to be a legal ~
-                       local macro definition."
-		       definition))
-		    (destructuring-bind (name arglist &body body) definition
-		      (unless (symbolp name)
-			(compiler-error
-			 "The local macro name ~S is not a symbol." name))
-		      (multiple-value-bind (body local-decls)
-			  (parse-defmacro arglist whole body name 'macrolet
-					  :environment environment)
-			`(,name macro .
-				,(compile nil
-					  `(lambda (,whole ,environment)
-					     ,@local-decls
-					     (block ,name ,body)))))))
-		  definitions))
-	 (*lexenv* (make-lexenv :functions processed-definitions)))
-    (unless (= (length definitions)
-	       (length (remove-duplicates definitions :key #'first)))
-      (compiler-style-warning
-       "duplicate macro names in MACROLET ~S" definitions))
-    (funcall fun))
-  (values))
+  (%funcall-in-foomacrolet-lexenv
+   (lambda (definition)
+     (unless (list-of-length-at-least-p definition 2)
+       (compiler-error
+	"The list ~S is too short to be a legal local macro definition."
+	definition))
+     (destructuring-bind (name arglist &body body) definition
+       (unless (symbolp name)
+	 (compiler-error "The local macro name ~S is not a symbol." name))
+       (let ((whole (gensym "WHOLE"))
+	     (environment (gensym "ENVIRONMENT")))
+	 (multiple-value-bind (body local-decls)
+	     (parse-defmacro arglist whole body name 'macrolet
+			     :environment environment)
+	   `(,name macro .
+		   ,(compile nil
+			     `(lambda (,whole ,environment)
+				,@local-decls
+				(block ,name ,body))))))))
+   definitions
+   fun))
 
 (def-ir1-translator macrolet ((definitions &rest body) start cont)
   #!+sb-doc
diff --git a/version.lisp-expr b/version.lisp-expr
index 571475f..06e78cc 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.20"
+"0.pre7.21"