From b858464a0a34381caf8661ec32a27bb94ce8c6cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20Grabm=C3=BCller?= Date: Wed, 27 Jun 2001 13:15:20 +0000 Subject: [PATCH] * 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). --- libguile/ChangeLog | 11 +++++++ libguile/num2integral.i.c | 10 +++--- libguile/read.c | 65 ++++++++++++++++++++++++++------------- 3 files changed, 59 insertions(+), 27 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7d0f808c2..6458869ef 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,14 @@ +2001-06-27 Martin Grabmueller + + * 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 * eval.h, eval.c (scm_call_4): New function. diff --git a/libguile/num2integral.i.c b/libguile/num2integral.i.c index 5498c2828..f273eef89 100644 --- a/libguile/num2integral.i.c +++ b/libguile/num2integral.i.c @@ -6,22 +6,22 @@ NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller) if (SCM_INUMP (num)) { /* immediate */ - scm_t_bits n = SCM_INUM (num); + scm_t_signed_bits n = SCM_INUM (num); #ifdef UNSIGNED if (n < 0) scm_out_of_range (s_caller, num); #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 anyway */ return (ITYPE) n; else { /* 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 - || n < (scm_t_bits)MIN_VALUE + || n < (scm_t_signed_bits)MIN_VALUE #endif ) scm_out_of_range (s_caller, num); @@ -84,7 +84,7 @@ NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller) SCM INTEGRAL2NUM (ITYPE n) { - if (sizeof (ITYPE) < sizeof (scm_t_bits) + if (sizeof (ITYPE) < sizeof (scm_t_signed_bits) || #ifndef UNSIGNED SCM_FIXABLE (n) diff --git a/libguile/read.c b/libguile/read.c index 214118473..a7e690a1e 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -289,9 +289,9 @@ scm_lreadr (SCM *tok_buf,SCM port,SCM *copy) size_t j; SCM p; -tryagain: + tryagain: c = scm_flush_ws (port, s_scm_read); -tryagain_no_flush_ws: + tryagain_no_flush_ws: switch (c) { case EOF: @@ -299,8 +299,8 @@ tryagain_no_flush_ws: case '(': return SCM_RECORD_POSITIONS_P - ? scm_lreadrecparen (tok_buf, port, s_list, copy) - : scm_lreadparen (tok_buf, port, s_list, copy); + ? scm_lreadrecparen (tok_buf, port, s_list, copy) + : scm_lreadparen (tok_buf, port, s_list, copy); case ')': SCM_MISC_ERROR ("unexpected \")\"", SCM_EOL); goto tryagain; @@ -339,6 +339,27 @@ tryagain_no_flush_ws: return p; case '#': 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) { case '(': @@ -435,8 +456,8 @@ tryagain_no_flush_ws: } } unkshrp: - scm_misc_error (s_scm_read, "Unknown # object: ~S", - SCM_LIST1 (SCM_MAKE_CHAR (c))); + scm_misc_error (s_scm_read, "Unknown # object: ~S", + SCM_LIST1 (SCM_MAKE_CHAR (c))); } case '"': @@ -484,27 +505,27 @@ tryagain_no_flush_ws: SCM_STRING_CHARS (*tok_buf)[j] = 0; 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 '.': case '-': case '+': num: - j = scm_read_token (c, tok_buf, port, 0); - p = scm_istring2number (SCM_STRING_CHARS (*tok_buf), (long) j, 10L); - if (!SCM_FALSEP (p)) - return p; - if (c == '#') - { - if ((j == 2) && (scm_getc (port) == '(')) - { - scm_ungetc ('(', port); - c = SCM_STRING_CHARS (*tok_buf)[1]; - goto callshrp; - } - SCM_MISC_ERROR ("unknown # object", SCM_EOL); - } - goto tok; + j = scm_read_token (c, tok_buf, port, 0); + p = scm_istring2number (SCM_STRING_CHARS (*tok_buf), (long) j, 10L); + if (!SCM_FALSEP (p)) + return p; + if (c == '#') + { + if ((j == 2) && (scm_getc (port) == '(')) + { + scm_ungetc ('(', port); + c = SCM_STRING_CHARS (*tok_buf)[1]; + goto callshrp; + } + SCM_MISC_ERROR ("unknown # object", SCM_EOL); + } + goto tok; case ':': if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))