From cc6499dd1d68b1383a926ed533ec293e3ff31e12 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Fri, 6 May 2005 16:42:38 +0000 Subject: [PATCH] NIL was matching keyword args when it should match. Slightly modified version of the patch by Helmut Eller, cmucl-imp, 2005-05-05. --- compiler/ir1tran.lisp | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index 630c94c1b..0b3ca2bdc 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.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/ir1tran.lisp,v 1.171 2004/08/30 14:55:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.172 2005/05/06 16:42:38 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1997,9 +1997,9 @@ :type (leaf-type var) :where-from (leaf-where-from var)))) - (let* ((n-context (gensym)) + (let* ((n-context (gensym "N-CONTEXT-")) (context-temp (make-lambda-var :name n-context)) - (n-count (gensym)) + (n-count (gensym "N-COUNT-")) (count-temp (make-lambda-var :name n-count :type (specifier-type 'index))) (*lexical-environment* @@ -2016,11 +2016,11 @@ (arg-vals n-count)) (when (optional-dispatch-keyp res) - (let ((n-index (gensym)) - (n-key (gensym)) - (n-value-temp (gensym)) - (n-allowp (gensym)) - (n-losep (gensym)) + (let ((n-index (gensym "N-INDEX-")) + (n-key (gensym "N-KEY-")) + (n-value-temp (gensym "N-VALUE-TEMP")) + (n-allowp (gensym "N-ALLOWP-")) + (n-losep (gensym "N-LOSEP-")) (allowp (or (optional-dispatch-allowp res) (policy nil (zerop safety))))) @@ -2033,10 +2033,10 @@ (default (arg-info-default info)) (keyword (arg-info-keyword info)) (supplied-p (arg-info-supplied-p info)) - (n-value (gensym))) + (n-value (gensym "N-VALUE-"))) (temps `(,n-value ,default)) (cond (supplied-p - (let ((n-supplied (gensym))) + (let ((n-supplied (gensym "N-SUPPLIED-"))) (temps n-supplied) (arg-vals n-value n-supplied) (tests `((eq ,n-key ',keyword) @@ -2052,7 +2052,7 @@ (tests `((eq ,n-key :allow-other-keys) (setq ,n-allowp ,n-value-temp))) (tests `(t - (setq ,n-losep ,n-key)))) + (setq ,n-losep ,n-index)))) (body `(when (oddp ,n-count) @@ -2066,12 +2066,13 @@ (setf ,n-value-temp (%more-arg ,n-context ,n-index)) (decf ,n-index) (setq ,n-key (%more-arg ,n-context ,n-index)) - (decf ,n-index) - (cond ,@(tests))))) + (cond ,@(tests)) + (decf ,n-index)))) (unless allowp (body `(when (and ,n-losep (not ,n-allowp)) - (%unknown-keyword-argument-error ,n-losep))))))) + (%unknown-keyword-argument-error + (%more-arg ,n-context ,n-losep)))))))) (let ((ep (ir1-convert-lambda-body `((let ,(temps) -- GitLab