* * net_db.c (scm_lnaof): change scheme name from lnaof to inet-lnaof.

	* read.c (scm_lreadr): use scm_misc_error to improve one of the
	"unknown # object" error messages.

	* strop.c (scm_i_index, scm_i_rindex): combine into one procedure
	(scm_i_index) and declare it static.  Add a 'direction' argument
	to indicate what way the search should go.
	(scm_i_index): throw out-of-range error instead	of wrong-type-arg
	if indices are bad.
	(scm_string_index, scm_string_rindex): adjust usage of scm_i_index.
	strop.h: remove scm_i_index, scm_i_rindex prototypes.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 18cc034..90ca858 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,20 @@
+Tue Feb  4 05:07:35 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+*      * net_db.c (scm_lnaof): change scheme name from lnaof to inet-lnaof.
+
+Mon Feb  3 06:12:37 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+       * read.c (scm_lreadr): use scm_misc_error to improve one of the 
+       "unknown # object" error messages.
+
+       * strop.c (scm_i_index, scm_i_rindex): combine into one procedure
+       (scm_i_index) and declare it static.  Add a 'direction' argument
+       to indicate what way the search should go.
+       (scm_i_index): throw out-of-range error instead of wrong-type-arg
+       if indices are bad.
+       (scm_string_index, scm_string_rindex): adjust usage of scm_i_index.
+       strop.h: remove scm_i_index, scm_i_rindex prototypes.
+
 Fri Jan 31 04:33:11 1997  Gary Houston  <ghouston@actrix.gen.nz>
 
        * ioext.c, ioext.h: remove obsolete _sys_ from 9 procedure names.

diff --git a/libguile/net_db.c b/libguile/net_db.c
index 51daac8..0e21667 100644 (file)
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@@ -116,7 +116,7 @@ scm_inet_netof (address)
   return scm_ulong2num ((unsigned long) inet_netof (addr));
 }
 
-SCM_PROC (s_lnaof, "lnaof", 1, 0, 0, scm_lnaof);
+SCM_PROC (s_lnaof, "inet-lnaof", 1, 0, 0, scm_lnaof);
 
 SCM 
 scm_lnaof (address)

diff --git a/libguile/read.c b/libguile/read.c
index 229681a..dc04c34 100644 (file)
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -419,7 +419,9 @@ tryagain_no_flush_ws:
              else
                return got;
            }
-       unkshrp:scm_wta ((SCM) SCM_MAKICHR (c), "unknown # object", "");
+       unkshrp:
+         scm_misc_error (s_read, "Unknown # object: %S",
+                         scm_listify (SCM_MAKICHR (c), SCM_UNDEFINED));
        }
 
     case '"':

diff --git a/libguile/strop.c b/libguile/strop.c
index c0e9556..cb65812 100644 (file)
--- a/libguile/strop.c
+++ b/libguile/strop.c
@@ -26,58 +26,15 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 \f
 
 
-int
-scm_i_index (str, chr, sub_start, sub_end, pos, pos2, pos3, pos4, why)
-     SCM * str;
-     SCM chr;
-     SCM sub_start;
-     SCM sub_end;
-     int pos;
-     int pos2;
-     int pos3;
-     int pos4;
-     char * why;
-{
-  unsigned char * p;
-  int x;
-  int bound;
-  int ch;
-
-  SCM_ASSERT (SCM_NIMP (*str) && SCM_ROSTRINGP (*str), *str, pos, why);
-  SCM_ASSERT (SCM_ICHRP (chr), chr, pos2, why);
-
-  if (sub_start == SCM_BOOL_F)
-    sub_start = SCM_MAKINUM (0);
-  else
-    SCM_ASSERT (   SCM_INUMP (sub_start)
-           && (0 <= SCM_INUM (sub_start))
-           && (SCM_INUM (sub_start) <= SCM_ROLENGTH (*str)),
-           sub_start, pos3, why);
-
-  if (sub_end == SCM_BOOL_F)
-    sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str));
-  else
-    SCM_ASSERT (   SCM_INUMP (sub_end)
-           && (SCM_INUM (sub_start) <= SCM_INUM (sub_end))
-           && (SCM_INUM (sub_end) <= SCM_ROLENGTH (*str)),
-           sub_end, pos4, why);
-
-  p = (unsigned char *)SCM_ROCHARS (*str) + SCM_INUM (sub_start);
-  bound = SCM_INUM (sub_end);
-  ch = SCM_ICHR (chr);
-
-  for (x = SCM_INUM (sub_start); x < bound; ++x, ++p)
-    if (*p == ch)
-      return x;
+static int scm_i_index SCM_P ((SCM * str, SCM chr, int direction, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, char * why));
 
-  return -1;
-}
-
-
-int
-scm_i_rindex (str, chr, sub_start, sub_end, pos, pos2, pos3, pos4, why)
+/* implements index if direction > 0 otherwise rindex.  */
+static int
+scm_i_index (str, chr, direction, sub_start, sub_end, pos, pos2, pos3, pos4,
+            why)
      SCM * str;
      SCM chr;
