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

exposing sexp_free_vars

Browse source
This commit is contained in:
Alex Shinn 2010-02-25 23:59:40 +09:00
parent 670a4ae67b
commit c14e32a0eb
2 changed files with 16 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
eval.c
View file

@ -28,7 +28,7 @@ static sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env);
static sexp sexp_find_module_file_op (sexp ctx, sexp file); static sexp sexp_find_module_file_op (sexp ctx, sexp file);
#endif #endif
static sexp sexp_compile_error (sexp ctx, char *message, sexp obj) { sexp sexp_compile_error (sexp ctx, char *message, sexp obj) {
sexp exn; sexp exn;
sexp_gc_var3(sym, irritants, msg); sexp_gc_var3(sym, irritants, msg);
sexp_gc_preserve3(ctx, sym, irritants, msg); sexp_gc_preserve3(ctx, sym, irritants, msg);
@ -1149,12 +1149,12 @@ static sexp diff_free_vars (sexp ctx, sexp lambda, sexp fv, sexp params) {
return res; return res;
} }
static sexp free_vars (sexp ctx, sexp x, sexp fv) { sexp sexp_free_vars (sexp ctx, sexp x, sexp fv) {
sexp_gc_var2(fv1, fv2); sexp_gc_var2(fv1, fv2);
sexp_gc_preserve2(ctx, fv1, fv2); sexp_gc_preserve2(ctx, fv1, fv2);
fv1 = fv; fv1 = fv;
if (sexp_lambdap(x)) { if (sexp_lambdap(x)) {
fv1 = free_vars(ctx, sexp_lambda_body(x), SEXP_NULL); fv1 = sexp_free_vars(ctx, sexp_lambda_body(x), SEXP_NULL);
fv2 = sexp_flatten_dot(ctx, sexp_lambda_params(x)); fv2 = sexp_flatten_dot(ctx, sexp_lambda_params(x));
fv2 = sexp_append2(ctx, sexp_lambda_locals(x), fv2); fv2 = sexp_append2(ctx, sexp_lambda_locals(x), fv2);
fv2 = diff_free_vars(ctx, x, fv1, fv2); fv2 = diff_free_vars(ctx, x, fv1, fv2);
@ -1162,21 +1162,21 @@ static sexp free_vars (sexp ctx, sexp x, sexp fv) {
fv1 = union_free_vars(ctx, fv2, fv); fv1 = union_free_vars(ctx, fv2, fv);
} else if (sexp_pairp(x)) { } else if (sexp_pairp(x)) {
for ( ; sexp_pairp(x); x=sexp_cdr(x)) for ( ; sexp_pairp(x); x=sexp_cdr(x))
fv1 = free_vars(ctx, sexp_car(x), fv1); fv1 = sexp_free_vars(ctx, sexp_car(x), fv1);
} else if (sexp_cndp(x)) { } else if (sexp_cndp(x)) {
fv1 = free_vars(ctx, sexp_cnd_test(x), fv); fv1 = sexp_free_vars(ctx, sexp_cnd_test(x), fv);
fv1 = free_vars(ctx, sexp_cnd_pass(x), fv1); fv1 = sexp_free_vars(ctx, sexp_cnd_pass(x), fv1);
fv1 = free_vars(ctx, sexp_cnd_fail(x), fv1); fv1 = sexp_free_vars(ctx, sexp_cnd_fail(x), fv1);
} else if (sexp_seqp(x)) { } else if (sexp_seqp(x)) {
for (x=sexp_seq_ls(x); sexp_pairp(x); x=sexp_cdr(x)) for (x=sexp_seq_ls(x); sexp_pairp(x); x=sexp_cdr(x))
fv1 = free_vars(ctx, sexp_car(x), fv1); fv1 = sexp_free_vars(ctx, sexp_car(x), fv1);
} else if (sexp_setp(x)) { } else if (sexp_setp(x)) {
fv1 = free_vars(ctx, sexp_set_value(x), fv); fv1 = sexp_free_vars(ctx, sexp_set_value(x), fv);
fv1 = free_vars(ctx, sexp_set_var(x), fv1); fv1 = sexp_free_vars(ctx, sexp_set_var(x), fv1);
} else if (sexp_refp(x) && sexp_lambdap(sexp_ref_loc(x))) { } else if (sexp_refp(x) && sexp_lambdap(sexp_ref_loc(x))) {
fv1 = insert_free_var(ctx, x, fv); fv1 = insert_free_var(ctx, x, fv);
} else if (sexp_synclop(x)) { } else if (sexp_synclop(x)) {
fv1 = free_vars(ctx, sexp_synclo_expr(x), fv); fv1 = sexp_free_vars(ctx, sexp_synclo_expr(x), fv);
} }
sexp_gc_release2(ctx); sexp_gc_release2(ctx);
return fv1; return fv1;
@ -2261,7 +2261,7 @@ static sexp sexp_string_cmp (sexp ctx, sexp str1, sexp str2, sexp ci) {
/************************** optimizations *****************************/ /************************** optimizations *****************************/
static sexp sexp_apply_optimization (sexp ctx, sexp proc, sexp ast) { sexp sexp_apply_optimization (sexp ctx, sexp proc, sexp ast) {
sexp res; sexp res;
sexp_gc_var1(args); sexp_gc_var1(args);
if (sexp_opcodep(proc)) { if (sexp_opcodep(proc)) {
@ -2701,7 +2701,7 @@ sexp sexp_compile (sexp ctx, sexp x) {
res = sexp_global(ctx, SEXP_G_OPTIMIZATIONS); res = sexp_global(ctx, SEXP_G_OPTIMIZATIONS);
for ( ; sexp_pairp(res); res=sexp_cdr(res)) for ( ; sexp_pairp(res); res=sexp_cdr(res))
ast = sexp_apply_optimization(ctx, sexp_cdar(res), ast); ast = sexp_apply_optimization(ctx, sexp_cdar(res), ast);
free_vars(ctx, ast, SEXP_NULL); /* should return SEXP_NULL */ sexp_free_vars(ctx, ast, SEXP_NULL); /* should return SEXP_NULL */
generate(ctx, ast); generate(ctx, ast);
res = finalize_bytecode(ctx); res = finalize_bytecode(ctx);
vec = sexp_make_vector(ctx, 0, SEXP_VOID); vec = sexp_make_vector(ctx, 0, SEXP_VOID);

3
include/chibi/eval.h
View file

@ -124,8 +124,11 @@ enum sexp_opcode_names {
SEXP_API void sexp_scheme_init (void); SEXP_API void sexp_scheme_init (void);
SEXP_API sexp sexp_make_eval_context (sexp context, sexp stack, sexp env, sexp_uint_t size); SEXP_API sexp sexp_make_eval_context (sexp context, sexp stack, sexp env, sexp_uint_t size);
SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda); SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda);
SEXP_API sexp sexp_compile_error (sexp ctx, char *message, sexp obj);
SEXP_API sexp sexp_analyze (sexp context, sexp x); SEXP_API sexp sexp_analyze (sexp context, sexp x);
SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args); SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args);
SEXP_API sexp sexp_apply_optimization (sexp context, sexp proc, sexp ast);
SEXP_API sexp sexp_free_vars (sexp context, sexp x, sexp fv);
SEXP_API sexp sexp_eval (sexp context, sexp obj, sexp env); SEXP_API sexp sexp_eval (sexp context, sexp obj, sexp env);
SEXP_API sexp sexp_eval_string (sexp context, char *str, sexp env); SEXP_API sexp sexp_eval_string (sexp context, char *str, sexp env);
SEXP_API sexp sexp_load (sexp context, sexp expr, sexp env); SEXP_API sexp sexp_load (sexp context, sexp expr, sexp env);