From 74c545416c79548da45d2075b9715930a5f0ab65 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Wed, 10 Apr 2019 22:56:01 -0400
Subject: [PATCH] Added validate:num-function-args

---
 scheme/cyclone/cps-optimizations.sld | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld
index 6206d89e..d7147a8b 100644
--- a/scheme/cyclone/cps-optimizations.sld
+++ b/scheme/cyclone/cps-optimizations.sld
@@ -48,6 +48,8 @@
       ;; Analysis - well-known lambdas
       well-known-lambda
       analyze:find-known-lambdas
+      ;; Analysis - validation
+      validate:num-function-args
       ;; Analyze variables
       adb:make-var
       %adb:make-var
@@ -714,6 +716,7 @@
                               ,(analyze2 (if->else exp))))
         ; Application:
         ((app? exp)
+         ;(trace:info `(DEBUG ,exp ,(validate:num-function-args exp)))
          (for-each (lambda (e) (analyze2 e)) exp))
         (else #f)))
 
@@ -2379,4 +2382,29 @@
   (set! *well-known-lambda-sym-lookup-tbl* candidates)
 )
 
+
+;; Analysis - validation section
+
+;; Does given symbol define a procedure?
+;(define (avld:procedure? sym) #f)
+
+;; Does the given function call pass enough arguments?
+(define (validate:num-function-args ast)
+  (and-let* (((app? ast))
+             ((not (prim? (car ast))))
+             ((ref? (car ast)))
+             (var (adb:get/default (car ast) #f))
+             (lam* (adbv:assigned-value var))
+             ((pair? lam*))
+             (lam (car lam*))
+             ((ast:lambda? lam))
+             (formals-type (ast:lambda-formals-type lam))
+             ((equal? 'args:fixed formals-type)) ;; Could validate fixed-with-varargs, too
+             (argc (length (ast:lambda-args lam)))
+            )
+     (cond
+      ((not (= argc (- (length ast) 1)))
+       'error-not-enough-args))
+    ))
+
 ))