libguile/strings.c

   1 /* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  16  */
  17
  18
  19 \f
  20
  21 #include <string.h>
  22
  23 #include "libguile/_scm.h"
  24 #include "libguile/chars.h"
  25 #include "libguile/root.h"
  26 #include "libguile/strings.h"
  27 #include "libguile/deprecation.h"
  28 #include "libguile/validate.h"
  29 #include "libguile/dynwind.h"
  30
  31 \f
  32
  33 /* {Strings}
  34  */
  35
  36 SCM_DEFINE (scm_string_p, "string?", 1, 0, 0,
  37             (SCM obj),
  38             "Return @code{#t} if @var{obj} is a string, else @code{#f}.")
  39 #define FUNC_NAME s_scm_string_p
  40 {
  41   return scm_from_bool (SCM_I_STRINGP (obj));
  42 }
  43 #undef FUNC_NAME
  44
  45
  46 SCM_REGISTER_PROC (s_scm_list_to_string, "list->string", 1, 0, 0, scm_string);
  47
  48 SCM_DEFINE (scm_string, "string", 0, 0, 1,
  49             (SCM chrs),
  50             "@deffnx {Scheme Procedure} list->string chrs\n"
  51             "Return a newly allocated string composed of the arguments,\n"
  52             "@var{chrs}.")
  53 #define FUNC_NAME s_scm_string
  54 {
  55   SCM result;
  56
  57   {
  58     long i = scm_ilength (chrs);
  59
  60     SCM_ASSERT (i >= 0, chrs, SCM_ARG1, FUNC_NAME);
  61     result = scm_allocate_string (i);
  62   }
  63
  64   {
  65     unsigned char *data = SCM_I_STRING_UCHARS (result);
  66
  67     while (!SCM_NULLP (chrs))
  68       {
  69         SCM elt = SCM_CAR (chrs);
  70
  71         SCM_VALIDATE_CHAR (SCM_ARGn, elt);
  72         *data++ = SCM_CHAR (elt);
  73         chrs = SCM_CDR (chrs);
  74       }
  75   }
  76   return result;
  77 }
  78 #undef FUNC_NAME
  79
  80
  81 /* converts C scm_array of strings to SCM scm_list of strings. */
  82 /* If argc < 0, a null terminated scm_array is assumed. */
  83 SCM
  84 scm_makfromstrs (int argc, char **argv)
  85 {
  86   int i = argc;
  87   SCM lst = SCM_EOL;
  88   if (0 > i)
  89     for (i = 0; argv[i]; i++);
  90   while (i--)
  91     lst = scm_cons (scm_mem2string (argv[i], strlen (argv[i])), lst);
  92   return lst;
  93 }
  94
  95
  96 /* This function must only be applied to memory obtained via malloc,
  97    since the GC is going to apply `free' to it when the string is
  98    dropped.
  99
 100    Also, s[len] must be `\0', since we promise that strings are
 101    null-terminated.  Perhaps we could handle non-null-terminated
 102    strings by claiming they're shared substrings of a string we just
 103    made up.  */
 104 SCM
 105 scm_take_str (char *s, size_t len)
 106 #define FUNC_NAME "scm_take_str"
 107 {
 108   SCM answer;
 109
 110   SCM_ASSERT_RANGE (2, scm_from_ulong (len), len <= SCM_STRING_MAX_LENGTH);
 111
 112   answer = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) s);
 113   scm_gc_register_collectable_memory (s, len+1, "string");
 114
 115   return answer;
 116 }
 117 #undef FUNC_NAME
 118
 119
 120 /* `s' must be a malloc'd string.  See scm_take_str.  */
 121 SCM
 122 scm_take0str (char *s)
 123 {
 124   return scm_take_locale_string (s);
 125 }
 126
 127
 128 SCM
 129 scm_mem2string (const char *src, size_t len)
 130 {
 131   return scm_from_locale_stringn (src, len);
 132 }
 133
 134
 135 SCM
 136 scm_str2string (const char *src)
 137 {
 138   return scm_from_locale_string (src);
 139 }
 140
 141
 142 SCM
 143 scm_makfrom0str (const char *src)
 144 {
 145   if (!src) return SCM_BOOL_F;
 146   return scm_from_locale_string (src);
 147 }
 148
 149
 150 SCM
 151 scm_makfrom0str_opt (const char *src)
 152 {
 153   return scm_makfrom0str (src);
 154 }
 155
 156
 157 SCM
 158 scm_allocate_string (size_t len)
 159 #define FUNC_NAME "scm_allocate_string"
 160 {
 161   char *mem;
 162   SCM s;
 163
 164   SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= SCM_STRING_MAX_LENGTH);
 165
 166   mem = (char *) scm_gc_malloc (len + 1, "string");
 167   mem[len] = 0;
 168
 169   s = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) mem);
 170
 171   return s;
 172 }
 173 #undef FUNC_NAME
 174
 175
 176 SCM_DEFINE (scm_make_string, "make-string", 1, 1, 0,
 177             (SCM k, SCM chr),
 178             "Return a newly allocated string of\n"
 179             "length @var{k}.  If @var{chr} is given, then all elements of\n"
 180             "the string are initialized to @var{chr}, otherwise the contents\n"
 181             "of the @var{string} are unspecified.")
 182 #define FUNC_NAME s_scm_make_string
 183 {
 184   size_t i = scm_to_unsigned_integer (k, 0, SCM_STRING_MAX_LENGTH);
 185   SCM res = scm_allocate_string (i);
 186
 187   if (!SCM_UNBNDP (chr))
 188     {
 189       unsigned char *dst;
 190
 191       SCM_VALIDATE_CHAR (2, chr);
 192
 193       dst = SCM_I_STRING_UCHARS (res);
 194       memset (dst, SCM_CHAR (chr), i);
 195     }
 196
 197   return res;
 198 }
 199 #undef FUNC_NAME
 200
 201
 202 SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0,
 203             (SCM string),
 204             "Return the number of characters in @var{string}.")
 205 #define FUNC_NAME s_scm_string_length
 206 {
 207   SCM_VALIDATE_STRING (1, string);
 208   return scm_from_size_t (SCM_I_STRING_LENGTH (string));
 209 }
 210 #undef FUNC_NAME
 211
 212 SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0,
 213             (SCM str, SCM k),
 214             "Return character @var{k} of @var{str} using zero-origin\n"
 215             "indexing. @var{k} must be a valid index of @var{str}.")
 216 #define FUNC_NAME s_scm_string_ref
 217 {
 218   unsigned long idx;
 219
 220   SCM_VALIDATE_STRING (1, str);
 221   idx = scm_to_unsigned_integer (k, 0, SCM_I_STRING_LENGTH(str)-1);
 222   return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (str)[idx]);
 223 }
 224 #undef FUNC_NAME
 225
 226
 227 SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
 228             (SCM str, SCM k, SCM chr),
 229             "Store @var{chr} in element @var{k} of @var{str} and return\n"
 230             "an unspecified value. @var{k} must be a valid index of\n"
 231             "@var{str}.")
 232 #define FUNC_NAME s_scm_string_set_x
 233 {
 234   unsigned long idx;
 235
 236   SCM_VALIDATE_STRING (1, str);
 237   idx = scm_to_unsigned_integer (k, 0, SCM_I_STRING_LENGTH(str)-1);
 238   SCM_VALIDATE_CHAR (3, chr);
 239   SCM_I_STRING_UCHARS (str)[idx] = SCM_CHAR (chr);
 240   return SCM_UNSPECIFIED;
 241 }
 242 #undef FUNC_NAME
 243
 244
 245 SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
 246             (SCM str, SCM start, SCM end),
 247             "Return a newly allocated string formed from the characters\n"
 248             "of @var{str} beginning with index @var{start} (inclusive) and\n"
 249             "ending with index @var{end} (exclusive).\n"
 250             "@var{str} must be a string, @var{start} and @var{end} must be\n"
 251             "exact integers satisfying:\n\n"
 252             "0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
 253 #define FUNC_NAME s_scm_substring
 254 {
 255   unsigned long int from;
 256   unsigned long int to;
 257   SCM substr;
 258
 259   SCM_VALIDATE_STRING (1, str);
 260   from = scm_to_unsigned_integer (start, 0, SCM_I_STRING_LENGTH(str));
 261   if (SCM_UNBNDP (end))
 262     to = SCM_I_STRING_LENGTH(str);
 263   else
 264     to = scm_to_unsigned_integer (end, from, SCM_I_STRING_LENGTH(str));
 265   substr = scm_allocate_string (to - from);
 266   memcpy (SCM_I_STRING_CHARS (substr), SCM_I_STRING_CHARS (str) + from,
 267           to - from);
 268   scm_remember_upto_here_1 (str);
 269   return substr;
 270 }
 271 #undef FUNC_NAME
 272
 273
 274 SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
 275             (SCM args),
 276             "Return a newly allocated string whose characters form the\n"
 277             "concatenation of the given strings, @var{args}.")
 278 #define FUNC_NAME s_scm_string_append
 279 {
 280   SCM res;
 281   size_t i = 0;
 282   SCM l, s;
 283   char *data;
 284
 285   SCM_VALIDATE_REST_ARGUMENT (args);
 286   for (l = args; !SCM_NULLP (l); l = SCM_CDR (l))
 287     {
 288       s = SCM_CAR (l);
 289       SCM_VALIDATE_STRING (SCM_ARGn, s);
 290       i += SCM_I_STRING_LENGTH (s);
 291     }
 292   res = scm_allocate_string (i);
 293   data = SCM_I_STRING_CHARS (res);
 294   for (l = args; !SCM_NULLP (l); l = SCM_CDR (l))
 295     {
 296       s = SCM_CAR (l);
 297       memcpy (data, SCM_I_STRING_CHARS (s), SCM_I_STRING_LENGTH (s));
 298       data += SCM_I_STRING_LENGTH (s);
 299       scm_remember_upto_here_1 (s);
 300     }
 301   return res;
 302 }
 303 #undef FUNC_NAME
 304
 305 int
 306 scm_is_string (SCM obj)
 307 {
 308   return SCM_I_STRINGP (obj);
 309 }
 310
 311 SCM
 312 scm_from_locale_stringn (const char *str, size_t len)
 313 {
 314   SCM res;
 315   char *dst;
 316
 317   if (len == (size_t)-1)
 318     len = strlen (str);
 319   res = scm_allocate_string (len);
 320   dst = SCM_I_STRING_CHARS (res);
 321   memcpy (dst, str, len);
 322   return res;
 323 }
 324
 325 SCM
 326 scm_from_locale_string (const char *str)
 327 {
 328   return scm_from_locale_stringn (str, -1);
 329 }
 330
 331 SCM
 332 scm_take_locale_stringn (char *str, size_t len)
 333 {
 334   if (len == (size_t)-1)
 335     return scm_take_locale_string (str);
 336   else
 337     {
 338       /* STR might not be zero terminated and we are not allowed to
 339          look at str[len], so we have to make a new one...
 340       */
 341       SCM res = scm_from_locale_stringn (str, len);
 342       free (str);
 343       return res;
 344     }
 345 }
 346
 347 SCM
 348 scm_take_locale_string (char *str)
 349 {
 350   size_t len = strlen (str);
 351   SCM res;
 352
 353   if (len > SCM_STRING_MAX_LENGTH)
 354     {
 355       free (str);
 356       scm_out_of_range (NULL, scm_from_size_t (len));
 357     }
 358
 359   res = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) str);
 360   scm_gc_register_collectable_memory (str, len+1, "string");
 361
 362   return res;
 363 }
 364
 365 char *
 366 scm_to_locale_stringn (SCM str, size_t *lenp)
 367 {
 368   char *res;
 369   size_t len;
 370
 371   if (!SCM_I_STRINGP (str))
 372     scm_wrong_type_arg_msg (NULL, 0, str, "string");
 373   len = SCM_I_STRING_LENGTH (str);
 374   res = scm_malloc (len + ((lenp==NULL)? 1 : 0));
 375   memcpy (res, SCM_I_STRING_CHARS (str), len);
 376   if (lenp == NULL)
 377     {
 378       res[len] = '\0';
 379       if (strlen (res) != len)
 380         {
 381           free (res);
 382           scm_misc_error (NULL,
 383                           "string contains #\\nul character: ~S",
 384                           scm_list_1 (str));
 385         }
 386     }
 387   else
 388     *lenp = len;
 389
 390   scm_remember_upto_here_1 (str);
 391   return res;
 392 }
 393
 394 char *
 395 scm_to_locale_string (SCM str)
 396 {
 397   return scm_to_locale_stringn (str, NULL);
 398 }
 399
 400 size_t
 401 scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len)
 402 {
 403   size_t len;
 404
 405   if (!SCM_I_STRINGP (str))
 406     scm_wrong_type_arg_msg (NULL, 0, str, "string");
 407   len = SCM_I_STRING_LENGTH (str);
 408   memcpy (buf, SCM_I_STRING_CHARS (str), (len > max_len)? max_len : len);
 409   scm_remember_upto_here_1 (str);
 410   return len;
 411 }
 412
 413 /* Return a newly allocated array of char pointers to each of the strings
 414    in args, with a terminating NULL pointer.  */
 415
 416 char **
 417 scm_i_allocate_string_pointers (SCM list)
 418 {
 419   char **result;
 420   int len = scm_ilength (list);
 421   int i;
 422
 423   if (len < 0)
 424     scm_wrong_type_arg_msg (NULL, 0, list, "proper list");
 425
 426   scm_frame_begin (0);
 427
 428   result = (char **) scm_malloc ((len + 1) * sizeof (char *));
 429   result[len] = NULL;
 430   scm_frame_unwind_handler (free, result, 0);
 431
 432   /* The list might be have been modified in another thread, so
 433      we check LIST before each access.
 434    */
 435   for (i = 0; i < len && SCM_CONSP (list); i++)
 436     {
 437       result[i] = scm_to_locale_string (SCM_CAR (list));
 438       list = SCM_CDR (list);
 439     }
 440
 441   scm_frame_end ();
 442   return result;
 443 }
 444
 445 void
 446 scm_i_free_string_pointers (char **pointers)
 447 {
 448   int i;
 449
 450   for (i = 0; pointers[i]; i++)
 451     free (pointers[i]);
 452   free (pointers);
 453 }
 454
 455 void
 456 scm_init_strings ()
 457 {
 458   scm_nullstr = scm_allocate_string (0);
 459
 460 #include "libguile/strings.x"
 461 }
 462
 463
 464 /*
 465   Local Variables:
 466   c-file-style: "gnu"
 467   End:
 468 */