don't bother consing up rest arguments if they're never used

eval.c

@@ -1385,6 +1385,8 @@ sexp sexp_make_promise (sexp ctx sexp_api_params(self, n), sexp thunk) {
 
 #if SEXP_USE_SIMPLIFY
 #include "opt/simplify.c"
+#else
+#define sexp_rest_unused_p(lambda) 0
 #endif
 
 /***************************** opcodes ********************************/

include/chibi/sexp.h

@@ -128,6 +128,11 @@ enum sexp_types {
   SEXP_NUM_CORE_TYPES
 };
 
+/* procedure flags */
+#define SEXP_PROC_NONE 0uL
+#define SEXP_PROC_VARIADIC 1uL
+#define SEXP_PROC_UNUSED_REST 2uL
+
 #ifdef _WIN32
 typedef unsigned short sexp_tag_t;
 typedef SIZE_T sexp_uint_t;
@@ -677,7 +682,8 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
 
 #define sexp_procedure_num_args(x)   (sexp_field(x, procedure, SEXP_PROCEDURE, num_args))
 #define sexp_procedure_flags(x)      (sexp_field(x, procedure, SEXP_PROCEDURE, flags))
-#define sexp_procedure_variadic_p(x) (sexp_unbox_fixnum(sexp_procedure_flags(x)) & 1)
+#define sexp_procedure_variadic_p(x) (sexp_unbox_fixnum(sexp_procedure_flags(x)) & SEXP_PROC_VARIADIC)
+#define sexp_procedure_unused_rest_p(x) (sexp_unbox_fixnum(sexp_procedure_flags(x)) & SEXP_PROC_UNUSED_REST)
 #define sexp_procedure_code(x)       (sexp_field(x, procedure, SEXP_PROCEDURE, bc))
 #define sexp_procedure_vars(x)       (sexp_field(x, procedure, SEXP_PROCEDURE, vars))
 #define sexp_procedure_source(x)     sexp_bytecode_source(sexp_procedure_code(x))

opt/simplify.c

@@ -1,6 +1,6 @@
-/*  simplify.c -- basic simplification pass              */
+/*  simplify.c -- basic simplification pass                   */
-/*  Copyright (c) 2010 Alex Shinn.  All rights reserved. */
+/*  Copyright (c) 2010-2011 Alex Shinn.  All rights reserved. */
-/*  BSD-style license: http://synthcode.com/license.txt  */
+/*  BSD-style license: http://synthcode.com/license.txt       */
 
 #define simplify_it(it) ((it) = simplify(ctx, it, substs, lambda))
 
@@ -141,3 +141,38 @@ sexp sexp_simplify (sexp ctx sexp_api_params(self, n), sexp ast) {
   return simplify(ctx, ast, SEXP_NULL, NULL);
 }
 
+static int usedp (sexp lambda, sexp var, sexp x) {
+  sexp ls;
+ loop:
+  switch (sexp_pointerp(x) ? sexp_pointer_tag(x) : 0) {
+  case SEXP_REF:
+    return sexp_ref_name(x) == var && sexp_ref_loc(x) == lambda;
+  case SEXP_SET:
+    x = sexp_set_value(x);
+    goto loop;
+  case SEXP_LAMBDA:
+    x = sexp_lambda_body(x);
+    goto loop;
+  case SEXP_CND:
+    if (usedp(lambda, var, sexp_cnd_test(x))
+        || usedp(lambda, var, sexp_cnd_pass(x)))
+      return 1;
+    x = sexp_cnd_fail(x);
+    goto loop;
+  case SEXP_SEQ:
+    x = sexp_seq_ls(x);
+  case SEXP_PAIR:
+    for (ls=x; sexp_pairp(ls); ls=sexp_cdr(ls))
+      if (usedp(lambda, var, sexp_car(ls)))
+        return 1;
+  }
+  return 0;
+}
+
+int sexp_rest_unused_p (sexp lambda) {
+  sexp var;
+  for (var=sexp_lambda_params(lambda); sexp_pairp(var); var=sexp_cdr(var))
+    ;
+  if (sexp_nullp(var)) return 0;
+  return !usedp(lambda, var, sexp_lambda_body(lambda));
+}

vm.c

@@ -384,8 +384,10 @@ static void generate_lambda (sexp ctx, sexp lambda) {
   }
   sexp_context_tailp(ctx2) = 1;
   generate(ctx2, sexp_lambda_body(lambda));
-  flags = sexp_make_fixnum((sexp_listp(ctx2, sexp_lambda_params(lambda))
+  flags = sexp_make_fixnum(sexp_not(sexp_listp(ctx, sexp_lambda_params(lambda)))
-                             == SEXP_FALSE) ? 1uL : 0uL);
+                           ? (SEXP_PROC_VARIADIC + (sexp_rest_unused_p(lambda)
+                                                    ? SEXP_PROC_UNUSED_REST: 0))
+                           : SEXP_PROC_NONE);
   len = sexp_length(ctx2, sexp_lambda_params(lambda));
   bc = finalize_bytecode(ctx2);
   sexp_bytecode_name(bc) = sexp_lambda_name(lambda);
@@ -790,16 +792,17 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
                  sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
     if (j > 0) {
       if (sexp_procedure_variadic_p(tmp1)) {
-        stack[top-i-1] = sexp_cons(ctx, stack[top-i-1], SEXP_NULL);
+        if (!sexp_procedure_unused_rest_p(tmp1)) {
-        for (k=top-i; k<top-(i-j)-1; k++)
+          stack[top-i-1] = sexp_cons(ctx, stack[top-i-1], SEXP_NULL);
-          stack[top-i-1] = sexp_cons(ctx, stack[k], stack[top-i-1]);
+          for (k=top-i; k<top-(i-j)-1; k++)
-        for ( ; k<top; k++)
+            stack[top-i-1] = sexp_cons(ctx, stack[k], stack[top-i-1]);
-          stack[k-j+1] = stack[k];
+          for ( ; k<top; k++)
-        top -= (j-1);
+            stack[k-j+1] = stack[k];
-        i -= (j-1);
+          top -= (j-1);
+          i -= (j-1);
+        }
       } else {
-        sexp_raise("too many args",
+        sexp_raise("too many args", sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
-                   sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
       }
     } else if (sexp_procedure_variadic_p(tmp1)) {
       /* shift stack, set extra arg to null */