From 675c5a9f9e3028bc2fd922ed6f570f01cf8c41cf Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 24 Nov 2000 18:33:50 +0000 Subject: [PATCH] 0.6.8.25: redid DEFMETHOD macroexpansion, fixing bug 9 (problems with IGNORE/IGNORABLE declarations) and generally tidying up added copyright boilerplate to tests/*.lisp --- NEWS | 4 +-- src/pcl/boot.lisp | 63 +++++++++++---------------------- src/pcl/macros.lisp | 22 ++++++------ src/pcl/slots.lisp | 6 ++-- src/pcl/vector.lisp | 73 +++++++++++++++++++++++---------------- tests/assertoid.lisp | 11 ++++++ tests/compiler-1.impure.lisp | 14 ++++++++ tests/compiler.impure.lisp | 11 ++++++ tests/compiler.pure.lisp | 13 +++++++ tests/compound-cons.impure.lisp | 11 ++++++ tests/map-tests.impure.lisp | 13 +++++++ tests/pcl.impure.lisp | 13 +++++++ tests/pure.lisp | 12 ++++--- tests/run-program.test.sh | 11 ++++++ tests/run-tests.sh | 11 ++++++ tests/stress-gc.lisp | 11 ++++++ tests/stress-gc.sh | 11 ++++++ tests/vector.pure.lisp | 11 ++++++ version.lisp-expr | 2 +- 19 files changed, 229 insertions(+), 94 deletions(-) diff --git a/NEWS b/NEWS index ac16da9..62b8ff0 100644 --- a/NEWS +++ b/NEWS @@ -603,8 +603,8 @@ changes in sbcl-0.6.9 relative to sbcl-0.6.8: in the not-a-CL:STREAM case, so that even when Gray streams aren't installed, at least appropriate type errors are generated * fixed bug 8: better reporting of various PROGRAM-ERRORs -?? fixed bug 9: IGNORE and IGNORABLE now work reasonably in DEFMETHOD - forms. +* fixed bug 9: IGNORE and IGNORABLE now work reasonably and more + consistently in DEFMETHOD forms. * removed bug 21 from BUGS, since Martin Atzmueller points out that it doesn't seem to affect SBCL after all diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index ced791c..009954b 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -472,7 +472,7 @@ bootstrapping. method-lambda initargs env) (declare (ignore proto-gf proto-method)) (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) - (error "The METHOD-LAMBDA argument to MAKE-METHOD-FUNCTION, ~S,~ + (error "The METHOD-LAMBDA argument to MAKE-METHOD-FUNCTION, ~S, ~ is not a lambda form." method-lambda)) (make-method-initargs-form-internal method-lambda initargs env)) @@ -487,7 +487,7 @@ bootstrapping. (defun make-method-lambda-internal (method-lambda &optional env) (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) - (error "The METHOD-LAMBDA argument to MAKE-METHOD-LAMBDA, ~S,~ + (error "The METHOD-LAMBDA argument to MAKE-METHOD-LAMBDA, ~S, ~ is not a lambda form." method-lambda)) (multiple-value-bind (documentation declarations real-body) @@ -500,17 +500,11 @@ bootstrapping. (multiple-value-bind (parameters lambda-list specializers) (parse-specialized-lambda-list specialized-lambda-list) (let* ((required-parameters - (mapcar #'(lambda (r s) (declare (ignore s)) r) + (mapcar (lambda (r s) (declare (ignore s)) r) parameters specializers)) (slots (mapcar #'list required-parameters)) (calls (list nil)) - (parameters-to-reference - (make-parameter-references specialized-lambda-list - required-parameters - declarations - method-name - specializers)) (class-declarations `(declare ;; FIXME: Are these (DECLARE (SB-PCL::CLASS FOO BAR)) @@ -580,18 +574,27 @@ bootstrapping. ;; appropriate class declarations. The documentation ;; string is removed to make it easy for us to insert ;; new declarations later, they will just go after the - ;; cadr of the method lambda. The class declarations + ;; CADR of the method lambda. The class declarations ;; are inserted to communicate the class of the method's ;; arguments to the code walk. `(lambda ,lambda-list + ;; The default ignorability of method parameters + ;; doesn't seem to be specified by ANSI. PCL had + ;; them basically ignorable but was a little + ;; inconsistent. E.g. even though the two + ;; method definitions + ;; (DEFMETHOD FOO ((X T) (Y T)) "Z") + ;; (DEFMETHOD FOO ((X T) Y) "Z") + ;; are otherwise equivalent, PCL treated Y as + ;; ignorable in the first definition but not in the + ;; second definition. We make all required + ;; parameters ignorable as a way of systematizing + ;; the old PCL behavior. -- WHN 2000-11-24 + (declare (ignorable ,@required-parameters)) ,class-declarations ,@declarations - (declare (ignorable ,@parameters-to-reference)) - - ;; FIXME: should become FUNCTION-NAME-BLOCK-NAME - (block ,(if (listp generic-function-name) - (cadr generic-function-name) - generic-function-name) + (block ,(sb-int:function-name-block-name + generic-function-name) ,@real-body))) (constant-value-p (and (null (cdr real-body)) (constantp (car real-body)))) @@ -990,10 +993,10 @@ bootstrapping. (if (memq var lambda-list-keywords) (progn (case var - (&optional (setq state 'optional)) + (&optional (setq state 'optional)) (&key (setq state 'key)) (&allow-other-keys) - (&rest (setq state 'rest)) + (&rest (setq state 'rest)) (&aux (setq state 'aux)) (otherwise (error @@ -1137,30 +1140,6 @@ bootstrapping. (if (eq *boot-state* 'complete) (standard-generic-function-p (gdefinition name)) (funcallable-instance-p (gdefinition name))))) - -(defun make-parameter-references (specialized-lambda-list - required-parameters - declarations - method-name - specializers) - (flet ((ignoredp (symbol) - (dolist (decl (cdar declarations)) - (when (and (eq (car decl) 'ignore) - (memq symbol (cdr decl))) - (return t))))) - (gathering ((references (collecting))) - (iterate ((s (list-elements specialized-lambda-list)) - (p (list-elements required-parameters))) - (progn p) - (cond ((not (listp s))) - ((ignoredp (car s)) - (warn "In DEFMETHOD ~S, there is a~%~ - redundant IGNORE declaration for the parameter ~S." - method-name - specializers - (car s))) - (t - (gather (car s) references))))))) (defvar *method-function-plist* (make-hash-table :test 'eq)) (defvar *mf1* nil) diff --git a/src/pcl/macros.lisp b/src/pcl/macros.lisp index ed88c23..9f89a8c 100644 --- a/src/pcl/macros.lisp +++ b/src/pcl/macros.lisp @@ -43,9 +43,10 @@ method-name method-lambda-list)) -;;; These are age-old functions which CommonLisp cleaned-up away. They probably -;;; exist in other packages in all CommonLisp implementations, but I will leave -;;; it to the compiler to optimize into calls to them. +;;; These are age-old functions which CommonLisp cleaned-up away. They +;;; probably exist in other packages in all CommonLisp +;;; implementations, but I will leave it to the compiler to optimize +;;; into calls to them. ;;; ;;; FIXME: MEMQ, ASSQ, and DELQ are already defined in SBCL, and we should ;;; use those. POSQ and NEQ aren't defined in SBCL, and are used too often @@ -58,20 +59,19 @@ (defmacro posq (item list) `(position ,item ,list :test #'eq)) (defmacro neq (x y) `(not (eq ,x ,y))) -;;; Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and CONSTANTLY-0 +;;; FIXME: Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and CONSTANTLY-0 ;;; and boost them up to SB-INT. (defun true (&rest ignore) (declare (ignore ignore)) t) (defun false (&rest ignore) (declare (ignore ignore)) nil) (defun zero (&rest ignore) (declare (ignore ignore)) 0) -;;; ONCE-ONLY does the same thing as it does in zetalisp. I should have just -;;; lifted it from there but I am honest. Not only that but this one is -;;; written in Common Lisp. I feel a lot like bootstrapping, or maybe more -;;; like rebuilding Rome. +;;; ONCE-ONLY does the same thing as it does in zetalisp. I should +;;; have just lifted it from there but I am honest. Not only that but +;;; this one is written in Common Lisp. I feel a lot like +;;; bootstrapping, or maybe more like rebuilding Rome. ;;; -;;; FIXME: We should only need one ONCE-ONLY in CMU CL, and there's one -;;; in SB-EXT already (presently to go in SB-INT). Can we use -;;; only one of these in both places? +;;; FIXME: We should only need one ONCE-ONLY in SBCL, and there's one +;;; in SB-INT already. Can we use only one of these in both places? (defmacro once-only (vars &body body) (let ((gensym-var (gensym)) (run-time-vars (gensym)) diff --git a/src/pcl/slots.lisp b/src/pcl/slots.lisp index ac09ca0..a7bcb6d 100644 --- a/src/pcl/slots.lisp +++ b/src/pcl/slots.lisp @@ -321,10 +321,10 @@ (ecase operation (slot-value "read the slot's value (slot-value)") (setf (format nil - "set the slot's value to ~S (setf of slot-value)" + "set the slot's value to ~S (SETF of SLOT-VALUE)" new-value)) - (slot-boundp "test to see whether slot is bound (slot-boundp)") - (slot-makunbound "make the slot unbound (slot-makunbound)")) + (slot-boundp "test to see whether slot is bound (SLOT-BOUNDP)") + (slot-makunbound "make the slot unbound (SLOT-MAKUNBOUND)")) slot-name instance)) diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index 5f240ba..54ebc82 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -929,9 +929,10 @@ ,@forms)) (defvar *non-variable-declarations* - ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but - ;; I don't *think* CMU CL had, or SBCL has, VALUES declarations. If - ;; SBCL doesn't have 'em, VALUES should probably be removed from this list. + ;; FIXME: VALUES was in this list, conditionalized with #+CMU, but I + ;; don't *think* CMU CL had, or SBCL has, VALUES declarations. If + ;; SBCL doesn't have 'em, VALUES should probably be removed from + ;; this list. '(values method-name method-lambda-list optimize ftype inline notinline)) @@ -940,7 +941,13 @@ type)) (defvar *variable-declarations-without-argument* - '(ignore ignorable special dynamic-extent + '(ignore + ignorable special dynamic-extent + ;; FIXME: Possibly this entire list and variable should go away. + ;; If not, certainly we should remove all these built-in typenames + ;; from the list, and replace them with a test for "is it a type + ;; name?" (CLTL1 allowed only built-in type names as declarations, + ;; but ANSI CL allows any type name as a declaration.) array atom base-char bignum bit bit-vector character compiled-function complex cons double-float extended-char fixnum float function hash-table integer @@ -950,7 +957,9 @@ stream string symbol t unsigned-byte vector)) (defun split-declarations (body args calls-next-method-p) - (let ((inner-decls nil) (outer-decls nil) decl) + (let ((inner-decls nil) + (outer-decls nil) + decl) (loop (when (null body) (return nil)) (setq decl (car body)) (unless (and (consp decl) @@ -970,9 +979,12 @@ (dname (list (pop form))) (inners nil) (outers nil)) (unless (or arg-p non-arg-p) - ;; FIXME: This warning should probably go away now - ;; that we're not trying to be portable between - ;; different CLTL1 hosts the way PCL was. + ;; FIXME: This warning, and perhaps the + ;; various *VARIABLE-DECLARATIONS-FOO* and/or + ;; *NON-VARIABLE-DECLARATIONS* variables, + ;; should probably go away now that we're not + ;; trying to be portable between different + ;; CLTL1 hosts the way PCL was. (warn "The declaration ~S is not understood by ~S.~@ Please put ~S on one of the lists ~S,~%~S, or~%~S.~@ (Assuming it is a variable declaration without argument)." @@ -987,11 +999,12 @@ (setq dname (append dname (list (pop form))))) (dolist (var form) (if (member var args) - ;; Quietly remove IGNORE declarations on args when - ;; a next-method is involved, to prevent compiler - ;; warns about ignored args being read. - (unless (and calls-next-method-p - (eq (car dname) 'ignore)) + ;; Quietly remove IGNORE declarations on + ;; args when a next-method is involved, to + ;; prevent compiler warns about ignored + ;; args being read. + (unless (and calls-next-method-p + (eq (car dname) 'ignore)) (push var outers)) (push var inners))) (when outers @@ -1036,23 +1049,23 @@ (append req-args (list rest-arg)) req-args))) `(list* :fast-function - #'(lambda (.pv-cell. .next-method-call. ,@args+rest-arg) - ,@outer-decls - .pv-cell. .next-method-call. - (macrolet ((pv-env ((pv calls pv-table-symbol pv-parameters) - &rest forms) - (declare (ignore pv-table-symbol pv-parameters)) - `(let ((,pv (car .pv-cell.)) - (,calls (cdr .pv-cell.))) - (declare ,(make-pv-type-declaration pv) - ,(make-calls-type-declaration calls)) - ,pv ,calls - ,@forms))) - (fast-lexical-method-functions - (,(car lmf-params) .next-method-call. ,req-args ,rest-arg - ,@(cdddr lmf-params)) - ,@inner-decls - ,@body))) + (lambda (.pv-cell. .next-method-call. ,@args+rest-arg) + (declare (ignorable .pv-cell. .next-method-call.)) + ,@outer-decls + (macrolet ((pv-env ((pv calls pv-table-symbol pv-parameters) + &rest forms) + (declare (ignore pv-table-symbol pv-parameters)) + `(let ((,pv (car .pv-cell.)) + (,calls (cdr .pv-cell.))) + (declare ,(make-pv-type-declaration pv) + ,(make-calls-type-declaration calls)) + ,pv ,calls + ,@forms))) + (fast-lexical-method-functions + (,(car lmf-params) .next-method-call. ,req-args ,rest-arg + ,@(cdddr lmf-params)) + ,@inner-decls + ,@body))) ',initargs)))) ;;; Use arrays and hash tables and the fngen stuff to make this much better. It diff --git a/tests/assertoid.lisp b/tests/assertoid.lisp index d115d9e..4b1e9bf 100644 --- a/tests/assertoid.lisp +++ b/tests/assertoid.lisp @@ -1,6 +1,17 @@ ;;;; the ASSERTOID macro, asserting something with added generality ;;;; to help in regression tests +;;;; 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. + (cl:in-package :cl-user) ;;; EXPR is an expression to evaluate (both with EVAL and with diff --git a/tests/compiler-1.impure.lisp b/tests/compiler-1.impure.lisp index 4dbd333..7ce2b21 100644 --- a/tests/compiler-1.impure.lisp +++ b/tests/compiler-1.impure.lisp @@ -1,3 +1,17 @@ +;;;; miscellaneous compiler tests with side-effects (e.g. DEFUN +;;;; changing FDEFINITIONs and globaldb stuff) + +;;;; 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. + (cl:in-package :cl-user) (declaim (optimize (debug 3) (speed 2) (space 1))) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index ec57c83..0aeda7e 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -4,6 +4,17 @@ ;;;; settings). Similar tests which *do* expect special settings may ;;;; be in files compiler-1.impure.lisp, compiler-2.impure.lisp, etc. +;;;; 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. + (cl:in-package :cl-user) (load "assertoid.lisp") diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 38aebc8..1fa6e25 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1,3 +1,16 @@ +;;;; various compiler tests without side-effects + +;;;; 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. + (cl:in-package :cl-user) ;;; Exercise a compiler bug (by crashing the compiler). diff --git a/tests/compound-cons.impure.lisp b/tests/compound-cons.impure.lisp index ef08021..3a75ecd 100644 --- a/tests/compound-cons.impure.lisp +++ b/tests/compound-cons.impure.lisp @@ -3,6 +3,17 @@ ;;;; various patches made around May 2000 added support for this to ;;;; CMU CL. This file contains tests of their functionality. +;;;; 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. + (cl:in-package :cl-user) ;;; This block of eight assertions is taken directly from diff --git a/tests/map-tests.impure.lisp b/tests/map-tests.impure.lisp index 5a97b45..930fa66 100644 --- a/tests/map-tests.impure.lisp +++ b/tests/map-tests.impure.lisp @@ -1,3 +1,16 @@ +;;;; side-effectful tests of MAP-related stuff + +;;;; 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. + (cl:in-package :cl-user) (load "assertoid.lisp") diff --git a/tests/pcl.impure.lisp b/tests/pcl.impure.lisp index d76233a..8486540 100644 --- a/tests/pcl.impure.lisp +++ b/tests/pcl.impure.lisp @@ -1,3 +1,16 @@ +;;;; miscellaneous side-effectful tests of CLOS + +;;;; 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. + (defpackage "FOO" (:use "CL")) (in-package "FOO") diff --git a/tests/pure.lisp b/tests/pure.lisp index 6f18434..25140bf 100644 --- a/tests/pure.lisp +++ b/tests/pure.lisp @@ -3,11 +3,13 @@ ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. ;;;; -;;;; This software is derived from the CMU CL system, which was -;;;; written at Carnegie Mellon University and released into the -;;;; public domain. The software is in the public domain and is -;;;; provided with absolutely no warranty. See the COPYING and CREDITS -;;;; files 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") diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh index a1a36e7..f04a3bd 100644 --- a/tests/run-program.test.sh +++ b/tests/run-program.test.sh @@ -2,6 +2,17 @@ # tests related to SB-EXT:RUN-PROGRAM +# 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. + sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null <