libguile/regex-posix.c

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