2002-01-28 Stefan Jahn <stefan@lkcc.org>
[bpt/guile.git] / libguile / regex-posix.c
index b714bb7..3d1ef56 100644 (file)
@@ -1,15 +1,15 @@
-/*     Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
- * 
+/*     Copyright (C) 1997, 1998, 1999, 2000, 2001 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
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.
- * 
+ *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  *
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  
+ * If you do not wish that, delete this exception notice.
  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 \f
 
@@ -53,7 +51,6 @@
    libraries which do not agree with the Spencer implementation may
    produce varying behavior.  Sigh. */
 
-#include <stdio.h>
 #include <sys/types.h>
 
 #include "libguile/_scm.h"
 #define REG_BASIC 0
 #endif
 
-long scm_tc16_regex;
+scm_t_bits scm_tc16_regex;
 
-static scm_sizet
-free_regex (SCM obj)
+static size_t
+regex_free (SCM obj)
 {
   regfree (SCM_RGX (obj));
   free (SCM_RGX (obj));
@@ -124,69 +121,73 @@ scm_regexp_error_msg (int regerrno, regex_t *rx)
 
   errmsg = scm_make_string (SCM_MAKINUM (80), SCM_UNDEFINED);
   SCM_DEFER_INTS;
-  l = regerror (regerrno, rx, SCM_CHARS (errmsg), 80);
+  l = regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), 80);
   if (l > 80)
     {
       errmsg = scm_make_string (SCM_MAKINUM (l), SCM_UNDEFINED);
-      regerror (regerrno, rx, SCM_CHARS (errmsg), l);
+      regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), l);
     }
   SCM_ALLOW_INTS;
-  return SCM_CHARS (errmsg);
+  return SCM_STRING_CHARS (errmsg);
 }
 
-SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0, 
-            (SCM x),
-           "Return @code{#t} if @var{obj} is a compiled regular expression, or\n"
-           "@code{#f} otherwise.")
+SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
+            (SCM obj),
+           "Return @code{#t} if @var{obj} is a compiled regular expression,\n"
+           "or @code{#f} otherwise.")
 #define FUNC_NAME s_scm_regexp_p
 {
-  return SCM_BOOL(SCM_RGXP (x));
+  return SCM_BOOL(SCM_RGXP (obj));
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1, 
+SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
             (SCM pat, SCM flags),
-           "Compile the regular expression described by @var{str}, and return the\n"
-           "compiled regexp structure.  If @var{str} does not describe a legal\n"
-           "regular expression, @code{make-regexp} throws a\n"
-           "@code{regular-expression-syntax} error.\n\n"
-           "The @var{flag} arguments change the behavior of the compiled regexp.\n"
-           "The following flags may be supplied:\n\n"
+           "Compile the regular expression described by @var{pat}, and\n"
+           "return the compiled regexp structure.  If @var{pat} does not\n"
+           "describe a legal regular expression, @code{make-regexp} throws\n"
+           "a @code{regular-expression-syntax} error.\n"
+           "\n"
+           "The @var{flags} arguments change the behavior of the compiled\n"
+           "regular expression.  The following flags may be supplied:\n"
+           "\n"
            "@table @code\n"
            "@item regexp/icase\n"
-           "Consider uppercase and lowercase letters to be the same when matching.\n\n"
+           "Consider uppercase and lowercase letters to be the same when\n"
+           "matching.\n"
            "@item regexp/newline\n"
-           "If a newline appears in the target string, then permit the @samp{^} and\n"
-           "@samp{$} operators to match immediately after or immediately before the\n"
-           "newline, respectively.  Also, the @samp{.} and @samp{[^...]} operators\n"
-           "will never match a newline character.  The intent of this flag is to\n"
-           "treat the target string as a buffer containing many lines of text, and\n"
-           "the regular expression as a pattern that may match a single one of those\n"
-           "lines.\n\n"
+           "If a newline appears in the target string, then permit the\n"
+           "@samp{^} and @samp{$} operators to match immediately after or\n"
+           "immediately before the newline, respectively.  Also, the\n"
+           "@samp{.} and @samp{[^...]} operators will never match a newline\n"
+           "character.  The intent of this flag is to treat the target\n"
+           "string as a buffer containing many lines of text, and the\n"
+           "regular expression as a pattern that may match a single one of\n"
+           "those lines.\n"
            "@item regexp/basic\n"
            "Compile a basic (``obsolete'') regexp instead of the extended\n"
-           "(``modern'') regexps that are the default.  Basic regexps do not\n"
-           "consider @samp{|}, @samp{+} or @samp{?} to be special characters, and\n"
-           "require the @samp{@{...@}} and @samp{(...)} metacharacters to be\n"
-           "backslash-escaped (@pxref{Backslash Escapes}).  There are several other\n"
-           "differences between basic and extended regular expressions, but these\n"
-           "are the most significant.\n\n"
+           "(``modern'') regexps that are the default.  Basic regexps do\n"
+           "not consider @samp{|}, @samp{+} or @samp{?} to be special\n"
+           "characters, and require the @samp{@{...@}} and @samp{(...)}\n"
+           "metacharacters to be backslash-escaped (@pxref{Backslash\n"
+           "Escapes}).  There are several other differences between basic\n"
+           "and extended regular expressions, but these are the most\n"
+           "significant.\n"
            "@item regexp/extended\n"
-           "Compile an extended regular expression rather than a basic regexp.  This\n"
-           "is the default behavior; this flag will not usually be needed.  If a\n"
-           "call to @code{make-regexp} includes both @code{regexp/basic} and\n"
-           "@code{regexp/extended} flags, the one which comes last will override\n"
-           "the earlier one.\n"
-           "@end table\n")
+           "Compile an extended regular expression rather than a basic\n"
+           "regexp.  This is the default behavior; this flag will not\n"
+           "usually be needed.  If a call to @code{make-regexp} includes\n"
+           "both @code{regexp/basic} and @code{regexp/extended} flags, the\n"
+           "one which comes last will override the earlier one.\n"
+           "@end table")
 #define FUNC_NAME s_scm_make_regexp
 {
   SCM flag;
   regex_t *rx;
   int status, cflags;
 
-  SCM_VALIDATE_ROSTRING (1,pat);
+  SCM_VALIDATE_STRING (1, pat);
   SCM_VALIDATE_REST_ARGUMENT (flags);
-  SCM_COERCE_SUBSTR (pat);
 
   /* Examine list of regexp flags.  If REG_BASIC is supplied, then
      turn off REG_EXTENDED flag (on by default). */
@@ -200,9 +201,9 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
        cflags |= SCM_INUM (SCM_CAR (flag));
       flag = SCM_CDR (flag);
     }
