[Sbcl-commits] CVS: sbcl/src/compiler assem.lisp, 1.32, 1.33 macros.lisp, 1.58, 1.59

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv25530/src/compiler

Modified Files:
	assem.lisp macros.lisp 
Log Message:
0.9.15.26: compiler-macro lambda-list parsing and FUNCALL forms
 * We previously handled only the &WHOLE case, and also failed to
   handle the argument count checking correct. Now things should work,
   but FUNCALL forms are not still subject to compiler-macroexpansion -- yet.
   (Reported by James Y Knight)
 * Refactor the macro-lambda-list parsing code slightly for easier
   comprehension.


Index: assem.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/assem.lisp,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- assem.lisp	13 May 2006 18:33:40 -0000	1.32
+++ assem.lisp	11 Aug 2006 08:08:39 -0000	1.33
@@ -1683,10 +1683,7 @@
 (defmacro define-instruction-macro (name lambda-list &body body)
   (with-unique-names (whole env)
     (multiple-value-bind (body local-defs)
-        (sb!kernel:parse-defmacro lambda-list
-                                  whole
-                                  body
-                                  name
+        (sb!kernel:parse-defmacro lambda-list whole body name
                                   'instruction-macro
                                   :environment env)
       `(eval-when (:compile-toplevel :load-toplevel :execute)

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/macros.lisp,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -d -r1.58 -r1.59
--- macros.lisp	11 Dec 2005 04:23:05 -0000	1.58
+++ macros.lisp	11 Aug 2006 08:08:39 -0000	1.59
@@ -40,42 +40,41 @@
 ;;; kind to associate with NAME.
 (defmacro def-ir1-translator (name (lambda-list start-var next-var result-var)
                               &body body)
-  (let ((fn-name (symbolicate "IR1-CONVERT-" name))
-        (n-form (gensym))
-        (n-env (gensym)))
-    (multiple-value-bind (body decls doc)
-        (parse-defmacro lambda-list n-form body name "special form"
-                        :environment n-env
-                        :error-fun 'compiler-error
-                        :wrap-block nil)
-      `(progn
-         (declaim (ftype (function (ctran ctran (or lvar null) t) (values))
-                         ,fn-name))
-         (defun ,fn-name (,start-var ,next-var ,result-var ,n-form
-                          &aux (,n-env *lexenv*))
-           (declare (ignorable ,start-var ,next-var ,result-var))
-           ,@decls
-           ,body
-           (values))
-         ,@(when doc
-             `((setf (fdocumentation ',name 'function) ,doc)))
-         ;; FIXME: Evidently "there can only be one!" -- we overwrite any
-         ;; other :IR1-CONVERT value. This deserves a warning, I think.
-         (setf (info :function :ir1-convert ',name) #',fn-name)
-         ;; FIXME: rename this to SPECIAL-OPERATOR, to update it to
-         ;; the 1990s?
-         (setf (info :function :kind ',name) :special-form)
-         ;; It's nice to do this for error checking in the target
-         ;; SBCL, but it's not nice to do this when we're running in
-         ;; the cross-compilation host Lisp, which owns the
-         ;; SYMBOL-FUNCTION of its COMMON-LISP symbols.
-         #-sb-xc-host
-         (let ((fun (lambda (&rest rest)
-                      (declare (ignore rest))
-                      (error 'special-form-function :name ',name))))
-           (setf (%simple-fun-arglist fun) ',lambda-list)
-           (setf (symbol-function ',name) fun))
-         ',name))))
+  (let ((fn-name (symbolicate "IR1-CONVERT-" name)))
+    (with-unique-names (whole-var n-env)
+      (multiple-value-bind (body decls doc)
+          (parse-defmacro lambda-list whole-var body name "special form"
+                          :environment n-env
+                          :error-fun 'compiler-error
+                          :wrap-block nil)
+        `(progn
+           (declaim (ftype (function (ctran ctran (or lvar null) t) (values))
+                           ,fn-name))
+           (defun ,fn-name (,start-var ,next-var ,result-var ,whole-var
+                            &aux (,n-env *lexenv*))
+             (declare (ignorable ,start-var ,next-var ,result-var))
+             ,@decls
+             ,body
+             (values))
+           ,@(when doc
+                   `((setf (fdocumentation ',name 'function) ,doc)))
+           ;; FIXME: Evidently "there can only be one!" -- we overwrite any
+           ;; other :IR1-CONVERT value. This deserves a warning, I think.
+           (setf (info :function :ir1-convert ',name) #',fn-name)
+           ;; FIXME: rename this to SPECIAL-OPERATOR, to update it to
+           ;; the 1990s?
+           (setf (info :function :kind ',name) :special-form)
+           ;; It's nice to do this for error checking in the target
+           ;; SBCL, but it's not nice to do this when we're running in
+           ;; the cross-compilation host Lisp, which owns the
+           ;; SYMBOL-FUNCTION of its COMMON-LISP symbols.
+           #-sb-xc-host
+           (let ((fun (lambda (&rest rest)
+                        (declare (ignore rest))
+                        (error 'special-form-function :name ',name))))
+             (setf (%simple-fun-arglist fun) ',lambda-list)
+             (setf (symbol-function ',name) fun))
+           ',name)))))
 
 ;;; (This is similar to DEF-IR1-TRANSLATOR, except that we pass if the
 ;;; syntax is invalid.)
@@ -97,18 +96,16 @@
 ;;; OPTIMIZE parameters, then the POLICY macro should be used to
 ;;; determine when to pass.
 (defmacro source-transform-lambda (lambda-list &body body)
-  (let ((n-form (gensym))
-        (n-env (gensym))
-        (name (gensym)))
+  (with-unique-names (whole-var n-env name)
     (multiple-value-bind (body decls)
-        (parse-defmacro lambda-list n-form body "source transform" "form"
+        (parse-defmacro lambda-list whole-var body "source transform" "form"
                         :environment n-env
                         :error-fun `(lambda (&rest stuff)
                                       (declare (ignore stuff))
                                       (return-from ,name
                                         (values nil t)))
                         :wrap-block nil)
-      `(lambda (,n-form &aux (,n-env *lexenv*))
+      `(lambda (,whole-var &aux (,n-env *lexenv*))
          ,@decls
          (block ,name
            ,body)))))