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

* read.c (scm_lreadr): When reading a hash token, check for a

Browse source 
user-defined hash procedure first, so that overriding the builtin
	hash characters is possible (this was needed for implementing
	SRFI-4's read synax `f32(...)').

	* num2integral.i.c: Use scm_t_signed_bits instead of scm_t_bits,
	because the latter is unsigned now and breaks comparisons like
	(n < (scm_t_signed_bits)MIN_VALUE).
This commit is contained in:
Martin Grabmüller 2001-06-27 13:15:20 +00:00
parent dbfadc8588
commit b858464a0a
3 changed files with 59 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

11
libguile/ChangeLog
View file

@ -1,3 +1,14 @@
2001-06-27 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
* read.c (scm_lreadr): When reading a hash token, check for a
user-defined hash procedure first, so that overriding the builtin
hash characters is possible (this was needed for implementing
SRFI-4's read synax `f32(...)').
* num2integral.i.c: Use scm_t_signed_bits instead of scm_t_bits,
because the latter is unsigned now and breaks comparisons like
(n < (scm_t_signed_bits)MIN_VALUE).
2001-06-26 Neil Jerram <neil@ossau.uklinux.net> 2001-06-26 Neil Jerram <neil@ossau.uklinux.net>
* eval.h, eval.c (scm_call_4): New function. * eval.h, eval.c (scm_call_4): New function.

10
libguile/num2integral.i.c
View file

@ -6,22 +6,22 @@ NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
if (SCM_INUMP (num)) if (SCM_INUMP (num))
{ /* immediate */ { /* immediate */
scm_t_bits n = SCM_INUM (num); scm_t_signed_bits n = SCM_INUM (num);
#ifdef UNSIGNED #ifdef UNSIGNED
if (n < 0) if (n < 0)
scm_out_of_range (s_caller, num); scm_out_of_range (s_caller, num);
#endif #endif
if (sizeof (ITYPE) >= sizeof (scm_t_bits)) if (sizeof (ITYPE) >= sizeof (scm_t_signed_bits))
/* can't fit anything too big for this type in an inum /* can't fit anything too big for this type in an inum
anyway */ anyway */
return (ITYPE) n; return (ITYPE) n;
else else
{ /* an inum can be out of range, so check */ { /* an inum can be out of range, so check */
if (n > (scm_t_bits)MAX_VALUE if (n > (scm_t_signed_bits)MAX_VALUE
#ifndef UNSIGNED #ifndef UNSIGNED
|| n < (scm_t_bits)MIN_VALUE || n < (scm_t_signed_bits)MIN_VALUE
#endif #endif
) )
scm_out_of_range (s_caller, num); scm_out_of_range (s_caller, num);
@ -84,7 +84,7 @@ NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
SCM SCM
INTEGRAL2NUM (ITYPE n) INTEGRAL2NUM (ITYPE n)
{ {
if (sizeof (ITYPE) < sizeof (scm_t_bits) if (sizeof (ITYPE) < sizeof (scm_t_signed_bits)
|| ||
#ifndef UNSIGNED #ifndef UNSIGNED
SCM_FIXABLE (n) SCM_FIXABLE (n)

65
libguile/read.c
View file

@ -289,9 +289,9 @@ scm_lreadr (SCM *tok_buf,SCM port,SCM *copy)
size_t j; size_t j;
SCM p; SCM p;
tryagain: tryagain:
c = scm_flush_ws (port, s_scm_read); c = scm_flush_ws (port, s_scm_read);
tryagain_no_flush_ws: tryagain_no_flush_ws:
switch (c) switch (c)
{ {
case EOF: case EOF:
@ -299,8 +299,8 @@ tryagain_no_flush_ws:
case '(': case '(':
return SCM_RECORD_POSITIONS_P return SCM_RECORD_POSITIONS_P
? scm_lreadrecparen (tok_buf, port, s_list, copy) ? scm_lreadrecparen (tok_buf, port, s_list, copy)
: scm_lreadparen (tok_buf, port, s_list, copy); : scm_lreadparen (tok_buf, port, s_list, copy);
case ')': case ')':
SCM_MISC_ERROR ("unexpected \")\"", SCM_EOL); SCM_MISC_ERROR ("unexpected \")\"", SCM_EOL);
goto tryagain; goto tryagain;
@ -339,6 +339,27 @@ tryagain_no_flush_ws:
return p; return p;
case '#': case '#':
c = scm_getc (port); c = scm_getc (port);
{
/* Check for user-defined hash procedure first, to allow
overriding of builtin hash read syntaxes. */
SCM sharp = scm_get_hash_procedure (c);
if (!SCM_FALSEP (sharp))
{
int line = SCM_LINUM (port);
int column = SCM_COL (port) - 2;
SCM got;
got = scm_call_2 (sharp, SCM_MAKE_CHAR (c), port);
if (SCM_EQ_P (got, SCM_UNSPECIFIED))
goto unkshrp;
if (SCM_RECORD_POSITIONS_P)
return *copy = recsexpr (got, line, column,
SCM_FILENAME (port));
else
return got;
}
}
switch (c) switch (c)
{ {
case '(': case '(':
@ -435,8 +456,8 @@ tryagain_no_flush_ws:
} }
} }
unkshrp: unkshrp:
scm_misc_error (s_scm_read, "Unknown # object: ~S", scm_misc_error (s_scm_read, "Unknown # object: ~S",
SCM_LIST1 (SCM_MAKE_CHAR (c))); SCM_LIST1 (SCM_MAKE_CHAR (c)));
} }
case '"': case '"':
@ -484,27 +505,27 @@ tryagain_no_flush_ws:
SCM_STRING_CHARS (*tok_buf)[j] = 0; SCM_STRING_CHARS (*tok_buf)[j] = 0;
return scm_mem2string (SCM_STRING_CHARS (*tok_buf), j); return scm_mem2string (SCM_STRING_CHARS (*tok_buf), j);
case'0':case '1':case '2':case '3':case '4': case'0':case '1':case '2':case '3':case '4':
case '5':case '6':case '7':case '8':case '9': case '5':case '6':case '7':case '8':case '9':
case '.': case '.':
case '-': case '-':
case '+': case '+':
num: num:
j = scm_read_token (c, tok_buf, port, 0); j = scm_read_token (c, tok_buf, port, 0);
p = scm_istring2number (SCM_STRING_CHARS (*tok_buf), (long) j, 10L); p = scm_istring2number (SCM_STRING_CHARS (*tok_buf), (long) j, 10L);
if (!SCM_FALSEP (p)) if (!SCM_FALSEP (p))
return p; return p;
if (c == '#') if (c == '#')
{ {
if ((j == 2) && (scm_getc (port) == '(')) if ((j == 2) && (scm_getc (port) == '('))
{ {
scm_ungetc ('(', port); scm_ungetc ('(', port);
c = SCM_STRING_CHARS (*tok_buf)[1]; c = SCM_STRING_CHARS (*tok_buf)[1];
goto callshrp; goto callshrp;
} }
SCM_MISC_ERROR ("unknown # object", SCM_EOL); SCM_MISC_ERROR ("unknown # object", SCM_EOL);
} }
goto tok; goto tok;
case ':': case ':':
if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix)) if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))