From 7a2d30770bea40c8bd2a306f1d90acf8cd6a8726 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 23 Dec 2011 15:38:37 +0100 Subject: [PATCH] Add IGNORE declarations and remove some unused variables. --- contrib/bytecmp/bytecmp.lsp | 7 ++++--- src/clos/boot.lsp | 6 +++++- src/clos/builtin.lsp | 9 ++++++++- src/clos/change.lsp | 5 ++--- src/clos/combin.lsp | 5 ++--- src/clos/conditions.lsp | 1 - src/clos/fixup.lsp | 15 ++++++++++----- src/clos/generic.lsp | 5 ++++- src/clos/kernel.lsp | 1 + src/clos/method.lsp | 6 +++--- src/clos/print.lsp | 24 ++++++++++++++---------- src/clos/standard.lsp | 19 +++++++++++++------ src/clos/stdmethod.lsp | 2 ++ src/clos/streams.lsp | 22 +++++++++++++++++++++- src/cmp/cmpmac.lsp | 3 +-- src/cmp/cmptop.lsp | 4 ---- src/cmp/cmpwt.lsp | 2 +- src/h/external.h | 2 +- src/lsp/autoload.lsp | 2 ++ src/lsp/cmdline.lsp | 1 + src/lsp/defmacro.lsp | 6 ++++++ src/lsp/describe.lsp | 2 -- src/lsp/evalmacros.lsp | 1 + src/lsp/export.lsp | 3 +++ src/lsp/ffi.lsp | 1 + src/lsp/helpfile.lsp | 1 + src/lsp/mislib.lsp | 1 + src/lsp/mp.lsp | 2 +- src/lsp/packlib.lsp | 1 + src/lsp/pprint.lsp | 1 + src/lsp/predlib.lsp | 7 +++++-- src/lsp/seqlib.lsp | 4 +++- src/lsp/setf.lsp | 2 +- src/lsp/top.lsp | 11 +++++++---- 34 files changed, 127 insertions(+), 57 deletions(-) diff --git a/contrib/bytecmp/bytecmp.lsp b/contrib/bytecmp/bytecmp.lsp index 46b5e6f66..aa1cd692f 100644 --- a/contrib/bytecmp/bytecmp.lsp +++ b/contrib/bytecmp/bytecmp.lsp @@ -55,9 +55,10 @@ (setq form `(progn (setf (symbol-function ',name) #',form) ',name)))) (values (eval form) nil nil)) -(defun bc-compile-file-pathname (name &key (output-file name) (type :fasl type-supplied-p) - verbose print c-file h-file data-file shared-data-file - system-p load) +(defun bc-compile-file-pathname (name &key (output-file name) (type :fasl) + verbose print c-file h-file data-file + shared-data-file system-p load) + (declare (ignore load c-file h-file data-file shared-data-file system-p verbose print)) (let ((extension "fasc")) (case type ((:fasl :fas) (setf extension "fasc")) diff --git a/src/clos/boot.lsp b/src/clos/boot.lsp index 69b97de4d..654710563 100644 --- a/src/clos/boot.lsp +++ b/src/clos/boot.lsp @@ -219,12 +219,15 @@ (values (slot-unbound class self (slot-definition-name slotd)))))) (defmethod slot-boundp-using-class ((class class) self slotd) + (declare (ignore class)) (si::sl-boundp (standard-instance-get self slotd))) (defmethod (setf slot-value-using-class) (val (class class) self slotd) + (declare (ignore class)) (standard-instance-set val self slotd)) (defmethod slot-makunbound-using-class ((class class) instance slotd) + (declare (ignore class)) (ensure-up-to-date-instance instance) (let* ((location (slot-definition-location slotd))) (cond ((ext:fixnump location) @@ -244,10 +247,11 @@ (defmethod slot-missing ((class t) object slot-name operation &optional new-value) - (declare (ignore operation new-value)) + (declare (ignore operation new-value class)) (error "~A is not a slot of ~A" slot-name object)) (defmethod slot-unbound ((class t) object slot-name) + (declare (ignore class)) (error 'unbound-slot :instance object :name slot-name)) ;;; diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp index 3633c10b6..d042fa607 100644 --- a/src/clos/builtin.lsp +++ b/src/clos/builtin.lsp @@ -106,8 +106,10 @@ finally (si::*make-constant '+builtin-classes+ array)) (defmethod ensure-class-using-class ((class null) name &rest rest) + (declare (ignore class)) (multiple-value-bind (metaclass direct-superclasses options) (apply #'help-ensure-class rest) + (declare (ignore direct-superclasses)) (apply #'make-instance metaclass :name name options))) (defmethod change-class ((instance t) (new-class symbol) &rest initargs) @@ -121,18 +123,23 @@ (apply #'make-instance (find-class class-name) initargs)) (defmethod slot-makunbound-using-class ((class built-in-class) self slotd) + (declare (ignore class self slotd)) (error "SLOT-MAKUNBOUND-USING-CLASS cannot be applied on built-in objects")) (defmethod slot-boundp-using-class ((class built-in-class) self slotd) + (declare (ignore class self slotd)) (error "SLOT-BOUNDP-USING-CLASS cannot be applied on built-in objects")) (defmethod slot-value-using-class ((class built-in-class) self slotd) + (declare (ignore class self slotd)) (error "SLOT-VALUE-USING-CLASS cannot be applied on built-in objects")) (defmethod (setf slot-value-using-class) (val (class built-in-class) self slotd) + (declare (ignore class self slotd val)) (error "SLOT-VALUE-USING-CLASS cannot be applied on built-in objects")) (defmethod slot-exists-p-using-class ((class built-in-class) self slotd) + (declare (ignore class self slotd)) nil) ;;; ====================================================================== @@ -169,7 +176,7 @@ (:metaclass structure-class)) (defmethod make-load-form ((object structure-object) &optional environment) - (make-load-form-saving-slots object)) + (make-load-form-saving-slots object :key environment)) (defmethod print-object ((obj structure-object) stream) (let* ((class (si:instance-class obj)) diff --git a/src/clos/change.lsp b/src/clos/change.lsp index 67eb33a3c..a9a9b231c 100644 --- a/src/clos/change.lsp +++ b/src/clos/change.lsp @@ -62,8 +62,7 @@ ;; unbound." ;; "The values of slots specified as shared in the class Cfrom and ;; as local in the class Cto are retained." - (let* ((old-local-slotds (class-slots (class-of old-instance))) - (new-local-slotds (class-slots (class-of instance)))) + (let* ((new-local-slotds (class-slots (class-of instance)))) (dolist (new-slot new-local-slotds) ;; CHANGE-CLASS can only operate on the value of local slots. (when (eq (slot-definition-allocation new-slot) :INSTANCE) @@ -77,6 +76,7 @@ instance)) (defmethod change-class ((instance class) new-class &rest initargs) + (declare (ignore new-class initargs)) (if (forward-referenced-class-p instance) (call-next-method) (error "The metaclass of a class metaobject cannot be changed."))) @@ -114,7 +114,6 @@ (defmethod update-instance-for-redefined-class ((instance standard-object) added-slots discarded-slots property-list &rest initargs) - (declare (ignore discarded-slots property-list)) (check-initargs (class-of instance) initargs (valid-keywords-from-methods (compute-applicable-methods diff --git a/src/clos/combin.lsp b/src/clos/combin.lsp index eea4ff5aa..a7135707d 100644 --- a/src/clos/combin.lsp +++ b/src/clos/combin.lsp @@ -203,6 +203,7 @@ ,name (&optional (order :MOST-SPECIFIC-FIRST)) ((around (:AROUND)) (principal (,name) :REQUIRED t)) + ,documentation (let ((main-effective-method `(,',operator ,@(mapcar #'(lambda (x) `(CALL-METHOD ,x NIL)) (if (eql order :MOST-SPECIFIC-LAST) @@ -237,7 +238,6 @@ (when (and (consp x) (eql (first x) :GENERIC-FUNCTION)) (setf body (rest body)) (unless (symbolp (setf generic-function (second x))) - (print 1) (syntax-error)))) (dolist (group method-groups) (destructuring-bind (group-name predicate &key description @@ -257,7 +257,7 @@ (if (eql q '*) `(every #'equal ',p .METHOD-QUALIFIERS.) `(equal ',p .METHOD-QUALIFIERS.)))))) - (t (print 2) (syntax-error))))) + (t (syntax-error))))) (push `(,condition (push .METHOD. ,group-name)) group-checks)) (when required (push `(unless ,group-name @@ -307,7 +307,6 @@ ;;; (defun compute-effective-method (gf method-combination applicable-methods) - (declare (ignore method-combination-type method-combination-args)) (let* ((method-combination-name (car method-combination)) (method-combination-args (cdr method-combination))) (if (eq method-combination-name 'STANDARD) diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp index eadea9292..4220316ee 100644 --- a/src/clos/conditions.lsp +++ b/src/clos/conditions.lsp @@ -775,7 +775,6 @@ that caused the error. CONTINUE-FORMAT-STRING and ERROR-FORMAT-STRING are the format strings of the error message. ARGS are the arguments to the format strings." (declare (inline apply) ;; So as not to get bogus frames in debugger - (ignore error-name) #-ecl-min (c::policy-debug-ihs-frame)) (let ((condition (coerce-to-condition datum args 'simple-error 'error))) diff --git a/src/clos/fixup.lsp b/src/clos/fixup.lsp index 1dff8c2d3..849b5daa6 100644 --- a/src/clos/fixup.lsp +++ b/src/clos/fixup.lsp @@ -68,11 +68,13 @@ (defmethod reader-method-class ((class std-class) (direct-slot direct-slot-definition) &rest initargs) + (declare (ignore class direct-slot initargs)) (find-class 'standard-reader-method)) (defmethod writer-method-class ((class std-class) (direct-slot direct-slot-definition) &rest initargs) + (declare (ignore class direct-slot initargs)) (find-class 'standard-writer-method)) ;;; ---------------------------------------------------------------------- @@ -96,7 +98,7 @@ (cond ((null old-class) (find-class 'standard-method)) ((symbolp old-class) - (find-class old-class)) + (find-class (the symbol old-class))) (t old-class)))) (si::instance-sig-set gfun) @@ -133,6 +135,7 @@ (defun congruent-lambda-p (l1 l2) (multiple-value-bind (r1 opts1 rest1 key-flag1 keywords1 a-o-k1) (si::process-lambda-list l1 'FUNCTION) + (declare (ignore a-o-k1)) (multiple-value-bind (r2 opts2 rest2 key-flag2 keywords2 a-o-k2) (si::process-lambda-list l2 'FUNCTION) (and (= (length r2) (length r1)) @@ -145,7 +148,7 @@ (null key-flag2) a-o-k2 (null (set-difference (all-keywords keywords1) - (all-keywords keywords2)))) + (all-keywords keywords2)))) t)))) (defun add-method (gf method) @@ -232,7 +235,7 @@ their lambda lists ~A and ~A are not congruent." (mapcar #'type-of args))) (defmethod no-next-method (gf method &rest args) - (declare (ignore gf args)) + (declare (ignore gf)) (error "In method ~A~%No next method given arguments ~A" method args)) (defun no-primary-method (gf &rest args) @@ -242,7 +245,8 @@ their lambda lists ~A and ~A are not congruent." ;;; Now we protect classes from redefinition: (eval-when (compile load) (defun setf-find-class (new-value name &optional errorp env) - (let ((old-class (find-class name nil))) + (declare (ignore errorp)) + (let ((old-class (find-class name nil env))) (cond ((typep old-class 'built-in-class) (error "The class associated to the CL specifier ~S cannot be changed." @@ -269,7 +273,7 @@ their lambda lists ~A and ~A are not congruent." (function-to-method 'add-dependent '((c standard-generic-function) function)) (defmethod add-dependent ((c class) dep) - (pushnew c (class-dependents c))) + (pushnew dep (class-dependents c))) (defmethod remove-dependent ((c standard-generic-function) dep) (setf (generic-function-dependents c) @@ -290,6 +294,7 @@ their lambda lists ~A and ~A are not congruent." (defmethod update-dependents ((object generic-function) (dep initargs-updater) &rest initargs) + (declare (ignore dep initargs)) (recursively-update-classes +the-class+)) (setf *clos-booted* t) diff --git a/src/clos/generic.lsp b/src/clos/generic.lsp index 4cf9118bd..505d1c4d4 100644 --- a/src/clos/generic.lsp +++ b/src/clos/generic.lsp @@ -123,6 +123,7 @@ method-combination (method-class (find-class 'method)) ) + (declare (ignore initargs slot-names)) ;; ;; Check the validity of several fields. ;; @@ -173,6 +174,7 @@ (defmethod shared-initialize ((gfun standard-generic-function) slot-names &rest initargs) + (declare (ignore initargs slot-names)) (call-next-method) (compute-g-f-spec-list gfun) gfun) @@ -216,6 +218,7 @@ (method-class 'STANDARD-METHOD method-class-p) (generic-function-class 'STANDARD-GENERIC-FUNCTION) (delete-methods nil)) + (declare (ignore delete-methods gfun)) ;; else create a new generic function object (setf args (copy-list args)) (remf args :generic-function-class) @@ -242,7 +245,7 @@ ((macro-function name) (simple-program-error "The symbol ~A is bound to a macro and is not a valid name for a generic function" name)) ((not *clos-booted*) - (setf (fdefinition (or traced name)) + (setf (fdefinition name) (apply #'ensure-generic-function-using-class nil name args)) (fdefinition name)) (t diff --git a/src/clos/kernel.lsp b/src/clos/kernel.lsp index f95496b53..78f981f52 100644 --- a/src/clos/kernel.lsp +++ b/src/clos/kernel.lsp @@ -162,6 +162,7 @@ (warn "Ignoring class definition for ~S" class))) (defun setf-find-class (new-value name &optional errorp env) + (declare (ignore errorp env)) (let ((old-class (find-class name nil))) (cond ((and old-class diff --git a/src/clos/method.lsp b/src/clos/method.lsp index a051e3089..97ce5c1fc 100644 --- a/src/clos/method.lsp +++ b/src/clos/method.lsp @@ -139,7 +139,8 @@ (> (count-if #'function-boundary (car env)) 1))) (defun walk-method-lambda (method-lambda required-parameters env) - (declare (si::c-local)) + (declare (si::c-local) + (ignore required-parameters)) (let ((call-next-method-p nil) (next-method-p-p nil) (in-closure-p nil)) @@ -270,6 +271,7 @@ have disappeared." (defun add-method-keywords (method) (multiple-value-bind (reqs opts rest key-flag keywords allow-other-keys) (si::process-lambda-list (method-lambda-list method) t) + (declare (ignore reqs opts rest key-flag)) (setf (method-keywords method) (if allow-other-keys 't @@ -322,8 +324,6 @@ have disappeared." (defun find-method (gf qualifiers specializers &optional (errorp t)) (declare (notinline method-qualifiers)) (let* ((method-list (generic-function-methods gf)) - (required-args (subseq (generic-function-lambda-list gf) 0 - (length specializers))) found) (dolist (method method-list) (when (and (equal qualifiers (method-qualifiers method)) diff --git a/src/clos/print.lsp b/src/clos/print.lsp index c8f386afc..d5ed90f60 100644 --- a/src/clos/print.lsp +++ b/src/clos/print.lsp @@ -36,9 +36,10 @@ `(slot-makunbound ,object ',slot-name)) initialization))))) -(defun need-to-make-load-form-p (object) +(defun need-to-make-load-form-p (object env) "Return T if the object cannot be externalized using the lisp printer and we should rather use MAKE-LOAD-FORM." + (declare (ignore env)) (let ((*load-form-cache* nil)) (declare (special *load-form-cache*)) (labels ((recursive-test (object) @@ -80,12 +81,12 @@ printer and we should rather use MAKE-LOAD-FORM." (recursive-test object) nil)))) -(defmethod make-load-form ((object t) &optional environment) +(defmethod make-load-form ((object t) &optional env) (flet ((maybe-quote (object) (if (or (consp object) (symbolp object)) (list 'quote object) object))) - (unless (need-to-make-load-form-p object) + (unless (need-to-make-load-form-p object env) (return-from make-load-form (maybe-quote object))) (typecase object (compiled-function @@ -93,10 +94,10 @@ printer and we should rather use MAKE-LOAD-FORM." (si::bc-split object) (unless code (error "Cannot externalize object ~a" object)) - (values `(si::bc-join ,(make-load-form lex) + (values `(si::bc-join ,(make-load-form lex env) ',code ; An specialized array, no load form - ,(make-load-form data) - ,(make-load-form name))))) + ,(make-load-form data env) + ,(make-load-form name env))))) (array (let ((init-forms '())) (values `(make-array ',(array-dimensions object) @@ -105,7 +106,7 @@ printer and we should rather use MAKE-LOAD-FORM." :initial-contents ',(loop for i from 0 below (array-total-size object) collect (let ((x (row-major-aref object i))) - (if (need-to-make-load-form-p x) + (if (need-to-make-load-form-p x env) (progn (push `(setf (row-major-aref ,object ,i) ',x) init-forms) 0) @@ -113,7 +114,8 @@ printer and we should rather use MAKE-LOAD-FORM." (and init-forms `(progn ,@init-forms))))) (cons (values `(cons ,(maybe-quote (car object)) nil) - (and (rest object) `(rplacd ,(maybe-quote object) ,(maybe-quote (cdr object)))))) + (and (rest object) `(rplacd ,(maybe-quote object) + ,(maybe-quote (cdr object)))))) (hash-table (let* ((content (ext:hash-table-content object)) (make-form `(make-hash-table @@ -121,7 +123,7 @@ printer and we should rather use MAKE-LOAD-FORM." :rehash-size ,(hash-table-rehash-size object) :rehash-threshold ,(hash-table-rehash-threshold object) :test ',(hash-table-test object)))) - (if (need-to-make-load-form-p content) + (if (need-to-make-load-form-p content env) (values make-form `(dolist (i ',(loop for key being each hash-key in object @@ -135,15 +137,17 @@ printer and we should rather use MAKE-LOAD-FORM." (error "Cannot externalize object ~a" object))))) (defmethod make-load-form ((object standard-object) &optional environment) - (make-load-form-saving-slots object)) + (make-load-form-saving-slots object :environment environment)) (defmethod make-load-form ((class class) &optional environment) + (declare (ignore environment)) (let ((name (class-name class))) (if (and name (eq (find-class name) class)) `(find-class ',name) (error "Cannot externalize anonymous class ~A" class)))) (defmethod make-load-form ((package package) &optional environment) + (declare (ignore environment)) `(find-package ,(package-name package))) ;;; ---------------------------------------------------------------------- diff --git a/src/clos/standard.lsp b/src/clos/standard.lsp index 5f95f4a6f..7de4bbcd2 100644 --- a/src/clos/standard.lsp +++ b/src/clos/standard.lsp @@ -138,9 +138,11 @@ initargs))) (defmethod direct-slot-definition-class ((class T) &rest canonicalized-slot) + (declare (ignore class canonicalized-slot)) (find-class 'standard-direct-slot-definition nil)) (defmethod effective-slot-definition-class ((class T) &rest canonicalized-slot) + (declare (ignore class canonicalized-slot)) (find-class 'standard-effective-slot-definition nil)) (defun has-forward-referenced-parents (class) @@ -155,6 +157,7 @@ (defmethod initialize-instance ((class class) &rest initargs &key sealedp direct-superclasses direct-slots) + (declare (ignore sealedp)) ;; convert the slots from lists to direct slots (setf direct-slots (loop for s in direct-slots collect (canonical-slot-to-direct-slot class s))) @@ -194,6 +197,7 @@ (defmethod shared-initialize ((class std-class) slot-names &rest initargs &key (optimize-slot-access (list *optimize-slot-access*)) sealedp) + (declare (ignore initargs slot-names)) (setf (slot-value class 'optimize-slot-access) (first optimize-slot-access) (slot-value class 'sealedp) (and sealedp t)) (setf class (call-next-method)) @@ -436,8 +440,10 @@ because it contains a reference to the undefined class~% ~A" ;;; (defmethod ensure-class-using-class ((class class) name &rest rest &key direct-slots direct-default-initargs) + (declare (ignore direct-default-initargs direct-slots)) (multiple-value-bind (metaclass direct-superclasses options) (apply #'help-ensure-class rest) + (declare (ignore direct-superclasses)) (cond ((forward-referenced-class-p class) (change-class class metaclass)) ((not (eq (class-of class) metaclass)) @@ -758,21 +764,22 @@ because it contains a reference to the undefined class~% ~A" (defmethod describe-object ((obj std-class) (stream t)) (let ((slotds (class-slots (si:instance-class obj)))) - (format t "~%~A is an instance of class ~A" + (format stream "~%~A is an instance of class ~A" obj (class-name (si:instance-class obj))) (do ((scan slotds (cdr scan)) (i 0 (1+ i))) ((null scan)) (declare (fixnum i)) - (print (slot-definition-name (car scan))) (princ ": ") + (print (slot-definition-name (car scan)) stream) + (princ ": " stream) (case (slot-definition-name (car scan)) ((SUPERIORS INFERIORS PRECEDENCE-LIST) - (princ "(") + (princ "(" stream) (do* ((scan (si:instance-ref obj i) (cdr scan)) (e (car scan) (car scan))) ((null scan)) - (prin1 (class-name e)) - (when (cdr scan) (princ " "))) + (prin1 (class-name e) stream) + (when (cdr scan) (princ " " stream))) (princ ")")) - (otherwise (prin1 (si:instance-ref obj i)))))) + (otherwise (prin1 (si:instance-ref obj i) stream))))) obj) diff --git a/src/clos/stdmethod.lsp b/src/clos/stdmethod.lsp index d555ca90e..42bc79703 100644 --- a/src/clos/stdmethod.lsp +++ b/src/clos/stdmethod.lsp @@ -41,6 +41,7 @@ (defun function-keywords (method) (multiple-value-bind (reqs opts rest-var key-flag keywords) (si::process-lambda-list (slot-value method 'lambda-list) 'function) + (declare (ignore reqs opts rest-var)) (when key-flag (do* ((output '()) (l (cdr keywords) (cddddr l))) @@ -58,4 +59,5 @@ (defclass standard-writer-method (standard-accessor-method) ()) (defmethod shared-initialize ((method standard-method) slot-names &rest initargs) + (declare (ignore initargs method slot-names)) (add-method-keywords (call-next-method))) diff --git a/src/clos/streams.lsp b/src/clos/streams.lsp index ff2f477a6..d13ea18a4 100644 --- a/src/clos/streams.lsp +++ b/src/clos/streams.lsp @@ -284,6 +284,7 @@ ;; CLEAR-INPUT (defmethod stream-clear-input ((stream fundamental-character-input-stream)) + (declare (ignore stream)) nil) (defmethod stream-clear-input ((stream ansi-stream)) @@ -296,6 +297,7 @@ ;; CLEAR-OUTPUT (defmethod stream-clear-output ((stream fundamental-output-stream)) + (declare (ignore stream)) nil) (defmethod stream-clear-output ((stream ansi-stream)) @@ -316,12 +318,14 @@ (cl:close stream :abort abort)) (defmethod close ((stream t) &key abort) + (declare (ignore abort)) (bug-or-error stream 'close)) ;; STREAM-ELEMENT-TYPE (defmethod stream-element-type ((stream fundamental-character-stream)) + (declare (ignore stream)) 'character) (defmethod stream-element-type ((stream ansi-stream)) @@ -333,6 +337,7 @@ ;; FINISH-OUTPUT (defmethod stream-finish-output ((stream fundamental-output-stream)) + (declare (ignore stream)) nil) (defmethod stream-finish-output ((stream ansi-stream)) @@ -345,6 +350,7 @@ ;; FORCE-OUTPUT (defmethod stream-force-output ((stream fundamental-output-stream)) + (declare (ignore stream)) nil) (defmethod stream-force-output ((stream ansi-stream)) @@ -368,9 +374,11 @@ ;; INPUT-STREAM-P (defmethod input-stream-p ((stream fundamental-stream)) + (declare (ignore stream)) nil) (defmethod input-stream-p ((stream fundamental-input-stream)) + (declare (ignore stream)) t) (defmethod input-stream-p ((stream ansi-stream)) @@ -392,7 +400,8 @@ ;; LINE-COLUMN (defmethod stream-line-column ((stream fundamental-character-output-stream)) - nil) + (declare (ignore stream)) + nil) ;; LISTEN @@ -422,9 +431,11 @@ ;; OUTPUT-STREAM-P (defmethod output-stream-p ((stream fundamental-stream)) + (declare (ignore stream)) nil) (defmethod output-stream-p ((stream fundamental-output-stream)) + (declare (ignore stream)) t) (defmethod output-stream-p ((stream ansi-stream)) @@ -473,6 +484,7 @@ (cl:unread-char character stream)) (defmethod stream-unread-char ((stream ansi-stream) character) + (declare (ignore character)) (bug-or-error stream 'stream-unread-char)) @@ -531,6 +543,7 @@ (si:do-read-sequence stream sequence start end)) (defmethod stream-read-sequence ((stream t) sequence &optional start end) + (declare (ignore sequence start end)) (bug-or-error stream 'stream-read-sequence)) @@ -551,9 +564,11 @@ ;; STREAM-P (defmethod streamp ((stream stream)) + (declare (ignore stream)) t) (defmethod streamp ((stream t)) + (declare (ignore stream)) nil) @@ -563,6 +578,7 @@ (cl:write-byte integer stream)) (defmethod stream-write-byte ((stream t) integer) + (declare (ignore integer)) (bug-or-error stream 'stream-write-byte)) @@ -572,6 +588,7 @@ (cl:write-char character stream)) (defmethod stream-write-char ((stream t) character) + (declare (ignore character)) (bug-or-error stream 'stream-write-char)) @@ -589,6 +606,7 @@ (si::do-write-sequence sequence stream start end)) (defmethod stream-write-sequence ((stream t) sequence &optional start end) + (declare (ignore sequence start end)) (bug-or-error stream 'stream-write-sequence)) @@ -612,6 +630,7 @@ (cl:write-string string stream :start start :end end)) (defmethod stream-write-string ((stream t) string &optional start end) + (declare (ignore string start end)) (bug-or-error stream 'stream-write-string)) @@ -663,6 +682,7 @@ (defmethod stream-file-descriptor ((stream file-stream) &optional (direction :input)) + (declare (ignore direction)) (si:file-stream-fd stream)) diff --git a/src/cmp/cmpmac.lsp b/src/cmp/cmpmac.lsp index 5351a71dc..f757d19cc 100644 --- a/src/cmp/cmpmac.lsp +++ b/src/cmp/cmpmac.lsp @@ -22,8 +22,7 @@ (EQ 'SI::HASH-EQ) (EQL 'SI::HASH-EQL) (EQUAL 'SI::HASH-EQUAL) - (t (setf test 'EQUALP) 'SI::HASH-EQUALP))) - (hash (gensym "HASH"))) + (t (setf test 'EQUALP) 'SI::HASH-EQUALP)))) `(progn (defparameter ,cache-name (make-array 1024 :element-type t :adjustable nil)) (defun ,reset-name () diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 3e7bc310b..1e12fa8ad 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -29,7 +29,6 @@ (*current-form* form) (*first-error* t) (*setjmps* 0)) - ;(let ((*print-level* 3)) (print form)) (catch *cmperr-tag* (when (consp form) (let ((fun (car form)) (args (cdr form)) fd) @@ -110,7 +109,6 @@ &aux def top-output-string (*volatile* " volatile ")) - ;(let ((*print-level* 3)) (pprint *top-level-forms*)) (setq *top-level-forms* (nreverse *top-level-forms*)) (wt-nl1 "#include \"" (brief-namestring h-pathname) "\"") @@ -376,7 +374,6 @@ return f2; (equal (ref-ref-clb x) (ref-ref-clb y)) (equal (ref-ref x) (ref-ref y)))) (similar-var (x y) - (print (list (var-loc x) (var-loc y))) (and! (similar-ref x y) (equal (var-name x) (var-name y)) (equal (var-kind x) (var-kind y)) @@ -390,7 +387,6 @@ return f2; (eql (c1form-sp-change x) (c1form-sp-change y)) (eql (c1form-volatile x) (c1form-volatile y)))) (similar-fun (x y) - (print (list '? (fun-name x) (fun-name y))) (and! (similar-ref x y) (eql (fun-global x) (fun-global y)) (eql (fun-exported x) (fun-exported y)) diff --git a/src/cmp/cmpwt.lsp b/src/cmp/cmpwt.lsp index 430047ad0..807bab5a2 100644 --- a/src/cmp/cmpwt.lsp +++ b/src/cmp/cmpwt.lsp @@ -113,7 +113,7 @@ (add-object 0 :duplicate t :permanent t)) (defun add-load-form (object location) - (when (clos::need-to-make-load-form-p object) + (when (clos::need-to-make-load-form-p object *cmp-env*) (if (not (eq *compiler-phase* 't1)) (cmperr "Unable to internalize complex object ~A in ~a phase" object *compiler-phase*) (multiple-value-bind (make-form init-form) (make-load-form object) diff --git a/src/h/external.h b/src/h/external.h index 3bdc005c1..aba5d9c01 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -2071,7 +2071,7 @@ extern ECL_API cl_object cl_slot_value(cl_object object, cl_object slot); extern ECL_API cl_object cl_slot_exists_p(cl_object object, cl_object slot); /* print.lsp */ -extern ECL_API cl_object clos_need_to_make_load_form_p(cl_object o); +extern ECL_API cl_object clos_need_to_make_load_form_p(cl_object o, cl_object env); /* defclass.lsp */ extern ECL_API cl_object clos_load_defclass(cl_object name, cl_object superclasses, cl_object slots, cl_object options); diff --git a/src/lsp/autoload.lsp b/src/lsp/autoload.lsp index 024cb74b9..bdfd68c02 100644 --- a/src/lsp/autoload.lsp +++ b/src/lsp/autoload.lsp @@ -38,6 +38,7 @@ Gives a global declaration. See DECLARE for possible DECL-SPECs." ) (defmacro with-compilation-unit (options &rest body) + (declare (ignore options)) `(progn ,@body)) ;;; Editor. @@ -72,6 +73,7 @@ Displays information about storage allocation in the following format. * number of pages ECL can use. The number of times the garbage collector has been called is not shown, if the number is zero. The optional X is simply ignored." + (declare (ignorable x)) #+boehm-gc (progn (format t " diff --git a/src/lsp/cmdline.lsp b/src/lsp/cmdline.lsp index 709855e2b..1dfc0086f 100644 --- a/src/lsp/cmdline.lsp +++ b/src/lsp/cmdline.lsp @@ -184,6 +184,7 @@ An excerpt of the rules used by ECL: " (multiple-value-bind (commands loadrc unprocessed-options) (produce-init-code args rules) + (declare (ignore unprocessed-options)) (restart-case (handler-bind ((error #'(lambda (c) diff --git a/src/lsp/defmacro.lsp b/src/lsp/defmacro.lsp index 4626c6fad..8fac37675 100644 --- a/src/lsp/defmacro.lsp +++ b/src/lsp/defmacro.lsp @@ -250,14 +250,17 @@ ppn doc))))) +#+ecl-min (si::fset 'defmacro #'(ext::lambda-block defmacro (def env) + (declare (ignore env)) (let* ((name (second def)) (vl (third def)) (body (cdddr def)) (function)) (multiple-value-bind (function pprint doc) (sys::expand-defmacro name vl body) + (declare (ignore doc)) (setq function `(function ,function)) (when *dump-defmacro-definitions* (print function) @@ -298,6 +301,7 @@ (find-declarations body) (multiple-value-bind (ppn whole dl arg-check) (destructure vl nil) + (declare (ignore ppn)) `(let* ((,whole ,list) ,@dl) ,@decls ,@arg-check @@ -317,11 +321,13 @@ or SYMBOL-MACRO forms, and also to evaluate other forms." (declare (si::c-local)) (flet ((local-var-error-function (name) #'(lambda (whole env) + (declare (ignore whole env)) (error "In a MACROLET function you tried to access a local variable, ~A, from the function in which it appears." name))) (local-fun-error-function (name) #'(lambda (whole env) + (declare (ignore whole env)) (error "In a MACROLET function you tried to access a local function, ~A, from the function in which it appears." name)))) diff --git a/src/lsp/describe.lsp b/src/lsp/describe.lsp index 8c7951075..fc0d630b7 100644 --- a/src/lsp/describe.lsp +++ b/src/lsp/describe.lsp @@ -468,8 +468,6 @@ inspect commands, or type '?' to the inspector." (values))) (defun inspect (object) - (print 'hola) - (print ext:*inspector-hook*) (if ext:*inspector-hook* (funcall *inspector-hook* object) (default-inspector object)) diff --git a/src/lsp/evalmacros.lsp b/src/lsp/evalmacros.lsp index 182496ec1..3a7c871bf 100644 --- a/src/lsp/evalmacros.lsp +++ b/src/lsp/evalmacros.lsp @@ -111,6 +111,7 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)." (defmacro define-compiler-macro (&whole whole name vl &rest body) (multiple-value-bind (function pprint doc-string) (sys::expand-defmacro name vl body) + (declare (ignore pprint)) (setq function `(function ,function)) (when *dump-defun-definitions* (print function) diff --git a/src/lsp/export.lsp b/src/lsp/export.lsp index 77eec48c6..bef9a3ec5 100644 --- a/src/lsp/export.lsp +++ b/src/lsp/export.lsp @@ -55,6 +55,7 @@ ;; defmacro.lsp. ;; (let ((f #'(ext::lambda-block dolist (whole env) + (declare (ignore env)) (let (body pop finished control var expr exit) (setq body (rest whole)) (when (endp body) @@ -81,6 +82,7 @@ (si::fset 'dolist f t)) (let ((f #'(ext::lambda-block dotimes (whole env) + (declare (ignore env)) (let (body pop finished control var expr exit) (setq body (rest whole)) (when (endp body) @@ -108,6 +110,7 @@ (si::fset 'dotimes f t)) (let ((f #'(ext::lambda-block do/do*-expand (whole env) + (declare (ignore env)) (let (do/do* control test result vl step let psetq body) (setq do/do* (first whole) body (rest whole)) (if (eq do/do* 'do) diff --git a/src/lsp/ffi.lsp b/src/lsp/ffi.lsp index 9f90c664c..2c07bcf3d 100644 --- a/src/lsp/ffi.lsp +++ b/src/lsp/ffi.lsp @@ -96,6 +96,7 @@ align (apply #'max (mapcar #'(lambda (field) (multiple-value-bind (field-size field-align) (size-of-foreign-type (second field)) + (declare (ignore field-size)) field-align)) (rest type)))) (%align-data size align)) diff --git a/src/lsp/helpfile.lsp b/src/lsp/helpfile.lsp index 092c84791..26b2894d6 100644 --- a/src/lsp/helpfile.lsp +++ b/src/lsp/helpfile.lsp @@ -239,6 +239,7 @@ strings." ;; (EXT:OPTIONAL-ANNOTATION arguments for EXT:ANNOTATE) (si::fset 'ext:optional-annotation #'(ext:lambda-block ext:optional-annotation (whole env) + (declare (ignore env #-ecl-min whole)) #+ecl-min `(ext:annotate ,@(rest whole))) t) diff --git a/src/lsp/mislib.lsp b/src/lsp/mislib.lsp index d3636d7d7..e8c87705d 100644 --- a/src/lsp/mislib.lsp +++ b/src/lsp/mislib.lsp @@ -296,6 +296,7 @@ hash table; otherwise it signals that we have reached the end of the hash table. ,@body))) (defun sharp-!-reader (stream subchar arg) + (declare (ignore arg subchar)) (read-line stream) (values)) diff --git a/src/lsp/mp.lsp b/src/lsp/mp.lsp index e3dde9881..ce0a9c584 100644 --- a/src/lsp/mp.lsp +++ b/src/lsp/mp.lsp @@ -117,7 +117,7 @@ by ALLOW-WITH-INTERRUPTS." ;; the get-lock statement, to ensure that the unlocking is done with ;; interrupts disabled. #+threads - (ext:with-unique-names (lock count interrupts) + (ext:with-unique-names (lock count) `(let* ((,lock ,lock-form) (,count (mp:lock-count-mine ,lock))) (without-interrupts diff --git a/src/lsp/packlib.lsp b/src/lsp/packlib.lsp index f6a0d1bcf..2d4d7812d 100644 --- a/src/lsp/packlib.lsp +++ b/src/lsp/packlib.lsp @@ -56,6 +56,7 @@ is used." AGAIN (multiple-value-bind (found key value) (funcall iterator) + (declare (ignore key)) (cond (found (when (eq type :inherited) diff --git a/src/lsp/pprint.lsp b/src/lsp/pprint.lsp index 5b5a6403f..7962d0268 100644 --- a/src/lsp/pprint.lsp +++ b/src/lsp/pprint.lsp @@ -136,6 +136,7 @@ (pretty-out stream char)) (defmethod gray::stream-force-output ((stream pretty-stream)) + (declare (ignore stream)) ;(force-pretty-output stream) ) diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp index 56854f9b5..c55d97d3d 100644 --- a/src/lsp/predlib.lsp +++ b/src/lsp/predlib.lsp @@ -362,6 +362,7 @@ and is not adjustable." '(SINGLE-FLOAT DOUBLE-FLOAT T))) (defun upgraded-array-element-type (element-type &optional env) + (declare (ignore env)) (let* ((hash (logand 127 (si:hash-eql element-type))) (record (aref *upgraded-array-element-type-cache* hash))) (declare (type (integer 0 127) hash)) @@ -378,6 +379,7 @@ and is not adjustable." answer)))) (defun upgraded-complex-part-type (real-type &optional env) + (declare (ignore env)) ;; ECL does not have specialized complex types. If we had them, the ;; code would look as follows ;; (dolist (v '(INTEGER RATIO RATIONAL SINGLE-FLOAT DOUBLE-FLOAT FLOAT REAL) @@ -408,7 +410,6 @@ and is not adjustable." (defun error-type-specifier (type) (declare (si::c-local)) - (print type) (error "~S is not a valid type specifier." type)) (defun match-dimensions (array pat) @@ -883,7 +884,8 @@ if not possible." ;; somewhere up, to denote failure of the decision procedure. ;; (defun register-satisfies-type (type) - (declare (si::c-local)) + (declare (si::c-local) + (ignore type)) (throw '+canonical-type-failure+ 'satisfies)) ;;---------------------------------------------------------------------- @@ -1391,6 +1393,7 @@ if not possible." (values nil nil))))) (defun subtypep (t1 t2 &optional env) + (declare (ignore env)) ;; One easy case: types are equal (when (eq t1 t2) (return-from subtypep (values t t))) diff --git a/src/lsp/seqlib.lsp b/src/lsp/seqlib.lsp index 10c259367..767656b26 100644 --- a/src/lsp/seqlib.lsp +++ b/src/lsp/seqlib.lsp @@ -68,6 +68,7 @@ (let ((function (si::coerce-to-function function))) (declare (optimize (speed 3) (safety 0) (debug 0))) (with-start-end (start end sequence length) + (declare (ignore length)) (with-key (key) (cond ((>= start end) (if ivsp @@ -416,7 +417,8 @@ (defun find (item sequence &key test test-not (start 0) end from-end key) (with-tests (test test-not key) (declare (optimize (speed 3) (safety 0) (debug 0))) - (with-start-end (start end sequence l) + (with-start-end (start end sequence length) + (declare (ignore length)) (let ((output nil)) (do-sequence (elt sequence start end :output output :index index :specialize t) diff --git a/src/lsp/setf.lsp b/src/lsp/setf.lsp index e28d348aa..bf849e475 100644 --- a/src/lsp/setf.lsp +++ b/src/lsp/setf.lsp @@ -43,6 +43,7 @@ (defun setf-method-wrapper (name setf-lambda) (declare (si::c-local)) #'(lambda (env &rest args) + (declare (ignore env)) (do-setf-method-expansion name setf-lambda args))) (defun do-defsetf (access-fn function) @@ -342,7 +343,6 @@ Does not check if the third gang is a single-element list." (declare (si::c-local)) (multiple-value-bind (vars vals stores store-form access-form) (get-setf-expansion place env) - (declare (ignore access-form)) (cond ((trivial-setf-form place vars stores store-form access-form) (list 'setq place newvalue)) ((try-simpler-expansion place vars stores newvalue store-form)) diff --git a/src/lsp/top.lsp b/src/lsp/top.lsp index 8da7fbeaa..2aa6ebfe7 100644 --- a/src/lsp/top.lsp +++ b/src/lsp/top.lsp @@ -503,6 +503,7 @@ Use special code 0 to cancel this operation.") (continue ()))) (defun terminal-interrupt (&optional (correctablep t)) + (declare (ignore correctablep)) #+threads (mp:without-interrupts (let* ((suspended '()) @@ -773,7 +774,7 @@ Use special code 0 to cancel this operation.") (terpri)) (values)) -(defun tpl-disassemble-command (&optional no-values) +(defun tpl-disassemble-command () (let*((*print-level* 2) (*print-length* 4) (*print-pretty* t) @@ -785,7 +786,7 @@ Use special code 0 to cancel this operation.") (format t " Function cannot be disassembled.~%")) (values))) -(defun tpl-lambda-expression-command (&optional no-values) +(defun tpl-lambda-expression-command () (let*(;;(*print-level* 2) ;;(*print-length* 4) ;;(*print-pretty* t) @@ -972,7 +973,8 @@ Use special code 0 to cancel this operation.") (blocks '()) (local-variables '()) (special-variables '()) - (restarts '())) + (restarts '()) + record0 record1) (dolist (record (decode-ihs-env (ihs-env ihs-index))) (cond ((atom record) (push (compiled-function-name record) functions)) @@ -1494,7 +1496,8 @@ value." (unwind-protect (handler-bind ((serious-condition (if err-value-p - #'(lambda (c) + #'(lambda (condition) + (declare (ignore condition)) (return-from safe-eval err-value)) #'invoke-debugger))) (setf output (si::eval-with-env form env)