Patches

[Dirk Herrmann <dirk at ida dot ing dot tu-bs dot de>]

Hi!


Below is a set of patches.

chars.h:
* Provide SCM_CHARP, SCM_CHAR, SCM_MAKE_CHAR in addition to the existing
  macros SCM_ICHRP, SCM_ICHR and SCM_MAKICHR.  The point of this change is to
  hide the fact that chars are immediates.  I suggest to deprecate the
  existing ICHR macros.
* Remove SCM_P macro calls, assume ANSI compliant compiler.

scm_validate.h:
* provide SCM_VALIDATE_CHAR and SCM_VALIDATE_CHAR_COPY as replacements for 
  the existing ICHR macros.

strings.c:
* scm_string_p: Added comment, removed redundant SCM_IMP test.
* scm_read_only_string_p: Removed redundant SCM_IMP test.
* scm_string: Made R5RS compliant, check of rest argument only performed
  in GUILE_DEBUG mode

Currently, list->string is realized as an alias to string with just the
difference, that the string gets the list of characters as rest arguments,
while list->string gets the list as a first parameter.  Since for both
functions we need different error messages and checks, I suggest to make a
separate function for list->string.


Best regards,
Dirk Herrmann



Index: libguile/chars.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/chars.h,v
retrieving revision 1.6
diff -u -p -r1.6 chars.h
--- chars.h	1999/02/06 12:29:08	1.6
+++ chars.h	2000/01/26 14:04:11
@@ -49,6 +49,10 @@
 
 /* Immediate Characters
  */
+#define SCM_CHARP(x)      (SCM_ITAG8(x) == scm_tc8_char)
+#define SCM_CHAR(x)       ((unsigned int)SCM_ITAG8_DATA(x))
+#define SCM_MAKE_CHAR(x)  SCM_MAKE_ITAG8(x, scm_tc8_char)
+
 #define SCM_ICHRP(x)	(SCM_ITAG8(x) == scm_tc8_char)
 #define SCM_ICHR(x)	((unsigned int)SCM_ITAG8_DATA(x))
 #define SCM_MAKICHR(x)	SCM_MAKE_ITAG8(x, scm_tc8_char)
@@ -61,30 +65,30 @@ extern const char scm_charnums[];
 
 
 
-extern SCM scm_char_p SCM_P ((SCM x));
-extern SCM scm_char_eq_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_less_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_leq_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_gr_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_geq_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_ci_eq_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_ci_less_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_ci_leq_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_ci_gr_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_ci_geq_p SCM_P ((SCM x, SCM y));
-extern SCM scm_char_alphabetic_p SCM_P ((SCM chr));
-extern SCM scm_char_numeric_p SCM_P ((SCM chr));
-extern SCM scm_char_whitespace_p SCM_P ((SCM chr));
-extern SCM scm_char_upper_case_p SCM_P ((SCM chr));
-extern SCM scm_char_lower_case_p SCM_P ((SCM chr));
-extern SCM scm_char_is_both_p SCM_P ((SCM chr));
-extern SCM scm_char_to_integer SCM_P ((SCM chr));
-extern SCM scm_integer_to_char SCM_P ((SCM n));
-extern SCM scm_char_upcase SCM_P ((SCM chr));
-extern SCM scm_char_downcase SCM_P ((SCM chr));
-extern void scm_tables_prehistory SCM_P ((void));
-extern int scm_upcase SCM_P ((unsigned int c));
-extern int scm_downcase SCM_P ((unsigned int c));
-extern void scm_init_chars SCM_P ((void));
+extern SCM scm_char_p (SCM x);
+extern SCM scm_char_eq_p (SCM x, SCM y);
+extern SCM scm_char_less_p (SCM x, SCM y);
+extern SCM scm_char_leq_p (SCM x, SCM y);
+extern SCM scm_char_gr_p (SCM x, SCM y);
+extern SCM scm_char_geq_p (SCM x, SCM y);
+extern SCM scm_char_ci_eq_p (SCM x, SCM y);
+extern SCM scm_char_ci_less_p (SCM x, SCM y);
+extern SCM scm_char_ci_leq_p (SCM x, SCM y);
+extern SCM scm_char_ci_gr_p (SCM x, SCM y);
+extern SCM scm_char_ci_geq_p (SCM x, SCM y);
+extern SCM scm_char_alphabetic_p (SCM chr);
+extern SCM scm_char_numeric_p (SCM chr);
+extern SCM scm_char_whitespace_p (SCM chr);
+extern SCM scm_char_upper_case_p (SCM chr);
+extern SCM scm_char_lower_case_p (SCM chr);
+extern SCM scm_char_is_both_p (SCM chr);
+extern SCM scm_char_to_integer (SCM chr);
+extern SCM scm_integer_to_char (SCM n);
+extern SCM scm_char_upcase (SCM chr);
+extern SCM scm_char_downcase (SCM chr);
+extern void scm_tables_prehistory (void);
+extern int scm_upcase (unsigned int c);
+extern int scm_downcase (unsigned int c);
+extern void scm_init_chars (void);
 
 #endif  /* SCM_CHARSH */
