Adding setenv/unsetenv.

This commit is contained in:
Alex Shinn 2013-08-29 23:18:31 +09:00
parent 8629b10ca0
commit 76b0209725
2 changed files with 14 additions and 1 deletions

View file

@ -453,6 +453,17 @@ static sexp sexp_update_free_vars (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
return sexp_free_vars(ctx, x, SEXP_NULL); return sexp_free_vars(ctx, x, SEXP_NULL);
} }
static sexp sexp_setenv (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp value) {
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, name);
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, value);
return sexp_make_boolean(setenv(sexp_string_data(name), sexp_string_data(value), 1));
}
static sexp sexp_unsetenv (sexp ctx, sexp self, sexp_sint_t n, sexp name) {
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, name);
return sexp_make_boolean(unsetenv(sexp_string_data(name)));
}
#define sexp_define_type(ctx, name, tag) \ #define sexp_define_type(ctx, name, tag) \
sexp_env_define(ctx, env, sexp_intern(ctx, name, -1), sexp_type_by_index(ctx, tag)); sexp_env_define(ctx, env, sexp_intern(ctx, name, -1), sexp_type_by_index(ctx, tag));
@ -591,5 +602,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_define_foreign(ctx, env, "string-contains", 2, sexp_string_contains); sexp_define_foreign(ctx, env, "string-contains", 2, sexp_string_contains);
sexp_define_foreign_opt(ctx, env, "integer->error-string", 1, sexp_error_string, SEXP_FALSE); sexp_define_foreign_opt(ctx, env, "integer->error-string", 1, sexp_error_string, SEXP_FALSE);
sexp_define_foreign(ctx, env, "update-free-vars!", 1, sexp_update_free_vars); sexp_define_foreign(ctx, env, "update-free-vars!", 1, sexp_update_free_vars);
sexp_define_foreign(ctx, env, "setenv", 2, sexp_setenv);
sexp_define_foreign(ctx, env, "unsetenv", 1, sexp_unsetenv);
return SEXP_VOID; return SEXP_VOID;
} }

View file

@ -35,7 +35,7 @@
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 atomically thread-list object-size integer->immediate gc atomically thread-list
string-contains integer->error-string string-contains integer->error-string
flatten-dot update-free-vars!) flatten-dot update-free-vars! setenv unsetenv)
(import (chibi)) (import (chibi))
(include-shared "ast") (include-shared "ast")
(include "ast.scm")) (include "ast.scm"))