From 973ac9b4fa685fc63cc36e868c084b2e18eb9d9d Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sun, 24 Mar 1991 18:41:34 +0000 Subject: [PATCH] Fixed CHECK-KEYWORDS not to print "zeroth". --- compiler/ctype.lisp | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/compiler/ctype.lisp b/compiler/ctype.lisp index 87f497ff8..a33438d47 100644 --- a/compiler/ctype.lisp +++ b/compiler/ctype.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.16 1991/02/20 14:56:57 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.17 1991/03/24 18:41:34 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -245,26 +245,26 @@ (proclaim '(function check-keywords (list fixnum function-type) void)) (defun check-keywords (args pre-key type) (do ((key (nthcdr pre-key args) (cddr key)) - (n pre-key (+ n 2))) + (n (1+ pre-key) (+ n 2))) ((null key)) (declare (fixnum n)) (let ((k (car key))) - (check-arg-type k (specifier-type 'symbol) n) - (cond ((not (check-arg-type k (specifier-type 'keyword) n))) - ((not (constant-continuation-p k)) - (note-slime "The keyword for the ~:R argument is not a constant." - n)) - (t - (let* ((name (continuation-value k)) - (info (find name (function-type-keywords type) - :key #'key-info-name))) - (cond ((not info) - (unless (function-type-allowp type) - (note-lossage "~S is not a known argument keyword." - name))) - (t - (check-arg-type (second key) (key-info-type info) - n))))))))) + (cond + ((not (check-arg-type k (specifier-type 'symbol) n))) + ((not (constant-continuation-p k)) + (note-slime "The ~:R argument (in keyword position) is not a constant." + n)) + (t + (let* ((name (continuation-value k)) + (info (find name (function-type-keywords type) + :key #'key-info-name))) + (cond ((not info) + (unless (function-type-allowp type) + (note-lossage "~S is not a known argument keyword." + name))) + (t + (check-arg-type (second key) (key-info-type info) + (1+ n)))))))))) ;;; Lambda-Result-Type -- Internal -- GitLab