From c9108e339bf36ad6c900b8a5607f30e132f5be8a Mon Sep 17 00:00:00 2001 From: felix Date: Tue, 7 Apr 2020 12:45:58 +0200 Subject: [PATCH] Check known call argument count in analysis phase This was done in the optimizer previously but will be disabled with -O0. See also #1689 --- core.scm | 12 +++++++++++- optimizer.scm | 8 -------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/core.scm b/core.scm index a490915a..272a1f77 100644 --- a/core.scm +++ b/core.scm @@ -2122,7 +2122,17 @@ (grow 1) (let ([fun (car subs)]) (when (eq? '##core#variable (node-class fun)) - (let ((name (first (node-parameters fun)))) + (let* ((name (first (node-parameters fun))) + (val (db-get db name 'value))) + (when (and first-analysis + val + (not (db-get db name 'unknown)) + (eq? '##core#lambda (node-class val)) + (not (llist-match? (third (node-parameters val)) + (cdr subs)))) + (quit-compiling + "known procedure called with wrong number of arguments: `~A'" + (real-name name))) (collect! db name 'call-sites (cons here n)))) (walk (first subs) env localenv fullenv here) (walkeach (cdr subs) env localenv fullenv here))) diff --git a/optimizer.scm b/optimizer.scm index bcf0148f..92634de0 100644 --- a/optimizer.scm +++ b/optimizer.scm @@ -1649,10 +1649,6 @@ (cond [(eq? fnvar (first fnp)) (set! ksites (alist-cons #f n ksites)) (cond [(eq? kvar (first arg0p)) - (unless (= argc (length (cdr subs))) - (quit-compiling - "known procedure called recursively with wrong number of arguments: `~A'" - fnvar) ) (node-class-set! n '##core#recurse) (node-parameters-set! n (list #t id)) (node-subexpressions-set! n (cddr subs)) ] @@ -1660,10 +1656,6 @@ => (lambda (a) (let* ([klam (cdr a)] [kbody (first (node-subexpressions klam))] ) - (unless (= argc (length (cdr subs))) - (quit-compiling - "known procedure called recursively with wrong number of arguments: `~A'" - fnvar) ) (node-class-set! n 'let) (node-parameters-set! n (take (third (node-parameters klam)) 1)) (node-subexpressions-set! -- 2.21.0