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

Adding support for case-folding.

Browse source
This commit is contained in:
Alex Shinn 2011-03-03 00:31:32 +09:00
parent e4659ff649
commit e6ba6e59a5
4 changed files with 45 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
include/chibi/features.h
View file

@ -1,5 +1,5 @@
/* features.h -- general feature configuration */ /* 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 */ /* BSD-style license: http://synthcode.com/license.txt */
/* uncomment this to disable most features */ /* uncomment this to disable most features */
@ -393,6 +393,14 @@
#define SEXP_USE_HASH_SYMS ! SEXP_USE_NO_FEATURES #define SEXP_USE_HASH_SYMS ! SEXP_USE_NO_FEATURES
#endif #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 #ifndef SEXP_USE_DEBUG_VM
#define SEXP_USE_DEBUG_VM 0 #define SEXP_USE_DEBUG_VM 0
#endif #endif

30
include/chibi/sexp.h
View file

@ -277,7 +277,7 @@ struct sexp_struct {
struct { struct {
FILE *stream; FILE *stream;
char *buf; char *buf;
char openp, no_closep, sourcep, blockedp; char openp, no_closep, sourcep, blockedp, fold_casep;
sexp_uint_t offset, line, flags; sexp_uint_t offset, line, flags;
size_t size; size_t size;
sexp name; 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_data(x) (sexp_field(x, symbol, SEXP_SYMBOL, data))
#define sexp_symbol_length(x) (sexp_field(x, symbol, SEXP_SYMBOL, length)) #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_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_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_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_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_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_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_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_fold_casep(p) (sexp_pred_field(p, port, sexp_portp, fold_casep))
#define sexp_port_buf(p) (sexp_pred_field(p, port, sexp_portp, buf)) #define sexp_port_cookie(p) (sexp_pred_field(p, port, sexp_portp, cookie))
#define sexp_port_size(p) (sexp_pred_field(p, port, sexp_portp, size)) #define sexp_port_buf(p) (sexp_pred_field(p, port, sexp_portp, buf))
#define sexp_port_offset(p) (sexp_pred_field(p, port, sexp_portp, offset)) #define sexp_port_size(p) (sexp_pred_field(p, port, sexp_portp, size))
#define sexp_port_flags(p) (sexp_pred_field(p, port, sexp_portp, flags)) #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_kind(x) (sexp_field(x, exception, SEXP_EXCEPTION, kind))
#define sexp_exception_message(x) (sexp_field(x, exception, SEXP_EXCEPTION, message)) #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_ERR_HANDLER,
SEXP_G_RESUMECC_BYTECODE, SEXP_G_RESUMECC_BYTECODE,
SEXP_G_FINAL_RESUMER, SEXP_G_FINAL_RESUMER,
#if SEXP_USE_FOLD_CASE_SYMS
SEXP_G_FOLD_CASE_P,
#endif
#if SEXP_USE_WEAK_REFERENCES #if SEXP_USE_WEAK_REFERENCES
SEXP_G_WEAK_REFERENCE_CACHE, SEXP_G_WEAK_REFERENCE_CACHE,
#endif #endif

7
main.c
View file

@ -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"); \ fprintf(stderr, "chibi-scheme: out of memory\n"); \
exit_failure(); \ exit_failure(); \
} \ } \
sexp_global(ctx, SEXP_G_FOLD_CASE_P) = sexp_make_boolean(fold_case); \
env = sexp_context_env(ctx); \ env = sexp_context_env(ctx); \
sexp_gc_preserve2(ctx, tmp, args); \ sexp_gc_preserve2(ctx, tmp, args); \
} while (0) } 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) { void run_main (int argc, char **argv) {
char *arg, *impmod, *p; char *arg, *impmod, *p;
sexp out=SEXP_FALSE, res=SEXP_VOID, env=NULL, ctx=NULL; 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_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE;
sexp_gc_var2(tmp, args); sexp_gc_var2(tmp, args);
args = SEXP_NULL; args = SEXP_NULL;
@ -207,6 +208,10 @@ void run_main (int argc, char **argv) {
sexp_write(ctx, tmp, out); sexp_write(ctx, tmp, out);
sexp_newline(ctx, out); sexp_newline(ctx, out);
return; return;
case 'f':
fold_case = 1;
if (ctx) sexp_global(ctx, SEXP_G_FOLD_CASE_P) = SEXP_TRUE;
break;
default: default:
fprintf(stderr, "unknown option: %s\n", argv[i]); fprintf(stderr, "unknown option: %s\n", argv[i]);
exit_failure(); exit_failure();

13
sexp.c
View file

@ -277,6 +277,9 @@ void sexp_init_context_globals (sexp ctx) {
= sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID); = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_G_NUM_GLOBALS), SEXP_VOID);
#if ! SEXP_USE_GLOBAL_SYMBOLS #if ! SEXP_USE_GLOBAL_SYMBOLS
sexp_global(ctx, SEXP_G_SYMBOLS) = sexp_make_vector(ctx, sexp_make_fixnum(SEXP_SYMBOL_TABLE_SIZE), SEXP_NULL); 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 #endif
sexp_global(ctx, SEXP_G_OOM_ERROR) = sexp_user_exception(ctx, SEXP_FALSE, "out of memory", SEXP_NULL); 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); 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_no_closep(p) = 0;
sexp_port_sourcep(p) = 0; sexp_port_sourcep(p) = 0;
sexp_port_blockedp(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; sexp_port_cookie(p) = SEXP_VOID;
return p; 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 initbuf[INIT_STRING_BUFFER_SIZE];
char *buf=initbuf, *tmp; char *buf=initbuf, *tmp;
sexp res; sexp res;
#if SEXP_USE_FOLD_CASE_SYMS
int foldp = sexp_port_fold_casep(in);
init = (foldp ? tolower(init) : init);
#endif
if (init != EOF) if (init != EOF)
buf[i++] = init; buf[i++] = init;
for (c = sexp_read_char(ctx, in); c != '"'; c = sexp_read_char(ctx, in)) { 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 == '\\') c = sexp_read_char(ctx, in);
if (c == EOF || is_separator(c)) { if (c == EOF || is_separator(c)) {
sexp_push_char(ctx, c, in); sexp_push_char(ctx, c, in);