* regex.c (match_regex_right): New function.

* regex.h (match_regex_right): Declared.

* eval.c (eval_init): Register match_regex_right as instrinsic.

4 files changed, 31 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index f721f6ff..b3c32d96 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,13 @@
 2014-01-26  Kaz Kylheku  <kaz@kylheku.com>
 
+	* regex.c (match_regex_right): New function.
+
+	* regex.h (match_regex_right): Declared.
+
+	* eval.c (eval_init): Register match_regex_right as instrinsic. 
+
+2014-01-26  Kaz Kylheku  <kaz@kylheku.com>
+
 	Implementing more correct treatment of meta forms 
 	like @[...] and @(...) occurring in the TXR pattern language.
 
diff --git a/eval.c b/eval.c
index 7de6de77..9e965d54 100644
--- a/eval.c
+++ b/eval.c
@@ -2438,6 +2438,8 @@ void eval_init(void)
   reg_fun(intern(lit("regexp"), user_package), func_n1(regexp));
   reg_fun(intern(lit("search-regex"), user_package), func_n4o(search_regex, 2));
   reg_fun(intern(lit("match-regex"), user_package), func_n3o(match_regex, 2));
+  reg_fun(intern(lit("match-regex-right"), user_package),
+          func_n3o(match_regex_right, 2));
   reg_fun(intern(lit("regsub"), user_package), func_n3(regsub));
   reg_fun(intern(lit("regex-parse"), user_package), func_n2o(regex_parse, 1));
 
diff --git a/regex.c b/regex.c
index 06e19cd2..67f17f60 100644
--- a/regex.c
+++ b/regex.c
@@ -1854,6 +1854,26 @@ val match_regex(val str, val reg, val pos)
   return nil;
 }
 
+val match_regex_right(val str, val regex, val pos)
+{
+  val slen = length(str);
+
+  if (!pos)
+    pos = zero;
+
+  for (;;) {
+    cons_bind (from, len, search_regex(str, regex, pos, nil));
+
+    if (!from)
+      return nil;
+
+    if (eql(plus(from, len), slen))
+      return len;
+
+    pos = plus(pos, one);
+  }
+}
+
 val regsub(val regex, val repl, val str)
 {
   list_collect_decl (out, ptail);
diff --git a/regex.h b/regex.h
index 0fce0bbc..1ea148bd 100644
--- a/regex.h
+++ b/regex.h
@@ -31,6 +31,7 @@ val regex_compile(val regex, val error_stream);
 val regexp(val);
 val search_regex(val haystack, val needle_regex, val start_num, val from_end);
 val match_regex(val str, val regex, val pos);
+val match_regex_right(val str, val regex, val pos);
 val regsub(val regex, val repl, val str);
 
 void regex_init(void);