Re: [Sbcl-devel] [Sbcl-commits] master: Better printing of lambda lists via new function PRINT-LAMBDA-LIST
20 views
Skip to first unread message
Douglas Katzman via Sbcl-devel
Mar 20, 2021, 12:09:44 AM3/20/21
to Jan Moringen, SBCL Devel-list
This change breaks package-renaming transparency with lots of non-pre-tokenized strings, so after sb-impl is renamed to host-sb-impl in self-build, any host format-control strings will fail. Example:
Found string "New lambda-list ~/sb-impl:print-lambda-list/ is ~
incompatible with existing methods of ~S.~%~
Old lambda-list ~/sb-impl:print-lambda-list/"
I thought we had a regression test for this, but it looks like it's just a warning that is printed which tells you what to fix:
WARNING: Potential problem with format-control strings.
Please check that all strings which were not recognizable to the compiler
(as the first argument to WARN, etc.) are wrapped in SB-FORMAT:TOKENS
On Fri, Mar 19, 2021 at 4:38 PM Jan Moringen via Sbcl-commits <sbcl-c...@lists.sourceforge.net> wrote:
The branch "master" has been updated in SBCL:
via b922d2477452a894aaca66cd6630b77716183cd4 (commit)
from ac6384a6ba2397e32817206719bec6589c438c9e (commit)
- Log -----------------------------------------------------------------
commit b922d2477452a894aaca66cd6630b77716183cd4
Author: Jan Moringen <jmor...@techfak.uni-bielefeld.de>
Date: Fri Mar 19 21:19:24 2021 +0100
Better printing of lambda lists via new function PRINT-LAMBDA-LIST
Previously, lambda list were sometimes printed confusingly by DESCRIBE
et al., e.g.:
(function collection) => #'COLLECTION
See c1b03a36ec4439c8ada7a7ab01fe9f16d26597aa.
---
package-data-list.lisp-expr | 1 +
src/code/describe.lisp | 9 ++++++---
src/code/early-extensions.lisp | 6 ++++++
src/code/early-type.lisp | 3 ++-
src/code/full-eval.lisp | 12 ++++++++----
src/code/parse-defmacro-errors.lisp | 2 +-
src/compiler/parse-lambda-list.lisp | 37 +++++++++++++++++++++++++------------
src/pcl/boot.lisp | 9 +++++----
tests/compiler.impure.lisp | 13 +++++++++++++
9 files changed, 67 insertions(+), 25 deletions(-)
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 290ef7e98..d1d6231da 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -649,6 +649,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
:import-from (("SB-KERNEL" "*PACKAGE-NAMES*"))
:export ("FORMAT-MICROSECONDS" "FORMAT-MILLISECONDS" ; for ~/fmt/
"PRINT-TYPE" "PRINT-TYPE-SPECIFIER"
+ "PRINT-LAMBDA-LIST"
;; protect from tree shaker so we can test this function
"EXPAND-SYMBOL-CASE"
;; symbols used by sb-simple-streams
diff --git a/src/code/describe.lisp b/src/code/describe.lisp
index db96ba9b8..ec14c35d2 100644
--- a/src/code/describe.lisp
+++ b/src/code/describe.lisp
@@ -539,13 +539,15 @@
(let ((*print-circle* nil)
(*print-level* 24)
(*print-length* 100))
- (format stream "~@:_Lambda-list: ~:S" lambda-list)))
+ (format stream "~@:_Lambda-list: ~/sb-impl:print-lambda-list/" lambda-list)))
(defun describe-argument-precedence-order (argument-list stream)
(let ((*print-circle* nil)
(*print-level* 24)
(*print-length* 100))
- (format stream "~@:_Argument precedence order: ~:A" argument-list)))
+ (format stream "~@:_Argument precedence order: ~
+ ~/sb-impl:print-lambda-list/"
+ argument-list)))
(defun describe-function-source (function stream)
(declare (function function))
@@ -683,7 +685,8 @@
(format stream "Methods:")
(dolist (method methods)
(pprint-indent :block 2 stream)
- (format stream "~@:_(~A ~{~S ~}~:S)"
+ (format stream "~@:_(~A ~{~S ~}~
+ ~/sb-impl:print-lambda-list/)"
name
(method-qualifiers method)
(sb-pcl::unparse-specializers
diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 10ae7acb8..9306e925b 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -1040,6 +1040,12 @@ NOTE: This interface is experimental and subject to change."
(defun print-type (stream type &optional colon at)
(print-type-specifier stream (type-specifier type) colon at)))
+(defun print-lambda-list (stream lambda-list &optional colon at)
+ (declare (ignore colon at))
+ (let ((sb-pretty:*pprint-quote-with-syntactic-sugar* nil)
+ (*package* *cl-package*))
+ (format stream "~:A" lambda-list)))
+
;;;; Deprecating stuff
diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index 0decb6912..8b7e02819 100644
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -154,7 +154,8 @@
(error "Keyword type description is not a two-list: ~S." key))
(let ((kwd (first key)))
(when (find kwd (key-info) :key #'key-info-name)
- (error "~@<repeated keyword ~S in lambda list: ~2I~_~S~:>"
+ (error "~@<repeated keyword ~S in lambda list: ~2I~_~
+ ~/sb-impl:print-lambda-list/~:>"
kwd lambda-listy-thing))
(key-info
(make-key-info
diff --git a/src/code/full-eval.lisp b/src/code/full-eval.lisp
index 119f1a7fe..7e1582bef 100644
--- a/src/code/full-eval.lisp
+++ b/src/code/full-eval.lisp
@@ -323,14 +323,17 @@
(let*-like-bindings nil))
(cond
((< arguments-present required-length)
- (ip-error "~@<Too few arguments in ~S to satisfy lambda list ~S.~:@>"
+ (ip-error "~@<Too few arguments in ~S to satisfy lambda list ~
+ ~/sb-impl:print-lambda-list/.~:@>"
arguments lambda-list))
((and (not (or rest-p keyword-p)) keywords-present-p)
- (ip-error "~@<Too many arguments in ~S to satisfy lambda list ~S.~:@>"
+ (ip-error "~@<Too many arguments in ~S to satisfy lambda list ~
+ ~/sb-impl:print-lambda-list/.~:@>"
arguments lambda-list))
((and keyword-p keywords-present-p
(oddp (- arguments-present non-keyword-arguments)))
- (ip-error "~@<Odd number of &KEY arguments in ~S for ~S.~:@>"
+ (ip-error "~@<Odd number of &KEY arguments in ~S for ~
+ /sb-impl:print-lambda-list/.~:@>"
arguments lambda-list)))
(dotimes (i required-length)
(push (cons (pop required) (pop arguments)) let-like-bindings))
@@ -356,7 +359,8 @@
(loop for (key value) on keyword-plist by #'cddr doing
(when (and (not (eq key :allow-other-keys))
(not (member key keyword :key #'keyword-key)))
- (ip-error "~@<Unknown &KEY argument ~S in ~S for ~S.~:@>"
+ (ip-error "~@<Unknown &KEY argument ~S in ~S for ~
+ ~/sb-impl:print-lambda-list/.~:@>"
key original-arguments lambda-list))))
(dolist (keyword-spec keyword)
(let ((supplied (getf keyword-plist (keyword-key keyword-spec)
diff --git a/src/code/parse-defmacro-errors.lisp b/src/code/parse-defmacro-errors.lisp
index 4d9dbb8c2..d6bea69da 100644
--- a/src/code/parse-defmacro-errors.lisp
+++ b/src/code/parse-defmacro-errors.lisp
@@ -56,7 +56,7 @@
(n-actual (if (proper-list-p actual) (length actual) nil)))
(format stream
"~A elements in ~2I~_~:S ~
- ~I~_to satisfy lambda list ~2I~_~:S: ~I~_"
+ ~I~_to satisfy lambda list ~2I~_~/sb-impl:print-lambda-list/: ~I~_"
(cond ((and n-actual (< n-actual min)) "too few")
((and n-actual max (> n-actual max)) "too many")
(t "invalid number of"))
diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp
index 80f4c1b1d..5bd810915 100644
--- a/src/compiler/parse-lambda-list.lisp
+++ b/src/compiler/parse-lambda-list.lisp
@@ -122,11 +122,14 @@
(member form lambda-list-keywords)
(report-suspicious kind form)))
(report-suspicious (kind what)
- (style-warn-once list "suspicious ~A ~S in lambda list: ~S."
+ (style-warn-once list "suspicious ~A ~S in lambda list: ~
+ ~/sb-impl:print-lambda-list/."
kind what list)
nil) ; Avoid "return convention is not fixed" optimizer note
(need-arg (state)
- (croak "expecting variable after ~A in: ~S" state list))
+ (croak "expecting variable after ~A in: ~
+ ~/sb-impl:print-lambda-list/"
+ state list))
(need-symbol (x why)
(unless (symbolp x)
(croak "~A is not a symbol: ~S" why x)))
@@ -179,7 +182,9 @@
(symbolp input))
(setf rest (list input)))
(t
- (croak "illegal dotted lambda list: ~S" list)))
+ (croak "illegal dotted lambda list: ~
+ ~/sb-impl:print-lambda-list/"
+ list)))
(return))
(shiftf last-arg arg (pop input))
@@ -220,7 +225,9 @@
(destructuring-bind "a destructuring lambda list")
(defmethod "a specialized lambda list")
(t context))))
- (croak "~A is not allowed in ~A: ~S" arg where list)))
+ (croak "~A is not allowed in ~A: ~
+ ~/sb-impl:print-lambda-list/"
+ arg where list)))
;; &ENVIRONMENT can't intercede between &KEY,&ALLOW-OTHER-KEYS.
;; For all other cases it's as if &ENVIRONMENT were never there.
@@ -235,9 +242,12 @@
;; a better thing can be said, e.g. &WHOLE must go to the front.
(cond ((logbitp to-state seen) ; Oops! Been here before.
(if (= rest-bits 3)
- (croak "~S and ~S are mutually exclusive: ~S"
+ (croak "~S and ~S are mutually exclusive: ~
+ ~/sb-impl:print-lambda-list/"
'&body '&rest list)
- (croak "repeated ~S in lambda list: ~S" arg list)))
+ (croak "repeated ~S in lambda list: ~
+ ~/sb-impl:print-lambda-list/"
+ arg list)))
((logbitp state from-states) ; valid transition
(setq state to-state
seen (logior seen (ash 1 state))
@@ -245,10 +255,10 @@
((logbitp state (bits &whole &rest &more &environment))
(need-arg last-arg)) ; Variable expected.
(t
- (croak (if (state= to-state &whole)
- "~A must appear first in a lambda list: ~S"
- "misplaced ~A in lambda list: ~S")
- arg list)))
+ (croak "~:[misplaced ~A in lambda list~;~
+ ~A must appear first in a lambda list~]:
+ ~/sb-impl:print-lambda-list/"
+ (state= to-state &whole) arg list)))
(go LOOP)))
;; Fell through, so warn if desired, and fall through some more.
(unless silent (report-suspicious "variable" arg)))
@@ -256,7 +266,9 @@
;; Handle a lambda variable
(when (logbitp state (bits &allow-other-keys ; Not a collecting state.
:post-env :post-rest :post-more))
- (croak "expected lambda list keyword at ~S in: ~S" arg list))
+ (croak "expected lambda list keyword at ~S in: ~
+ ~/sb-impl:print-lambda-list/"
+ arg list))
(let ((item (list arg)))
(setq tail (if tail (setf (cdr tail) item) (begin-list item))))
(when (logbitp state (bits &rest &more &whole &environment))
@@ -278,7 +290,8 @@
(style-warn-once
list
(make-condition '&optional-and-&key-in-lambda-list
- :format-control "&OPTIONAL and &KEY found in the same lambda list: ~S"
+ :format-control "&OPTIONAL and &KEY found in the same lambda list: ~
+ ~/sb-impl:print-lambda-list/"
:format-arguments (list list))))
;; For CONTEXT other than :VALUES-TYPE/:FUNCTION-TYPE we reject
diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 1d046008a..ed178ef32 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -401,7 +401,8 @@ bootstrapping.
;; incorrect use of defaults.
(labels ((lose (kind arg)
(generic-function-lambda-list-error
- "~@<Invalid ~A argument specifier ~S ~_in ~A ~:S~:>"
+ "~@<Invalid ~A argument specifier ~S ~_in ~A ~
+ ~/sb-impl:print-lambda-list/~:>"
kind arg context lambda-list))
(verify-optional (spec)
(when (nth-value 3 (parse-optional-arg-spec spec))
@@ -2086,9 +2087,9 @@ bootstrapping.
(= nopt gf-nopt)
(eq (ll-keyp-or-restp llks) gf-key/rest-p))
(restart-case
- (error "New lambda-list ~S is incompatible with ~
- existing methods of ~S.~%~
- Old lambda-list ~s"
+ (error "New lambda-list ~/sb-impl:print-lambda-list/ is ~
+ incompatible with existing methods of ~S.~%~
+ Old lambda-list ~/sb-impl:print-lambda-list/"
lambda-list gf (arg-info-lambda-list arg-info))
(continue ()
:report "Remove all methods."
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index bf28a0a48..3f9192841 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -2789,6 +2789,19 @@
((function (function *)) "(FUNCTION (FUNCTION *))")
((function (function (eql 1))) "(FUNCTION (FUNCTION (EQL 1))")))))
+(with-test (:name (:compiler-messages function :lambda-list))
+ ;; Previously, function lambda lists were sometimes printed
+ ;; confusingly, e.g.:
+ ;;
+ ;; (function collection) => #'COLLECTION
+ ;; ((function t)) => (#'T)
+ ;;
+ (handler-case
+ (sb-c::parse-lambda-list '((function t) . a) :context 'defmethod)
+ (error (condition)
+ (assert (search "illegal dotted lambda list: ((FUNCTION T) . A)"
+ (princ-to-string condition))))))
+
(with-test (:name :boxed-ref-setf-special
:skipped-on :interpreter)
(let* ((var (gensym))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
_______________________________________________
Sbcl-commits mailing list
Sbcl-c...@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
Jan Moringen
Mar 20, 2021, 8:03:46 AM3/20/21
to Douglas Katzman, SBCL Devel-list
Hi.
On Sat, 2021-03-20 at 00:08 -0400, Douglas Katzman via Sbcl-devel
wrote:
not sure I got everything right.
Sorry for the inconvenience,
Jan
_______________________________________________
Sbcl-devel mailing list
Sbcl-...@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-devel
On Sat, 2021-03-20 at 00:08 -0400, Douglas Katzman via Sbcl-devel
wrote:
> This change breaks package-renaming transparency with lots of
> non-pre-tokenized strings, so after sb-impl is renamed to host-sb-
> impl in
> self-build, any host format-control strings will fail. Example:
Thanks for the heads up. I pushed a fix, but I had to rush it, so I'm
> non-pre-tokenized strings, so after sb-impl is renamed to host-sb-
> impl in
> self-build, any host format-control strings will fail. Example:
not sure I got everything right.
Sorry for the inconvenience,
Jan
_______________________________________________
Sbcl-devel mailing list
Sbcl-...@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-devel
Reply all
Reply to author
Forward
0 new messages