0.pre7.122:

[sbcl.git] / src / code / early-extensions.lisp

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 3888697..4d84e8c 100644 (file)
--- 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))))
 \f
 ;;;; 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,8 +711,7 @@
 ;;; 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))
 (defmacro enforce-type (value type)
@@ -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))