diff --git a/include/chibi/features.h b/include/chibi/features.h index aad53596..081faa4a 100644 --- a/include/chibi/features.h +++ b/include/chibi/features.h @@ -1,5 +1,5 @@ /* features.h -- general feature configuration */ -/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ /* uncomment this to disable most features */ @@ -393,6 +393,14 @@ #define SEXP_USE_HASH_SYMS ! SEXP_USE_NO_FEATURES #endif +#ifndef SEXP_USE_FOLD_CASE_SYMS +#define SEXP_USE_FOLD_CASE_SYMS ! SEXP_USE_NO_FEATURES +#endif + +#ifndef SEXP_DEFAULT_FOLD_CASE_SYMS +#define SEXP_DEFAULT_FOLD_CASE_SYMS 0 +#endif + #ifndef SEXP_USE_DEBUG_VM #define SEXP_USE_DEBUG_VM 0 #endif diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 02a35cc4..5b828c87 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -277,7 +277,7 @@ struct sexp_struct { struct { FILE *stream; char *buf; - char openp, no_closep, sourcep, blockedp; + char openp, no_closep, sourcep, blockedp, fold_casep; sexp_uint_t offset, line, flags; size_t size; sexp name; @@ -686,18 +686,19 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #define sexp_symbol_data(x) (sexp_field(x, symbol, SEXP_SYMBOL, data)) #define sexp_symbol_length(x) (sexp_field(x, symbol, SEXP_SYMBOL, length)) -#define sexp_port_stream(p) (sexp_pred_field(p, port, sexp_portp, stream)) -#define sexp_port_name(p) (sexp_pred_field(p, port, sexp_portp, name)) -#define sexp_port_line(p) (sexp_pred_field(p, port, sexp_portp, line)) -#define sexp_port_openp(p) (sexp_pred_field(p, port, sexp_portp, openp)) -#define sexp_port_no_closep(p) (sexp_pred_field(p, port, sexp_portp, no_closep)) -#define sexp_port_sourcep(p) (sexp_pred_field(p, port, sexp_portp, sourcep)) -#define sexp_port_blockedp(p) (sexp_pred_field(p, port, sexp_portp, blockedp)) -#define sexp_port_cookie(p) (sexp_pred_field(p, port, sexp_portp, cookie)) -#define sexp_port_buf(p) (sexp_pred_field(p, port, sexp_portp, buf)) -#define sexp_port_size(p) (sexp_pred_field(p, port, sexp_portp, size)) -#define sexp_port_offset(p) (sexp_pred_field(p, port, sexp_portp, offset)) -#define sexp_port_flags(p) (sexp_pred_field(p, port, sexp_portp, flags)) +#define sexp_port_stream(p) (sexp_pred_field(p, port, sexp_portp, stream)) +#define sexp_port_name(p) (sexp_pred_field(p, port, sexp_portp, name)) +#define sexp_port_line(p) (sexp_pred_field(p, port, sexp_portp, line)) +#define sexp_port_openp(p) (sexp_pred_field(p, port, sexp_portp, openp)) +#define sexp_port_no_closep(p) (sexp_pred_field(p, port, sexp_portp, no_closep)) +#define sexp_port_sourcep(p) (sexp_pred_field(p, port, sexp_portp, sourcep)) +#define sexp_port_blockedp(p) (sexp_pred_field(p, port, sexp_portp, blockedp)) +#define sexp_port_fold_casep(p) (sexp_pred_field(p, port, sexp_portp, fold_casep)) +#define sexp_port_cookie(p) (sexp_pred_field(p, port, sexp_portp, cookie)) +#define sexp_port_buf(p) (sexp_pred_field(p, port, sexp_portp, buf)) +#define sexp_port_size(p) (sexp_pred_field(p, port, sexp_portp, size)) +#define sexp_port_offset(p) (sexp_pred_field(p, port, sexp_portp, offset)) +#define sexp_port_flags(p) (sexp_pred_field(p, port, sexp_portp, flags)) #define sexp_exception_kind(x) (sexp_field(x, exception, SEXP_EXCEPTION, kind)) #define sexp_exception_message(x) (sexp_field(x, exception, SEXP_EXCEPTION, message)) @@ -950,6 +951,9 @@ enum sexp_context_globals { SEXP_G_ERR_HANDLER, SEXP_G_RESUMECC_BYTECODE, SEXP_G_FINAL_RESUMER, +#if SEXP_USE_FOLD_CASE_SYMS + SEXP_G_FOLD_CASE_P, +#endif #if SEXP_USE_WEAK_REFERENCES SEXP_G_WEAK_REFERENCE_CACHE, #endif diff --git a/main.c b/main.c index 592e3df9..7becccdf 100644 --- a/main.c +++ b/main.c @@ -112,6 +112,7 @@ static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) { fprintf(stderr, "chibi-scheme: out of memory\n"); \ exit_failure(); \ } \ + sexp_global(ctx, SEXP_G_FOLD_CASE_P) = sexp_make_boolean(fold_case); \ env = sexp_context_env(ctx); \ sexp_gc_preserve2(ctx, tmp, args); \ } while (0) @@ -124,7 +125,7 @@ static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) { void run_main (int argc, char **argv) { char *arg, *impmod, *p; sexp out=SEXP_FALSE, res=SEXP_VOID, env=NULL, ctx=NULL; - sexp_sint_t i, j, len, quit=0, print=0, init_loaded=0; + sexp_sint_t i, j, len, quit=0, print=0, init_loaded=0, fold_case=SEXP_DEFAULT_FOLD_CASE_SYMS; sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE; sexp_gc_var2(tmp, args); args = SEXP_NULL; @@ -207,6 +208,10 @@ void run_main (int argc, char **argv) { sexp_write(ctx, tmp, out); sexp_newline(ctx, out); return; + case 'f': + fold_case = 1; + if (ctx) sexp_global(ctx, SEXP_G_FOLD_CASE_P) = SEXP_TRUE; + break; default: fprintf(stderr, "unknown option: %s\n", argv[i]); exit_failure(); diff --git a/sexp.c b/sexp.c index e5e40c03..878be4b3 100644 --- a/sexp.c +++ b/sexp.c @@ -277,6 +277,9 @@ void sexp_init_context_globals (sexp ctx) { = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID); #if ! SEXP_USE_GLOBAL_SYMBOLS sexp_global(ctx, SEXP_G_SYMBOLS) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_SYMBOL_TABLE_SIZE), SEXP_NULL); +#endif +#if SEXP_USE_FOLD_CASE_SYMS + sexp_global(ctx, SEXP_G_FOLD_CASE_P) = sexp_make_boolean(SEXP_DEFAULT_FOLD_CASE_SYMS); #endif sexp_global(ctx, SEXP_G_OOM_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of memory", SEXP_NULL); sexp_global(ctx, SEXP_G_OOS_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of stack space", SEXP_NULL); @@ -1253,6 +1256,9 @@ sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) { sexp_port_no_closep(p) = 0; sexp_port_sourcep(p) = 0; sexp_port_blockedp(p) = 0; +#if SEXP_USE_FOLD_CASE_SYMS + sexp_port_fold_casep(p) = sexp_truep(sexp_global(ctx, SEXP_G_FOLD_CASE_P)); +#endif sexp_port_cookie(p) = SEXP_VOID; return p; } @@ -1537,11 +1543,18 @@ sexp sexp_read_symbol (sexp ctx, sexp in, int init, int internp) { char initbuf[INIT_STRING_BUFFER_SIZE]; char *buf=initbuf, *tmp; sexp res; +#if SEXP_USE_FOLD_CASE_SYMS + int foldp = sexp_port_fold_casep(in); + init = (foldp ? tolower(init) : init); +#endif if (init != EOF) buf[i++] = init; for (c = sexp_read_char(ctx, in); c != '"'; c = sexp_read_char(ctx, in)) { +#if SEXP_USE_FOLD_CASE_SYMS + if (foldp) c = tolower(c); +#endif if (c == '\\') c = sexp_read_char(ctx, in); if (c == EOF || is_separator(c)) { sexp_push_char(ctx, c, in);