guile/guile-core/libguile ChangeLog num2integra...

[Martin Grabmueller]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Martin Grabmueller <address@hidden>     01/06/27 06:15:20

Modified files:
        guile-core/libguile: ChangeLog num2integral.i.c read.c 

Log message:
        * 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).

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ChangeLog.diff?cvsroot=OldCVS&tr1=1.1454&tr2=1.1455&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/num2integral.i.c.diff?cvsroot=OldCVS&tr1=1.3&tr2=1.4&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/read.c.diff?cvsroot=OldCVS&tr1=1.72&tr2=1.73&r1=text&r2=text

Patches:
Index: guile/guile-core/libguile/ChangeLog
diff -u guile/guile-core/libguile/ChangeLog:1.1454 
guile/guile-core/libguile/ChangeLog:1.1455
--- guile/guile-core/libguile/ChangeLog:1.1454  Tue Jun 26 14:55:45 2001
+++ guile/guile-core/libguile/ChangeLog Wed Jun 27 06:15:20 2001
@@ -1,3 +1,14 @@
+2001-06-27  Martin Grabmueller  <address@hidden>
+
+       * 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  <address@hidden>
 
        * eval.h, eval.c (scm_call_4): New function.
Index: guile/guile-core/libguile/num2integral.i.c
diff -u guile/guile-core/libguile/num2integral.i.c:1.3 
guile/guile-core/libguile/num2integral.i.c:1.4
--- guile/guile-core/libguile/num2integral.i.c:1.3      Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/num2integral.i.c  Wed Jun 27 06:15:20 2001
@@ -6,22 +6,22 @@
   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 @@
 SCM
 INTEGRAL2NUM (ITYPE n)
 {
-  if (sizeof (ITYPE) < sizeof (scm_t_bits)
+  if (sizeof (ITYPE) < sizeof (scm_t_signed_bits)
       ||
 #ifndef UNSIGNED  
       SCM_FIXABLE (n)
Index: guile/guile-core/libguile/read.c
diff -u guile/guile-core/libguile/read.c:1.72 
guile/guile-core/libguile/read.c:1.73
--- guile/guile-core/libguile/read.c:1.72       Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/read.c    Wed Jun 27 06:15:20 2001
@@ -289,9 +289,9 @@
   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 @@
 
     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 @@
       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 @@
              }
          }
        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 @@
       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))