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

This commit is contained in:
Alex Shinn 2011-06-11 14:52:30 +09:00
parent 744bde8997
commit 2961f23d1d
4 changed files with 61 additions and 15 deletions

2
eval.c
View file

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

View file

@ -128,6 +128,11 @@ enum sexp_types {
SEXP_NUM_CORE_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 #ifdef _WIN32
typedef unsigned short sexp_tag_t; typedef unsigned short sexp_tag_t;
typedef SIZE_T sexp_uint_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_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_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_code(x) (sexp_field(x, procedure, SEXP_PROCEDURE, bc))
#define sexp_procedure_vars(x) (sexp_field(x, procedure, SEXP_PROCEDURE, vars)) #define sexp_procedure_vars(x) (sexp_field(x, procedure, SEXP_PROCEDURE, vars))
#define sexp_procedure_source(x) sexp_bytecode_source(sexp_procedure_code(x)) #define sexp_procedure_source(x) sexp_bytecode_source(sexp_procedure_code(x))

View file

@ -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)) #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); 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));
}

25
vm.c
View file

@ -384,8 +384,10 @@ static void generate_lambda (sexp ctx, sexp lambda) {
} }
sexp_context_tailp(ctx2) = 1; sexp_context_tailp(ctx2) = 1;
generate(ctx2, sexp_lambda_body(lambda)); 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)); len = sexp_length(ctx2, sexp_lambda_params(lambda));
bc = finalize_bytecode(ctx2); bc = finalize_bytecode(ctx2);
sexp_bytecode_name(bc) = sexp_lambda_name(lambda); 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))); sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
if (j > 0) { if (j > 0) {
if (sexp_procedure_variadic_p(tmp1)) { 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 { } 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)) { } else if (sexp_procedure_variadic_p(tmp1)) {
/* shift stack, set extra arg to null */ /* shift stack, set extra arg to null */