diff --git a/eval.c b/eval.c index ae17ecec..b2f7d3aa 100644 --- a/eval.c +++ b/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 ********************************/ diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index ff8430d6..a8a4e87e 100755 --- a/include/chibi/sexp.h +++ b/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)) diff --git a/opt/simplify.c b/opt/simplify.c index 74fa4fa6..238f5614 100644 --- a/opt/simplify.c +++ b/opt/simplify.c @@ -1,6 +1,6 @@ -/* simplify.c -- basic simplification pass */ -/* Copyright (c) 2010 Alex Shinn. All rights reserved. */ -/* BSD-style license: http://synthcode.com/license.txt */ +/* simplify.c -- basic simplification pass */ +/* Copyright (c) 2010-2011 Alex Shinn. All rights reserved. */ +/* 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)); +} diff --git a/vm.c b/vm.c index bc31f98f..bf3dd2f1 100644 --- a/vm.c +++ b/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)) - == SEXP_FALSE) ? 1uL : 0uL); + flags = sexp_make_fixnum(sexp_not(sexp_listp(ctx, sexp_lambda_params(lambda))) + ? (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); - for (k=top-i; k