[bpt/guile.git] / libguile / regex-posix.c

/*	Copyright (C) 1997, 1998 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, 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * 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.  
 */
\f

/* regex-posix.c -- POSIX regular expression support.

   This code was written against Henry Spencer's famous regex package.
   The principal reference for POSIX behavior was the man page for this
   library, not the 1003.2 document itself.  Ergo, other `POSIX'
   libraries which do not agree with the Spencer implementation may
   produce varying behavior.  Sigh. */

#include <stdio.h>
#include <sys/types.h>

#include "_scm.h"

/* Supposedly, this file is never compiled unless we know we have
   POSIX regular expressions.  But we still put this in an #ifdef so
   the file is CPP'able (for dependency scanning) even on systems that
   don't have a <regex.h> header.  */
#ifdef HAVE_REGCOMP
#ifdef HAVE_REGEX_H
#include <regex.h>
#else
#ifdef HAVE_RXPOSIX_H
#include <rxposix.h>		/* GNU Rx library */
#else
#ifdef HAVE_RX_RXPOSIX_H
#include <rx/rxposix.h>		/* GNU Rx library on Linux */
#endif
#endif
#endif
#endif

#include "smob.h"
#include "symbols.h"
#include "vectors.h"
#include "strports.h"
#include "ports.h"
#include "feature.h"

#include "regex-posix.h"

/* This is defined by some regex libraries and omitted by others. */
#ifndef REG_BASIC
#define REG_BASIC 0
#endif

long scm_tc16_regex;

static scm_sizet
free_regex (obj)
     SCM obj;
{
  regfree (SCM_RGX (obj));
  free (SCM_RGX (obj));
  return sizeof(regex_t);
}

\f

SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");

static char *
scm_regexp_error_msg (regerrno, rx)
     int regerrno;
     SCM rx;
{
  SCM errmsg;
  int l;

  /* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS?
     Or are these only necessary when a SCM object may be left in an
     undetermined state (half-formed)?  If the latter then I believe we
     may do without the critical section code. -twp */

  /* We could simply make errmsg a char pointer, and allocate space with
     malloc.  But since we are about to pass the pointer to scm_error, which
     never returns, we would never have the opportunity to free it.  Creating
     it as a SCM object means that the system will GC it at some point. */

  errmsg = scm_make_string (SCM_MAKINUM (80), SCM_UNDEFINED);
  SCM_DEFER_INTS;
  l = regerror (regerrno, SCM_RGX (rx), SCM_CHARS (errmsg), 80);
  if (l > 80)
    {
      errmsg = scm_make_string (SCM_MAKINUM (l), SCM_UNDEFINED);
      regerror (regerrno, SCM_RGX (rx), SCM_CHARS (errmsg), l);
    }
  SCM_ALLOW_INTS;
  return SCM_CHARS (errmsg);
}

SCM_PROC (s_regexp_p, "regexp?", 1, 0, 0, scm_regexp_p);

SCM
scm_regexp_p (x)
     SCM x;
{
  return (SCM_NIMP (x) && SCM_RGXP (x) ? SCM_BOOL_T : SCM_BOOL_F);
}

SCM_PROC (s_make_regexp, "make-regexp", 1, 0, 1, scm_make_regexp);

SCM
scm_make_regexp (SCM pat, SCM flags)
{
  SCM flag;
  regex_t *rx;
  int status, cflags;

  SCM_ASSERT (SCM_NIMP(pat) && SCM_ROSTRINGP(pat), pat, SCM_ARG1, 
	      s_make_regexp);
  SCM_COERCE_SUBSTR (pat);

  /* Examine list of regexp flags.  If REG_BASIC is supplied, then
     turn off REG_EXTENDED flag (on by default). */
  cflags = REG_EXTENDED;
  flag = flags;
  while (SCM_NNULLP (flag))
    {
      if (SCM_INUM (SCM_CAR (flag)) == REG_BASIC)
	cflags &= ~REG_EXTENDED;
      else
	cflags |= SCM_INUM (SCM_CAR (flag));
      flag = SCM_CDR (flag);
    }
	  
  rx = (regex_t *) scm_must_malloc (sizeof (regex_t), s_make_regexp);
  status = regcomp (rx, SCM_ROCHARS (pat),
		    /* Make sure they're not passing REG_NOSUB;
                       regexp-exec assumes we're getting match data.  */
		    cflags & ~REG_NOSUB);
  if (status != 0)
    {
      scm_error (scm_regexp_error_key,
		 s_make_regexp,
		 scm_regexp_error_msg (status, rx),
		 SCM_BOOL_F,
		 SCM_BOOL_F);
      /* never returns */
    }
  SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
}

