X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=9e528e86cdeced0711da66693074dcd68a27daef;hb=bcbbce86c47a1c530d488c7876a453100fcd933e;hp=3888697b649de3acc833d24dce12e7ddb3510926;hpb=5ec8d0c1c8b7939818b75118b472fac1af554f9a;p=sbcl.git

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 3888697..9e528e8 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -200,7 +200,7 @@
 ;;; the function is made the new value for the collection. As a
 ;;; totally magical special-case, FUNCTION may be COLLECT, which tells
 ;;; us to build a list in forward order; this is the default. If an
-;;; INITIAL-VALUE is supplied for Collect, the stuff will be RPLACD'd
+;;; INITIAL-VALUE is supplied for COLLECT, the stuff will be RPLACD'd
 ;;; onto the end. Note that FUNCTION may be anything that can appear
 ;;; in the functional position, including macros and lambdas.
 (defmacro collect (collections &body body)
@@ -208,7 +208,7 @@
 	(binds ()))
     (dolist (spec collections)
       (unless (proper-list-of-length-p spec 1 3)
-	(error "malformed collection specifier: ~S." spec))
+	(error "malformed collection specifier: ~S" spec))
       (let* ((name (first spec))
 	     (default (second spec))
 	     (kind (or (third spec) 'collect))
@@ -403,7 +403,7 @@
 	 (n-cache (gensym)))
 
     (unless (= (length default-values) values)
-      (error "The number of default values ~S differs from :VALUES ~D."
+      (error "The number of default values ~S differs from :VALUES ~W."
 	     default values))
 
     (collect ((inlines)
@@ -462,8 +462,8 @@
 		  (,n-cache ,var-name))
 	      (declare (type fixnum ,n-index))
 	      ,@(sets)
-	      ,@(mapcar #'(lambda (i val)
-			    `(setf (svref ,n-cache ,i) ,val))
+	      ,@(mapcar (lambda (i val)
+			  `(setf (svref ,n-cache ,i) ,val))
 			(values-indices)
 			(values-names))
 	      (values)))))
@@ -479,8 +479,8 @@
 		  (dotimes (i nargs)
 		    (arg-sets `(setf (svref ,n-cache (+ ,n-index ,i)) nil)))
 		  (arg-sets))
-	      ,@(mapcar #'(lambda (i val)
-			    `(setf (svref ,n-cache ,i) ,val))
+	      ,@(mapcar (lambda (i val)
+			  `(setf (svref ,n-cache ,i) ,val))
 			(values-indices)
 			default-values))
 	    (values)))
@@ -632,7 +632,7 @@
 
 
 ;;; If COLD-FSET occurs not at top level, just treat it as an ordinary
-;;; assignment. That way things like
+;;; assignment instead of doing cold static linking. That way things like
 ;;;   (FLET ((FROB (X) ..))
 ;;;     (DEFUN FOO (X Y) (FROB X) ..)
 ;;;     (DEFUN BAR (Z) (AND (FROB X) ..)))
@@ -645,7 +645,12 @@
    "~@<COLD-FSET ~S not cross-compiled at top level: demoting to ~
 (SETF FDEFINITION)~:@>"
    name)
-  `(setf (fdefinition ',name) ,lambda))
+  ;; We convert the LAMBDA expression to the corresponding NAMED-LAMBDA
+  ;; expression so that the compiler can use NAME in debug names etc. 
+  (destructuring-bind (lambda-symbol &rest lambda-rest) lambda
+    (assert (eql lambda-symbol 'lambda)) ; else dunno how to do conversion
+    `(setf (fdefinition ',name)
+           (named-lambda ,name ,@lambda-rest))))
 
 ;;;; ONCE-ONLY
 ;;;;
@@ -689,10 +694,10 @@
 ;;; error indicating that a required &KEY argument was not supplied.
 ;;; This function is also useful for DEFSTRUCT slot defaults
 ;;; corresponding to required arguments.
-(declaim (ftype (function () nil) required-arg))
-(defun required-arg ()
+(declaim (ftype (function () nil) missing-arg))
+(defun missing-arg ()
   #!+sb-doc
-  (/show0 "entering REQUIRED-ARG")
+  (/show0 "entering MISSING-ARG")
   (error "A required &KEY or &OPTIONAL argument was not supplied."))
 
 ;;; like CL:ASSERT and CL:CHECK-TYPE, but lighter-weight
@@ -706,16 +711,15 @@
 ;;; guts of complex systems anyway, I replaced it too.)
 (defmacro aver (expr)
   `(unless ,expr
-     (%failed-aver ,(let ((*package* (find-package :keyword)))
-		      (format nil "~S" expr)))))
+     (%failed-aver ,(format nil "~A" expr))))
 (defun %failed-aver (expr-as-string)
-  (error "~@<internal error, failed AVER: ~2I~_~S~:>" expr-as-string))
+  (bug "~@<failed AVER: ~2I~_~S~:>" expr-as-string))
 (defmacro enforce-type (value type)
   (once-only ((value value))
     `(unless (typep ,value ',type)
        (%failed-enforce-type ,value ',type))))
 (defun %failed-enforce-type (value type)
-  (error 'simple-type-error
+  (error 'simple-type-error ; maybe should be TYPE-BUG, subclass of BUG?
 	 :value value
 	 :expected-type type
 	 :format-string "~@<~S ~_is not a ~_~S~:>"
@@ -954,3 +958,8 @@
   (if (typep possibly-logical-pathname 'logical-pathname)
       (translate-logical-pathname possibly-logical-pathname)
       possibly-logical-pathname))
+
+(defun deprecation-warning (bad-name &optional good-name)
+  (warn "using deprecated ~S~@[, should use ~S instead~]"
+	bad-name
+	good-name))