From: William Harold Newman Date: Sun, 11 Feb 2001 23:11:36 +0000 (+0000) Subject: 0.6.10.15: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1d941f3d8f343f5779526b66b2358b4893a17281;p=sbcl.git 0.6.10.15: MNA patches from sbcl-devel e-mail 2001-02-10: Make %DEFUN update INFO better, and (originally due to Paolo Amoroso on cmucl-imp) clean up debugger restarts. also degraded FTYPE mismatch to a STYLE-WARNING instead of a full WARNING --- diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 26caa7b..5005b32 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -1078,20 +1078,20 @@ argument") ;;; ;;; Two commands are made for each restart: one for the number, and ;;; one for the restart name (unless it's been shadowed by an earlier -;;; restart of the same name). +;;; restart of the same name, or it is NIL). (defun make-restart-commands (&optional (restarts *debug-restarts*)) (let ((commands) (num 0)) ; better be the same as show-restarts! (dolist (restart restarts) (let ((name (string (restart-name restart)))) - (unless (find name commands :key #'car :test #'string=) - (let ((restart-fun - #'(lambda () - (invoke-restart-interactively restart)))) - (push (cons name restart-fun) commands) - (push (cons (format nil "~D" num) restart-fun) commands)))) - (incf num)) - commands)) + (let ((restart-fun + #'(lambda () (invoke-restart-interactively restart)))) + (push (cons (format nil "~d" num) restart-fun) commands) + (unless (or (null (restart-name restart)) + (find name commands :key #'car :test #'string=)) + (push (cons name restart-fun) commands)))) + (incf num)) + commands)) ;;;; frame-changing commands @@ -1592,7 +1592,7 @@ argument") (if function (describe function) (format t "can't figure out the function for this frame")))) - + < ;;;; debug loop command utilities (defun read-prompting-maybe (prompt &optional (in *standard-input*) diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 00ca92d..69c3e9a 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -190,6 +190,16 @@ (defun sb!c::%defun (name def doc source) (declare (ignore source)) (setf (sb!eval:interpreted-function-name def) name) + (ecase (info :function :where-from name) + (:assumed + (setf (info :function :where-from name) :defined) + (setf (info :function :type name) + (extract-function-type def)) + (when (info :function :assumed-type name) + (setf (info :function :assumed-type name) nil))) + (:declared) + (:defined + (setf (info :function :type name) (extract-function-type def)))) (sb!c::%%defun name def doc)) ;;;; DEFVAR and DEFPARAMETER diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index b9bd2c4..f094849 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -11,6 +11,11 @@ ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. +;;;; FIXME: This is a poor name for this file, since CTYPE is the name +;;;; of the type used internally to represent Lisp types. It'd +;;;; probably be good to rename this file to "call-type.lisp" or +;;;; "ir1-type.lisp" or something. + (in-package "SB!C") ;;; These are the functions that are to be called when a problem is @@ -18,6 +23,15 @@ ;;; anything. The error function is called when something is ;;; definitely incorrect. The warning function is called when it is ;;; somehow impossible to tell whether the call is correct. +;;; +;;; FIXME: *ERROR-FUNCTION* and *WARNING-FUNCTION* are now misnomers. +;;; As per the KLUDGE note below, what the Python compiler +;;; considered a "definite incompatibility" could easily be conforming +;;; ANSI Common Lisp (if the incompatibility is across a compilation +;;; unit boundary, and we don't keep track of whether it is..), so we +;;; have to just report STYLE-WARNINGs instead of ERRORs or full +;;; WARNINGs; and unlike CMU CL, we don't use the condition system +;;; at all when we're reporting notes. (defvar *error-function*) (defvar *warning-function*) @@ -30,12 +44,22 @@ (declaim (type (or function null) *error-function* *warning-function *test-function*)) -;;; *LOSSAGE-DETECTED* is set when a definite incompatibility is +;;; *LOSSAGE-DETECTED* is set when a "definite incompatibility" is ;;; detected. *SLIME-DETECTED* is set when we can't tell whether the ;;; call is compatible or not. +;;; +;;; KLUDGE: Common Lisp is a dynamic language, even if CMU CL was not. +;;; As far as I can see, none of the "definite incompatibilities" +;;; detected in this file are actually definite under the ANSI spec. +;;; They would be incompatibilites if the use were within the same +;;; compilation unit as the contradictory definition (as per the spec +;;; section "3.2.2.3 Semantic Constraints") but the old Python code +;;; doesn't keep track of whether that's the case. So until/unless we +;;; upgrade the code to keep track of that, we have to handle all +;;; these as STYLE-WARNINGs. -- WHN 2001-02-10 (defvar *lossage-detected*) (defvar *slime-detected*) -;;; FIXME: SLIME is vivid and concise, but "DEFINITE-CALL-LOSSAGE" and +;;; FIXME: "SLIME" is vivid and concise, but "DEFINITE-CALL-LOSSAGE" and ;;; "POSSIBLE-CALL-LOSSAGE" would be more mnemonic. ;;; Signal a warning if appropriate and set *LOSSAGE-DETECTED*. @@ -59,7 +83,7 @@ ;;;; function type inference and declarations. ;;; A dummy version of SUBTYPEP useful when we want a functional like -;;; subtypep that always returns true. +;;; SUBTYPEP that always returns true. (defun always-subtypep (type1 type2) (declare (ignore type1 type2)) (values t t)) @@ -70,20 +94,20 @@ ;;; NIL, T: the call is definitely invalid. ;;; NIL, NIL: unable to determine whether the call is valid. ;;; -;;; The Argument-Test function is used to determine whether an +;;; The ARGUMENT-TEST function is used to determine whether an ;;; argument type matches the type we are checking against. Similarly, -;;; the Result-Test is used to determine whether the result type +;;; the RESULT-TEST is used to determine whether the result type ;;; matches the specified result. ;;; ;;; Unlike the argument test, the result test may be called on values -;;; or function types. If Strict-Result is true and safety is -;;; non-zero, then the Node-Derived-Type is always used. Otherwise, if -;;; Cont's Type-Check is true, then the Node-Derived-Type is -;;; intersected with the Cont's Asserted-Type. +;;; or function types. If STRICT-RESULT is true and SAFETY is +;;; non-zero, then the NODE-DERIVED-TYPE is always used. Otherwise, if +;;; CONT's TYPE-CHECK is true, then the NODE-DERIVED-TYPE is +;;; intersected with the CONT's ASSERTED-TYPE. ;;; ;;; The error and warning functions are functions that are called to -;;; explain the result. We bind *compiler-error-context* to the -;;; combination node so that Compiler-Warning and related functions +;;; explain the result. We bind *COMPILER-ERROR-CONTEXT* to the +;;; combination node so that COMPILER-WARNING and related functions ;;; will do the right thing if they are supplied. (defun valid-function-use (call type &key ((:argument-test *test-function*) #'csubtypep) @@ -157,8 +181,8 @@ (*slime-detected* (values nil nil)) (t (values t t))))) -;;; Check that the derived type of the continuation Cont is compatible -;;; with Type. N is the arg number, for error message purposes. We +;;; Check that the derived type of the continuation CONT is compatible +;;; with TYPE. N is the arg number, for error message purposes. We ;;; return true if arg is definitely o.k. If the type is a magic ;;; CONSTANT-TYPE, then we check for the argument being a constant ;;; value of the specified type. If there is a manifest type error @@ -325,9 +349,9 @@ ;; :allow-other-keys. (allowp nil :type (member t nil))) -;;; Return an Approximate-Function-Type representing the context of -;;; Call. If Type is supplied and not null, then we merge the -;;; information into the information already accumulated in Type. +;;; Return an APPROXIMATE-FUNCTION-TYPE representing the context of +;;; CALL. If TYPE is supplied and not null, then we merge the +;;; information into the information already accumulated in TYPE. (declaim (ftype (function (combination &optional (or approximate-function-type null)) approximate-function-type) @@ -391,15 +415,16 @@ :types (list val-type)))))))))))) type)) -;;; Similar to Valid-Function-Use, but checks an -;;; Approximate-Function-Type against a real function type. +;;; This is similar to VALID-FUNCTION-USE, but checks an +;;; APPROXIMATE-FUNCTION-TYPE against a real function type. (declaim (ftype (function (approximate-function-type function-type &optional function function function) (values boolean boolean)) valid-approximate-type)) (defun valid-approximate-type (call-type type &optional (*test-function* #'types-intersect) - (*error-function* #'compiler-warning) + (*error-function* + #'compiler-style-warning) (*warning-function* #'compiler-note)) (let* ((*lossage-detected* nil) (*slime-detected* nil) @@ -416,19 +441,21 @@ (let ((call-min (approximate-function-type-min-args call-type))) (when (< call-min min-args) (note-lossage - "Function previously called with ~R argument~:P, but wants at least ~R." + "~:@" call-min min-args))) (let ((call-max (approximate-function-type-max-args call-type))) (cond ((<= call-max max-args)) ((not (or keyp rest)) (note-lossage - "Function previously called with ~R argument~:P, but wants at most ~R." + "~:@" call-max max-args)) ((and keyp (oddp (- call-max max-args))) (note-lossage - "Function previously called with an odd number of arguments in ~ - the keyword portion."))) + "~:@"))) (when (and keyp (> call-max max-args)) (check-approximate-keywords call-type max-args type))) @@ -455,7 +482,7 @@ (check-approximate-arg-type (car types) decl-type "~:R" n))) (values)) -;;; Check that each of the call-types is compatible with Decl-Type, +;;; Check that each of the call-types is compatible with DECL-TYPE, ;;; complaining if not or if we can't tell. (declaim (ftype (function (list ctype string &rest t) (values)) check-approximate-arg-type)) @@ -479,7 +506,7 @@ ;;; argument position. Check the validity of all keys that appeared in ;;; valid keyword positions. ;;; -;;; ### We could check the Approximate-Function-Type-Types to make +;;; ### We could check the APPROXIMATE-FUNCTION-TYPE-TYPES to make ;;; sure that all arguments in keyword positions were manifest ;;; keywords. (defun check-approximate-keywords (call-type max-args type) @@ -510,7 +537,7 @@ ;;;; ASSERT-DEFINITION-TYPE -;;; Intersect Lambda's var types with Types, giving a warning if there +;;; Intersect LAMBDA's var types with TYPES, giving a warning if there ;;; is a mismatch. If all intersections are non-null, we return lists ;;; of the variables and intersections, otherwise we return NIL, NIL. (defun try-type-intersections (vars types where) @@ -639,7 +666,7 @@ (when info (arg-info-keyword info))))) (note-lossage - "Definition lacks the ~S keyword present in ~A." + "The definition lacks the ~S keyword present in ~A." (key-info-name key) where)))) (try-type-intersections (vars) (res) where)))) @@ -651,7 +678,7 @@ (flet ((frob (x what) (when x (note-lossage - "Definition has no ~A, but the ~A did." + "The definition has no ~A, but the ~A did." what where)))) (frob (function-type-optional type) "optional args") (frob (function-type-keyp type) "keyword args") @@ -661,26 +688,27 @@ (req (function-type-required type)) (nreq (length req))) (unless (= nvars nreq) - (note-lossage "Definition has ~R arg~:P, but the ~A has ~R." + (note-lossage "The definition has ~R arg~:P, but the ~A has ~R." nvars where nreq)) (if *lossage-detected* (values nil nil) (try-type-intersections vars req where)))) ;;; Check for syntactic and type conformance between the definition -;;; Functional and the specified Function-Type. If they are compatible -;;; and Really-Assert is T, then add type assertions to the definition -;;; from the Function-Type. +;;; FUNCTIONAL and the specified FUNCTION-TYPE. If they are compatible +;;; and REALLY-ASSERT is T, then add type assertions to the definition +;;; from the FUNCTION-TYPE. ;;; ;;; If there is a syntactic or type problem, then we call -;;; Error-Function with an error message using Where as context -;;; describing where Function-Type came from. +;;; ERROR-FUNCTION with an error message using WHERE as context +;;; describing where FUNCTION-TYPE came from. ;;; -;;; If there is no problem, we return T (even if Really-Assert was +;;; If there is no problem, we return T (even if REALLY-ASSERT was ;;; false). If there was a problem, we return NIL. (defun assert-definition-type (functional type &key (really-assert t) - ((:error-function *error-function*) #'compiler-warning) + ((:error-function *error-function*) + #'compiler-style-warning) warning-function (where "previous declaration")) (declare (type functional functional) diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp index 98548ee..92548d9 100644 --- a/src/compiler/ir1final.lisp +++ b/src/compiler/ir1final.lisp @@ -65,9 +65,7 @@ (let* ((where (info :function :where-from name)) (*compiler-error-context* (lambda-bind (main-entry leaf))) (global-def (gethash name *free-functions*)) - (global-p - (and (defined-function-p global-def) - (eq (defined-function-functional global-def) leaf)))) + (global-p (defined-function-p global-def))) (note-name-defined name :function) (when global-p (remhash name *free-functions*)) @@ -81,8 +79,8 @@ (setf (info :function :where-from name) :defined)) (:declared); Just keep declared type. (:defined - (when global-p - (setf (info :function :type name) dtype))))))) + (when global-p + (setf (info :function :type name) dtype))))))) (values)) ;;; Find all calls in Component to assumed functions and update the assumed diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 3c99417..9c853d1 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -841,7 +841,23 @@ ((valid-function-use call type :argument-test #'always-subtypep :result-test #'always-subtypep - :error-function #'compiler-warning + ;; KLUDGE: Common Lisp is such a dynamic + ;; language that all we can do here in + ;; general is issue a STYLE-WARNING. It + ;; would be nice to issue a full WARNING + ;; in the special case of of type + ;; mismatches within a compilation unit + ;; (as in section 3.2.2.3 of the spec) + ;; but at least as of sbcl-0.6.11, we + ;; don't keep track of whether the + ;; mismatched data came from the same + ;; compilation unit, so we can't do that. + ;; -- WHN 2001-02-11 + ;; + ;; FIXME: Actually, I think we could + ;; issue a full WARNING if the call + ;; violates a DECLAIM FTYPE. + :error-function #'compiler-style-warning :warning-function #'compiler-note) (assert-call-type call type) (maybe-terminate-block call ir1-p) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 70d4cec..268afc5 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -3083,7 +3083,7 @@ ;;; Check a new global function definition for consistency with ;;; previous declaration or definition, and assert argument/result -;;; types if appropriate. This this assertion is suppressed by the +;;; types if appropriate. This assertion is suppressed by the ;;; EXPLICIT-CHECK attribute, which is specified on functions that ;;; check their argument types as a consequence of type dispatching. ;;; This avoids redundant checks such as NUMBERP on the args to +, @@ -3094,8 +3094,18 @@ (info (info :function :info (leaf-name var)))) (assert-definition-type fun type - :error-function #'compiler-warning - :warning-function (cond (info #'compiler-warning) + ;; KLUDGE: Common Lisp is such a dynamic language that in general + ;; all we can do here in general is issue a STYLE-WARNING. It + ;; would be nice to issue a full WARNING in the special case of + ;; of type mismatches within a compilation unit (as in section + ;; 3.2.2.3 of the spec) but at least as of sbcl-0.6.11, we don't + ;; keep track of whether the mismatched data came from the same + ;; compilation unit, so we can't do that. -- WHN 2001-02-11 + ;; + ;; FIXME: Actually, I think we could issue a full WARNING if the + ;; new definition contradicts a DECLAIM FTYPE. + :error-function #'compiler-style-warning + :warning-function (cond (info #'compiler-style-warning) (for-real #'compiler-note) (t nil)) :really-assert diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 14e699c..ed6f948 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -418,6 +418,12 @@ ;; but as long as we continue to use that policy, that's the ;; not our biggest problem.:-| When we fix that policy, this ;; should come back into compliance. (So fix that policy!) + ;; ..but.. + ;; FIXME, continued: Except that section "3.2.2.3 Semantic + ;; Constraints" says that if it's within the same file, it's + ;; wrong. And we're in locall.lisp here, so it's probably + ;; (haven't checked this..) a call to something in the same + ;; file. So maybe it deserves a full warning anyway. (compiler-warning "function called with ~R argument~:P, but wants exactly ~R" call-args nargs) @@ -436,17 +442,8 @@ (max-args (optional-dispatch-max-args fun)) (call-args (length (combination-args call)))) (cond ((< call-args min-args) - ;; FIXME: ANSI requires in "3.2.5 Exceptional Situations in the - ;; Compiler" that calling a function with "the wrong number of - ;; arguments" be only a STYLE-ERROR. I think, though, that this - ;; should only apply when the number of arguments is inferred - ;; from a previous definition. If the number of arguments - ;; is DECLAIMed, surely calling with the wrong number is a - ;; real WARNING. As long as SBCL continues to use CMU CL's - ;; non-ANSI DEFUN-is-a-DECLAIM policy, we're in violation here, - ;; but as long as we continue to use that policy, that's the - ;; not our biggest problem.:-| When we fix that policy, this - ;; should come back into compliance. (So fix that policy!) + ;; FIXME: See FIXME note at the previous + ;; wrong-number-of-arguments warnings in this file. (compiler-warning "function called with ~R argument~:P, but wants at least ~R" call-args min-args) @@ -458,17 +455,8 @@ ((optional-dispatch-more-entry fun) (convert-more-call ref call fun)) (t - ;; FIXME: ANSI requires in "3.2.5 Exceptional Situations in the - ;; Compiler" that calling a function with "the wrong number of - ;; arguments" be only a STYLE-ERROR. I think, though, that this - ;; should only apply when the number of arguments is inferred - ;; from a previous definition. If the number of arguments - ;; is DECLAIMed, surely calling with the wrong number is a - ;; real WARNING. As long as SBCL continues to use CMU CL's - ;; non-ANSI DEFUN-is-a-DECLAIM policy, we're in violation here, - ;; but as long as we continue to use that policy, that's the - ;; not our biggest problem.:-| When we fix that policy, this - ;; should come back into compliance. (So fix that policy!) + ;; FIXME: See FIXME note at the previous + ;; wrong-number-of-arguments warnings in this file. (compiler-warning "function called with ~R argument~:P, but wants at most ~R" call-args max-args) diff --git a/tests/info.impure.lisp b/tests/info.impure.lisp new file mode 100644 index 0000000..8376d67 --- /dev/null +++ b/tests/info.impure.lisp @@ -0,0 +1,48 @@ +;;;; tests of the INFO/globaldb system +;;;; +;;;; KLUDGE: Unlike most of the system's tests, these are not in the +;;;; problem domain, but in the implementation domain, so modification +;;;; of the system could cause these tests to fail even if the system +;;;; was still a correct implementation of ANSI Common Lisp + SBCL +;;;; extensions. Perhaps such tests should be separate from tests in +;;;; the problem domain. -- WHN 2001-02-11 + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(in-package :cl-user) + +(defun foo (a) (list a)) +(let ((x 1)) (foo x)) + +(assert (eq (sb-int:info :function :where-from 'foo) + :defined)) + +(defun foo (a b) (list a b)) +(let ((x 1)) (foo x 2)) + +(flet ((foo (a b c) + (list a b c))) + (foo 1 2 3)) + +;;; FIXME: This one is commented out since it doesn't work when +;;; the DEFUN is just LOADed instead of COMPILE-FILEd, and it's +;;; not immediately obvious what's the best way to set up +;;; the COMPILE-FILE test. +#| +(assert + (equal + (format nil "~A" (sb-int:info :function :type 'foo)) + "#")) +|# + +;;; success +(quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 28fb7e2..2c75b03 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.14" +"0.6.10.15"