mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 06:39:17 +02:00
Adding support for case-folding.
This commit is contained in:
Alex Shinn
parent
e4659ff649
commit
e6ba6e59a5
4 changed files with 45 additions and 15 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
7
main.c
7
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();
|
||||
|
|
|
|||
13
sexp.c
13
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);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue