X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=8c1b3084c45eb096d5c2b80e667c3bc2e78eea90;hb=47bcbbb709e9e35e38e34ef2ea658f5a8eb0804d;hp=eb21f3aa07ec5910ad71b90d2d44fc91a6b42bbf;hpb=1a6def3955b715472eb2c75b15660912b9f90173;p=sbcl.git

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