0.pre7.113:

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

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index eb21f3a..8c1b308 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -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)
@@ -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))