+     int direction;
      SCM sub_start;
      SCM sub_end;
      int pos;
@@ -88,8 +45,8 @@ scm_i_rindex (str, chr, sub_start, sub_end, pos, pos2, pos3, pos4, why)
 {
   unsigned char * p;
   int x;
-  int upper_bound;
-  int lower_bound;
+  int lower;
+  int upper;
   int ch;
 
   SCM_ASSERT (SCM_NIMP (*str) && SCM_ROSTRINGP (*str), *str, pos, why);
@@ -97,32 +54,43 @@ scm_i_rindex (str, chr, sub_start, sub_end, pos, pos2, pos3, pos4, why)
 
   if (sub_start == SCM_BOOL_F)
     sub_start = SCM_MAKINUM (0);
-  else
-    SCM_ASSERT (   SCM_INUMP (sub_start)
-           && (0 <= SCM_INUM (sub_start))
-           && (SCM_INUM (sub_start) <= SCM_ROLENGTH (*str)),
-           sub_start, pos3, why);
+
+  SCM_ASSERT (SCM_INUMP (sub_start), sub_start, pos3, why);
+  lower = SCM_INUM (sub_start);
+  if (lower < 0
+      || lower >= SCM_ROLENGTH (*str))
+    scm_out_of_range (why, sub_start);
 
   if (sub_end == SCM_BOOL_F)
     sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str));
+
+  SCM_ASSERT (SCM_INUMP (sub_end), sub_end, pos4, why);
+  upper = SCM_INUM (sub_end);
+  if (upper < SCM_INUM (sub_start)
+      || upper > SCM_ROLENGTH (*str))
+    scm_out_of_range (why, sub_end);
+
+  if (direction > 0)
+    {
+      p = (unsigned char *)SCM_ROCHARS (*str) + lower;
+      ch = SCM_ICHR (chr);
+
+      for (x = SCM_INUM (sub_start); x < upper; ++x, ++p)
+       if (*p == ch)
+         return x;
+    }
   else
-    SCM_ASSERT (   SCM_INUMP (sub_end)
-           && (SCM_INUM (sub_start) <= SCM_INUM (sub_end))
-           && (SCM_INUM (sub_end) <= SCM_ROLENGTH (*str)),
-           sub_end, pos4, why);
-
-  upper_bound = SCM_INUM (sub_end);
-  lower_bound = SCM_INUM (sub_start);
-  p = upper_bound - 1 + (unsigned char *)SCM_ROCHARS (*str);
-  ch = SCM_ICHR (chr);
-  for (x = upper_bound - 1; x >= lower_bound; --x, --p)
-    if (*p == ch)
-      return x;
+    {
+      p = upper - 1 + (unsigned char *)SCM_ROCHARS (*str);
+      ch = SCM_ICHR (chr);
+      for (x = upper - 1; x >= lower; --x, --p)
+       if (*p == ch)
+         return x;
+    }
 
   return -1;
 }
 
-
 SCM_PROC(s_string_index, "string-index", 2, 2, 0, scm_string_index);
 
 SCM 
@@ -138,7 +106,7 @@ scm_string_index (str, chr, frm, to)
     frm = SCM_BOOL_F;
   if (to == SCM_UNDEFINED)
     to = SCM_BOOL_F;
-  pos = scm_i_index (&str, chr, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
+  pos = scm_i_index (&str, chr, 1, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
   return (pos < 0
          ? SCM_BOOL_F
          : SCM_MAKINUM (pos));
@@ -159,7 +127,7 @@ scm_string_rindex (str, chr, frm, to)
     frm = SCM_BOOL_F;
   if (to == SCM_UNDEFINED)
     to = SCM_BOOL_F;
-  pos = scm_i_rindex (&str, chr, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
+  pos = scm_i_index (&str, chr, -1, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
   return (pos < 0
          ? SCM_BOOL_F
          : SCM_MAKINUM (pos));

diff --git a/libguile/strop.h b/libguile/strop.h
index fea23d7..091931a 100644 (file)
--- a/libguile/strop.h
+++ b/libguile/strop.h
@@ -49,8 +49,6 @@
 \f
 
 
-extern int scm_i_index SCM_P ((SCM * str, SCM chr, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, char * why));
-extern int scm_i_rindex SCM_P ((SCM * str, SCM chr, SCM sub_start, SCM sub_end, int pos, int pos2, int pos3, int pos4, char * why));
 extern SCM scm_string_index SCM_P ((SCM str, SCM chr, SCM frm, SCM to));
 extern SCM scm_string_rindex SCM_P ((SCM str, SCM chr, SCM frm, SCM to));
 extern SCM scm_substring_move_left_x SCM_P ((SCM str1, SCM start1, SCM args));