SCM_PROC (s_regexp_exec, "regexp-exec", 2, 2, 0, scm_regexp_exec);

SCM
scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags)
{
  int status, nmatches, offset;
  regmatch_t *matches;
  SCM mvec = SCM_BOOL_F;

  SCM_ASSERT (SCM_NIMP (rx) && SCM_RGXP (rx), rx, SCM_ARG1, s_regexp_exec);
  SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG2,
	      s_regexp_exec);

  if (SCM_UNBNDP (start))
    offset = 0;
  else
    {
      SCM_ASSERT (SCM_INUMP (start), start, SCM_ARG3, s_regexp_exec);
      offset = SCM_INUM (start);
      SCM_ASSERT (offset >= 0 && (unsigned) offset <= SCM_LENGTH (str), start,
		  SCM_OUTOFRANGE, s_regexp_exec);
    }

  if (SCM_UNBNDP (flags))
    flags = SCM_INUM0;
  SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG2, s_regexp_exec);

  SCM_COERCE_SUBSTR (str);

  /* re_nsub doesn't account for the `subexpression' representing the
     whole regexp, so add 1 to nmatches. */

  nmatches = SCM_RGX(rx)->re_nsub + 1;
  SCM_DEFER_INTS;
  matches = (regmatch_t *) scm_must_malloc (sizeof (regmatch_t) * nmatches,
					    s_regexp_exec);
  status = regexec (SCM_RGX (rx), SCM_ROCHARS (str) + offset,
		    nmatches, matches,
		    SCM_INUM (flags));
  if (!status)
    {
      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);
      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_must_free ((char *) matches);
  SCM_ALLOW_INTS;

  if (status != 0 && status != REG_NOMATCH)
    scm_error (scm_regexp_error_key,
	       s_regexp_exec,
	       scm_regexp_error_msg (status),
	       SCM_BOOL_F,
	       SCM_BOOL_F);
  return mvec;
}

void
scm_init_regex_posix ()
{
  scm_tc16_regex = scm_make_smob_type_mfpe ("regexp", sizeof (regex_t),
                                            NULL, free_regex, NULL, NULL);

  /* 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));

  /* Execution flags.  */
  scm_sysintern ("regexp/notbol", scm_long2num (REG_NOTBOL));
  scm_sysintern ("regexp/noteol", scm_long2num (REG_NOTEOL));

#include "regex-posix.x"

  scm_add_feature ("regex");
}
Commit	Line	Data
7dc6e754	1	/* Copyright (C) 1997, 1998 Free Software Foundation, Inc.
f255378e JB	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>
24e37377	53
69e0587b JB	54	#include "_scm.h"
69e0587b JB	55
24e37377 JB	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
a46d5ff2	61	#ifdef HAVE_REGEX_H
f255378e	62	#include <regex.h>
a46d5ff2 MD	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
24e37377	73
f255378e JB	74	#include "smob.h"
	75	#include "symbols.h"
	76	#include "vectors.h"
	77	#include "strports.h"
	78	#include "ports.h"
20044282	79	#include "feature.h"
f255378e JB	80
	81	#include "regex-posix.h"
	82
5d4774bc TP	83	/* This is defined by some regex libraries and omitted by others. */
	84	#ifndef REG_BASIC
	85	#define REG_BASIC 0
	86	#endif
	87
22580a48	88	long scm_tc16_regex;
f255378e	89
03ca35af	90	static scm_sizet
22580a48	91	free_regex (obj)
f255378e JB	92	SCM obj;
	93	{
	94	regfree (SCM_RGX (obj));
	95	free (SCM_RGX (obj));
80b991c3	96	return sizeof(regex_t);
f255378e JB	97	}
f255378e JB	98
f255378e JB	99	\f
	100
	101	SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
	102
8a04c1a2	103	static char *
f255378e JB	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
5d4774bc	142	SCM_PROC (s_make_regexp, "make-regexp", 1, 0, 1, scm_make_regexp);
f255378e JB	143
f255378e JB	144	SCM
bd56d016	145	scm_make_regexp (SCM pat, SCM flags)
f255378e	146	{
23a62151	147	SCM flag;
f255378e	148	regex_t *rx;
5d4774bc	149	int status, cflags;
f255378e JB	150
	151	SCM_ASSERT (SCM_NIMP(pat) && SCM_ROSTRINGP(pat), pat, SCM_ARG1,
	152	s_make_regexp);
	153	SCM_COERCE_SUBSTR (pat);
	154
5d4774bc TP	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
f255378e	168	rx = (regex_t *) scm_must_malloc (sizeof (regex_t), s_make_regexp);
1a222b91 JB	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. */
5d4774bc	172	cflags & ~REG_NOSUB);
f255378e JB	173	if (status != 0)
f255378e JB	174	{
f255378e JB	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	}
23a62151	182	SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
f255378e JB	183	}
f255378e JB	184
bd56d016	185	SCM_PROC (s_regexp_exec, "regexp-exec", 2, 2, 0, scm_regexp_exec);
f255378e JB	186
f255378e JB	187	SCM
bd56d016	188	scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags)
f255378e	189	{
0b787875	190	int status, nmatches, offset;
f255378e JB	191	regmatch_t *matches;
	192	SCM mvec = SCM_BOOL_F;
	193
	194	SCM_ASSERT (SCM_NIMP (rx) && SCM_RGXP (rx), rx, SCM_ARG1, s_regexp_exec);
	195	SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG2,
	196	s_regexp_exec);
