diff --git a/cgen.scm b/cgen.scm index ccaa140e..26142206 100644 --- a/cgen.scm +++ b/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) diff --git a/runtime.c b/runtime.c index 0a57be7d..763d9ade 100644 --- a/runtime.c +++ b/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("", ((closure)func)->num_args, args); // TODO: could be more efficient, eg: cyc_length(args) is called twice. + Cyc_check_num_args("", ((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; diff --git a/transforms.scm b/transforms.scm index 3429daad..bf607df0 100644 --- a/transforms.scm +++ b/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