summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/Makefile.am5
-rw-r--r--libguile/Makefile.in17
-rw-r--r--libguile/init.c6
-rw-r--r--libguile/regex-posix.c229
-rw-r--r--libguile/regex-posix.h57
-rw-r--r--libguile/scmconfig.h.in3
6 files changed, 307 insertions, 10 deletions
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index a0d6f5492..ffa12232d 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -28,7 +28,8 @@ libguile_la_SOURCES = \
EXTRA_libguile_la_SOURCES = _scm.h \
backtrace.c stacks.c debug.c srcprop.c \
strerror.c inet_aton.c putenv.c \
- threads.c alloca.c
+ threads.c alloca.c \
+ regex-posix.c
## This is kind of nasty... there are ".c" files that we don't want to
## compile, since they are #included in threads.c. So instead we list
@@ -52,7 +53,7 @@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \
eq.h error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \
gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h \
ioext.h kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \
- numbers.h objprop.h options.h pairs.h ports.h posix.h print.h \
+ numbers.h objprop.h options.h pairs.h ports.h posix.h regex-posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmhob.h scmsigs.h script.h \
sequences.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \
stime.h strings.h strop.h strorder.h strports.h struct.h symbols.h \
diff --git a/libguile/Makefile.in b/libguile/Makefile.in
index ea24e1193..5b6470790 100644
--- a/libguile/Makefile.in
+++ b/libguile/Makefile.in
@@ -99,7 +99,8 @@ libguile_la_SOURCES = \
EXTRA_libguile_la_SOURCES = _scm.h \
backtrace.c stacks.c debug.c srcprop.c \
strerror.c inet_aton.c putenv.c \
- threads.c alloca.c
+ threads.c alloca.c \
+ regex-posix.c
noinst_HEADERS = coop-threads.c coop-threads.h coop.c
@@ -119,7 +120,7 @@ modinclude_HEADERS = __scm.h alist.h append.h arbiters.h async.h \
eq.h error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \
gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h \
ioext.h kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \
- numbers.h objprop.h options.h pairs.h ports.h posix.h print.h \
+ numbers.h objprop.h options.h pairs.h ports.h posix.h regex-posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmhob.h scmsigs.h script.h \
sequences.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \
stime.h strings.h strop.h strorder.h strports.h struct.h symbols.h \
@@ -216,12 +217,12 @@ DEP_FILES = .deps/alist.P .deps/alloca.P .deps/append.P .deps/appinit.P \
.deps/net_db.P .deps/numbers.P .deps/objprop.P .deps/options.P \
.deps/pairs.P .deps/ports.P .deps/posix.P .deps/print.P \
.deps/procprop.P .deps/procs.P .deps/putenv.P .deps/ramap.P \
-.deps/read.P .deps/root.P .deps/scmsigs.P .deps/script.P \
-.deps/sequences.P .deps/simpos.P .deps/smob.P .deps/socket.P \
-.deps/srcprop.P .deps/stackchk.P .deps/stacks.P .deps/stime.P \
-.deps/strerror.P .deps/strings.P .deps/strop.P .deps/strorder.P \
-.deps/strports.P .deps/struct.P .deps/symbols.P .deps/tag.P \
-.deps/threads.P .deps/throw.P .deps/unif.P .deps/variable.P \
+.deps/read.P .deps/regex-posix.P .deps/root.P .deps/scmsigs.P \
+.deps/script.P .deps/sequences.P .deps/simpos.P .deps/smob.P \
+.deps/socket.P .deps/srcprop.P .deps/stackchk.P .deps/stacks.P \
+.deps/stime.P .deps/strerror.P .deps/strings.P .deps/strop.P \
+.deps/strorder.P .deps/strports.P .deps/struct.P .deps/symbols.P \
+.deps/tag.P .deps/threads.P .deps/throw.P .deps/unif.P .deps/variable.P \
.deps/vectors.P .deps/version.P .deps/vports.P .deps/weaks.P
SOURCES = $(libguile_la_SOURCES) $(EXTRA_libguile_la_SOURCES) $(guile_SOURCES) $(gh_test_c_SOURCES) $(gh_test_repl_SOURCES)
OBJECTS = $(libguile_la_OBJECTS) $(guile_OBJECTS) $(gh_test_c_OBJECTS) $(gh_test_repl_OBJECTS)
diff --git a/libguile/init.c b/libguile/init.c
index 0133cf2b5..2b7271ca9 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -81,6 +81,9 @@
#include "pairs.h"
#include "ports.h"
#include "posix.h"
+#ifdef HAVE_REGCOMP
+#include "regex-posix.h"
+#endif
#include "print.h"
#include "procprop.h"
#include "procs.h"
@@ -415,6 +418,9 @@ scm_boot_guile_1 (base, closure)
scm_init_pairs ();
scm_init_ports ();
scm_init_posix ();
+#ifdef HAVE_REGCOMP
+ scm_init_regex_posix ();
+#endif
scm_init_procs ();
scm_init_procprop ();
scm_init_scmsigs ();
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
new file mode 100644
index 000000000..c40919909
--- /dev/null
+++ b/libguile/regex-posix.c
@@ -0,0 +1,229 @@
+/* Copyright (C) 1997 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.
+ */
+
+
+/* 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 <regex.h>
+#include "_scm.h"
+#include "smob.h"
+#include "symbols.h"
+#include "vectors.h"
+#include "strports.h"
+#include "ports.h"
+
+#include "regex-posix.h"
+
+long scm_tc16_regex_t;
+
+static size_t
+scm_free_regex_t (obj)
+ SCM obj;
+{
+ regfree (SCM_RGX (obj));
+ free (SCM_RGX (obj));
+ return 0;
+}
+
+static int
+scm_print_regex_t (obj, port, pstate)
+ SCM obj;
+ SCM port;
+ scm_print_state *pstate;
+{
+ regex_t *r;
+ r = SCM_RGX (obj);
+ scm_gen_puts (scm_regular_string, "#<rgx ", port);
+ scm_intprint (obj, 16, port);
+ scm_gen_puts (scm_regular_string, ">", port);
+ return 1;
+}
+
+
+static scm_smobfuns regex_t_smob =
+{ scm_mark0, scm_free_regex_t, scm_print_regex_t, 0 };
+
+
+SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
+
+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);
+}
+
+/* FIXME: make-regexp should support flags like
+ * REG_BASIC and REG_ICASE. Maybe these could be optional symbols
+ * in the command args: e.g.:
+ * (make-regexp "foo.*bar" 'basic
+ * 'ignore-case
+ * 'multi-line)
+ */
+
+SCM_PROC (s_make_regexp, "make-regexp", 1, 0, 0, scm_make_regexp);
+
+SCM
+scm_make_regexp (pat)
+ SCM pat;
+{
+ SCM result;
+ regex_t *rx;
+ int status;
+
+ SCM_ASSERT (SCM_NIMP(pat) && SCM_ROSTRINGP(pat), pat, SCM_ARG1,
+ s_make_regexp);
+ SCM_COERCE_SUBSTR (pat);
+
+ SCM_DEFER_INTS;
+ rx = (regex_t *) scm_must_malloc (sizeof (regex_t), s_make_regexp);
+ status = regcomp (rx, SCM_ROCHARS (pat), REG_EXTENDED);
+ if (status != 0)
+ {
+ SCM_ALLOW_INTS;
+ scm_error (scm_regexp_error_key,
+ s_make_regexp,
+ scm_regexp_error_msg (status, rx),
+ SCM_BOOL_F,
+ SCM_BOOL_F);
+ /* never returns */
+ }
+ SCM_NEWCELL (result);
+ SCM_SETCAR (result, scm_tc16_regex_t);
+ SCM_SETCDR (result, rx);
+ SCM_ALLOW_INTS;
+ return result;
+}
+
+SCM_PROC (s_regexp_exec, "regexp-exec", 2, 1, 0, scm_regexp_exec);
+
+SCM
+scm_regexp_exec (rx, str, start)
+ SCM rx;
+ SCM str;
+ SCM start;
+{
+ int status, nmatches;
+ 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);
+ 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), nmatches, matches, 0);
+ 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_UNDEFINED);
+ SCM_VELTS(mvec)[0] = str;
+ for (i = 0; i < nmatches; ++i)
+ SCM_VELTS(mvec)[i+1] = scm_cons (SCM_MAKINUM (matches[i].rm_so),
+ SCM_MAKINUM (matches[i].rm_eo));
+ }
+ 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_t = scm_newsmob (&regex_t_smob);
+#include "regex-posix.x"
+}
diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h
new file mode 100644
index 000000000..d72fb45c9
--- /dev/null
+++ b/libguile/regex-posix.h
@@ -0,0 +1,57 @@
+/* classes: h_files */
+
+#ifndef REGEXPOSIXH
+#define REGEXPOSIXH
+
+/* Copyright (C) 1997 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.
+ */
+
+#include "libguile/__scm.h"
+
+extern long scm_tc16_regex_t;
+#define SCM_RGX(X) ((regex_t *)SCM_CDR(X))
+#define SCM_RGXP(X) (SCM_CAR(X) == (SCM)scm_tc16_regex_t)
+
+extern SCM scm_make_regexp SCM_P ((SCM pat));
+extern SCM scm_regexp_exec SCM_P ((SCM rx, SCM str, SCM start));
+extern void scm_init_regex_posix ();
+
+#endif
diff --git a/libguile/scmconfig.h.in b/libguile/scmconfig.h.in
index ba1e48c1a..2005c89e3 100644
--- a/libguile/scmconfig.h.in
+++ b/libguile/scmconfig.h.in
@@ -197,6 +197,9 @@
/* Define if you have the readlink function. */
#undef HAVE_READLINK
+/* Define if you have the regcomp function. */
+#undef HAVE_REGCOMP
+
/* Define if you have the rename function. */
#undef HAVE_RENAME