From c4050a82e802502e74366ce021844aece106490c Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Mon, 3 Feb 2003 15:24:44 +0000 Subject: [PATCH] Recognize :allow-other-keys as a valid keyword arg for all functions, and enable (or disable) compile-time checking of keyword args as appropriate. Also give a compile-time warning if the value of :allow-other-keys is not a constant. Compile-time checking is disabled in this case. Based on a patch from Gerd Moellmann for a issue noted by Paul Dietz. --- compiler/ctype.lisp | 67 ++++++++++++++++++++++++++++++--------------- 1 file changed, 45 insertions(+), 22 deletions(-) diff --git a/compiler/ctype.lisp b/compiler/ctype.lisp index 9fd5a1881..842f9ea3d 100644 --- a/compiler/ctype.lisp +++ b/compiler/ctype.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.34 2001/03/04 20:12:14 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.35 2003/02/03 15:24:44 toy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -249,27 +249,50 @@ ;;; (defun check-keywords (args pre-key type) (declare (list args) (fixnum pre-key)) - (do ((key (nthcdr pre-key args) (cddr key)) - (n (1+ pre-key) (+ n 2))) - ((null key)) - (declare (fixnum n)) - (let ((k (car key))) - (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)))))))))) + (let ((allow-other-keys nil) + (allow-other-keys-seen nil)) + (do ((key (nthcdr pre-key args) (cddr key)) + (n (1+ pre-key) (+ n 2))) + ((null key)) + (declare (fixnum n)) + (let ((k (car key))) + (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 (allow-other-keys) + ((eq name :allow-other-keys) + (unless allow-other-keys-seen + (let ((value (second key))) + ;; If the value of :allow-other-keys has a + ;; known constant value, use that so we can + ;; enable (or disable) checking of args at + ;; compile time. + ;; + ;; If :allow-other-keys is not a compile-time + ;; constant, set ALLOW-OTHER-KEYS to T so that + ;; we don't do checking at compile time, but + ;; also warn that it's not constant. Run-time + ;; checking, of course, still happens. + (if (constant-continuation-p value) + (setq allow-other-keys (continuation-value value)) + (progn + (setq allow-other-keys t) + (note-slime "The value of ~S is not a constant" + :allow-other-keys))) + (setq allow-other-keys-seen t)))) + ((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))))))))))) ;;; Definition-Type -- Interface -- GitLab