Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

making features a context global

Browse source
This commit is contained in:
Alex Shinn 2016-06-12 14:25:46 +09:00
parent 8359b48a59
commit 08494037ea
4 changed files with 63 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
eval.c
View file

@ -2349,53 +2349,9 @@ sexp sexp_load_standard_ports (sexp ctx, sexp env, FILE* in, FILE* out,
return SEXP_VOID;
}
static const char* sexp_initial_features[] = {
sexp_platform,
#if SEXP_BSD
"bsd",
#endif
#if defined(_WIN32) || defined(__MINGW32__)
"windows",
#endif
#if SEXP_USE_DL
"dynamic-loading",
#endif
#if SEXP_USE_BIDIRECTIONAL_PORTS
"bidir-ports",
#endif
#if SEXP_USE_MODULES
"modules",
#endif
#if SEXP_USE_BOEHM
"boehm-gc",
#endif
#if SEXP_USE_UTF8_STRINGS
"full-unicode",
#endif
#if SEXP_USE_GREEN_THREADS
"threads",
#endif
#if SEXP_USE_NTP_GETTIME
"ntp",
#endif
#if SEXP_USE_AUTO_FORCE
"auto-force",
#endif
#if SEXP_USE_COMPLEX
"complex",
#endif
#if SEXP_USE_RATIOS
"ratios",
#endif
"r7rs",
"chibi",
NULL,
};
sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
int len;
char init_file[128];
const char** features;
int endianess_check = 1;
sexp_gc_var3(op, tmp, sym);
sexp_gc_preserve3(ctx, op, tmp, sym);
@ -2404,9 +2360,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
tmp=sexp_c_string(ctx, sexp_so_extension, -1));
tmp = SEXP_NULL;
sexp_push(ctx, tmp, sym=sexp_intern(ctx, (*(unsigned char*) &endianess_check) ? "little-endian" : "big-endian", -1));
for (features=sexp_initial_features; *features; features++)
sexp_push(ctx, tmp, sym=sexp_intern(ctx, *features, -1));
sexp_env_define(ctx, e, sym=sexp_intern(ctx, "*features*", -1), tmp);
sexp_env_define(ctx, e, sym=sexp_intern(ctx, "*features*", -1), sexp_global(ctx, SEXP_G_FEATURES));
sexp_global(ctx, SEXP_G_OPTIMIZATIONS) = SEXP_NULL;
#if SEXP_USE_SIMPLIFY
op = sexp_make_foreign(ctx, "sexp_simplify", 1, 0,

1
include/chibi/sexp.h
View file

@ -1320,6 +1320,7 @@ enum sexp_context_globals {
SEXP_G_SYMBOLS,
#endif
SEXP_G_TYPES,
SEXP_G_FEATURES,
SEXP_G_NUM_TYPES,
SEXP_G_OOM_ERROR, /* out of memory exception object */
SEXP_G_OOS_ERROR, /* out of stack exception object */

22
main.c
View file

@ -236,8 +236,8 @@ static sexp sexp_add_import_binding (sexp ctx, sexp env) {
}
static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k, int bootp) {
sexp_gc_var1(e);
sexp_gc_preserve1(ctx, e);
sexp_gc_var3(e, ls, sym);
sexp_gc_preserve3(ctx, e, ls, sym);
e = sexp_load_standard_env(ctx, env, k);
if (!sexp_exceptionp(e)) {
#if SEXP_USE_MODULES
@ -249,7 +249,7 @@ static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k, int bootp)
if (!sexp_exceptionp(e))
e = sexp_load_standard_params(ctx, e);
}
sexp_gc_release1(ctx);
sexp_gc_release3(ctx);
return e;
}
@ -296,7 +296,7 @@ sexp run_main (int argc, char **argv) {
sexp_sint_t i, j, c, quit=0, print=0, init_loaded=0, mods_loaded=0,
fold_case=SEXP_DEFAULT_FOLD_CASE_SYMS;
sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE;
sexp out=SEXP_FALSE, ctx=NULL;
sexp out=SEXP_FALSE, ctx=NULL, ls;
sexp_gc_var4(tmp, sym, args, env);
args = SEXP_NULL;
env = NULL;
@ -305,14 +305,14 @@ sexp run_main (int argc, char **argv) {
for (i=1; i < argc && argv[i][0] == '-'; i++) {
switch ((c=argv[i][1])) {
case 'D':
mods_loaded = 1;
load_init(1);
tmp = sexp_env_ref(ctx, env, sym=sexp_intern(ctx, "*features*", -1), SEXP_NULL);
if (sexp_pairp(tmp)) {
sym = sexp_intern(ctx, ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2), -1);
for (; sexp_pairp(sexp_cdr(tmp)); tmp=sexp_cdr(tmp))
init_context();
arg = (argv[i][2] == '\0') ? argv[++i] : argv[i]+2;
sym = sexp_intern(ctx, arg, -1);
ls = sexp_global(ctx, SEXP_G_FEATURES);
if (sexp_pairp(ls)) {
for (; sexp_pairp(sexp_cdr(ls)); ls=sexp_cdr(ls))
;
sexp_cdr(tmp) = sexp_cons(ctx, sym, SEXP_NULL);
sexp_cdr(ls) = sexp_cons(ctx, sym, SEXP_NULL);
}
break;
case 'e':

51
sexp.c
View file

@ -381,9 +381,53 @@ sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj) {
/****************************** contexts ******************************/
static const char* sexp_initial_features[] = {
sexp_platform,
#if SEXP_BSD
"bsd",
#endif
#if defined(_WIN32) || defined(__MINGW32__)
"windows",
#endif
#if SEXP_USE_DL
"dynamic-loading",
#endif
#if SEXP_USE_BIDIRECTIONAL_PORTS
"bidir-ports",
#endif
#if SEXP_USE_MODULES
"modules",
#endif
#if SEXP_USE_BOEHM
"boehm-gc",
#endif
#if SEXP_USE_UTF8_STRINGS
"full-unicode",
#endif
#if SEXP_USE_GREEN_THREADS
"threads",
#endif
#if SEXP_USE_NTP_GETTIME
"ntp",
#endif
#if SEXP_USE_AUTO_FORCE
"auto-force",
#endif
#if SEXP_USE_COMPLEX
"complex",
#endif
#if SEXP_USE_RATIOS
"ratios",
#endif
"r7rs",
"chibi",
NULL,
};
void sexp_init_context_globals (sexp ctx) {
sexp type, *vec, print=NULL;
const char** features;
int i;
sexp type, *vec, print=NULL;
sexp_context_globals(ctx)
= sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID);
#if ! SEXP_USE_GLOBAL_SYMBOLS
@ -415,6 +459,11 @@ void sexp_init_context_globals (sexp ctx) {
sexp_global(ctx, SEXP_G_CONTINUABLE_SYMBOL) = sexp_intern(ctx, "continuable", -1);
sexp_global(ctx, SEXP_G_EMPTY_VECTOR) = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
sexp_vector_length(sexp_global(ctx, SEXP_G_EMPTY_VECTOR)) = 0;
sexp_global(ctx, SEXP_G_FEATURES) = SEXP_NULL;
for (features=sexp_initial_features; *features; features++) {
sexp_push(ctx, sexp_global(ctx, SEXP_G_FEATURES), SEXP_FALSE);
sexp_car(sexp_global(ctx, SEXP_G_FEATURES)) = sexp_intern(ctx, *features, -1);
}
sexp_global(ctx, SEXP_G_NUM_TYPES) = sexp_make_fixnum(SEXP_NUM_CORE_TYPES);
sexp_global(ctx, SEXP_G_TYPES)
= sexp_make_vector(ctx, sexp_make_fixnum(SEXP_INIT_NUM_TYPES), SEXP_VOID);