mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

* read.c (scm_lreadr): Call scm_i_read_homogenous_vector for '#f',

Browse source 
'#u', and '#s'.

* read.h, read.c (scm_i_input_error): Renamed from scm_input_error
and made non-static.  Changed all uses.
This commit is contained in:
Marius Vollmer 2004-10-26 17:00:13 +00:00
parent 358ebb0b74
commit a4022e691e
2 changed files with 45 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

64
libguile/read.c
View file

@ -35,6 +35,7 @@
#include "libguile/strports.h" #include "libguile/strports.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/srfi-4.h"
#include "libguile/read.h" #include "libguile/read.h"
@ -75,9 +76,9 @@ scm_t_option scm_read_opts[] = {
*/ */
static void void
scm_input_error (char const *function, scm_i_input_error (char const *function,
SCM port, const char *message, SCM arg) SCM port, const char *message, SCM arg)
{ {
SCM fn = (scm_is_string (SCM_FILENAME(port)) SCM fn = (scm_is_string (SCM_FILENAME(port))
? SCM_FILENAME(port) ? SCM_FILENAME(port)
@ -95,7 +96,7 @@ scm_input_error (char const *function,
string = scm_get_output_string (string_port); string = scm_get_output_string (string_port);
scm_close_output_port (string_port); scm_close_output_port (string_port);
scm_error_scm (scm_from_locale_symbol ("read-error"), scm_error_scm (scm_from_locale_symbol ("read-error"),
scm_from_locale_string (function), function? scm_from_locale_string (function) : SCM_BOOL_F,
string, string,
arg, arg,
SCM_BOOL_F); SCM_BOOL_F);
@ -179,8 +180,8 @@ skip_scsh_block_comment (SCM port)
int c = scm_getc (port); int c = scm_getc (port);
if (c == EOF) if (c == EOF)
scm_input_error ("skip_block_comment", port, scm_i_input_error ("skip_block_comment", port,
"unterminated `#! ... !#' comment", SCM_EOL); "unterminated `#! ... !#' comment", SCM_EOL);
if (c == '!') if (c == '!')
bang_seen = 1; bang_seen = 1;
@ -202,10 +203,10 @@ scm_flush_ws (SCM port, const char *eoferr)
goteof: goteof:
if (eoferr) if (eoferr)
{ {
scm_input_error (eoferr, scm_i_input_error (eoferr,
port, port,
"end of file", "end of file",
SCM_EOL); SCM_EOL);
} }
return c; return c;
case ';': case ';':
@ -350,7 +351,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
? scm_lreadrecparen (tok_buf, port, s_list, copy) ? scm_lreadrecparen (tok_buf, port, s_list, copy)
: scm_i_lreadparen (tok_buf, port, s_list, copy, ')'); : scm_i_lreadparen (tok_buf, port, s_list, copy, ')');
case ')': case ')':
scm_input_error (FUNC_NAME, port,"unexpected \")\"", SCM_EOL); scm_i_input_error (FUNC_NAME, port,"unexpected \")\"", SCM_EOL);
goto tryagain; goto tryagain;
#if SCM_ENABLE_ELISP #if SCM_ENABLE_ELISP
@ -427,7 +428,11 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
case 't': case 't':
case 'T': case 'T':
return SCM_BOOL_T; return SCM_BOOL_T;
case 'f': case 'f':
/* #f32(...), #f64(...), or just #f.
*/
return scm_i_read_homogenous_vector (port, 'f');
case 'F': case 'F':
return SCM_BOOL_F; return SCM_BOOL_F;
@ -447,6 +452,16 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
c = '#'; c = '#';
goto num; goto num;
case 's':
/* #s8(...), #s16(...), #s32(...) or #s64(...)
*/
return scm_i_read_homogenous_vector (port, 's');
case 'u':
/* #u8(...), #u16(...), #u32(...) or #u64(...)
*/
return scm_i_read_homogenous_vector (port, 'u');
case '!': case '!':
/* should never happen, #!...!# block comments are skipped /* should never happen, #!...!# block comments are skipped
over in scm_flush_ws. */ over in scm_flush_ws. */
@ -487,8 +502,8 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
&& (scm_i_casei_streq (scm_charnames[c], && (scm_i_casei_streq (scm_charnames[c],
scm_i_string_chars (*tok_buf), j))) scm_i_string_chars (*tok_buf), j)))
return SCM_MAKE_CHAR (scm_charnums[c]); return SCM_MAKE_CHAR (scm_charnums[c]);
scm_input_error (FUNC_NAME, port, "unknown character name ~a", scm_i_input_error (FUNC_NAME, port, "unknown character name ~a",
scm_list_1 (scm_c_substring (*tok_buf, 0, j))); scm_list_1 (scm_c_substring (*tok_buf, 0, j)));
/* #:SYMBOL is a syntax for keywords supported in all contexts. */ /* #:SYMBOL is a syntax for keywords supported in all contexts. */
case ':': case ':':
@ -516,8 +531,8 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
} }
} }
unkshrp: unkshrp:
scm_input_error (FUNC_NAME, port, "Unknown # object: ~S", scm_i_input_error (FUNC_NAME, port, "Unknown # object: ~S",
scm_list_1 (SCM_MAKE_CHAR (c))); scm_list_1 (SCM_MAKE_CHAR (c)));
} }
case '"': case '"':
@ -525,7 +540,9 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
while ('"' != (c = scm_getc (port))) while ('"' != (c = scm_getc (port)))
{ {
if (c == EOF) if (c == EOF)
str_eof: scm_input_error (FUNC_NAME, port, "end of file in string constant", SCM_EOL); str_eof: scm_i_input_error (FUNC_NAME, port,
"end of file in string constant",
SCM_EOL);
while (j + 2 >= scm_i_string_length (*tok_buf)) while (j + 2 >= scm_i_string_length (*tok_buf))
scm_grow_tok_buf (tok_buf); scm_grow_tok_buf (tok_buf);
@ -588,9 +605,9 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
} }
default: default:
bad_escaped: bad_escaped:
scm_input_error(FUNC_NAME, port, scm_i_input_error(FUNC_NAME, port,
"illegal character in escape sequence: ~S", "illegal character in escape sequence: ~S",
scm_list_1 (SCM_MAKE_CHAR (c))); scm_list_1 (SCM_MAKE_CHAR (c)));
} }
scm_c_string_set_x (*tok_buf, j, SCM_MAKE_CHAR (c)); scm_c_string_set_x (*tok_buf, j, SCM_MAKE_CHAR (c));
++j; ++j;
@ -625,7 +642,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
c = scm_i_string_chars (*tok_buf)[1]; c = scm_i_string_chars (*tok_buf)[1];
goto callshrp; goto callshrp;
} }
scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL); scm_i_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL);
} }
goto tok; goto tok;
@ -760,7 +777,7 @@ scm_i_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char)
ans = scm_lreadr (tok_buf, port, copy); ans = scm_lreadr (tok_buf, port, copy);
closeit: closeit:
if (term_char != (c = scm_flush_ws (port, name))) if (term_char != (c = scm_flush_ws (port, name)))
scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL); scm_i_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL);
return ans; return ans;
} }
ans = tl = scm_cons (tmp, SCM_EOL); ans = tl = scm_cons (tmp, SCM_EOL);
@ -800,7 +817,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
{ {
ans = scm_lreadr (tok_buf, port, copy); ans = scm_lreadr (tok_buf, port, copy);
if (')' != (c = scm_flush_ws (port, name))) if (')' != (c = scm_flush_ws (port, name)))
scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL); scm_i_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL);
return ans; return ans;
} }
/* Build the head of the list structure. */ /* Build the head of the list structure. */
@ -824,7 +841,8 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
: tmp, : tmp,
SCM_EOL)); SCM_EOL));
if (')' != (c = scm_flush_ws (port, name))) if (')' != (c = scm_flush_ws (port, name)))
scm_input_error (FUNC_NAME, port, "missing close paren", SCM_EOL); scm_i_input_error (FUNC_NAME, port,
"missing close paren", SCM_EOL);
goto exit; goto exit;
} }

4
libguile/read.h
View file

@ -72,6 +72,10 @@ SCM_API SCM scm_lreadr (SCM * tok_buf, SCM port, SCM *copy);
SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird); SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird);
SCM_API SCM scm_lreadrecparen (SCM * tok_buf, SCM port, char *name, SCM *copy); SCM_API SCM scm_lreadrecparen (SCM * tok_buf, SCM port, char *name, SCM *copy);
SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc); SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc);
SCM_API void scm_i_input_error (const char *func, SCM port,
const char *message, SCM arg);
SCM_API void scm_init_read (void); SCM_API void scm_init_read (void);
#endif /* SCM_READ_H */ #endif /* SCM_READ_H */