[armedbear-cvs] r11835 - trunk/abcl/src/org/armedbear/lisp
Ville Voutilainen
vvoutilainen at common-lisp.net
Wed May 6 18:34:44 UTC 2009
Author: vvoutilainen
Date: Wed May 6 14:34:40 2009
New Revision: 11835
Log:
Combine check-arg-count and check-min-args with a format
recipe and an optional argument. Note, ansi tests do not
exercise the failure case for check-min-args, but the
format recipe is easy enough to test with the following
snippet:
(format t
"Wrong number of arguments for ~A (expected~:[~; at least~] ~D, but received ~D)."
1 nil 2 3)
By changing the second argument after the format string
from nil to t, both cases can be seen to work with this format
string.
Modified:
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Wed May 6 14:34:40 2009
@@ -1001,34 +1001,29 @@
;; the value of a constant defined with DEFCONSTANT, calling built-in Lisp
;; functions with a wrong number of arguments or malformed keyword argument
;; lists, and using unrecognized declaration specifiers." (3.2.5)
-(defknown check-arg-count (t fixnum) t)
-(defun check-arg-count (form n)
+(defun check-number-of-args (form n &optional (minimum nil))
(declare (type fixnum n))
(let* ((op (car form))
(args (cdr form))
- (ok (= (length args) n)))
+ (ok (if minimum
+ (>= (length args) n)
+ (= (length args) n))))
(declare (type boolean ok))
(unless ok
(funcall (if (eq (symbol-package op) +cl-package+)
#'compiler-warn ; See above!
#'compiler-style-warn)
- "Wrong number of arguments for ~A (expected ~D, but received ~D)."
- op n (length args)))
+ "Wrong number of arguments for ~A (expected~:[~; at least~] ~D, but received ~D)."
+ op minimum n (length args)))
ok))
+(defknown check-arg-count (t fixnum) t)
+(defun check-arg-count (form n)
+ (check-number-of-args form n))
+
(declaim (ftype (function (t fixnum) t) check-min-args))
(defun check-min-args (form n)
- (declare (type fixnum n))
- (let* ((op (car form))
- (args (cdr form))
- (ok (>= (length args) n)))
- (unless ok
- (funcall (if (eq (symbol-package op) +cl-package+)
- #'compiler-warn ; See above!
- #'compiler-style-warn)
- "Wrong number of arguments for ~A (expected at least ~D, but received ~D)."
- op n (length args)))
- ok))
+ (check-number-of-args form n t))
(defun unsupported-opcode (instruction)
(error "Unsupported opcode ~D." (instruction-opcode instruction)))
More information about the armedbear-cvs
mailing list