* Some more work to get rid of SCM_LENGTH
[bpt/guile.git] / libguile / strop.c
index 630ecbb..cc8b539 100644 (file)
@@ -1,6 +1,6 @@
 /* classes: src_files */
 
-/*     Copyright (C) 1994, 1996, 1997, 1999 Free Software Foundation, Inc.
+/*     Copyright (C) 1994, 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -24,13 +24,13 @@ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 \f
 
 #include <stdio.h>
-#include "_scm.h"
-#include "chars.h"
-#include "strings.h"
+#include "libguile/_scm.h"
+#include "libguile/chars.h"
+#include "libguile/strings.h"
 
-#include "validate.h"
-#include "strop.h"
-#include "read.h" /*For SCM_CASE_INSENSITIVE_P*/
+#include "libguile/validate.h"
+#include "libguile/strop.h"
+#include "libguile/read.h" /*For SCM_CASE_INSENSITIVE_P*/
 
 #ifdef HAVE_STRING_H
 #include <string.h>
@@ -114,11 +114,11 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
            "it is used as the starting index; if @var{to} is given and not @var{#f},\n"
            "it is used as the ending index (exclusive).\n\n"
            "@example\n"
-           "(string-index "weiner" #\e)\n"
+           "(string-index \"weiner\" #\\e)\n"
            "@result{} 1\n\n"
-           "(string-index "weiner" #\e 2)\n"
+           "(string-index \"weiner\" #\\e 2)\n"
            "@result{} 4\n\n"
-           "(string-index "weiner" #\e 2 4)\n"
+           "(string-index \"weiner\" #\\e 2 4)\n"
            "@result{} #f\n"
            "@end example")
 #define FUNC_NAME s_scm_string_index
@@ -145,11 +145,11 @@ SCM_DEFINE (scm_string_rindex, "string-rindex", 2, 2, 0,
            "of @var{char} in the range [@var{frm}, @var{to}-1], which defaults to\n"
            "the entire string.\n\n"
            "@example\n"
-           "(string-rindex "weiner" #\e)\n"
+           "(string-rindex \"weiner\" #\\e)\n"
            "@result{} 4\n\n"
-           "(string-rindex "weiner" #\e 2 4)\n"
+           "(string-rindex \"weiner\" #\\e 2 4)\n"
            "@result{} #f\n\n"
-           "(string-rindex "weiner" #\e 2 5)\n"
+           "(string-rindex \"weiner\" #\\e 2 5)\n"
            "@result{} 4\n"
            "@end example")
 #define FUNC_NAME s_scm_string_rindex
@@ -227,6 +227,8 @@ y
 
 SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, 
            (SCM str1, SCM start1, SCM end1, SCM str2, SCM start2),
+           "@deffnx primitive substring-move-left! str1 start1 end1 str2 start2\n"
+           "@deffnx primitive substring-move-right! str1 start1 end1 str2 start2\n"
            "Copy the substring of @var{str1} bounded by @var{start1} and @var{end1}\n"
            "into @var{str2} beginning at position @var{end2}.\n"
            "@code{substring-move-right!} begins copying from the rightmost character\n"
@@ -253,13 +255,13 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0,
   SCM_VALIDATE_INUM_COPY (5,start2,s2);
   len = e - s1;
   SCM_ASSERT_RANGE (3,end1,len >= 0);
-  SCM_ASSERT_RANGE (2,start1,s1 <= SCM_LENGTH (str1) && s1 >= 0);
-  SCM_ASSERT_RANGE (5,start2,s2 <= SCM_LENGTH (str2) && s2 >= 0);
-  SCM_ASSERT_RANGE (3,end1,e <= SCM_LENGTH (str1) && e >= 0);
-  SCM_ASSERT_RANGE (5,start2,len+s2 <= SCM_LENGTH (str2));
+  SCM_ASSERT_RANGE (2,start1,s1 <= SCM_STRING_LENGTH (str1) && s1 >= 0);
+  SCM_ASSERT_RANGE (5,start2,s2 <= SCM_STRING_LENGTH (str2) && s2 >= 0);
+  SCM_ASSERT_RANGE (3,end1,e <= SCM_STRING_LENGTH (str1) && e >= 0);
+  SCM_ASSERT_RANGE (5,start2,len+s2 <= SCM_STRING_LENGTH (str2));
 
-  SCM_SYSCALL(memmove((void *)(&(SCM_CHARS(str2)[s2])),
-                     (void *)(&(SCM_CHARS(str1)[s1])),
+  SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])),
+                     (void *)(&(SCM_STRING_CHARS(str1)[s1])),
                      len));
   
   return scm_return_first(SCM_UNSPECIFIED, str1, str2);
@@ -274,7 +276,7 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
            "(qdocs:) Destructively fills @var{str}, from @var{start} to @var{end}, with @var{fill}.\n\n"
            "@example\n"
            "(define y \"abcdefg\")\n"
-           "(substring-fill! y 1 3 #\r)\n"
+           "(substring-fill! y 1 3 #\\r)\n"
            "y\n"
            "@result{} \"arrdefg\"\n"
            "@end example")
@@ -286,9 +288,9 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
   SCM_VALIDATE_INUM_COPY (2,start,i);
   SCM_VALIDATE_INUM_COPY (3,end,e);
   SCM_VALIDATE_CHAR_COPY (4,fill,c);
-  SCM_ASSERT_RANGE (2,start,i <= SCM_LENGTH (str) && i >= 0);
-  SCM_ASSERT_RANGE (3,end,e <= SCM_LENGTH (str) && e >= 0);
-  while (i<e) SCM_CHARS (str)[i++] = c;
+  SCM_ASSERT_RANGE (2,start,i <= SCM_STRING_LENGTH (str) && i >= 0);
+  SCM_ASSERT_RANGE (3,end,e <= SCM_STRING_LENGTH (str) && e >= 0);
+  while (i<e) SCM_STRING_CHARS (str)[i++] = c;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -340,8 +342,8 @@ SCM_DEFINE (scm_string_copy, "string-copy", 1, 0, 0,
            "Returns a newly allocated copy of the given @var{string}. (r5rs)")
 #define FUNC_NAME s_scm_string_copy
 {
-  SCM_VALIDATE_STRINGORSUBSTR (1,str);
-  return scm_makfromstr (SCM_ROCHARS (str), (scm_sizet)SCM_ROLENGTH (str), 0);
+  SCM_VALIDATE_STRING (1, str);
+  return scm_makfromstr (SCM_ROCHARS (str), SCM_STRING_LENGTH (str), 0);
 }
 #undef FUNC_NAME
 
@@ -356,7 +358,7 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
   register long k;
   SCM_VALIDATE_STRING_COPY (1,str,dst);
   SCM_VALIDATE_CHAR_COPY (2,chr,c);
-  for (k = SCM_LENGTH (str)-1;k >= 0;k--) dst[k] = c;
+  for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c;
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -373,21 +375,13 @@ SCM_DEFINE (scm_string_upcase_x, "string-upcase!", 1, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_string_upcase_x
 {
-  register long k;
-  register unsigned char *cs;
-  SCM_ASRTGO (SCM_NIMP (v), badarg1);
-  k = SCM_LENGTH (v);
-  switch SCM_TYP7
-    (v)
-    {
-    case scm_tc7_string:
-      cs = SCM_UCHARS (v);
-      while (k--)
-       cs[k] = scm_upcase(cs[k]);
-      break;
-    default:
-    badarg1:SCM_WTA (1,v);
-    }
+  unsigned long k;
+
+  SCM_VALIDATE_STRING (1, v);
+
+  for (k = 0; k < SCM_STRING_LENGTH (v); ++k)
+    SCM_STRING_UCHARS (v) [k] = scm_upcase (SCM_STRING_UCHARS (v) [k]);
+
   return v;
 }
 #undef FUNC_NAME
@@ -415,20 +409,13 @@ SCM_DEFINE (scm_string_downcase_x, "string-downcase!", 1, 0, 0,
            "@end example")
 #define FUNC_NAME s_scm_string_downcase_x
 {
-  register long k;
-  register unsigned char *cs;
-  SCM_ASRTGO (SCM_NIMP (v), badarg1);
-  k = SCM_LENGTH (v);
-  switch (SCM_TYP7(v))
-    {
-      case scm_tc7_string:
-        cs = SCM_UCHARS (v);
-        while (k--)
-          cs[k] = scm_downcase(cs[k]);
-        break;
-      default:
-    badarg1:SCM_WTA (1,v);
-    }
+  unsigned long k;
+
+  SCM_VALIDATE_STRING (1, v);
+
+  for (k = 0; k < SCM_STRING_LENGTH (v); ++k)
+    SCM_STRING_UCHARS (v) [k] = scm_downcase (SCM_STRING_UCHARS (v) [k]);
+
   return v;
 }
 #undef FUNC_NAME
@@ -451,8 +438,8 @@ SCM_DEFINE (scm_string_capitalize_x, "string-capitalize!", 1, 0, 0,
   char *sz;
   int i, len, in_word=0;
   SCM_VALIDATE_STRING (1,str);
-  len = SCM_LENGTH(str);
-  sz = SCM_CHARS(str);
+  len = SCM_STRING_LENGTH(str);
+  sz = SCM_STRING_CHARS (str);
   for(i=0; i<len;  i++) {
     if(SCM_NFALSEP(scm_char_alphabetic_p(SCM_MAKE_CHAR(sz[i])))) {
       if(!in_word) {
@@ -492,7 +479,7 @@ SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0,
 void
 scm_init_strop ()
 {
-#include "strop.x"
+#include "libguile/strop.x"
 }
 
 /*