Changeset 9052 for trunk/source/compiler/nx0.lisp

Timestamp:

Apr 8, 2008, 4:52:04 AM (13 years ago)

Author:

gb

Message:

Don't constant-fold if arg count is obviously wrong.

File:

• trunk/source/compiler/nx0.lisp (modified) (2 diffs)

trunk/source/compiler/nx0.lisp

@@ -2143 +2143 @@
 
            
-; This guy has to return multiple values.
-; The arguments have already been transformed; if they're all constant (or quoted), try
-; to evaluate the expression at compile-time.
+;;; This guy has to return multiple values.  The arguments have
+;;; already been transformed; if they're all constant (or quoted), try
+;;; to evaluate the expression at compile-time.
 (defun nx-constant-fold (original-call &optional (environment *nx-lexical-environment*) &aux 
                                        (fn (car original-call)) form mv foldable foldfn)
@@ -2161 +2161 @@
         (funcall foldfn original-call environment)
         (progn
-            (let ((args nil))
-              (dolist (arg (cdr original-call) (setq args (nreverse args)))
-                (if (quoted-form-p arg)
-                  (setq arg (%cadr arg))
-                  (unless (self-evaluating-p arg) (return-from nx-constant-fold (values original-call nil))))
-                (push arg args))
+          (let ((args nil))
+            (dolist (arg (cdr original-call) (setq args (nreverse args)))
+              (if (quoted-form-p arg)
+                (setq arg (%cadr arg))
+                (unless (self-evaluating-p arg) (return-from nx-constant-fold (values original-call nil))))
+              (push arg args))
+            (if (nx1-check-call-args (fboundp fn) args nil)
+              (return-from nx-constant-fold (values original-call nil))
               (setq form (multiple-value-list 
-                          (handler-case (apply fn args)
-                            (error (condition)
-                                   (warn "Error: \"~A\" ~&signalled during compile-time evaluation of ~S ."
-                                         condition original-call)
-                                   (return-from nx-constant-fold
-                                     (values `(locally (declare (notinline ,fn))
-                                                ,original-call)
-                                             t)))))))
+                             (handler-case (apply fn args)
+                               (error (condition)
+                                      (warn "Error: \"~A\" ~&signalled during compile-time evaluation of ~S ."
+                                            condition original-call)
+                                      (return-from nx-constant-fold
+                                        (values `(locally (declare (notinline ,fn))
+                                                  ,original-call)
+                                                t))))))))
           (if form
             (if (null (%cdr form))