From: William Harold Newman Date: Fri, 23 Feb 2001 12:40:08 +0000 (+0000) Subject: 0.6.10.22: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fbd731d14e61b8f57e4bfb6f2865cb9c6aa2d86e;p=sbcl.git 0.6.10.22: Sometimes anonymous function names are STRINGs. Make %DESCRIBE-DOC and %DESCRIBE-FUNCTION-NAME handle that. hacking MNA "pcl cleanups" megapatch, phase III.. (EVAL-WHEN (:LOAD-TOPLEVEL :EXECUTE) ..) becomes (PROGN ..) or is elided completely. --- diff --git a/BUGS b/BUGS index 8a88aeb..8fa26ae 100644 --- a/BUGS +++ b/BUGS @@ -787,6 +787,18 @@ Error in function C::GET-LAMBDA-TO-COMPILE: invokes the debugger: "B is not of type list". SBCL does the same thing. +82: + Functions are assigned names based on the context in which they're + defined. This is less than ideal for the functions which are + used to implement CLOS methods. E.g. the output of + (DESCRIBE 'PRINT-OBJECT) lists functions like + # + and + # + It would be better if these functions' names always identified + them as methods, and identified their generic functions and + specializers. + KNOWN BUGS RELATED TO THE IR1 INTERPRETER diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 8a97208..9939e92 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -94,7 +94,7 @@ ;;; Print the specified kind of documentation about the given NAME. If ;;; NAME is null, or not a valid name, then don't print anything. -(declaim (ftype (function (symbol stream t t) (values)) %describe-doc)) +(declaim (ftype (function (t stream t t) (values)) %describe-doc)) (defun %describe-doc (name s kind kind-doc) (when (and name (typep name '(or symbol cons))) (let ((doc (fdocumentation name kind))) @@ -104,24 +104,28 @@ (values)) ;;; Describe various stuff about the functional semantics attached to -;;; the specified Name. Type-Spec is the function type specifier +;;; the specified NAME, if NAME is the kind of thing you can look +;;; up as a name. (In the case of anonymous closures and other +;;; things, it might not be.) TYPE-SPEC is the function type specifier ;;; extracted from the definition, or NIL if none. -(declaim (ftype (function ((or symbol cons) stream t)) %describe-function-name)) +(declaim (ftype (function (t stream t)) %describe-function-name)) (defun %describe-function-name (name s type-spec) - (multiple-value-bind (type where) - (if (or (symbolp name) (and (listp name) (eq (car name) 'setf))) - (values (type-specifier (info :function :type name)) - (info :function :where-from name)) - (values type-spec :defined)) - (when (consp type) - (format s "~@:_Its ~(~A~) argument types are:~@:_ ~S" - where (second type)) - (format s "~@:_Its result type is:~@:_ ~S" (third type)))) - (let ((inlinep (info :function :inlinep name))) - (when inlinep - (format s "~@:_It is currently declared ~(~A~);~ + (when (and name (typep name '(or symbol cons))) + (multiple-value-bind (type where) + (if (or (symbolp name) (and (listp name) (eq (car name) 'setf))) + (values (type-specifier (info :function :type name)) + (info :function :where-from name)) + (values type-spec :defined)) + (when (consp type) + (format s "~@:_Its ~(~A~) argument types are:~@:_ ~S" + where (second type)) + (format s "~@:_Its result type is:~@:_ ~S" (third type)))) + (let ((inlinep (info :function :inlinep name))) + (when inlinep + (format s + "~@:_It is currently declared ~(~A~);~ ~:[no~;~] expansion is available." - inlinep (info :function :inline-expansion name))))) + inlinep (info :function :inline-expansion name)))))) ;;; Interpreted function describing; handles both closure and ;;; non-closure functions. Instead of printing the compiled-from info, diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 866f813..4b63513 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -105,8 +105,6 @@ bootstrapping. ;;; early definition. Do this in a way that makes sure that if we ;;; redefine one of the early definitions the redefinition will take ;;; effect. This makes development easier. -(eval-when (:load-toplevel :execute) - (dolist (fns *!early-functions*) (let ((name (car fns)) (early-name (cadr fns))) @@ -115,7 +113,6 @@ bootstrapping. (lambda (&rest args) (apply (fdefinition early-name) args)) name)))) -) ; EVAL-WHEN ;;; *!GENERIC-FUNCTION-FIXUPS* is used by !FIX-EARLY-GENERIC-FUNCTIONS ;;; to convert the few functions in the bootstrap which are supposed @@ -387,27 +384,27 @@ bootstrapping. ;; prefixes.) (*package* sb-int:*keyword-package*)) (format nil "~S" mname))))) - `(eval-when (:load-toplevel :execute) - (defun ,mname-sym ,(cadr fn-lambda) - ,@(cddr fn-lambda)) - ,(make-defmethod-form-internal - name qualifiers `',specls - unspecialized-lambda-list method-class-name - `(list* ,(cadr initargs-form) - #',mname-sym - ,@(cdddr initargs-form)) - pv-table-symbol))) - (make-defmethod-form-internal - name qualifiers - `(list ,@(mapcar #'(lambda (specializer) - (if (consp specializer) - ``(,',(car specializer) - ,,(cadr specializer)) - `',specializer)) - specializers)) - unspecialized-lambda-list method-class-name - initargs-form - pv-table-symbol)))) + `(progn + (defun ,mname-sym ,(cadr fn-lambda) + ,@(cddr fn-lambda)) + ,(make-defmethod-form-internal + name qualifiers `',specls + unspecialized-lambda-list method-class-name + `(list* ,(cadr initargs-form) + #',mname-sym + ,@(cdddr initargs-form)) + pv-table-symbol))) + (make-defmethod-form-internal + name qualifiers + `(list ,@(mapcar #'(lambda (specializer) + (if (consp specializer) + ``(,',(car specializer) + ,,(cadr specializer)) + `',specializer)) + specializers)) + unspecialized-lambda-list method-class-name + initargs-form + pv-table-symbol)))) (defun make-defmethod-form-internal (name qualifiers specializers-form unspecialized-lambda-list @@ -2190,8 +2187,7 @@ bootstrapping. (cons (if (listp arg) (cadr arg) t) specializers) (cons (if (listp arg) (car arg) arg) required))))))) -(eval-when (:load-toplevel :execute) - (setq *boot-state* 'early)) +(setq *boot-state* 'early) ;;; FIXME: In here there was a #-CMU definition of SYMBOL-MACROLET ;;; which used %WALKER stuff. That suggests to me that maybe the code diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp index 9d5ee2c..320c5aa 100644 --- a/src/pcl/defclass.lisp +++ b/src/pcl/defclass.lisp @@ -92,23 +92,22 @@ mclass *the-class-structure-class*)))))) (let ((defclass-form - (eval-when (:load-toplevel :execute) - `(progn - ,@(mapcar #'(lambda (x) - `(declaim (ftype (function (t) t) ,x))) - *readers*) - ,@(mapcar #'(lambda (x) - `(declaim (ftype (function (t t) t) ,x))) - *writers*) - (let ,(mapcar #'cdr *initfunctions*) - (load-defclass ',name - ',metaclass - ',supers - (list ,@canonical-slots) - (list ,@(apply #'append - (when defstruct-p - '(:from-defclass-p t)) - other-initargs)))))))) + `(progn + ,@(mapcar (lambda (x) + `(declaim (ftype (function (t) t) ,x))) + *readers*) + ,@(mapcar (lambda (x) + `(declaim (ftype (function (t t) t) ,x))) + *writers*) + (let ,(mapcar #'cdr *initfunctions*) + (load-defclass ',name + ',metaclass + ',supers + (list ,@canonical-slots) + (list ,@(apply #'append + (when defstruct-p + '(:from-defclass-p t)) + other-initargs))))))) (if defstruct-p (progn (eval defclass-form) ; Define the class now, so that.. diff --git a/src/pcl/defs.lisp b/src/pcl/defs.lisp index 6c5b990..b5ca7e6 100644 --- a/src/pcl/defs.lisp +++ b/src/pcl/defs.lisp @@ -23,18 +23,20 @@ (in-package "SB-PCL") - -(eval-when (:load-toplevel :execute) - (when (eq *boot-state* 'complete) - (error "Trying to load (or compile) PCL in an environment in which it~%~ - has already been loaded. This doesn't work, you will have to~%~ - get a fresh lisp (reboot) and then load PCL.")) - (when *boot-state* - (cerror "Try loading (or compiling) PCL anyways." - "Trying to load (or compile) PCL in an environment in which it~%~ - has already been partially loaded. This may not work, you may~%~ - need to get a fresh lisp (reboot) and then load PCL.")) - ) ; EVAL-WHEN +;;; (These are left over from the days when PCL was an add-on package +;;; for a pre-CLOS Common Lisp. They shouldn't happen in a normal +;;; build, of course, but they might happen if someone is experimenting +;;; and debugging, and it's probably worth complaining if they do, +;;; so we've left 'em in.) +(when (eq *boot-state* 'complete) + (error "Trying to load (or compile) PCL in an environment in which it~%~ + has already been loaded. This doesn't work, you will have to~%~ + get a fresh lisp (reboot) and then load PCL.")) +(when *boot-state* + (cerror "Try loading (or compiling) PCL anyways." + "Trying to load (or compile) PCL in an environment in which it~%~ + has already been partially loaded. This may not work, you may~%~ + need to get a fresh lisp (reboot) and then load PCL.")) ;;; comments from CMU CL version of PCL: ;;; This is like fdefinition on the Lispm. If Common Lisp had diff --git a/version.lisp-expr b/version.lisp-expr index 773f9c2..c250019 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.10.21" +"0.6.10.22"