Adding environment-parent binding so we can traverse a full env hierarchy.

This commit is contained in:
Alex Shinn 2011-12-04 20:35:13 +09:00
parent ca55194c78
commit 81567045f3
2 changed files with 7 additions and 0 deletions

View file

@ -181,6 +181,11 @@ static sexp sexp_type_of (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
return sexp_type_by_index(ctx, SEXP_OBJECT); return sexp_type_by_index(ctx, SEXP_OBJECT);
} }
static sexp sexp_env_parent_op (sexp ctx, sexp self, sexp_sint_t n, sexp e) {
sexp_assert_type(ctx, sexp_envp, SEXP_ENV, e);
return sexp_env_parent(e) ? sexp_env_parent(e) : SEXP_FALSE;
}
static sexp sexp_type_name_op (sexp ctx, sexp self, sexp_sint_t n, sexp t) { static sexp sexp_type_name_op (sexp ctx, sexp self, sexp_sint_t n, sexp t) {
sexp_assert_type(ctx, sexp_typep, SEXP_TYPE, t); sexp_assert_type(ctx, sexp_typep, SEXP_TYPE, t);
return sexp_type_name(t); return sexp_type_name(t);
@ -450,6 +455,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_define_foreign(ctx, env, "type-slots", 1, sexp_type_slots_op); sexp_define_foreign(ctx, env, "type-slots", 1, sexp_type_slots_op);
sexp_define_foreign(ctx, env, "type-num-slots", 1, sexp_type_num_slots_op); sexp_define_foreign(ctx, env, "type-num-slots", 1, sexp_type_num_slots_op);
sexp_define_foreign(ctx, env, "type-printer", 1, sexp_type_printer_op); sexp_define_foreign(ctx, env, "type-printer", 1, sexp_type_printer_op);
sexp_define_foreign(ctx, env, "environment-parent", 1, sexp_env_parent_op);
sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size); sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size);
sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE); sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE);
sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op); sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);

View file

@ -30,6 +30,7 @@
bytecode-name bytecode-literals bytecode-source bytecode-name bytecode-literals bytecode-source
pair-source pair-source-set! pair-source pair-source-set!
port-line port-line-set! port-line port-line-set!
environment-parent
type-name type-cpl type-parent type-slots type-num-slots type-printer type-name type-cpl type-parent type-slots type-num-slots type-printer
object-size integer->immediate gc object-size integer->immediate gc
string-contains integer->error-string string-contains integer->error-string