Added hooks to validate number of fn args

Makefile

@@ -157,7 +157,7 @@ test2: examples/hello-library/int-test/hello.c libcyclone.a
 ## END temporary directives
 ###########################
 
-icyc: cyclone icyc.scm eval.scm libraries.scm parser.scm runtime.h scheme/base.o scheme/read.o scheme/write.o scheme/char.o scheme/eval.o scheme/file.o scheme/cyclone/util.o scheme/cyclone/common.o
+icyc: cyclone icyc.scm eval.scm libraries.scm parser.scm runtime.h scheme/base.o scheme/read.o scheme/write.o scheme/char.o scheme/eval.o scheme/file.o scheme/cyclone/util.o scheme/cyclone/common.o scheme/cyclone/util.o
 	./cyclone icyc.scm
 
 .PHONY: tags

cgen.scm

@@ -911,6 +911,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_elt = " (number->string (length free-vars)) ";\n"
              cv-name ".elts = (object *)alloca(sizeof(object) * " 
                      (number->string (length free-vars)) ");\n"
@@ -932,7 +933,9 @@
             "(function_type)__lambda_" (number->string lid)
             (if (> (length free-vars) 0) "," "")
             (string-join free-vars ", ")
-            ");"))))
+            ");"
+            cv-name ".num_args = " (number->string (lambda-num-args lam)) ";"
+            ))))
   (c-code/vars
     (string-append "&" cv-name)
     (list 

cyclone.h

@@ -232,12 +232,12 @@ cons_type n; n.tag = cons_tag; n.cons_car = a; n.cons_cdr = d;
 
 /* Closure types */
 
-typedef struct {tag_type tag; function_type fn;} closure0_type;
-typedef struct {tag_type tag; function_type fn; object elt1;} closure1_type;
-typedef struct {tag_type tag; function_type fn; object elt1,elt2;} closure2_type;
-typedef struct {tag_type tag; function_type fn; object elt1,elt2,elt3;} closure3_type;
-typedef struct {tag_type tag; function_type fn; object elt1,elt2,elt3,elt4;} closure4_type;
-typedef struct {tag_type tag; function_type fn; int num_elt; object *elts;} closureN_type;
+typedef struct {tag_type tag; function_type fn; int num_args; } closure0_type;
+typedef struct {tag_type tag; function_type fn; int num_args; object elt1;} closure1_type;
+typedef struct {tag_type tag; function_type fn; int num_args; object elt1,elt2;} closure2_type;
+typedef struct {tag_type tag; function_type fn; int num_args; object elt1,elt2,elt3;} closure3_type;
+typedef struct {tag_type tag; function_type fn; int num_args; object elt1,elt2,elt3,elt4;} closure4_type;
+typedef struct {tag_type tag; function_type fn; int num_args; int num_elt; object *elts;} closureN_type;
 
 typedef closure0_type *closure0;
 typedef closure1_type *closure1;
@@ -247,15 +247,15 @@ typedef closure4_type *closure4;
 typedef closureN_type *closureN;
 typedef closure0_type *closure;
 
-#define mclosure0(c,f) closure0_type c; c.tag = closure0_tag; c.fn = f;
+#define mclosure0(c,f) closure0_type c; c.tag = closure0_tag; c.fn = f; c.num_args = -1;
 #define mclosure1(c,f,a) closure1_type c; c.tag = closure1_tag; \
-   c.fn = f; c.elt1 = a;
+   c.fn = f; c.num_args = -1; c.elt1 = a;
 #define mclosure2(c,f,a1,a2) closure2_type c; c.tag = closure2_tag; \
-   c.fn = f; c.elt1 = a1; c.elt2 = a2;
+   c.fn = f; c.num_args = -1; c.elt1 = a1; c.elt2 = a2;
 #define mclosure3(c,f,a1,a2,a3) closure3_type c; c.tag = closure3_tag; \
-   c.fn = f; c.elt1 = a1; c.elt2 = a2; c.elt3 = a3;
+   c.fn = f; c.num_args = -1; c.elt1 = a1; c.elt2 = a2; c.elt3 = a3;
 #define mclosure4(c,f,a1,a2,a3,a4) closure4_type c; c.tag = closure4_tag; \
-   c.fn = f; c.elt1 = a1; c.elt2 = a2; c.elt3 = a3; c.elt4 = a4;
+   c.fn = f; c.num_args = -1; c.elt1 = a1; c.elt2 = a2; c.elt3 = a3; c.elt4 = a4;
 // #define setq(x,e) x = e
 
 #define mlist1(e1) (mcons(e1,nil))

runtime.c

@@ -1590,6 +1590,8 @@ object apply(object cont, object func, object args){
     case closure4_tag:
     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.
       dispatch(buf.integer_t.value, ((closure)func)->fn, func, cont, args);
       break;
 
@@ -1685,12 +1687,14 @@ char *transport(x, gcgen) char *x; int gcgen;
     case closure0_tag:
       {register closure0 nx = (closure0) allocp;
        type_of(nx) = closure0_tag; nx->fn = ((closure0) x)->fn;
+       nx->num_args = ((closure0) x)->num_args;
        forward(x) = nx; type_of(x) = forward_tag;
        allocp = ((char *) nx)+sizeof(closure0_type);
        return (char *) nx;}
     case closure1_tag:
       {register closure1 nx = (closure1) allocp;
        type_of(nx) = closure1_tag; nx->fn = ((closure1) x)->fn;
+       nx->num_args = ((closure1) x)->num_args;
        nx->elt1 = ((closure1) x)->elt1;
        forward(x) = nx; type_of(x) = forward_tag;
        x = (char *) nx; allocp = ((char *) nx)+sizeof(closure1_type);
@@ -1698,6 +1702,7 @@ char *transport(x, gcgen) char *x; int gcgen;
     case closure2_tag:
       {register closure2 nx = (closure2) allocp;
        type_of(nx) = closure2_tag; nx->fn = ((closure2) x)->fn;
+       nx->num_args = ((closure2) x)->num_args;
        nx->elt1 = ((closure2) x)->elt1;
        nx->elt2 = ((closure2) x)->elt2;
        forward(x) = nx; type_of(x) = forward_tag;
@@ -1706,6 +1711,7 @@ char *transport(x, gcgen) char *x; int gcgen;
     case closure3_tag:
       {register closure3 nx = (closure3) allocp;
        type_of(nx) = closure3_tag; nx->fn = ((closure3) x)->fn;
+       nx->num_args = ((closure3) x)->num_args;
        nx->elt1 = ((closure3) x)->elt1;
        nx->elt2 = ((closure3) x)->elt2;
        nx->elt3 = ((closure3) x)->elt3;
@@ -1715,6 +1721,7 @@ char *transport(x, gcgen) char *x; int gcgen;
     case closure4_tag:
       {register closure4 nx = (closure4) allocp;
        type_of(nx) = closure4_tag; nx->fn = ((closure4) x)->fn;
+       nx->num_args = ((closure4) x)->num_args;
        nx->elt1 = ((closure4) x)->elt1;
        nx->elt2 = ((closure4) x)->elt2;
        nx->elt3 = ((closure4) x)->elt3;
@@ -1726,6 +1733,7 @@ char *transport(x, gcgen) char *x; int gcgen;
       {register closureN nx = (closureN) allocp;
        int i;
        type_of(nx) = closureN_tag; nx->fn = ((closureN) x)->fn;
+       nx->num_args = ((closureN) x)->num_args;
        nx->num_elt = ((closureN) x)->num_elt;
        nx->elts = (object *)(((char *)nx) + sizeof(closureN_type));
        for (i = 0; i < nx->num_elt; i++) {

scheme/cyclone/transforms.sld

@@ -53,6 +53,7 @@
     lambda-varargs-var 
     lambda-formals-type 
     lambda-formals->list 
+    lambda-num-args
     list->lambda-formals 
     pair->list 
     list->pair 

transforms.scm

@@ -437,6 +437,11 @@
             (pair->list args)))
       (lambda->formals exp)))
 
+(define (lambda-num-args exp)
+  (if (lambda-varargs? exp)
+    -1 ;; Unlimited
+    (length (lambda-formals->list exp))))
+
 ;; Repack a list of args (symbols) into lambda formals, by type
 ;; assumes args is a proper list
 (define (list->lambda-formals args type)