libguile/regex-posix.c

   1 /*      Copyright (C) 1997, 1998, 1999, 2000, 2001, 2004 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 /* regex-posix.c -- POSIX regular expression support.
  22
  23    This code was written against Henry Spencer's famous regex package.
  24    The principal reference for POSIX behavior was the man page for this
  25    library, not the 1003.2 document itself.  Ergo, other `POSIX'
  26    libraries which do not agree with the Spencer implementation may
  27    produce varying behavior.  Sigh. */
  28
  29 #if HAVE_CONFIG_H
  30 #  include <config.h>
  31 #endif
  32
  33 #include <sys/types.h>
  34
  35 #include "libguile/_scm.h"
  36
  37 /* Supposedly, this file is never compiled unless we know we have
  38    POSIX regular expressions.  But we still put this in an #ifdef so
  39    the file is CPP'able (for dependency scanning) even on systems that
  40    don't have a <regex.h> header.  */
  41 #ifdef HAVE_REGCOMP
  42 #ifdef HAVE_REGEX_H
  43 #include <regex.h>
  44 #else
  45 #ifdef HAVE_RXPOSIX_H
  46 #include <rxposix.h>            /* GNU Rx library */
  47 #else
  48 #ifdef HAVE_RX_RXPOSIX_H
  49 #include <rx/rxposix.h>         /* GNU Rx library on Linux */
  50 #endif
  51 #endif
  52 #endif
  53 #endif
  54
  55 #include "libguile/smob.h"
  56 #include "libguile/symbols.h"
  57 #include "libguile/vectors.h"
  58 #include "libguile/strports.h"
  59 #include "libguile/ports.h"
  60 #include "libguile/feature.h"
  61 #include "libguile/strings.h"
  62
  63 #include "libguile/validate.h"
  64 #include "libguile/regex-posix.h"
  65
  66 /* This is defined by some regex libraries and omitted by others. */
  67 #ifndef REG_BASIC
  68 #define REG_BASIC 0
  69 #endif
  70
  71 scm_t_bits scm_tc16_regex;
  72
  73 static size_t
  74 regex_free (SCM obj)
  75 {
  76   regfree (SCM_RGX (obj));
  77   scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
  78   return 0;
  79 }
  80
  81 \f
  82
  83 SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
  84
  85 static char *
  86 scm_regexp_error_msg (int regerrno, regex_t *rx)
  87 {
  88   SCM errmsg;
  89   int l;
  90
  91   /* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS?
  92      Or are these only necessary when a SCM object may be left in an
  93      undetermined state (half-formed)?  If the latter then I believe we
  94      may do without the critical section code. -twp */
  95
  96   /* We could simply make errmsg a char pointer, and allocate space with
  97      malloc.  But since we are about to pass the pointer to scm_error, which
  98      never returns, we would never have the opportunity to free it.  Creating
  99      it as a SCM object means that the system will GC it at some point. */
 100
 101   errmsg = scm_make_string (SCM_I_MAKINUM (80), SCM_UNDEFINED);
 102   SCM_DEFER_INTS;
 103   l = regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), 80);
 104   if (l > 80)
 105     {
 106       errmsg = scm_make_string (SCM_I_MAKINUM (l), SCM_UNDEFINED);
 107       regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), l);
 108     }
 109   SCM_ALLOW_INTS;
 110   return SCM_STRING_CHARS (errmsg);
 111 }
 112
 113 SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
 114             (SCM obj),
 115             "Return @code{#t} if @var{obj} is a compiled regular expression,\n"
 116             "or @code{#f} otherwise.")
 117 #define FUNC_NAME s_scm_regexp_p
 118 {
 119   return scm_from_bool(SCM_RGXP (obj));
 120 }
 121 #undef FUNC_NAME
 122
 123 SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
 124             (SCM pat, SCM flags),
 125             "Compile the regular expression described by @var{pat}, and\n"
 126             "return the compiled regexp structure.  If @var{pat} does not\n"
 127             "describe a legal regular expression, @code{make-regexp} throws\n"
 128             "a @code{regular-expression-syntax} error.\n"
 129             "\n"
 130             "The @var{flags} arguments change the behavior of the compiled\n"
 131             "regular expression.  The following flags may be supplied:\n"
 132             "\n"
 133             "@table @code\n"
 134             "@item regexp/icase\n"
 135             "Consider uppercase and lowercase letters to be the same when\n"
 136             "matching.\n"
 137             "@item regexp/newline\n"
 138             "If a newline appears in the target string, then permit the\n"
 139             "@samp{^} and @samp{$} operators to match immediately after or\n"
 140             "immediately before the newline, respectively.  Also, the\n"
 141             "@samp{.} and @samp{[^...]} operators will never match a newline\n"
 142             "character.  The intent of this flag is to treat the target\n"
 143             "string as a buffer containing many lines of text, and the\n"
 144             "regular expression as a pattern that may match a single one of\n"
 145             "those lines.\n"
 146             "@item regexp/basic\n"
 147             "Compile a basic (``obsolete'') regexp instead of the extended\n"
 148             "(``modern'') regexps that are the default.  Basic regexps do\n"
 149             "not consider @samp{|}, @samp{+} or @samp{?} to be special\n"
 150             "characters, and require the @samp{@{...@}} and @samp{(...)}\n"
 151             "metacharacters to be backslash-escaped (@pxref{Backslash\n"
 152             "Escapes}).  There are several other differences between basic\n"
 153             "and extended regular expressions, but these are the most\n"
 154             "significant.\n"
 155             "@item regexp/extended\n"
 156             "Compile an extended regular expression rather than a basic\n"
 157             "regexp.  This is the default behavior; this flag will not\n"
 158             "usually be needed.  If a call to @code{make-regexp} includes\n"
 159             "both @code{regexp/basic} and @code{regexp/extended} flags, the\n"
 160             "one which comes last will override the earlier one.\n"
 161             "@end table")
 162 #define FUNC_NAME s_scm_make_regexp
 163 {
 164   SCM flag;
 165   regex_t *rx;
 166   int status, cflags;
 167
 168   SCM_VALIDATE_STRING (1, pat);
 169   SCM_VALIDATE_REST_ARGUMENT (flags);
 170
 171   /* Examine list of regexp flags.  If REG_BASIC is supplied, then
 172      turn off REG_EXTENDED flag (on by default). */
 173   cflags = REG_EXTENDED;
 174   flag = flags;
 175   while (!SCM_NULLP (flag))
 176     {
 177       if (SCM_INUM (SCM_CAR (flag)) == REG_BASIC)
 178         cflags &= ~REG_EXTENDED;
 179       else
 180         cflags |= SCM_INUM (SCM_CAR (flag));
 181       flag = SCM_CDR (flag);
 182     }
 183
 184   rx = scm_gc_malloc (sizeof(regex_t), "regex");
 185   status = regcomp (rx, SCM_STRING_CHARS (pat),
 186                     /* Make sure they're not passing REG_NOSUB;
 187                        regexp-exec assumes we're getting match data.  */
 188                     cflags & ~REG_NOSUB);
 189   if (status != 0)
 190     {
 191       char *errmsg = scm_regexp_error_msg (status, rx);
 192       scm_gc_free (rx, sizeof(regex_t), "regex");
 193       scm_error (scm_regexp_error_key,
 194                  FUNC_NAME,
 195                  errmsg,
 196                  SCM_BOOL_F,
 197                  SCM_BOOL_F);
 198       /* never returns */
 199     }
 200   SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
 201 }
 202 #undef FUNC_NAME
 203
 204 SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
 205             (SCM rx, SCM str, SCM start, SCM flags),
 206             "Match the compiled regular expression @var{rx} against\n"
 207             "@code{str}.  If the optional integer @var{start} argument is\n"
 208             "provided, begin matching from that position in the string.\n"
 209             "Return a match structure describing the results of the match,\n"
 210             "or @code{#f} if no match could be found.\n"
 211             "\n"
 212             "The @var{flags} arguments change the matching behavior.\n"
 213             "The following flags may be supplied:\n"
 214             "\n"
 215             "@table @code\n"
 216             "@item regexp/notbol\n"
 217             "Operator @samp{^} always fails (unless @code{regexp/newline}\n"
 218             "is used).  Use this when the beginning of the string should\n"
 219             "not be considered the beginning of a line.\n"
 220             "@item regexp/noteol\n"
 221             "Operator @samp{$} always fails (unless @code{regexp/newline}\n"
 222             "is used).  Use this when the end of the string should not be\n"
 223             "considered the end of a line.\n"
 224             "@end table")
 225 #define FUNC_NAME s_scm_regexp_exec
 226 {
 227   int status, nmatches, offset;
 228   regmatch_t *matches;
 229   SCM mvec = SCM_BOOL_F;
 230
 231   SCM_VALIDATE_RGXP (1, rx);
 232   SCM_VALIDATE_STRING (2, str);
 233
 234   if (SCM_UNBNDP (start))
 235     offset = 0;
 236   else
 237     offset = scm_to_signed_integer (start, 0, SCM_STRING_LENGTH (str));
 238
 239   if (SCM_UNBNDP (flags))
 240     flags = SCM_INUM0;
 241
 242   /* re_nsub doesn't account for the `subexpression' representing the
 243      whole regexp, so add 1 to nmatches. */
 244
 245   nmatches = SCM_RGX(rx)->re_nsub + 1;
 246   SCM_DEFER_INTS;
 247   matches = scm_malloc (sizeof (regmatch_t) * nmatches);
 248   status = regexec (SCM_RGX (rx), SCM_STRING_CHARS (str) + offset,
 249                     nmatches, matches,
 250                     scm_to_int (flags));
 251   if (!status)
 252     {
 253       int i;
 254       /* The match vector must include a cell for the string that was matched,
 255          so add 1. */
 256       mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
 257       SCM_VECTOR_SET(mvec,0, str);
 258       for (i = 0; i < nmatches; ++i)
 259         if (matches[i].rm_so == -1)
 260           SCM_VECTOR_SET(mvec,i+1, scm_cons (SCM_I_MAKINUM (-1), SCM_I_MAKINUM (-1)));
 261         else
 262           SCM_VECTOR_SET(mvec,i+1,scm_cons (scm_long2num (matches[i].rm_so + offset),
 263                                        scm_long2num (matches[i].rm_eo + offset)));
 264     }
 265   free (matches);
 266   SCM_ALLOW_INTS;
 267
 268   if (status != 0 && status != REG_NOMATCH)
 269     scm_error (scm_regexp_error_key,
 270                FUNC_NAME,
 271                scm_regexp_error_msg (status, SCM_RGX (rx)),
 272                SCM_BOOL_F,
 273                SCM_BOOL_F);
 274   return mvec;
 275 }
 276 #undef FUNC_NAME
 277
 278 void
 279 scm_init_regex_posix ()
 280 {
 281   scm_tc16_regex = scm_make_smob_type ("regexp", sizeof (regex_t));
 282   scm_set_smob_free (scm_tc16_regex, regex_free);
 283
 284   /* Compilation flags.  */
 285   scm_c_define ("regexp/basic", scm_long2num (REG_BASIC));
 286   scm_c_define ("regexp/extended", scm_long2num (REG_EXTENDED));
 287   scm_c_define ("regexp/icase", scm_long2num (REG_ICASE));
 288   scm_c_define ("regexp/newline", scm_long2num (REG_NEWLINE));
 289
 290   /* Execution flags.  */
 291   scm_c_define ("regexp/notbol", scm_long2num (REG_NOTBOL));
 292   scm_c_define ("regexp/noteol", scm_long2num (REG_NOTEOL));
 293
 294 #include "libguile/regex-posix.x"
 295
 296   scm_add_feature ("regex");
 297 }
 298
 299 /*
 300   Local Variables:
 301   c-file-style: "gnu"
 302   End:
 303 */