From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 8 Jun 2011 17:15:40 +0000 (+0000)
Subject: Kludge up wrong-number-of-arguments error parsing for entities.
X-Git-Tag: 20110609-Gtk~1^2~2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fd45b3478e152b120202becd1aa70dc6ebf84b71;p=mit-scheme.git

Kludge up wrong-number-of-arguments error parsing for entities.

Before:

   (min)
   ;The procedure #[compiled-procedure 11 (min "arith" #x16) #x1b1a #x1c8ac2] has been called with 1 argument; it requires at least 2 arguments.

After:

   (min)
   ;The procedure #[arity-dispatched-procedure 11 min] has been called with 0 arguments; it requires at least 1 argument.

Screw cases be damned.
---

diff --git a/src/runtime/uerror.scm b/src/runtime/uerror.scm
index 874f92f69..7387ad177 100644
--- a/src/runtime/uerror.scm
+++ b/src/runtime/uerror.scm
@@ -933,11 +933,20 @@ USA.
     (lambda (continuation)
       (let ((frame (continuation/first-subproblem continuation)))
 	(if (apply-frame? frame)
-	    (let ((operator (apply-frame/operator frame)))
-	      (signal continuation
-		      operator
-		      (procedure-arity operator)
-		      (apply-frame/operands frame))))))))
+	    ;; This is a heuristic kludge.  It can break down:
+	    ;;   (let ((p (lambda (x y) 0)))
+	    ;;     (p (make-entity p 0)))
+	    ;; But without the kludge, (min) gives a confusing error,
+	    ;; which is probably more common than this pathological
+	    ;; case.
+	    (let loop ((operator (apply-frame/operator frame))
+		       (operands (apply-frame/operands frame)))
+	      (if (and (pair? operands)
+		       (entity? (car operands))
+		       (eq? operator (entity-procedure (car operands))))
+		  (loop (car operands) (cdr operands))
+		  (let ((arity (procedure-arity operator)))
+		    (signal continuation operator arity operands)))))))))
 
 (define-error-handler 'FLOATING-OVERFLOW
   (let ((signal