0b787875 JB	197
	198	if (SCM_UNBNDP (start))
	199	offset = 0;
	200	else
	201	{
	202	SCM_ASSERT (SCM_INUMP (start), start, SCM_ARG3, s_regexp_exec);
	203	offset = SCM_INUM (start);
3fd207d7	204	SCM_ASSERT (offset >= 0 && (unsigned) offset <= SCM_LENGTH (str), start,
0b787875 JB	205	SCM_OUTOFRANGE, s_regexp_exec);
	206	}
	207
bd56d016 JB	208	if (SCM_UNBNDP (flags))
	209	flags = SCM_INUM0;
	210	SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG2, s_regexp_exec);
	211
f255378e JB	212	SCM_COERCE_SUBSTR (str);
	213
	214	/* re_nsub doesn't account for the `subexpression' representing the
	215	whole regexp, so add 1 to nmatches. */
	216
	217	nmatches = SCM_RGX(rx)->re_nsub + 1;
	218	SCM_DEFER_INTS;
	219	matches = (regmatch_t ) scm_must_malloc (sizeof (regmatch_t) nmatches,
	220	s_regexp_exec);
bd56d016 JB	221	status = regexec (SCM_RGX (rx), SCM_ROCHARS (str) + offset,
	222	nmatches, matches,
	223	SCM_INUM (flags));
f255378e JB	224	if (!status)
	225	{
	226	int i;
	227	/* The match vector must include a cell for the string that was matched,
	228	so add 1. */
a8741caa	229	mvec = scm_make_vector (SCM_MAKINUM (nmatches + 1), SCM_UNSPECIFIED);
f255378e JB	230	SCM_VELTS(mvec)[0] = str;
f255378e JB	231	for (i = 0; i < nmatches; ++i)
7c7471d9 JB	232	if (matches[i].rm_so == -1)
	233	SCM_VELTS(mvec)[i+1] = scm_cons (SCM_MAKINUM (-1), SCM_MAKINUM (-1));
	234	else
	235	SCM_VELTS(mvec)[i+1]
	236	= scm_cons(SCM_MAKINUM(matches[i].rm_so + offset),
	237	SCM_MAKINUM(matches[i].rm_eo + offset));
f255378e	238	}
62f1c6d2	239	scm_must_free ((char *) matches);
f255378e JB	240	SCM_ALLOW_INTS;
	241
	242	if (status != 0 && status != REG_NOMATCH)
	243	scm_error (scm_regexp_error_key,
	244	s_regexp_exec,
	245	scm_regexp_error_msg (status),
	246	SCM_BOOL_F,
	247	SCM_BOOL_F);
	248	return mvec;
	249	}
	250
	251	void
	252	scm_init_regex_posix ()
	253	{
23a62151 MD	254	scm_tc16_regex = scm_make_smob_type_mfpe ("regexp", sizeof (regex_t),
23a62151 MD	255	NULL, free_regex, NULL, NULL);
bd56d016 JB	256
bd56d016 JB	257	/* Compilation flags. */
5d4774bc	258	scm_sysintern ("regexp/basic", scm_long2num (REG_BASIC));
fcfb248d JB	259	scm_sysintern ("regexp/extended", scm_long2num (REG_EXTENDED));
fcfb248d JB	260	scm_sysintern ("regexp/icase", scm_long2num (REG_ICASE));
fcfb248d	261	scm_sysintern ("regexp/newline", scm_long2num (REG_NEWLINE));
bd56d016 JB	262
bd56d016 JB	263	/* Execution flags. */
fcfb248d JB	264	scm_sysintern ("regexp/notbol", scm_long2num (REG_NOTBOL));
fcfb248d JB	265	scm_sysintern ("regexp/noteol", scm_long2num (REG_NOTEOL));
bd56d016	266
f255378e	267	#include "regex-posix.x"
20044282 JB	268
20044282 JB	269	scm_add_feature ("regex");
f255378e	270	}