libguile/regex-posix.c

   1 /*      Copyright (C) 1997, 1998, 1999 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program 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
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.
  41  */
  42
  43 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  44    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  45
  46 \f
  47
  48 /* regex-posix.c -- POSIX regular expression support.
  49
  50    This code was written against Henry Spencer's famous regex package.
  51    The principal reference for POSIX behavior was the man page for this
  52    library, not the 1003.2 document itself.  Ergo, other `POSIX'
  53    libraries which do not agree with the Spencer implementation may
  54    produce varying behavior.  Sigh. */
  55
  56 #include <stdio.h>
  57 #include <sys/types.h>
  58
  59 #include "_scm.h"
  60
  61 /* Supposedly, this file is never compiled unless we know we have
  62    POSIX regular expressions.  But we still put this in an #ifdef so
  63    the file is CPP'able (for dependency scanning) even on systems that
  64    don't have a <regex.h> header.  */
  65 #ifdef HAVE_REGCOMP
  66 #ifdef HAVE_REGEX_H
  67 #include <regex.h>
  68 #else
  69 #ifdef HAVE_RXPOSIX_H
  70 #include <rxposix.h>            /* GNU Rx library */
  71 #else
  72 #ifdef HAVE_RX_RXPOSIX_H
  73 #include <rx/rxposix.h>         /* GNU Rx library on Linux */
  74 #endif
  75 #endif
  76 #endif
  77 #endif
  78
  79 #include "smob.h"
  80 #include "symbols.h"
  81 #include "vectors.h"
  82 #include "strports.h"
  83 #include "ports.h"
  84 #include "feature.h"
  85
  86 #include "scm_validate.h"
  87 #include "regex-posix.h"
  88
  89 /* This is defined by some regex libraries and omitted by others. */
  90 #ifndef REG_BASIC
  91 #define REG_BASIC 0
  92 #endif
  93
  94 long scm_tc16_regex;
  95
  96 static scm_sizet
  97 free_regex (SCM obj)
  98 {
  99   regfree (SCM_RGX (obj));
 100   free (SCM_RGX (obj));
 101   return sizeof(regex_t);
 102 }
 103
 104 \f
 105
 106 SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
 107
 108 static char *
 109 scm_regexp_error_msg (int regerrno, regex_t *rx)
 110 {
 111   SCM errmsg;
 112   int l;
 113
 114   /* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS?
 115      Or are these only necessary when a SCM object may be left in an
 116      undetermined state (half-formed)?  If the latter then I believe we
 117      may do without the critical section code. -twp */
 118
 119   /* We could simply make errmsg a char pointer, and allocate space with
 120      malloc.  But since we are about to pass the pointer to scm_error, which
 121      never returns, we would never have the opportunity to free it.  Creating
 122      it as a SCM object means that the system will GC it at some point. */
 123
 124   errmsg = scm_make_string (SCM_MAKINUM (80), SCM_UNDEFINED);
 125   SCM_DEFER_INTS;
 126   l = regerror (regerrno, rx, SCM_CHARS (errmsg), 80);
 127   if (l > 80)
 128     {
 129       errmsg = scm_make_string (SCM_MAKINUM (l), SCM_UNDEFINED);
 130       regerror (regerrno, rx, SCM_CHARS (errmsg), l);
 131     }
 132   SCM_ALLOW_INTS;
 133   return SCM_CHARS (errmsg);
 134 }
 135
 136 GUILE_PROC (scm_regexp_p, "regexp?", 1, 0, 0,
 137             (SCM x),
 138 "")
 139 #define FUNC_NAME s_scm_regexp_p
 140 {
 141   return SCM_BOOL(SCM_NIMP (x) && SCM_RGXP (x));
 142 }
 143 #undef FUNC_NAME
 144
 145 GUILE_PROC (scm_make_regexp, "make-regexp", 1, 0, 1,
 146             (SCM pat, SCM flags),
 147 "")
 148 #define FUNC_NAME s_scm_make_regexp
 149 {
 150   SCM flag;
 151   regex_t *rx;
 152   int status, cflags;
 153
 154   SCM_VALIDATE_ROSTRING(1,pat);
 155   SCM_COERCE_SUBSTR (pat);
 156
 157   /* Examine list of regexp flags.  If REG_BASIC is supplied, then
 158      turn off REG_EXTENDED flag (on by default). */
 159   cflags = REG_EXTENDED;
 160   flag = flags;
 161   while (SCM_NNULLP (flag))
 162     {
 163       if (SCM_INUM (SCM_CAR (flag)) == REG_BASIC)
 164         cflags &= ~REG_EXTENDED;
 165       else
 166         cflags |= SCM_INUM (SCM_CAR (flag));
 167       flag = SCM_CDR (flag);
 168     }
 169
 170   rx = SCM_MUST_MALLOC_TYPE(regex_t);
 171   status = regcomp (rx, SCM_ROCHARS (pat),
 172                     /* Make sure they're not passing REG_NOSUB;
 173                        regexp-exec assumes we're getting match data.  */
 174                     cflags & ~REG_NOSUB);
 175   if (status != 0)
 176     {
 177       scm_error (scm_regexp_error_key,
 178                  FUNC_NAME,
 179                  scm_regexp_error_msg (status, rx),
 180                  SCM_BOOL_F,
 181                  SCM_BOOL_F);
 182       /* never returns */
 183     }
 184   SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
 185 }
 186 #undef FUNC_NAME
 187
 188 GUILE_PROC (scm_regexp_exec, "regexp-exec", 2, 2, 0,
 189             (SCM rx, SCM str, SCM start, SCM flags),
 190 "")
 191 #define FUNC_NAME s_scm_regexp_exec
 192 {
 193   int status, nmatches, offset;
 194   regmatch_t *matches;
 195   SCM mvec = SCM_BOOL_F;
 196
 197   SCM_VALIDATE_RGXP(1,rx);
 198   SCM_VALIDATE_ROSTRING(2,str);
 199   SCM_VALIDATE_INT_DEF_COPY(3,start,0,offset);
 200   SCM_ASSERT_RANGE (3,start,offset >= 0 && (unsigned) offset <= SCM_LENGTH (str));
 201   if (SCM_UNBNDP (flags))
 202     flags = SCM_INUM0;
 203   SCM_VALIDATE_INT(4,flags);
 204   SCM_COERCE_SUBSTR (str);
 205
 206   /* re_nsub doesn't account for the `subexpression' representing the
 207      whole regexp, so add 1 to nmatches. */
 208
 209   nmatches = SCM_RGX(rx)->re_nsub + 1;
 210   SCM_DEFER_INTS;
 211   matches = SCM_MUST_MALLOC_TYPE_NUM (regmatch_t,nmatches);
 212   status = regexec (SCM_RGX (rx), SCM_ROCHARS (str) + offset,
 213                     nmatches, matches,
 214                     SCM_INUM (flags));
 215   if (!status)
 216     {
 217       int i;
 218       /* The match vector must include a cell for the string that was matched,
 219          so add 1. */
 220       mvec = scm_make_vector (SCM_MAKINUM (nmatches + 1), SCM_UNSPECIFIED);
 221       SCM_VELTS(mvec)[0] = str;
 222       for (i = 0; i < nmatches; ++i)
 223         if (matches[i].rm_so == -1)
 224           SCM_VELTS(mvec)[i+1] = scm_cons (SCM_MAKINUM (-1), SCM_MAKINUM (-1));
 225         else
 226           SCM_VELTS(mvec)[i+1]
 227             = scm_cons(SCM_MAKINUM(matches[i].rm_so + offset),
 228                        SCM_MAKINUM(matches[i].rm_eo + offset));
 229     }
 230   scm_must_free ((char *) matches);
 231   SCM_ALLOW_INTS;
 232
 233   if (status != 0 && status != REG_NOMATCH)
 234     scm_error (scm_regexp_error_key,
 235                FUNC_NAME,
 236                scm_regexp_error_msg (status, SCM_RGX (rx)),
 237                SCM_BOOL_F,
 238                SCM_BOOL_F);
 239   return mvec;
 240 }
 241 #undef FUNC_NAME
 242
 243 void
 244 scm_init_regex_posix ()
 245 {
 246   scm_tc16_regex = scm_make_smob_type_mfpe ("regexp", sizeof (regex_t),
 247                                             NULL, free_regex, NULL, NULL);
 248
 249   /* Compilation flags.  */
 250   scm_sysintern ("regexp/basic", scm_long2num (REG_BASIC));
 251   scm_sysintern ("regexp/extended", scm_long2num (REG_EXTENDED));
 252   scm_sysintern ("regexp/icase", scm_long2num (REG_ICASE));
 253   scm_sysintern ("regexp/newline", scm_long2num (REG_NEWLINE));
 254
 255   /* Execution flags.  */
 256   scm_sysintern ("regexp/notbol", scm_long2num (REG_NOTBOL));
 257   scm_sysintern ("regexp/noteol", scm_long2num (REG_NOTEOL));
 258
 259 #include "regex-posix.x"
 260
 261   scm_add_feature ("regex");
 262 }