Index: libguile/scm_validate.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/scm_validate.h,v
retrieving revision 1.19
diff -u -p -r1.19 scm_validate.h
--- scm_validate.h	2000/01/17 19:44:01	1.19
+++ scm_validate.h	2000/01/26 14:04:11
@@ -100,6 +100,12 @@
   do { SCM_ASSERT(SCM_BOOLP(flag), flag, pos, FUNC_NAME); \
        cvar = (SCM_BOOL_T == flag)? 1: 0; } while (0)
 
+#define SCM_VALIDATE_CHAR(pos,scm) SCM_MAKE_VALIDATE(pos,scm,CHARP)
+
+#define SCM_VALIDATE_CHAR_COPY(pos,scm,cvar) \
+  do { SCM_ASSERT(SCM_CHARP(scm), scm, pos, FUNC_NAME); \
+       cvar = SCM_CHAR(scm); } while (0)
+
 #define SCM_VALIDATE_ICHR(pos,scm) SCM_MAKE_VALIDATE(pos,scm,ICHRP)
 
 #define SCM_VALIDATE_ICHR_COPY(pos,scm,cvar) \
Index: libguile/strings.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/strings.c,v
retrieving revision 1.24
diff -u -p -r1.24 strings.c
--- strings.c	2000/01/18 11:24:03	1.24
+++ strings.c	2000/01/26 14:04:11
@@ -55,17 +55,17 @@
 /* {Strings}
  */
 
+
 SCM_DEFINE (scm_string_p, "string?", 1, 0, 0, 
-           (SCM x),
-	    "")
+           (SCM obj),
+	    "Return #t iff OBJ is a string, else #f.")
 #define FUNC_NAME s_scm_string_p
 {
-  if (SCM_IMP (x))
-    return SCM_BOOL_F;
-  return SCM_BOOL(SCM_STRINGP (x));
+  return SCM_BOOL(SCM_STRINGP (obj));
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE (scm_read_only_string_p, "read-only-string?", 1, 0, 0, 
            (SCM x),
 	    "Return true of OBJ can be read as a string,\n\n"
@@ -79,12 +79,11 @@ SCM_DEFINE (scm_read_only_string_p, "rea
 	    "@end example")
 #define FUNC_NAME s_scm_read_only_string_p
 {
-  if (SCM_IMP (x))
-    return SCM_BOOL_F;
   return SCM_BOOL(SCM_ROSTRINGP (x));
 }
 #undef FUNC_NAME
 
+
 SCM_REGISTER_PROC(s_list_to_string, "list->string", 1, 0, 0, scm_string);
 
 
@@ -93,52 +92,26 @@ SCM_DEFINE (scm_string, "string", 0, 0, 
 	    "")
 #define FUNC_NAME s_scm_string
 {
+  unsigned int arg_nr;
   SCM res;
   register unsigned char *data;
-  long i;
   long len;
-  SCM_DEFER_INTS;
-  i = scm_ilength (chrs);
-  if (i < 0)
-    {
-      SCM_ALLOW_INTS;
-      SCM_ASSERT (0, chrs, SCM_ARG1, FUNC_NAME);
-    }
-  len = 0;
-  {
-    SCM s;
-
-    for (len = 0, s = chrs; s != SCM_EOL; s = SCM_CDR (s))
-      if (SCM_ICHRP (SCM_CAR (s)))
-	len += 1;
-      else if (SCM_ROSTRINGP (SCM_CAR (s)))
-	len += SCM_ROLENGTH (SCM_CAR (s));
-      else
-	{
-	  SCM_ALLOW_INTS;
-	  SCM_ASSERT (0, s, SCM_ARG1, FUNC_NAME);
-	}
-  }
+
+  len = scm_ilength (chrs);
+
+#ifdef GUILE_DEBUG
+  if (len < 0)
+    SCM_MISC_ERROR("rest arguments do not form a proper list.");
+#endif /* GUILE_DEBUG */
+
   res = scm_makstr (len, 0);
   data = SCM_UCHARS (res);
-  for (;SCM_NNULLP (chrs);chrs = SCM_CDR (chrs))
+  for (arg_nr = 0; arg_nr < len; ++arg_nr, chrs = SCM_CDR (chrs))
     {
-      if (SCM_ICHRP (SCM_CAR (chrs)))
-	*data++ = SCM_ICHR (SCM_CAR (chrs));
-      else
-	{
-	  int l;
-	  char * c;
-	  l = SCM_ROLENGTH (SCM_CAR (chrs));
-	  c = SCM_ROCHARS (SCM_CAR (chrs));
-	  while (l)
-	    {
-	      --l;
-	      *data++ = *c++;
-	    }
-	}
+      SCM arg = SCM_CAR (chrs);
+      SCM_VALIDATE_CHAR (arg, arg_nr);
+      *data++ = SCM_CHAR (arg);
     }
-  SCM_ALLOW_INTS;
   return res;
 }
 #undef FUNC_NAME