-         
-  rx = SCM_MUST_MALLOC_TYPE(regex_t);
-  status = regcomp (rx, SCM_ROCHARS (pat),
+
+  rx = SCM_MUST_MALLOC_TYPE (regex_t);
+  status = regcomp (rx, SCM_STRING_CHARS (pat),
                    /* Make sure they're not passing REG_NOSUB;
                        regexp-exec assumes we're getting match data.  */
                    cflags & ~REG_NOSUB);
@@ -219,12 +220,27 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, 
+SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
             (SCM rx, SCM str, SCM start, SCM flags),
-           "Match the compiled regular expression @var{regexp} against @code{str}.\n"
-           "If the optional integer @var{start} argument is provided, begin matching\n"
-           "from that position in the string.  Return a match structure describing\n"
-           "the results of the match, or @code{#f} if no match could be found.")
+           "Match the compiled regular expression @var{rx} against\n"
+           "@code{str}.  If the optional integer @var{start} argument is\n"
+           "provided, begin matching from that position in the string.\n"
+           "Return a match structure describing the results of the match,\n"
+           "or @code{#f} if no match could be found.\n"
+            "\n"
+            "The @var{flags} arguments change the matching behavior.\n"
+            "The following flags may be supplied:\n"
+           "\n"
+           "@table @code\n"
+           "@item regexp/notbol\n"
+            "Operator @samp{^} always fails (unless @code{regexp/newline}\n"
+            "is used).  Use this when the beginning of the string should\n"
+            "not be considered the beginning of a line.\n"
+           "@item regexp/noteol\n"
+            "Operator @samp{$} always fails (unless @code{regexp/newline}\n"
+            "is used).  Use this when the end of the string should not be\n"
+            "considered the end of a line.\n"
+            "@end table")
 #define FUNC_NAME s_scm_regexp_exec
 {
   int status, nmatches, offset;
@@ -232,13 +248,12 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
   SCM mvec = SCM_BOOL_F;
 
   SCM_VALIDATE_RGXP (1,rx);
-  SCM_VALIDATE_ROSTRING (2,str);
+  SCM_VALIDATE_STRING (2, str);
   SCM_VALIDATE_INUM_DEF_COPY (3,start,0,offset);
-  SCM_ASSERT_RANGE (3,start,offset >= 0 && (unsigned) offset <= SCM_LENGTH (str));
+  SCM_ASSERT_RANGE (3,start, offset >= 0 && offset <= SCM_STRING_LENGTH (str));
   if (SCM_UNBNDP (flags))
     flags = SCM_INUM0;
   SCM_VALIDATE_INUM (4,flags);
-  SCM_COERCE_SUBSTR (str);
 
   /* re_nsub doesn't account for the `subexpression' representing the
      whole regexp, so add 1 to nmatches. */
@@ -246,7 +261,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
   nmatches = SCM_RGX(rx)->re_nsub + 1;
   SCM_DEFER_INTS;
   matches = SCM_MUST_MALLOC_TYPE_NUM (regmatch_t,nmatches);
-  status = regexec (SCM_RGX (rx), SCM_ROCHARS (str) + offset,
+  status = regexec (SCM_RGX (rx), SCM_STRING_CHARS (str) + offset,
                    nmatches, matches,
                    SCM_INUM (flags));
   if (!status)
@@ -254,15 +269,15 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
       int i;
       /* The match vector must include a cell for the string that was matched,
         so add 1. */
-      mvec = scm_make_vector (SCM_MAKINUM (nmatches + 1), SCM_UNSPECIFIED);
+      mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
       SCM_VELTS(mvec)[0] = str;
       for (i = 0; i < nmatches; ++i)
        if (matches[i].rm_so == -1)
          SCM_VELTS(mvec)[i+1] = scm_cons (SCM_MAKINUM (-1), SCM_MAKINUM (-1));
        else
          SCM_VELTS(mvec)[i+1]
-           = scm_cons(SCM_MAKINUM(matches[i].rm_so + offset),
-                      SCM_MAKINUM(matches[i].rm_eo + offset));
+           = scm_cons (scm_long2num (matches[i].rm_so + offset),
+                       scm_long2num (matches[i].rm_eo + offset));
     }
   scm_must_free ((char *) matches);
   SCM_ALLOW_INTS;
@@ -280,20 +295,22 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
 void
 scm_init_regex_posix ()
 {
-  scm_tc16_regex = scm_make_smob_type_mfpe ("regexp", sizeof (regex_t),
-                                            NULL, free_regex, NULL, NULL);
+  scm_tc16_regex = scm_make_smob_type ("regexp", sizeof (regex_t));
+  scm_set_smob_free (scm_tc16_regex, regex_free);
 
   /* Compilation flags.  */
-  scm_sysintern ("regexp/basic", scm_long2num (REG_BASIC));
-  scm_sysintern ("regexp/extended", scm_long2num (REG_EXTENDED));
-  scm_sysintern ("regexp/icase", scm_long2num (REG_ICASE));
-  scm_sysintern ("regexp/newline", scm_long2num (REG_NEWLINE));
+  scm_c_define ("regexp/basic", scm_long2num (REG_BASIC));
+  scm_c_define ("regexp/extended", scm_long2num (REG_EXTENDED));
+  scm_c_define ("regexp/icase", scm_long2num (REG_ICASE));
+  scm_c_define ("regexp/newline", scm_long2num (REG_NEWLINE));
 
   /* Execution flags.  */
-  scm_sysintern ("regexp/notbol", scm_long2num (REG_NOTBOL));
-  scm_sysintern ("regexp/noteol", scm_long2num (REG_NOTEOL));
+  scm_c_define ("regexp/notbol", scm_long2num (REG_NOTBOL));
+  scm_c_define ("regexp/noteol", scm_long2num (REG_NOTEOL));
 
+#ifndef SCM_MAGIC_SNARFER
 #include "libguile/regex-posix.x"
+#endif
 
   scm_add_feature ("regex");
 }