Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-07 13:16:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

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
#include "opt/simplify.c"
#else
#define sexp_rest_unused_p(lambda) 0
#endif
/***************************** opcodes ********************************/

8
include/chibi/sexp.h
View file

@ -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))

37
opt/simplify.c
View file

@ -1,5 +1,5 @@
/* 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 */
#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));
}

11
vm.c
View file

@ -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,6 +792,7 @@ 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)) {
if (!sexp_procedure_unused_rest_p(tmp1)) {
stack[top-i-1] = sexp_cons(ctx, stack[top-i-1], SEXP_NULL);
for (k=top-i; k<top-(i-j)-1; k++)
stack[top-i-1] = sexp_cons(ctx, stack[k], stack[top-i-1]);
@ -797,9 +800,9 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
stack[k-j+1] = stack[k];
top -= (j-1);
i -= (j-1);
}
} else {
sexp_raise("too many args",
sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
sexp_raise("too many args", sexp_list2(ctx, tmp1, sexp_make_fixnum(i)));
}
} else if (sexp_procedure_variadic_p(tmp1)) {
/* shift stack, set extra arg to null */