From 69550d1ce4a94faec95a651f3f0c1e884966a496 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 19 Jun 2003 01:20:12 +0000 Subject: [PATCH] 0.8.0.80: PRINT-UNREADABLE-OBJECT isn't specified to do anything nice with pprint logical blocks, and it's hard to do anything nice without surprising the user, and (as pointed out by Antonio Martinez) it's specifically not supposed to do some of the whitespace stuff it was doing. So just ignore any pretty-streamness and do entirely physical output. tweaked ENCAPSULATE logic so that BACKTRACE reporting of TRACEd functions will be slightly less obscure: 1: (.... ) instead of 1: ("varargs entry for #'(LAMBDA (&REST SB!INT:ARG-LIST) ...)" ...) ruthlessly plundered CMU CL CVS and Gerd's emailed expertise for %NO-PRIMARY-METHOD .ARGS. code --- src/code/fdefinition.lisp | 6 +++--- src/code/parse-body.lisp | 9 +++++--- src/pcl/braid.lisp | 2 +- src/pcl/defcombin.lisp | 50 ++++++++++++++++++++++++--------------------- version.lisp-expr | 2 +- 5 files changed, 38 insertions(+), 31 deletions(-) diff --git a/src/code/fdefinition.lisp b/src/code/fdefinition.lisp index 5e1fab5..e4634f8 100644 --- a/src/code/fdefinition.lisp +++ b/src/code/fdefinition.lisp @@ -83,7 +83,7 @@ (type definition)) (:copier nil)) ;; This is definition's encapsulation type. The encapsulated - ;; definition is in the previous encapsulation-info element or + ;; definition is in the previous ENCAPSULATION-INFO element or ;; installed as the global definition of some function name. type ;; the previous, encapsulated definition. This used to be installed @@ -112,7 +112,7 @@ ;; an encapsulation that no longer exists. (let ((info (make-encapsulation-info type (fdefn-fun fdefn)))) (setf (fdefn-fun fdefn) - (lambda (&rest arg-list) + (named-lambda encapsulate (&rest arg-list) (declare (special arg-list)) (let ((basic-definition (encapsulation-info-definition info))) (declare (special basic-definition)) @@ -135,7 +135,7 @@ ;;; When removing an encapsulation, we must remember that ;;; encapsulating definitions close over a reference to the -;;; encapsulation-info that describes the encapsulating definition. +;;; ENCAPSULATION-INFO that describes the encapsulating definition. ;;; When you find an info with the target type, the previous info in ;;; the chain has the ensulating definition of that type. We take the ;;; encapsulated definition from the info with the target type, and we diff --git a/src/code/parse-body.lisp b/src/code/parse-body.lisp index f19db1c..616b16b 100644 --- a/src/code/parse-body.lisp +++ b/src/code/parse-body.lisp @@ -52,9 +52,12 @@ (if (consp x) (let ((name (car x))) (if (eq name 'declaim) - (progn (style-warn - "DECLAIM is met where DECLARE is expected.") - nil) + ;; technically legal, but rather unlikely to + ;; be what the user intended... + (progn + (style-warn + "DECLAIM where DECLARE was probably intended") + nil) (eq name 'declare)))))) (tagbody :again diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index ed010f8..1071e78 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -697,7 +697,7 @@ (setq *boot-state* 'braid) (defmethod no-applicable-method (generic-function &rest args) - (error "~@" generic-function args)) diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp index 897b644..7652ec8 100644 --- a/src/pcl/defcombin.lisp +++ b/src/pcl/defcombin.lisp @@ -161,29 +161,33 @@ `(,operator ,@(mapcar (lambda (m) `(call-method ,m ())) primary))))) (cond ((null primary) - ;; FIXME(?): NO-APPLICABLE-METHOD seems more appropriate - ;; here, but - ;; (1) discussion with CSR on #lisp reminded me that it's - ;; a vexed question whether we can validly call - ;; N-A-M when an :AROUND method exists (and the - ;; definition of NO-NEXT-METHOD seems to discourage - ;; us from calling NO-NEXT-METHOD directly in that - ;; case, since it's supposed to be called from a - ;; CALL-NEXT-METHOD form), and - ;; (2) a call to N-A-M would require &REST FUN-ARGS, and - ;; we don't seem to have FUN-ARGS here. - ;; I think ideally failures in short method combination - ;; would end up either in NO-APPLICABLE-METHOD or - ;; NO-NEXT-METHOD, and I expect that's what ANSI - ;; generally intended, but it's not clear to me whether - ;; the details of what they actually specified let us - ;; make that happen. So for now I've just tried to - ;; clarify the error message text but left the general - ;; logic alone (and raised the question on sbcl-devel). - ;; -- WHN 2003-06-16 - `(error "no ~S methods for ~S on these arguments" - ',type - ',generic-function)) + ;; As of sbcl-0.8.0.80 we don't seem to need to need + ;; to do anything messy like + ;; `(APPLY (FUNCTION (IF AROUND + ;; 'NO-PRIMARY-METHOD + ;; 'NO-APPLICABLE-METHOD) + ;; ',GENERIC-FUNCTION + ;; .ARGS.) + ;; here because (for reasons I don't understand at the + ;; moment -- WHN) control will never reach here if there + ;; are no applicable methods, but instead end up + ;; in NO-APPLICABLE-METHODS first. + ;; + ;; FIXME: The way that we arrange for .ARGS. to be bound + ;; here seems weird. We rely on EXPAND-EFFECTIVE-METHOD-FUNCTION + ;; recognizing any form whose operator is %NO-PRIMARY-METHOD + ;; as magical, and carefully surrounding it with a + ;; LAMBDA form which binds .ARGS. But... + ;; 1. That seems fragile, because the magicalness of + ;; %NO-PRIMARY-METHOD forms is scattered around + ;; the system. So it could easily be broken by + ;; locally-plausible maintenance changes like, + ;; e.g., using the APPLY expression above. + ;; 2. That seems buggy w.r.t. to MOPpish tricks in + ;; user code, e.g. + ;; (DEFMETHOD COMPUTE-EFFECTIVE-METHOD :AROUND (...) + ;; `(PROGN ,(CALL-NEXT-METHOD) (INCF *MY-CTR*))) + `(%no-primary-method ',generic-function .args.)) ((null around) main-method) (t `(call-method ,(car around) diff --git a/version.lisp-expr b/version.lisp-expr index e9d670e..4cd7d09 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.0.79" +"0.8.0.80" -- 1.7.10.4