mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-24 20:45:06 +02:00
Validate number of args when applying a closure
This commit is contained in:
parent
ce0851212d
commit
5604ecfca2
3 changed files with 61 additions and 6 deletions
52
cgen.scm
52
cgen.scm
|
@ -878,6 +878,54 @@
|
||||||
(car formals)
|
(car formals)
|
||||||
'unused)))
|
'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
|
;; c-compile-closure : closure-exp (string -> void) -> string
|
||||||
;;
|
;;
|
||||||
;; This function compiles closures generated earlier in the
|
;; This function compiles closures generated earlier in the
|
||||||
|
@ -911,7 +959,7 @@
|
||||||
"closureN_type " cv-name ";\n"
|
"closureN_type " cv-name ";\n"
|
||||||
cv-name ".tag = closureN_tag;\n "
|
cv-name ".tag = closureN_tag;\n "
|
||||||
cv-name ".fn = (function_type)__lambda_" (number->string lid) ";\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 ".num_elt = " (number->string (length free-vars)) ";\n"
|
||||||
cv-name ".elts = (object *)alloca(sizeof(object) * "
|
cv-name ".elts = (object *)alloca(sizeof(object) * "
|
||||||
(number->string (length free-vars)) ");\n"
|
(number->string (length free-vars)) ");\n"
|
||||||
|
@ -934,7 +982,7 @@
|
||||||
(if (> (length free-vars) 0) "," "")
|
(if (> (length free-vars) 0) "," "")
|
||||||
(string-join free-vars ", ")
|
(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
|
(c-code/vars
|
||||||
(string-append "&" cv-name)
|
(string-append "&" cv-name)
|
||||||
|
|
|
@ -1591,7 +1591,7 @@ object apply(object cont, object func, object args){
|
||||||
case closureN_tag:
|
case closureN_tag:
|
||||||
buf.integer_t = Cyc_length(args);
|
buf.integer_t = Cyc_length(args);
|
||||||
// TODO: validate number of args provided:
|
// 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);
|
dispatch(buf.integer_t.value, ((closure)func)->fn, func, cont, args);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
|
|
@ -437,10 +437,17 @@
|
||||||
(pair->list args)))
|
(pair->list args)))
|
||||||
(lambda->formals exp)))
|
(lambda->formals exp)))
|
||||||
|
|
||||||
|
;; Minimum number of required arguments for a lambda
|
||||||
(define (lambda-num-args exp)
|
(define (lambda-num-args exp)
|
||||||
(if (lambda-varargs? exp)
|
(let ((type (lambda-formals-type exp))
|
||||||
-1 ;; Unlimited
|
(num (length (lambda-formals->list exp))))
|
||||||
(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
|
;; Repack a list of args (symbols) into lambda formals, by type
|
||||||
;; assumes args is a proper list
|
;; assumes args is a proper list
|
||||||
|
|
Loading…
Add table
Reference in a new issue