X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=481a83dfcda537095ebdfe83b98ac981f5cc6f81;hb=bd0ba0f214518e8d72ff2d44de5a1e3e4b02af2c;hp=fe0f3195e1994d256240b56033d86c3a11630c8b;hpb=508bf17fa9e609c523a2795d84a3bc908db1b302;p=sbcl.git

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index fe0f319..481a83d 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -161,7 +161,7 @@
 ;;; COLLECT-LIST-EXPANDER handles the list collection case. N-TAIL
 ;;; is the pointer to the current tail of the list, or NIL if the list
 ;;; is empty.
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun collect-normal-expander (n-value fun forms)
     `(progn
        ,@(mapcar (lambda (form) `(setq ,n-value (,fun ,form ,n-value))) forms)
@@ -601,26 +601,7 @@
 
 ;;; Is NAME a legal function name?
 (defun legal-fun-name-p (name)
-  (or (symbolp name)
-      (and (consp name)
-	   ;; (SETF FOO)
-	   ;; (CLASS-PREDICATE FOO)
-           (or (and (or (eq (car name) 'setf)
-			(eq (car name) 'sb!pcl::class-predicate))
-		    (consp (cdr name))
-		    (symbolp (cadr name))
-		    (null (cddr name)))
-	       ;; (SLOT-ACCESSOR <CLASSNAME-OR-:GLOBAL>
-	       ;;  <SLOT-NAME> [READER|WRITER|BOUNDP])
-	       (and (eq (car name) 'sb!pcl::slot-accessor)
-		    (consp (cdr name))
-		    (symbolp (cadr name))
-		    (consp (cddr name))
-		    (symbolp (caddr name))
-		    (consp (cdddr name))
-		    (member
-		     (cadddr name)
-		     '(sb!pcl::reader sb!pcl::writer sb!pcl::boundp)))))))
+  (values (valid-function-name-p name)))
 
 ;;; Signal an error unless NAME is a legal function name.
 (defun legal-fun-name-or-type-error (name)
@@ -643,11 +624,12 @@
 (defun fun-name-block-name (fun-name)
   (cond ((symbolp fun-name)
 	 fun-name)
-	((and (consp fun-name)
-	      (legal-fun-name-p fun-name))
-	 (case (car fun-name)
-	   ((setf sb!pcl::class-predicate) (second fun-name))
-	   ((sb!pcl::slot-accessor) (third fun-name))))
+	((consp fun-name)
+	 (multiple-value-bind (legalp block-name)
+	     (valid-function-name-p fun-name)
+	   (if legalp
+	       block-name
+	       (error "not legal as a function name: ~S" fun-name))))
 	(t
 	 (error "not legal as a function name: ~S" fun-name))))
 
@@ -809,12 +791,6 @@ which can be found at <http://sbcl.sourceforge.net/>.~:@>"
 	 :format-string "~@<~S ~_is not a ~_~S~:>"
 	 :format-arguments (list value type)))
 
-;;; Return a list of N gensyms. (This is a common suboperation in
-;;; macros and other code-manipulating code.)
-(declaim (ftype (function (index) list) make-gensym-list))
-(defun make-gensym-list (n)
-  (loop repeat n collect (gensym)))
-
 ;;; Return a function like FUN, but expecting its (two) arguments in
 ;;; the opposite order that FUN does.
 (declaim (inline swapped-args-fun))