Validate number of args when applying a closure

cgen.scm

@@ -878,6 +878,54 @@
             (car formals)
             'unused)))
 
+;           (tmp-ident (if (> (length (lambda-formals->list exp)) 0) 
+;                          (mangle (if (pair? (lambda->formals exp))
+;                                      (car (lambda->formals exp))
+;                                      (lambda->formals exp)))
+;                          ""))
+;           (has-closure? 
+;             (and
+;               (> (string-length tmp-ident) 3)
+;               (equal? "self" (substring tmp-ident 0 4))))
+
+;; Compute the minimum number of arguments a function expects.
+;; Note this must be the count before additional closure/CPS arguments
+;; are added, so we need to detect those and not include them.
+(define (compute-num-args lam)
+  (let ((count (lambda-num-args lam))) ;; Current arg count, may be too high
+    (cond
+      ((< count 0) -1) ;; Unlimited
+      (else
+        (let ((formals (lambda-formals->list lam)))
+          (- count
+             (if (fl/closure? formals) 1 0)
+             (if (fl/cont? formals) 1 0)))))))
+
+;; Formal list with a closure?
+(define (fl/closure? lis)
+  (cond
+    ((null? lis) #f)
+    (else
+      (let ((arg (symbol->string (car lis))))
+        (and
+          (> (string-length arg) 4)
+          (equal? "self$" (substring arg 0 5)))))))
+
+;; Formal list with a continuation (k)?
+(define (fl/cont? lis)
+  (let ((check (lambda (lis)
+                (cond
+                  ((null? lis) #f)
+                  (else
+                    (let ((arg (symbol->string (car lis))))
+                      (and
+                        (> (string-length arg) 1)
+                        (equal? "k$" (substring arg 0 2)))))))))
+    ;; Find the cont arg; if there is a closure it is always first
+    (if (fl/closure? lis)
+      (check (cdr lis))
+      (check lis))))
+
 ;; c-compile-closure : closure-exp (string -> void) -> string
 ;;
 ;; This function compiles closures generated earlier in the
@@ -911,7 +959,7 @@
              "closureN_type " cv-name ";\n"
              cv-name ".tag = closureN_tag;\n "
              cv-name ".fn = (function_type)__lambda_" (number->string lid) ";\n"
-             cv-name ".num_args = " (number->string (lambda-num-args lam)) ";\n"
+             cv-name ".num_args = " (number->string (compute-num-args lam)) ";\n"
              cv-name ".num_elt = " (number->string (length free-vars)) ";\n"
              cv-name ".elts = (object *)alloca(sizeof(object) * " 
                      (number->string (length free-vars)) ");\n"
@@ -934,7 +982,7 @@
             (if (> (length free-vars) 0) "," "")
             (string-join free-vars ", ")
             ");"
-            cv-name ".num_args = " (number->string (lambda-num-args lam)) ";"
+            cv-name ".num_args = " (number->string (compute-num-args lam)) ";"
             ))))
   (c-code/vars
     (string-append "&" cv-name)

runtime.c

@@ -1591,7 +1591,7 @@ object apply(object cont, object func, object args){
     case closureN_tag:
       buf.integer_t = Cyc_length(args);
       // TODO: validate number of args provided:
-      //Cyc_check_num_args("<procedure>", ((closure)func)->num_args, args); // TODO: could be more efficient, eg: cyc_length(args) is called twice.
+      Cyc_check_num_args("<procedure>", ((closure)func)->num_args, args); // TODO: could be more efficient, eg: cyc_length(args) is called twice.
       dispatch(buf.integer_t.value, ((closure)func)->fn, func, cont, args);
       break;
 

transforms.scm

@@ -437,10 +437,17 @@
             (pair->list args)))
       (lambda->formals exp)))
 
+;; Minimum number of required arguments for a lambda
 (define (lambda-num-args exp)
-  (if (lambda-varargs? exp)
-    -1 ;; Unlimited
-    (length (lambda-formals->list exp))))
+  (let ((type (lambda-formals-type exp))
+        (num (length (lambda-formals->list exp))))
+    (cond
+      ((equal? type 'args:varargs)
+       -1) ;; Unlimited
+      ((equal? type 'args:fixed-with-varargs)
+       (- num 1)) ;; Last arg is optional
+      (else
+        num))))
 
 ;; Repack a list of args (symbols) into lambda formals, by type
 ;; assumes args is a proper list