From fe4f3352533b34af0c171a078a459d3c879155d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Melis?= Date: Wed, 19 Jul 2023 19:15:44 +0100 Subject: [PATCH] fewer warnings --- dref/src/base/extension-api.lisp | 3 ++- dref/src/full/swank-util.lisp | 3 ++- src/asdf.lisp | 3 ++- src/bootstrap/basics.lisp | 4 ++-- src/document/document.lisp | 4 +++- src/document/hyperspec.lisp | 3 +-- src/document/markdown.lisp | 34 +++++++++++++++++--------------- src/navigate/locatives.lisp | 17 +++++++--------- src/web/web.lisp | 1 + 9 files changed, 38 insertions(+), 34 deletions(-) diff --git a/dref/src/base/extension-api.lisp b/dref/src/base/extension-api.lisp index bb3d2156..7d631c6a 100644 --- a/dref/src/base/extension-api.lisp +++ b/dref/src/base/extension-api.lisp @@ -257,12 +257,13 @@ types. This function is for extending LOCATE. Do not call it directly.") (:method :around (name locative-type locative-args) + (declare (ignorable name locative-type locative-args)) (let ((located (call-next-method))) (assert (or (not (typep located 'xref)) (typep located 'dref))) located)) (:method (name locative-type locative-args) - (declare (ignore name locative-type locative-args)) + (declare (ignorable name locative-type locative-args)) (locate-error))) (defvar *resolving-dref*) diff --git a/dref/src/full/swank-util.lisp b/dref/src/full/swank-util.lisp index b6f6a531..4152dc22 100644 --- a/dref/src/full/swank-util.lisp +++ b/dref/src/full/swank-util.lisp @@ -188,7 +188,7 @@ (first dspec-forms) (progn (format *error-output* "!!! No definition for ~S." name) - `'(,(gensym "NOTIMPLEMENTED")))))))) + `'(,(gensym "NOTIMPLEMENTED") ,name))))))) #-(or allegro ecl) (defun normalize-dspec (dspec) @@ -327,6 +327,7 @@ (:or :ccl :cmucl) `(class ,name)) (define-dspec swank-package-dspec (name) + (:or :abcl :allegro :ecl :cmucl) `(:no-such-dspec ,name) :ccl `(package ,name) :sbcl `(defpackage ,name)) diff --git a/src/asdf.lisp b/src/asdf.lisp index 62a167a6..176a3360 100644 --- a/src/asdf.lisp +++ b/src/asdf.lisp @@ -22,7 +22,8 @@ (funcall continuation))) (defun compile-without-some-warnings (continuation) - (let (#+allegro (compiler:*cltl1-compile-file-toplevel-compatibility-p* nil)) + (let (#+allegro (compiler:*cltl1-compile-file-toplevel-compatibility-p* nil) + #+allegro (excl:*redefinition-warnings* nil)) (funcall continuation))) (defun compile-pax (continuation) diff --git a/src/bootstrap/basics.lisp b/src/bootstrap/basics.lisp index 9b35bb14..65b9fb7b 100644 --- a/src/bootstrap/basics.lisp +++ b/src/bootstrap/basics.lisp @@ -191,13 +191,13 @@ (defmethod exportable-reference-p (package symbol (locative-type (eql 'section)) locative-args) - (declare (ignore symbol locative-args)) + (declare (ignore package symbol locative-args)) nil) (defmethod exportable-reference-p (package symbol (locative-type (eql 'glossary-term)) locative-args) - (declare (ignore symbol locative-args)) + (declare (ignore package symbol locative-args)) nil) (defgeneric exportable-locative-type-p (locative-type) diff --git a/src/document/document.lisp b/src/document/document.lisp index 95ef343e..0c664c1f 100644 --- a/src/document/document.lisp +++ b/src/document/document.lisp @@ -1014,6 +1014,7 @@ (defgeneric document-object (object stream) (:method :around (object stream) + (declare (ignorable stream)) (let ((*objects-being-documented* (cons object *objects-being-documented*))) (call-next-method))) (:method (object stream) @@ -2251,7 +2252,8 @@ (defgeneric title (object) (:method (object) - nil) + (declare (ignore object)) + nil) (:method ((section section)) (values (section-title section) t)) (:method ((glossary-term glossary-term)) diff --git a/src/document/hyperspec.lisp b/src/document/hyperspec.lisp index fb3b2dfa..67284e2d 100644 --- a/src/document/hyperspec.lisp +++ b/src/document/hyperspec.lisp @@ -1117,8 +1117,7 @@ obj)) (defun hyperspec-locatives-for-name (name) - (loop for (locative filename) - in (gethash name *hyperspec-name-to-locatives*) + (loop for (locative *) in (gethash name *hyperspec-name-to-locatives*) collect locative)) diff --git a/src/document/markdown.lisp b/src/document/markdown.lisp index 95409f72..7491ef9d 100644 --- a/src/document/markdown.lisp +++ b/src/document/markdown.lisp @@ -214,22 +214,24 @@ ;;; of new tree (which must be a LIST) are added. No slice is like ;;; MAPCAR, slice is is MAPCAN. (defun transform-tree (fn tree) - (labels ((foo (parent tree) - (multiple-value-bind (new-tree recurse slice) - (funcall fn parent tree) - (assert (or (not slice) (listp new-tree))) - (if (or (atom new-tree) - (not recurse)) - (values new-tree slice) - (values (loop for sub-tree in new-tree - append (multiple-value-bind - (new-sub-tree slice) - (foo new-tree sub-tree) - (if slice - new-sub-tree - (list new-sub-tree)))) - slice))))) - (foo nil tree))) + (declare (optimize speed)) + (let ((fn (coerce fn 'function))) + (labels ((foo (parent tree) + (multiple-value-bind (new-tree recurse slice) + (funcall fn parent tree) + (assert (or (not slice) (listp new-tree))) + (if (or (atom new-tree) + (not recurse)) + (values new-tree slice) + (values (loop for sub-tree in new-tree + nconc (multiple-value-bind + (new-sub-tree slice) + (foo new-tree sub-tree) + (if slice + (copy-list new-sub-tree) + (list new-sub-tree)))) + slice))))) + (foo nil tree)))) ;;; When used as the FN argument to TRANSFORM-TREE, leave the tree ;;; intact except for subtrees (lists) whose CAR is in TAGS, whose diff --git a/src/navigate/locatives.lisp b/src/navigate/locatives.lisp index 973b0287..97e35146 100644 --- a/src/navigate/locatives.lisp +++ b/src/navigate/locatives.lisp @@ -51,7 +51,6 @@ (add-dref-actualizer 'actualize-variable-to-section) (defmethod docstring* ((dref section-dref)) - (declare (ignore dref)) nil) @@ -149,6 +148,7 @@ :target-dref go-dref)))) (defmethod map-definitions (name (locative-type (eql 'go))) + (declare (ignorable name)) ;; There are no real GO definitions. (values)) @@ -177,9 +177,8 @@ DISLOCATED references do not RESOLVE.") -(defmethod dref* (symbol (locative-type (eql 'dislocated)) - locative-args) - (declare (ignore symbol locative-args)) +(defmethod dref* (symbol (locative-type (eql 'dislocated)) locative-args) + (declare (ignorable symbol locative-args)) (locate-error "~S can never be located." 'dislocated)) @@ -204,9 +203,8 @@ ARGUMENT references do not RESOLVE.""") -(defmethod dref* (symbol (locative-type (eql 'argument)) - locative-args) - (declare (ignore symbol locative-args)) +(defmethod dref* (symbol (locative-type (eql 'argument)) locative-args) + (declare (ignorable symbol locative-args)) (locate-error "~S can never be located." 'argument)) @@ -217,9 +215,8 @@ There is no way to LOCATE DOCSTRINGs, so nothing to RESOLVE either.") -(defmethod dref* (symbol (locative-type (eql 'docstring)) - locative-args) - (declare (ignore symbol locative-args)) +(defmethod dref* (symbol (locative-type (eql 'docstring)) locative-args) + (declare (ignorable symbol locative-args)) (locate-error "DOCSTRING can never be located.")) diff --git a/src/web/web.lisp b/src/web/web.lisp index 7fa5f271..e66da2d0 100644 --- a/src/web/web.lisp +++ b/src/web/web.lisp @@ -159,6 +159,7 @@ (defmethod hunchentoot:acceptor-dispatch-request :around ((acceptor (eql *server*)) request) + (declare (ignorable request)) (let ((hunchentoot:*dispatch-table* (append *dispatch-table* *hyperspec-dispatch-table*)) (*document-hyperspec-root*