X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmacros.lisp;h=7d8bab0ffff199ac30f18f70059a330fa014c189;hb=8902b8b6bd2e9285749dd39d313b33b6c69c5213;hp=dbb41f928ed4e4d3470cf8ef1519780a754f1b71;hpb=287475f107626c6c8993b955daa9b19b292e69fd;p=sbcl.git

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index dbb41f9..7d8bab0 100644
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -26,17 +26,6 @@
 
 ;;;; source-hacking defining forms
 
-;;; to be passed to PARSE-DEFMACRO when we want compiler errors
-;;; instead of real errors
-#!-sb-fluid (declaim (inline convert-condition-into-compiler-error))
-(defun convert-condition-into-compiler-error (datum &rest stuff)
-  (if (stringp datum)
-      (apply #'compiler-error datum stuff)
-      (compiler-error "~A"
-		      (if (symbolp datum)
-			  (apply #'make-condition datum stuff)
-			  datum))))
-
 ;;; Parse a DEFMACRO-style lambda-list, setting things up so that a
 ;;; compiler error happens if the syntax is invalid.
 ;;;
@@ -53,16 +42,17 @@
     (multiple-value-bind (body decls doc)
 	(parse-defmacro lambda-list n-form body name "special form"
 			:environment n-env
-			:error-fun 'convert-condition-into-compiler-error
+			: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)
-	   (let ((,n-env *lexenv*))
-	     ,@decls
-	     ,body
-	     (values)))
+	 (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
@@ -513,11 +503,13 @@
     (let ((n-args (gensym)))
       `(progn
 	(defun ,name (,n-node ,@vars)
+	  (declare (ignorable ,@vars))
 	  (let ((,n-args (basic-combination-args ,n-node)))
 	    ,(parse-deftransform lambda-list body n-args
 				 `(return-from ,name nil))))
 	,@(when (consp what)
-	    `((setf (,(symbolicate "FUN-INFO-" (second what))
+	    `((setf (,(let ((*package* (symbol-package 'sb!c::fun-info)))
+                        (symbolicate "FUN-INFO-" (second what)))
 		     (fun-info-or-lose ',(first what)))
 		    #',name)))))))