[armedbear-cvs] r11835 - trunk/abcl/src/org/armedbear/lisp

[Ville Voutilainen]

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)))