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

fixing syntactic-closure free-variable references for wrapped expressions

Browse source 
(also renaming %env-copy! to %import)
This commit is contained in:
Alex Shinn 2011-05-21 16:42:02 -07:00
parent 78f0e9bd22
commit 987b6d98fb
5 changed files with 28 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
eval.c
View file

@ -178,6 +178,27 @@ sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value) {
return e;
}
sexp sexp_extend_synclo_env (sexp ctx, sexp env) {
sexp e1, e2;
sexp_gc_var1(e);
sexp_gc_preserve1(ctx, e);
e = env;
if (sexp_pairp(sexp_context_fv(ctx))) {
e = sexp_alloc_type(ctx, env, SEXP_ENV);
for (e1=env, e2=NULL; e1; e1=sexp_env_parent(e1)) {
e2 = e2 ? (sexp_env_parent(e2) = sexp_alloc_type(ctx, env, SEXP_ENV)) : e;
sexp_env_bindings(e2) = sexp_env_bindings(e1);
sexp_env_syntactic_p(e2) = 1;
#if SEXP_USE_RENAME_BINDINGS
sexp_env_renames(e2) = sexp_env_renames(e1);
#endif
}
sexp_env_parent(e2) = sexp_context_env(ctx);
}
sexp_gc_release1(ctx);
return e;
}
static sexp sexp_reverse_flatten_dot (sexp ctx, sexp ls) {
sexp_gc_var1(res);
sexp_gc_preserve1(ctx, res);
@ -871,10 +892,10 @@ static sexp analyze (sexp ctx, sexp object) {
res = analyze_var_ref(ctx, x, NULL);
} else if (sexp_synclop(x)) {
tmp = sexp_make_child_context(ctx, sexp_context_lambda(ctx));
sexp_context_env(tmp) = sexp_synclo_env(x);
sexp_context_fv(tmp) = sexp_append2(tmp,
sexp_synclo_free_vars(x),
sexp_context_fv(tmp));
sexp_context_env(tmp) = sexp_extend_synclo_env(tmp, sexp_synclo_env(x));
x = sexp_synclo_expr(x);
res = analyze(tmp, x);
} else if (sexp_nullp(x)) {
@ -1778,7 +1799,7 @@ sexp sexp_make_standard_env_op (sexp ctx sexp_api_params(self, n), sexp version)
#define sexp_same_bindingp(x, y) (sexp_env_value(x) == sexp_env_value(y))
#endif
sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp) {
sexp sexp_env_import_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp) {
sexp oldname, newname;
sexp_gc_var2(value, oldcell);
sexp_gc_preserve2(ctx, value, oldcell);

4
include/chibi/eval.h
View file

@ -156,7 +156,7 @@ SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file);
SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env);
SEXP_API sexp sexp_add_module_directory_op (sexp ctx sexp_api_params(self, n), sexp dir, sexp appendp);
SEXP_API sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value);
SEXP_API sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp);
SEXP_API sexp sexp_env_import_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp);
SEXP_API sexp sexp_identifier_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_syntactic_closure_expr(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_identifier_eq_op(sexp ctx sexp_api_params(self, n), sexp a, sexp b, sexp c, sexp d);
@ -200,7 +200,7 @@ SEXP_API sexp sexp_make_setter_op (sexp ctx sexp_api_params(self, n), sexp name,
#define sexp_add_module_directory(ctx, d, a) sexp_add_module_directory_op(ctx sexp_api_pass(NULL, 1), d, a)
#define sexp_eval(ctx, x, e) sexp_eval_op(ctx sexp_api_pass(NULL, 2), x, e)
#define sexp_load(ctx, f, e) sexp_load_op(ctx sexp_api_pass(NULL, 2), f, e)
#define sexp_env_copy(ctx, a, b, c, d) sexp_env_copy_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
#define sexp_env_import(ctx, a, b, c, d) sexp_env_import_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
#define sexp_identifierp(ctx, x) sexp_identifierp_op(ctx sexp_api_pass(NULL, 1), x)
#define sexp_identifier_to_symbol(ctx, x) sexp_syntactic_closure_expr(ctx sexp_api_pass(NULL, 1), x)
#define sexp_identifier_eq(ctx, a, b, c, d) sexp_identifier_eq_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)

2
lib/config.scm
View file

@ -110,7 +110,7 @@
(lambda (m)
(let* ((mod2-name+imports (resolve-import m))
(mod2 (load-module (car mod2-name+imports))))
(%env-copy! env (module-env mod2) (cdr mod2-name+imports) #t)))
(%import env (module-env mod2) (cdr mod2-name+imports) #t)))
(cdr x)))))
(module-meta-data mod))
(for-each

2
lib/init.scm
View file

@ -897,7 +897,7 @@
(let ((mod+imps (eval `(resolve-import ',(car ls)) *config-env*)))
(if (pair? mod+imps)
(lp (cdr ls)
(cons `(%env-copy!
(cons `(%import
#f
(vector-ref
(eval '(load-module ',(car mod+imps)) *config-env*)

2
opcodes.c
View file

@ -118,7 +118,7 @@ _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op
_FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op),
_FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op),
_FN2OPTP(SEXP_VOID, _I(SEXP_STRING), _I(SEXP_ENV), "load", (sexp)"interaction-environment", sexp_load_op),
_FN4(SEXP_VOID, _I(SEXP_ENV), _I(SEXP_ENV), _I(SEXP_OBJECT), "%env-copy!", 0, sexp_env_copy_op),
_FN4(SEXP_VOID, _I(SEXP_ENV), _I(SEXP_ENV), _I(SEXP_OBJECT), "%import", 0, sexp_env_import_op),
_FN2(SEXP_VOID, _I(SEXP_EXCEPTION), _I(SEXP_OPORT), "print-exception", 0, sexp_print_exception_op),
_FN1(_I(SEXP_OBJECT), _I(SEXP_EXCEPTION), "exception-type", 0, sexp_exception_type_op),
_FN2OPT(_I(SEXP_STRING), _I(SEXP_FIXNUM), _I(SEXP_CHAR), "make-string", sexp_make_character(' '), sexp_make_string_op),