mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
* strports.c (scm_read_0str, scm_eval_0str): update scm_read usage.
* gdbint.c (gdb_read): update scm_lreadr usage. * load.h: update prototypes. * load.c (scm_primitive_load, scm_read_and_eval_x, scm_primitive_load_path): remove case_insensitive_p, sharp arguments. * read.h: add prototype for scm_read_hash_extend. Change args for other prototypes. * read.c (scm_read_hash_procedures): new variable. (scm_read_hash_extend): new procedure. (scm_get_hash_procedure): new procedure. * (scm_lreadr): use scm_get_hash_procedure instead of an argument for extended # processing. (scm_read, scm_lreadr, scm_lreadrecparen, scm_lreadparen, scm_read_token): remove case_i, sharp arguments. Change callers. * read.h (SCM_N_READ_OPTIONS): increase to 3. (SCM_CASE_INSENSITIVE_P): define. * read.c: add case-insensitive option to scm_read_opts. * (scm_read_token): use SCM_CASE_INSENSITIVE_P instead of an argument to determine whether to convert symbol case. (default_case_i): definition removed. * read.c (scm_read_token): if case_i, downcase ic before doing anything with it.
This commit is contained in:
parent
90d5e28037
commit
deca31e173
7 changed files with 151 additions and 96 deletions
|
@ -1,3 +1,37 @@
|
||||||
|
Sat Mar 8 00:27:05 1997 Gary Houston <ghouston@actrix.gen.nz>
|
||||||
|
|
||||||
|
* strports.c (scm_read_0str, scm_eval_0str): update scm_read usage.
|
||||||
|
|
||||||
|
* gdbint.c (gdb_read): update scm_lreadr usage.
|
||||||
|
|
||||||
|
* load.h: update prototypes.
|
||||||
|
|
||||||
|
* load.c (scm_primitive_load, scm_read_and_eval_x,
|
||||||
|
scm_primitive_load_path): remove case_insensitive_p, sharp arguments.
|
||||||
|
|
||||||
|
* read.h: add prototype for scm_read_hash_extend. Change args for
|
||||||
|
other prototypes.
|
||||||
|
|
||||||
|
* read.c (scm_read_hash_procedures): new variable.
|
||||||
|
(scm_read_hash_extend): new procedure.
|
||||||
|
(scm_get_hash_procedure): new procedure.
|
||||||
|
* (scm_lreadr): use scm_get_hash_procedure instead of an argument
|
||||||
|
for extended # processing.
|
||||||
|
(scm_read, scm_lreadr, scm_lreadrecparen, scm_lreadparen,
|
||||||
|
scm_read_token): remove case_i, sharp arguments. Change callers.
|
||||||
|
|
||||||
|
Fri Mar 7 08:58:21 1997 Gary Houston <ghouston@actrix.gen.nz>
|
||||||
|
|
||||||
|
* read.h (SCM_N_READ_OPTIONS): increase to 3.
|
||||||
|
(SCM_CASE_INSENSITIVE_P): define.
|
||||||
|
|
||||||
|
* read.c: add case-insensitive option to scm_read_opts.
|
||||||
|
* (scm_read_token): use SCM_CASE_INSENSITIVE_P instead of an argument
|
||||||
|
to determine whether to convert symbol case.
|
||||||
|
(default_case_i): definition removed.
|
||||||
|
* read.c (scm_read_token): if case_i, downcase ic before doing
|
||||||
|
anything with it.
|
||||||
|
|
||||||
Sat Mar 8 03:49:03 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
|
Sat Mar 8 03:49:03 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
|
||||||
|
|
||||||
* configure.in: Added configuration option `guile-debug'.
|
* configure.in: Added configuration option `guile-debug'.
|
||||||
|
|
|
@ -215,7 +215,7 @@ gdb_read (str)
|
||||||
/* Read one object */
|
/* Read one object */
|
||||||
tok_buf_mark_p = SCM_GC8MARKP (tok_buf);
|
tok_buf_mark_p = SCM_GC8MARKP (tok_buf);
|
||||||
SCM_CLRGC8MARK (tok_buf);
|
SCM_CLRGC8MARK (tok_buf);
|
||||||
ans = scm_lreadr (&tok_buf, gdb_input_port, 0, SCM_BOOL_F, &ans);
|
ans = scm_lreadr (&tok_buf, gdb_input_port, &ans);
|
||||||
if (SCM_GC_P)
|
if (SCM_GC_P)
|
||||||
{
|
{
|
||||||
if (SCM_NIMP (ans))
|
if (SCM_NIMP (ans))
|
||||||
|
|
|
@ -68,12 +68,10 @@
|
||||||
Applied to the full name of the file. */
|
Applied to the full name of the file. */
|
||||||
static SCM *scm_loc_load_hook;
|
static SCM *scm_loc_load_hook;
|
||||||
|
|
||||||
SCM_PROC(s_primitive_load, "primitive-load", 1, 2, 0, scm_primitive_load);
|
SCM_PROC(s_primitive_load, "primitive-load", 1, 0, 0, scm_primitive_load);
|
||||||
SCM
|
SCM
|
||||||
scm_primitive_load (filename, case_insensitive_p, sharp)
|
scm_primitive_load (filename)
|
||||||
SCM filename;
|
SCM filename;
|
||||||
SCM case_insensitive_p;
|
|
||||||
SCM sharp;
|
|
||||||
{
|
{
|
||||||
SCM hook = *scm_loc_load_hook;
|
SCM hook = *scm_loc_load_hook;
|
||||||
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
|
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
|
||||||
|
@ -92,7 +90,7 @@ scm_primitive_load (filename, case_insensitive_p, sharp)
|
||||||
scm_makfromstr ("r", (scm_sizet) sizeof (char), 0));
|
scm_makfromstr ("r", (scm_sizet) sizeof (char), 0));
|
||||||
while (1)
|
while (1)
|
||||||
{
|
{
|
||||||
form = scm_read (port, case_insensitive_p, sharp);
|
form = scm_read (port);
|
||||||
if (SCM_EOF_VAL == form)
|
if (SCM_EOF_VAL == form)
|
||||||
break;
|
break;
|
||||||
scm_eval_x (form);
|
scm_eval_x (form);
|
||||||
|
@ -277,12 +275,10 @@ scm_sys_search_load_path (filename)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
SCM_PROC(s_primitive_load_path, "primitive-load-path", 1, 2, 0, scm_primitive_load_path);
|
SCM_PROC(s_primitive_load_path, "primitive-load-path", 1, 0, 0, scm_primitive_load_path);
|
||||||
SCM
|
SCM
|
||||||
scm_primitive_load_path (filename, case_insensitive_p, sharp)
|
scm_primitive_load_path (filename)
|
||||||
SCM filename;
|
SCM filename;
|
||||||
SCM case_insensitive_p;
|
|
||||||
SCM sharp;
|
|
||||||
{
|
{
|
||||||
SCM full_filename;
|
SCM full_filename;
|
||||||
|
|
||||||
|
@ -302,7 +298,7 @@ scm_primitive_load_path (filename, case_insensitive_p, sharp)
|
||||||
scm_listify (filename, SCM_UNDEFINED));
|
scm_listify (filename, SCM_UNDEFINED));
|
||||||
}
|
}
|
||||||
|
|
||||||
return scm_primitive_load (full_filename, case_insensitive_p, sharp);
|
return scm_primitive_load (full_filename);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* The following function seems trivial - and indeed it is. Its
|
/* The following function seems trivial - and indeed it is. Its
|
||||||
|
@ -312,15 +308,13 @@ scm_primitive_load_path (filename, case_insensitive_p, sharp)
|
||||||
|
|
||||||
SCM_SYMBOL (scm_end_of_file_key, "end-of-file");
|
SCM_SYMBOL (scm_end_of_file_key, "end-of-file");
|
||||||
|
|
||||||
SCM_PROC (s_read_and_eval_x, "read-and-eval!", 0, 3, 0, scm_read_and_eval_x);
|
SCM_PROC (s_read_and_eval_x, "read-and-eval!", 0, 1, 0, scm_read_and_eval_x);
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_read_and_eval_x (port, case_insensitive_p, sharp)
|
scm_read_and_eval_x (port)
|
||||||
SCM port;
|
SCM port;
|
||||||
SCM case_insensitive_p;
|
|
||||||
SCM sharp;
|
|
||||||
{
|
{
|
||||||
SCM form = scm_read (port, case_insensitive_p, sharp);
|
SCM form = scm_read (port);
|
||||||
if (form == SCM_EOF_VAL)
|
if (form == SCM_EOF_VAL)
|
||||||
scm_ithrow (scm_end_of_file_key, SCM_EOL, 1);
|
scm_ithrow (scm_end_of_file_key, SCM_EOL, 1);
|
||||||
return scm_eval_x (form);
|
return scm_eval_x (form);
|
||||||
|
|
|
@ -47,14 +47,11 @@
|
||||||
|
|
||||||
|
|
||||||
extern void scm_init_load_path SCM_P ((void));
|
extern void scm_init_load_path SCM_P ((void));
|
||||||
extern SCM scm_primitive_load SCM_P ((SCM filename, SCM casep, SCM sharp));
|
extern SCM scm_primitive_load SCM_P ((SCM filename));
|
||||||
extern SCM scm_sys_package_data_dir SCM_P ((void));
|
extern SCM scm_sys_package_data_dir SCM_P ((void));
|
||||||
extern SCM scm_sys_search_load_path SCM_P ((SCM filename));
|
extern SCM scm_sys_search_load_path SCM_P ((SCM filename));
|
||||||
extern SCM scm_primitive_load_path SCM_P ((SCM filename, SCM casep,
|
extern SCM scm_primitive_load_path SCM_P ((SCM filename));
|
||||||
SCM sharp));
|
extern SCM scm_read_and_eval_x SCM_P ((SCM port));
|
||||||
extern SCM scm_read_and_eval_x SCM_P ((SCM port,
|
|
||||||
SCM case_insensitive_p,
|
|
||||||
SCM sharp));
|
|
||||||
extern void scm_init_load SCM_P ((void));
|
extern void scm_init_load SCM_P ((void));
|
||||||
|
|
||||||
#endif /* LOADH */
|
#endif /* LOADH */
|
||||||
|
|
126
libguile/read.c
126
libguile/read.c
|
@ -58,15 +58,13 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#define default_case_i 0
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
scm_option scm_read_opts[] = {
|
scm_option scm_read_opts[] = {
|
||||||
{ SCM_OPTION_BOOLEAN, "copy", 0,
|
{ SCM_OPTION_BOOLEAN, "copy", 0,
|
||||||
"Copy source code expressions." },
|
"Copy source code expressions." },
|
||||||
{ SCM_OPTION_BOOLEAN, "positions", 0,
|
{ SCM_OPTION_BOOLEAN, "positions", 0,
|
||||||
"Record positions of source code expressions." }
|
"Record positions of source code expressions." },
|
||||||
|
{ SCM_OPTION_BOOLEAN, "case-insensitive", 0,
|
||||||
|
"Convert symbols to lower case."}
|
||||||
};
|
};
|
||||||
|
|
||||||
SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options);
|
SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options);
|
||||||
|
@ -84,17 +82,17 @@ scm_read_options (setting)
|
||||||
return ans;
|
return ans;
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_PROC (s_read, "read", 0, 3, 0, scm_read);
|
/* Association list mapping extra hash characters to procedures. */
|
||||||
|
static SCM scm_read_hash_procedures = SCM_EOL;
|
||||||
|
|
||||||
|
SCM_PROC (s_read, "read", 0, 1, 0, scm_read);
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_read (port, case_insensitive_p, sharp)
|
scm_read (port)
|
||||||
SCM port;
|
SCM port;
|
||||||
SCM case_insensitive_p;
|
|
||||||
SCM sharp;
|
|
||||||
{
|
{
|
||||||
int c;
|
int c;
|
||||||
SCM tok_buf, copy;
|
SCM tok_buf, copy;
|
||||||
int case_i;
|
|
||||||
|
|
||||||
if (SCM_UNBNDP (port))
|
if (SCM_UNBNDP (port))
|
||||||
port = scm_cur_inp;
|
port = scm_cur_inp;
|
||||||
|
@ -104,20 +102,13 @@ scm_read (port, case_insensitive_p, sharp)
|
||||||
SCM_ARG1,
|
SCM_ARG1,
|
||||||
s_read);
|
s_read);
|
||||||
|
|
||||||
case_i = (SCM_UNBNDP (case_insensitive_p)
|
|
||||||
? default_case_i
|
|
||||||
: (case_insensitive_p == SCM_BOOL_F));
|
|
||||||
|
|
||||||
if (SCM_UNBNDP (sharp))
|
|
||||||
sharp = SCM_BOOL_F;
|
|
||||||
|
|
||||||
c = scm_flush_ws (port, (char *) NULL);
|
c = scm_flush_ws (port, (char *) NULL);
|
||||||
if (EOF == c)
|
if (EOF == c)
|
||||||
return SCM_EOF_VAL;
|
return SCM_EOF_VAL;
|
||||||
scm_gen_ungetc (c, port);
|
scm_gen_ungetc (c, port);
|
||||||
|
|
||||||
tok_buf = scm_makstr (30L, 0);
|
tok_buf = scm_makstr (30L, 0);
|
||||||
return scm_lreadr (&tok_buf, port, case_i, sharp, ©);
|
return scm_lreadr (&tok_buf, port, ©);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -266,15 +257,15 @@ skip_scsh_block_comment (port)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static SCM
|
||||||
|
scm_get_hash_procedure SCM_P ((int c));
|
||||||
|
|
||||||
static char s_list[]="list";
|
static char s_list[]="list";
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_lreadr (tok_buf, port, case_i, sharp, copy)
|
scm_lreadr (tok_buf, port, copy)
|
||||||
SCM *tok_buf;
|
SCM *tok_buf;
|
||||||
SCM port;
|
SCM port;
|
||||||
int case_i;
|
|
||||||
SCM sharp;
|
|
||||||
SCM *copy;
|
SCM *copy;
|
||||||
{
|
{
|
||||||
int c;
|
int c;
|
||||||
|
@ -291,8 +282,8 @@ tryagain_no_flush_ws:
|
||||||
|
|
||||||
case '(':
|
case '(':
|
||||||
return SCM_RECORD_POSITIONS_P
|
return SCM_RECORD_POSITIONS_P
|
||||||
? scm_lreadrecparen (tok_buf, port, s_list, case_i, sharp, copy)
|
? scm_lreadrecparen (tok_buf, port, s_list, copy)
|
||||||
: scm_lreadparen (tok_buf, port, s_list, case_i, sharp, copy);
|
: scm_lreadparen (tok_buf, port, s_list, copy);
|
||||||
case ')':
|
case ')':
|
||||||
scm_wta (SCM_UNDEFINED, "unexpected \")\"", "read");
|
scm_wta (SCM_UNDEFINED, "unexpected \")\"", "read");
|
||||||
goto tryagain;
|
goto tryagain;
|
||||||
|
@ -314,7 +305,7 @@ tryagain_no_flush_ws:
|
||||||
}
|
}
|
||||||
recquote:
|
recquote:
|
||||||
p = scm_cons2 (p,
|
p = scm_cons2 (p,
|
||||||
scm_lreadr (tok_buf, port, case_i, sharp, copy),
|
scm_lreadr (tok_buf, port, copy),
|
||||||
SCM_EOL);
|
SCM_EOL);
|
||||||
if (SCM_RECORD_POSITIONS_P)
|
if (SCM_RECORD_POSITIONS_P)
|
||||||
scm_whash_insert (scm_source_whash,
|
scm_whash_insert (scm_source_whash,
|
||||||
|
@ -334,7 +325,7 @@ tryagain_no_flush_ws:
|
||||||
switch (c)
|
switch (c)
|
||||||
{
|
{
|
||||||
case '(':
|
case '(':
|
||||||
p = scm_lreadparen (tok_buf, port, "vector", case_i, sharp, copy);
|
p = scm_lreadparen (tok_buf, port, "vector", copy);
|
||||||
return SCM_NULLP (p) ? scm_nullvect : scm_vector (p);
|
return SCM_NULLP (p) ? scm_nullvect : scm_vector (p);
|
||||||
|
|
||||||
case 't':
|
case 't':
|
||||||
|
@ -369,7 +360,7 @@ tryagain_no_flush_ws:
|
||||||
goto tryagain_no_flush_ws;
|
goto tryagain_no_flush_ws;
|
||||||
|
|
||||||
case '*':
|
case '*':
|
||||||
j = scm_read_token (c, tok_buf, port, case_i, 0);
|
j = scm_read_token (c, tok_buf, port, 0);
|
||||||
p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
|
p = scm_istr2bve (SCM_CHARS (*tok_buf) + 1, (long) (j - 1));
|
||||||
if (SCM_NFALSEP (p))
|
if (SCM_NFALSEP (p))
|
||||||
return p;
|
return p;
|
||||||
|
@ -377,7 +368,7 @@ tryagain_no_flush_ws:
|
||||||
goto unkshrp;
|
goto unkshrp;
|
||||||
|
|
||||||
case '{':
|
case '{':
|
||||||
j = scm_read_token (c, tok_buf, port, case_i, 1);
|
j = scm_read_token (c, tok_buf, port, 1);
|
||||||
p = scm_intern (SCM_CHARS (*tok_buf), j);
|
p = scm_intern (SCM_CHARS (*tok_buf), j);
|
||||||
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
|
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
|
||||||
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
|
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
|
||||||
|
@ -385,7 +376,7 @@ tryagain_no_flush_ws:
|
||||||
|
|
||||||
case '\\':
|
case '\\':
|
||||||
c = scm_gen_getc (port);
|
c = scm_gen_getc (port);
|
||||||
j = scm_read_token (c, tok_buf, port, case_i, 0);
|
j = scm_read_token (c, tok_buf, port, 0);
|
||||||
if (j == 1)
|
if (j == 1)
|
||||||
return SCM_MAKICHR (c);
|
return SCM_MAKICHR (c);
|
||||||
if (c >= '0' && c < '8')
|
if (c >= '0' && c < '8')
|
||||||
|
@ -403,11 +394,15 @@ tryagain_no_flush_ws:
|
||||||
|
|
||||||
default:
|
default:
|
||||||
callshrp:
|
callshrp:
|
||||||
|
{
|
||||||
|
SCM sharp = scm_get_hash_procedure (c);
|
||||||
|
|
||||||
if (SCM_NIMP (sharp))
|
if (SCM_NIMP (sharp))
|
||||||
{
|
{
|
||||||
int line = SCM_LINUM (port);
|
int line = SCM_LINUM (port);
|
||||||
int column = SCM_COL (port) - 2;
|
int column = SCM_COL (port) - 2;
|
||||||
SCM got;
|
SCM got;
|
||||||
|
|
||||||
got = scm_apply (sharp,
|
got = scm_apply (sharp,
|
||||||
SCM_MAKICHR (c),
|
SCM_MAKICHR (c),
|
||||||
scm_acons (port, SCM_EOL, SCM_EOL));
|
scm_acons (port, SCM_EOL, SCM_EOL));
|
||||||
|
@ -419,6 +414,7 @@ tryagain_no_flush_ws:
|
||||||
else
|
else
|
||||||
return got;
|
return got;
|
||||||
}
|
}
|
||||||
|
}
|
||||||
unkshrp:
|
unkshrp:
|
||||||
scm_misc_error (s_read, "Unknown # object: %S",
|
scm_misc_error (s_read, "Unknown # object: %S",
|
||||||
scm_listify (SCM_MAKICHR (c), SCM_UNDEFINED));
|
scm_listify (SCM_MAKICHR (c), SCM_UNDEFINED));
|
||||||
|
@ -494,7 +490,7 @@ tryagain_no_flush_ws:
|
||||||
case '-':
|
case '-':
|
||||||
case '+':
|
case '+':
|
||||||
num:
|
num:
|
||||||
j = scm_read_token (c, tok_buf, port, case_i, 0);
|
j = scm_read_token (c, tok_buf, port, 0);
|
||||||
p = scm_istring2number (SCM_CHARS (*tok_buf), (long) j, 10L);
|
p = scm_istring2number (SCM_CHARS (*tok_buf), (long) j, 10L);
|
||||||
if (SCM_NFALSEP (p))
|
if (SCM_NFALSEP (p))
|
||||||
return p;
|
return p;
|
||||||
|
@ -511,14 +507,14 @@ tryagain_no_flush_ws:
|
||||||
goto tok;
|
goto tok;
|
||||||
|
|
||||||
case ':':
|
case ':':
|
||||||
j = scm_read_token ('-', tok_buf, port, case_i, 0);
|
j = scm_read_token ('-', tok_buf, port, 0);
|
||||||
p = scm_intern (SCM_CHARS (*tok_buf), j);
|
p = scm_intern (SCM_CHARS (*tok_buf), j);
|
||||||
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
|
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
|
||||||
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
|
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
|
||||||
return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
|
return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
|
||||||
|
|
||||||
default:
|
default:
|
||||||
j = scm_read_token (c, tok_buf, port, case_i, 0);
|
j = scm_read_token (c, tok_buf, port, 0);
|
||||||
/* fallthrough */
|
/* fallthrough */
|
||||||
|
|
||||||
tok:
|
tok:
|
||||||
|
@ -534,18 +530,17 @@ _Pragma ("noopt"); /* # pragma _CRI noopt */
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
scm_sizet
|
scm_sizet
|
||||||
scm_read_token (ic, tok_buf, port, case_i, weird)
|
scm_read_token (ic, tok_buf, port, weird)
|
||||||
int ic;
|
int ic;
|
||||||
SCM *tok_buf;
|
SCM *tok_buf;
|
||||||
SCM port;
|
SCM port;
|
||||||
int case_i;
|
|
||||||
int weird;
|
int weird;
|
||||||
{
|
{
|
||||||
register scm_sizet j;
|
register scm_sizet j;
|
||||||
register int c;
|
register int c;
|
||||||
register char *p;
|
register char *p;
|
||||||
|
|
||||||
c = ic;
|
c = (SCM_CASE_INSENSITIVE_P ? scm_downcase(ic) : ic);
|
||||||
p = SCM_CHARS (*tok_buf);
|
p = SCM_CHARS (*tok_buf);
|
||||||
|
|
||||||
if (weird)
|
if (weird)
|
||||||
|
@ -623,7 +618,7 @@ scm_read_token (ic, tok_buf, port, case_i, weird)
|
||||||
default:
|
default:
|
||||||
default_case:
|
default_case:
|
||||||
{
|
{
|
||||||
c = (case_i ? scm_downcase(c) : c);
|
c = (SCM_CASE_INSENSITIVE_P ? scm_downcase(c) : c);
|
||||||
if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
|
if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
|
||||||
{
|
{
|
||||||
p[j] = c;
|
p[j] = c;
|
||||||
|
@ -649,12 +644,10 @@ _Pragma ("opt"); /* # pragma _CRI opt */
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
|
scm_lreadparen (tok_buf, port, name, copy)
|
||||||
SCM *tok_buf;
|
SCM *tok_buf;
|
||||||
SCM port;
|
SCM port;
|
||||||
char *name;
|
char *name;
|
||||||
int case_i;
|
|
||||||
SCM sharp;
|
|
||||||
SCM *copy;
|
SCM *copy;
|
||||||
{
|
{
|
||||||
SCM tmp;
|
SCM tmp;
|
||||||
|
@ -666,9 +659,9 @@ scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
|
||||||
if (')' == c)
|
if (')' == c)
|
||||||
return SCM_EOL;
|
return SCM_EOL;
|
||||||
scm_gen_ungetc (c, port);
|
scm_gen_ungetc (c, port);
|
||||||
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
|
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
|
||||||
{
|
{
|
||||||
ans = scm_lreadr (tok_buf, port, case_i, sharp, copy);
|
ans = scm_lreadr (tok_buf, port, copy);
|
||||||
closeit:
|
closeit:
|
||||||
if (')' != (c = scm_flush_ws (port, name)))
|
if (')' != (c = scm_flush_ws (port, name)))
|
||||||
scm_wta (SCM_UNDEFINED, "missing close paren", "");
|
scm_wta (SCM_UNDEFINED, "missing close paren", "");
|
||||||
|
@ -678,9 +671,9 @@ scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
|
||||||
while (')' != (c = scm_flush_ws (port, name)))
|
while (')' != (c = scm_flush_ws (port, name)))
|
||||||
{
|
{
|
||||||
scm_gen_ungetc (c, port);
|
scm_gen_ungetc (c, port);
|
||||||
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
|
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
|
||||||
{
|
{
|
||||||
SCM_SETCDR (tl, scm_lreadr (tok_buf, port, case_i, sharp, copy));
|
SCM_SETCDR (tl, scm_lreadr (tok_buf, port, copy));
|
||||||
goto closeit;
|
goto closeit;
|
||||||
}
|
}
|
||||||
SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
|
SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
|
||||||
|
@ -691,12 +684,10 @@ scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
|
||||||
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
|
scm_lreadrecparen (tok_buf, port, name, copy)
|
||||||
SCM *tok_buf;
|
SCM *tok_buf;
|
||||||
SCM port;
|
SCM port;
|
||||||
char *name;
|
char *name;
|
||||||
int case_i;
|
|
||||||
SCM sharp;
|
|
||||||
SCM *copy;
|
SCM *copy;
|
||||||
{
|
{
|
||||||
register int c;
|
register int c;
|
||||||
|
@ -711,9 +702,9 @@ scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
|
||||||
if (')' == c)
|
if (')' == c)
|
||||||
return SCM_EOL;
|
return SCM_EOL;
|
||||||
scm_gen_ungetc (c, port);
|
scm_gen_ungetc (c, port);
|
||||||
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
|
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
|
||||||
{
|
{
|
||||||
ans = scm_lreadr (tok_buf, port, case_i, sharp, copy);
|
ans = scm_lreadr (tok_buf, port, copy);
|
||||||
if (')' != (c = scm_flush_ws (port, name)))
|
if (')' != (c = scm_flush_ws (port, name)))
|
||||||
scm_wta (SCM_UNDEFINED, "missing close paren", "");
|
scm_wta (SCM_UNDEFINED, "missing close paren", "");
|
||||||
return ans;
|
return ans;
|
||||||
|
@ -728,9 +719,9 @@ scm_lreadrecparen (tok_buf, port, name, case_i, sharp, copy)
|
||||||
while (')' != (c = scm_flush_ws (port, name)))
|
while (')' != (c = scm_flush_ws (port, name)))
|
||||||
{
|
{
|
||||||
scm_gen_ungetc (c, port);
|
scm_gen_ungetc (c, port);
|
||||||
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
|
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
|
||||||
{
|
{
|
||||||
SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy));
|
SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy));
|
||||||
if (SCM_COPY_SOURCE_P)
|
if (SCM_COPY_SOURCE_P)
|
||||||
SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp)
|
SCM_SETCDR (tl2, scm_cons (SCM_NIMP (tmp) && SCM_CONSP (tmp)
|
||||||
? *copy
|
? *copy
|
||||||
|
@ -763,7 +754,44 @@ exit:
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* Register a procedure for extended # object processing and the character
|
||||||
|
that will trigger it. */
|
||||||
|
SCM_PROC (s_read_hash_extend, "read-hash-extend", 2, 0, 0, scm_read_hash_extend);
|
||||||
|
SCM
|
||||||
|
scm_read_hash_extend (chr, proc)
|
||||||
|
SCM chr;
|
||||||
|
SCM proc;
|
||||||
|
{
|
||||||
|
SCM_ASSERT (SCM_ICHRP(chr), chr, SCM_ARG1, s_read_hash_extend);
|
||||||
|
SCM_ASSERT (SCM_NIMP(proc), proc, SCM_ARG2, s_read_hash_extend);
|
||||||
|
|
||||||
|
/* We are making every member of this list a permanent object.
|
||||||
|
Is that bad? */
|
||||||
|
SCM_DEFER_INTS;
|
||||||
|
scm_read_hash_procedures = scm_cons (scm_cons (chr, proc),
|
||||||
|
scm_read_hash_procedures);
|
||||||
|
scm_permanent_object (scm_read_hash_procedures);
|
||||||
|
SCM_ALLOW_INTS;
|
||||||
|
return SCM_UNSPECIFIED;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Recover the read-hash procedure corresponding to char c. */
|
||||||
|
static SCM
|
||||||
|
scm_get_hash_procedure (c)
|
||||||
|
int c;
|
||||||
|
{
|
||||||
|
SCM rest = scm_read_hash_procedures;
|
||||||
|
while (1)
|
||||||
|
{
|
||||||
|
if (SCM_NULLP (rest))
|
||||||
|
return SCM_BOOL_F;
|
||||||
|
|
||||||
|
if (SCM_ICHR (SCM_CAAR (rest)) == c)
|
||||||
|
return SCM_CDAR (rest);
|
||||||
|
|
||||||
|
rest = SCM_CDR (rest);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_init_read ()
|
scm_init_read ()
|
||||||
|
|
|
@ -71,19 +71,21 @@ extern scm_option scm_read_opts[];
|
||||||
|
|
||||||
#define SCM_COPY_SOURCE_P scm_read_opts[0].val
|
#define SCM_COPY_SOURCE_P scm_read_opts[0].val
|
||||||
#define SCM_RECORD_POSITIONS_P scm_read_opts[1].val
|
#define SCM_RECORD_POSITIONS_P scm_read_opts[1].val
|
||||||
#define SCM_N_READ_OPTIONS 2
|
#define SCM_CASE_INSENSITIVE_P scm_read_opts[2].val
|
||||||
|
#define SCM_N_READ_OPTIONS 3
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
extern SCM scm_read_options SCM_P ((SCM setting));
|
extern SCM scm_read_options SCM_P ((SCM setting));
|
||||||
extern SCM scm_read SCM_P ((SCM port, SCM casep, SCM sharp));
|
extern SCM scm_read SCM_P ((SCM port));
|
||||||
extern char * scm_grow_tok_buf SCM_P ((SCM * tok_buf));
|
extern char * scm_grow_tok_buf SCM_P ((SCM * tok_buf));
|
||||||
extern int scm_flush_ws SCM_P ((SCM port, char *eoferr));
|
extern int scm_flush_ws SCM_P ((SCM port, char *eoferr));
|
||||||
extern int scm_casei_streq SCM_P ((char * s1, char * s2));
|
extern int scm_casei_streq SCM_P ((char * s1, char * s2));
|
||||||
extern SCM scm_lreadr SCM_P ((SCM * tok_buf, SCM port, int case_i, SCM sharp, SCM *copy));
|
extern SCM scm_lreadr SCM_P ((SCM * tok_buf, SCM port, SCM *copy));
|
||||||
extern scm_sizet scm_read_token SCM_P ((int ic, SCM * tok_buf, SCM port, int case_i, int weird));
|
extern scm_sizet scm_read_token SCM_P ((int ic, SCM * tok_buf, SCM port, int weird));
|
||||||
extern SCM scm_lreadparen SCM_P ((SCM * tok_buf, SCM port, char *name, int case_i, SCM sharp, SCM *copy));
|
extern SCM scm_lreadparen SCM_P ((SCM * tok_buf, SCM port, char *name, SCM *copy));
|
||||||
extern SCM scm_lreadrecparen SCM_P ((SCM * tok_buf, SCM port, char *name, int case_i, SCM sharp, SCM *copy));
|
extern SCM scm_lreadrecparen SCM_P ((SCM * tok_buf, SCM port, char *name, SCM *copy));
|
||||||
|
extern SCM scm_read_hash_extend SCM_P ((SCM chr, SCM proc));
|
||||||
extern void scm_init_read SCM_P ((void));
|
extern void scm_init_read SCM_P ((void));
|
||||||
|
|
||||||
#endif /* READH */
|
#endif /* READH */
|
||||||
|
|
|
@ -242,7 +242,7 @@ scm_read_0str (expr)
|
||||||
SCM form;
|
SCM form;
|
||||||
|
|
||||||
/* Read expressions from that port; ignore the values. */
|
/* Read expressions from that port; ignore the values. */
|
||||||
form = scm_read (port, SCM_BOOL_F, SCM_BOOL_F);
|
form = scm_read (port);
|
||||||
|
|
||||||
scm_close_port (port);
|
scm_close_port (port);
|
||||||
return form;
|
return form;
|
||||||
|
@ -262,7 +262,7 @@ scm_eval_0str (expr)
|
||||||
SCM ans = SCM_EOL;
|
SCM ans = SCM_EOL;
|
||||||
|
|
||||||
/* Read expressions from that port; ignore the values. */
|
/* Read expressions from that port; ignore the values. */
|
||||||
while ((form = scm_read (port, SCM_BOOL_F, SCM_BOOL_F)) != SCM_EOF_VAL)
|
while ((form = scm_read (port)) != SCM_EOF_VAL)
|
||||||
ans = scm_eval_x (form);
|
ans = scm_eval_x (form);
|
||||||
|
|
||||||
scm_close_port (port);
|
scm_close_port (port);
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue