guile18/libguile/regex-posix.c

   1 /*      Copyright (C) 1997, 1998, 1999, 2000, 2001, 2004, 2006, 2007 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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 #ifdef 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/async.h"
  56 #include "libguile/smob.h"
  57 #include "libguile/symbols.h"
  58 #include "libguile/vectors.h"
  59 #include "libguile/strports.h"
  60 #include "libguile/ports.h"
  61 #include "libguile/feature.h"
  62 #include "libguile/strings.h"
  63
  64 #include "libguile/validate.h"
  65 #include "libguile/regex-posix.h"
  66
  67 /* This is defined by some regex libraries and omitted by others. */
  68 #ifndef REG_BASIC
  69 #define REG_BASIC 0
  70 #endif
  71
  72 scm_t_bits scm_tc16_regex;
  73
  74 static size_t
  75 regex_free (SCM obj)
  76 {
  77   regfree (SCM_RGX (obj));
  78   scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
  79   return 0;
  80 }
  81
  82 \f
  83
  84 SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
  85
  86 static SCM
  87 scm_regexp_error_msg (int regerrno, regex_t *rx)
  88 {
  89   char *errmsg;
  90   int l;
  91
  92   errmsg = scm_malloc (80);
  93   l = regerror (regerrno, rx, errmsg, 80);
  94   if (l > 80)
  95     {
  96       free (errmsg);
  97       errmsg = scm_malloc (l);
  98       regerror (regerrno, rx, errmsg, l);
  99     }
 100   return scm_take_locale_string (errmsg);
 101 }
 102
 103 SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
 104             (SCM obj),
 105             "Return @code{#t} if @var{obj} is a compiled regular expression,\n"
 106             "or @code{#f} otherwise.")
 107 #define FUNC_NAME s_scm_regexp_p
 108 {
 109   return scm_from_bool(SCM_RGXP (obj));
 110 }
 111 #undef FUNC_NAME
 112
 113 SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
 114             (SCM pat, SCM flags),
 115             "Compile the regular expression described by @var{pat}, and\n"
 116             "return the compiled regexp structure.  If @var{pat} does not\n"
 117             "describe a legal regular expression, @code{make-regexp} throws\n"
 118             "a @code{regular-expression-syntax} error.\n"
 119             "\n"
 120             "The @var{flags} arguments change the behavior of the compiled\n"
 121             "regular expression.  The following flags may be supplied:\n"
 122             "\n"
 123             "@table @code\n"
 124             "@item regexp/icase\n"
 125             "Consider uppercase and lowercase letters to be the same when\n"
 126             "matching.\n"
 127             "@item regexp/newline\n"
 128             "If a newline appears in the target string, then permit the\n"
 129             "@samp{^} and @samp{$} operators to match immediately after or\n"
 130             "immediately before the newline, respectively.  Also, the\n"
 131             "@samp{.} and @samp{[^...]} operators will never match a newline\n"
 132             "character.  The intent of this flag is to treat the target\n"
 133             "string as a buffer containing many lines of text, and the\n"
 134             "regular expression as a pattern that may match a single one of\n"
 135             "those lines.\n"
 136             "@item regexp/basic\n"
 137             "Compile a basic (``obsolete'') regexp instead of the extended\n"
 138             "(``modern'') regexps that are the default.  Basic regexps do\n"
 139             "not consider @samp{|}, @samp{+} or @samp{?} to be special\n"
 140             "characters, and require the @samp{@{...@}} and @samp{(...)}\n"
 141             "metacharacters to be backslash-escaped (@pxref{Backslash\n"
 142             "Escapes}).  There are several other differences between basic\n"
 143             "and extended regular expressions, but these are the most\n"
 144             "significant.\n"
 145             "@item regexp/extended\n"
 146             "Compile an extended regular expression rather than a basic\n"
 147             "regexp.  This is the default behavior; this flag will not\n"
 148             "usually be needed.  If a call to @code{make-regexp} includes\n"
 149             "both @code{regexp/basic} and @code{regexp/extended} flags, the\n"
 150             "one which comes last will override the earlier one.\n"
 151             "@end table")
 152 #define FUNC_NAME s_scm_make_regexp
 153 {
 154   SCM flag;
 155   regex_t *rx;
 156   int status, cflags;
 157   char *c_pat;
 158
 159   SCM_VALIDATE_STRING (1, pat);
 160   SCM_VALIDATE_REST_ARGUMENT (flags);
 161
 162   /* Examine list of regexp flags.  If REG_BASIC is supplied, then
 163      turn off REG_EXTENDED flag (on by default). */
 164   cflags = REG_EXTENDED;
 165   flag = flags;
 166   while (!scm_is_null (flag))
 167     {
 168       if (scm_to_int (SCM_CAR (flag)) == REG_BASIC)
 169         cflags &= ~REG_EXTENDED;
 170       else
 171         cflags |= scm_to_int (SCM_CAR (flag));
 172       flag = SCM_CDR (flag);
 173     }
 174
 175   rx = scm_gc_malloc (sizeof(regex_t), "regex");
 176   c_pat = scm_to_locale_string (pat);
 177   status = regcomp (rx, c_pat,
 178                     /* Make sure they're not passing REG_NOSUB;
 179                        regexp-exec assumes we're getting match data.  */
 180                     cflags & ~REG_NOSUB);
 181   free (c_pat);
 182   if (status != 0)
 183     {
 184       SCM errmsg = scm_regexp_error_msg (status, rx);
 185       scm_gc_free (rx, sizeof(regex_t), "regex");
 186       scm_error_scm (scm_regexp_error_key,
 187                      scm_from_locale_string (FUNC_NAME),
 188                      errmsg,
 189                      SCM_BOOL_F,
 190                      scm_list_1 (pat));
 191
 192       /* never returns */
 193     }
 194   SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
 195 }
 196 #undef FUNC_NAME
 197
 198 SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
 199             (SCM rx, SCM str, SCM start, SCM flags),
 200             "Match the compiled regular expression @var{rx} against\n"
 201             "@code{str}.  If the optional integer @var{start} argument is\n"
 202             "provided, begin matching from that position in the string.\n"
 203             "Return a match structure describing the results of the match,\n"
 204             "or @code{#f} if no match could be found.\n"
 205             "\n"
 206             "The @var{flags} arguments change the matching behavior.\n"
 207             "The following flags may be supplied:\n"
 208             "\n"
 209             "@table @code\n"
 210             "@item regexp/notbol\n"
 211             "Operator @samp{^} always fails (unless @code{regexp/newline}\n"
 212             "is used).  Use this when the beginning of the string should\n"
 213             "not be considered the beginning of a line.\n"
 214             "@item regexp/noteol\n"
 215             "Operator @samp{$} always fails (unless @code{regexp/newline}\n"
 216             "is used).  Use this when the end of the string should not be\n"
 217             "considered the end of a line.\n"
 218             "@end table")
 219 #define FUNC_NAME s_scm_regexp_exec
 220 {
 221   /* We used to have an SCM_DEFER_INTS, and then later an
 222      SCM_CRITICAL_SECTION_START, around the regexec() call.  Can't quite
 223      remember what defer ints was for, but a critical section would only be
 224      wanted now if we think regexec() is not thread-safe.  The posix spec
 225
 226      http://www.opengroup.org/onlinepubs/009695399/functions/regcomp.html
 227
 228      reads like regexec is meant to be both thread safe and reentrant
 229      (mentioning simultaneous use in threads, and in signal handlers).  So
 230      for now believe no protection needed.  */
 231
 232   int status, nmatches, offset;
 233   regmatch_t *matches;
 234   char *c_str;
 235   SCM mvec = SCM_BOOL_F;
 236   SCM substr;
 237
 238   SCM_VALIDATE_RGXP (1, rx);
 239   SCM_VALIDATE_STRING (2, str);
 240
 241   if (SCM_UNBNDP (start))
 242     {
 243       substr = str;
 244       offset = 0;
 245     }
 246   else
 247     {
 248       substr = scm_substring (str, start, SCM_UNDEFINED);
 249       offset = scm_to_int (start);
 250     }
 251
 252   if (SCM_UNBNDP (flags))
 253     flags = SCM_INUM0;
 254
 255   /* re_nsub doesn't account for the `subexpression' representing the
 256      whole regexp, so add 1 to nmatches. */
 257
 258   nmatches = SCM_RGX(rx)->re_nsub + 1;
 259   matches = scm_malloc (sizeof (regmatch_t) * nmatches);
 260   c_str = scm_to_locale_string (substr);
 261   status = regexec (SCM_RGX (rx), c_str, nmatches, matches,
 262                     scm_to_int (flags));
 263   free (c_str);
 264
 265   if (!status)
 266     {
 267       int i;
 268       /* The match vector must include a cell for the string that was matched,
 269          so add 1. */
 270       mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
 271       SCM_SIMPLE_VECTOR_SET(mvec,0, str);
 272       for (i = 0; i < nmatches; ++i)
 273         if (matches[i].rm_so == -1)
 274           SCM_SIMPLE_VECTOR_SET(mvec, i+1,
 275                          scm_cons (scm_from_int (-1), scm_from_int (-1)));
 276         else
 277           SCM_SIMPLE_VECTOR_SET(mvec, i+1,
 278                          scm_cons (scm_from_long (matches[i].rm_so + offset),
 279                                    scm_from_long (matches[i].rm_eo + offset)));
 280     }
 281   free (matches);
 282
 283   if (status != 0 && status != REG_NOMATCH)
 284     scm_error_scm (scm_regexp_error_key,
 285                    scm_from_locale_string (FUNC_NAME),
 286                    scm_regexp_error_msg (status, SCM_RGX (rx)),
 287                    SCM_BOOL_F, SCM_BOOL_F);
 288   return mvec;
 289 }
 290 #undef FUNC_NAME
 291
 292 void
 293 scm_init_regex_posix ()
 294 {
 295   scm_tc16_regex = scm_make_smob_type ("regexp", sizeof (regex_t));
 296   scm_set_smob_free (scm_tc16_regex, regex_free);
 297
 298   /* Compilation flags.  */
 299   scm_c_define ("regexp/basic",    scm_from_int (REG_BASIC));
 300   scm_c_define ("regexp/extended", scm_from_int (REG_EXTENDED));
 301   scm_c_define ("regexp/icase",    scm_from_int (REG_ICASE));
 302   scm_c_define ("regexp/newline",  scm_from_int (REG_NEWLINE));
 303
 304   /* Execution flags.  */
 305   scm_c_define ("regexp/notbol", scm_from_int (REG_NOTBOL));
 306   scm_c_define ("regexp/noteol", scm_from_int (REG_NOTEOL));
 307
 308 #include "libguile/regex-posix.x"
 309
 310   scm_add_feature ("regex");
 311 }
 312
 313 /*
 314   Local Variables:
 315   c-file-style: "gnu"
 316   End:
 317 */