* Some more work to get rid of SCM_LENGTH
[bpt/guile.git] / libguile / strop.c
index de98e83..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,12 +24,13 @@ Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
 \f
 
 #include <stdio.h>
-#include "_scm.h"
-#include "chars.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>
@@ -63,7 +64,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
   SCM_ASSERT (SCM_ROSTRINGP (*str), *str, SCM_ARG1, why);
   SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why);
 
-  if (sub_start == SCM_BOOL_F)
+  if (SCM_FALSEP (sub_start))
     sub_start = SCM_MAKINUM (0);
 
   SCM_ASSERT (SCM_INUMP (sub_start), sub_start, SCM_ARG3, why);
@@ -72,7 +73,7 @@ scm_i_index (SCM *str, SCM chr, int direction, SCM sub_start,
       || lower > SCM_ROLENGTH (*str))
     scm_out_of_range (why, sub_start);
 
-  if (sub_end == SCM_BOOL_F)
+  if (SCM_FALSEP (sub_end))
     sub_end = SCM_MAKINUM (SCM_ROLENGTH (*str));
 
   SCM_ASSERT (SCM_INUMP (sub_end), sub_end, SCM_ARG4, why);
@@ -113,20 +114,20 @@ 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
 {
   int pos;
   
-  if (frm == SCM_UNDEFINED)
+  if (SCM_UNBNDP (frm))
     frm = SCM_BOOL_F;
-  if (to == SCM_UNDEFINED)
+  if (SCM_UNBNDP (to))
     to = SCM_BOOL_F;
   pos = scm_i_index (&str, chr, 1, frm, to, FUNC_NAME);
   return (pos < 0
@@ -144,20 +145,20 @@ 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
 {
   int pos;
   
-  if (frm == SCM_UNDEFINED)
+  if (SCM_UNBNDP (frm))
     frm = SCM_BOOL_F;
-  if (to == SCM_UNDEFINED)
+  if (SCM_UNBNDP (to))
     to = SCM_BOOL_F;
   pos = scm_i_index (&str, chr, -1, frm, to, FUNC_NAME);
   return (pos < 0
@@ -226,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"
@@ -252,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);
@@ -273,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")
@@ -285,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
@@ -327,7 +330,7 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
   unsigned char *src;
   SCM_VALIDATE_ROSTRING (1,str);
   src = SCM_ROUCHARS (str);
-  for (i = SCM_ROLENGTH (str)-1;i >= 0;i--) res = scm_cons ((SCM)SCM_MAKE_CHAR (src[i]), res);
+  for (i = SCM_ROLENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res);
   return res;
 }
 #undef FUNC_NAME
@@ -339,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
 
@@ -355,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
@@ -372,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
@@ -414,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
@@ -450,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) {
@@ -491,5 +479,11 @@ SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0,
 void
 scm_init_strop ()
 {
-#include "strop.x"
+#include "libguile/strop.x"
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/