From f91c475e240ecfe7555396a70664ea1c4e57a8f2 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 27 Nov 2018 23:19:49 -0800
Subject: New range testing functions.

* eval.c (eval_init): Register in-range and in-range*
intrinsics.

* lib.c (in_range, in_range_star): New functions.

* lib.h (in_range, in_range_star): Declared.

* txr.1: Documented.
---
 eval.c |  2 ++
 lib.c  | 20 ++++++++++++++++++++
 lib.h  |  2 ++
 txr.1  | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 76 insertions(+)

diff --git a/eval.c b/eval.c
index 9219c8d4..8e9fb067 100644
--- a/eval.c
+++ b/eval.c
@@ -6771,6 +6771,8 @@ void eval_init(void)
   reg_fun(intern(lit("rangep"), user_package), func_n1(rangep));
   reg_fun(intern(lit("from"), user_package), func_n1(from));
   reg_fun(intern(lit("to"), user_package), func_n1(to));
+  reg_fun(intern(lit("in-range"), user_package), func_n2(in_range));
+  reg_fun(intern(lit("in-range*"), user_package), func_n2(in_range_star));
 
   reg_fun(intern(lit("make-like"), user_package), func_n2(make_like));
   reg_fun(intern(lit("nullify"), user_package), func_n1(nullify));
diff --git a/lib.c b/lib.c
index 5a4eb3ad..d06a71b1 100644
--- a/lib.c
+++ b/lib.c
@@ -10639,6 +10639,26 @@ val set_to(val range, val to)
   return range;
 }
 
+val in_range(val range, val num)
+{
+  type_check(lit("in-range"), range, RNG);
+  {
+    val from = range->rn.from;
+    val to = range->rn.to;
+    return and2(lequal(from, num), lequal(num, to));
+  }
+}
+
+val in_range_star(val range, val num)
+{
+  type_check(lit("in-range*"), range, RNG);
+  {
+    val from = range->rn.from;
+    val to = range->rn.to;
+    return and2(lequal(from, num), less(num, to));
+  }
+}
+
 val env(void)
 {
   if (env_list) {
diff --git a/lib.h b/lib.h
index 14882390..d74304db 100644
--- a/lib.h
+++ b/lib.h
@@ -1080,6 +1080,8 @@ val from(val range);
 val to(val range);
 val set_from(val range, val from);
 val set_to(val range, val to);
+val in_range(val range, val num);
+val in_range_star(val range, val num);
 val env(void);
 void out_str_char(wchar_t ch, val out, int *semi_flag, int regex);
 val obj_print_impl(val obj, val out, val pretty, struct strm_ctx *);
diff --git a/txr.1 b/txr.1
index 76e4f629..c2636c81 100644
--- a/txr.1
+++ b/txr.1
@@ -21384,6 +21384,58 @@ of a range.
 Note that these functions are not accessors, which is because
 ranges are immutable.
 
+.coNP Functions @ in-range and @ in-range*
+.synb
+.mets (in-range < range << value )
+.mets (in-range* < range << value )
+.syne
+.desc
+The
+.code in-range
+and
+.code in-range*
+functions test whether the
+.meta value
+argument lies in the range represented by the
+.meta range
+argument, indicating the Boolean result using one of the values
+.code t
+or
+.codn nil .
+
+The
+.meta range
+argument must be a range object.
+
+It is expected that the range object's
+.code from
+value does not exceed the
+.code to
+value; a reversed range is considered empty.
+
+The
+.code in-range*
+function differs from
+.code in-range
+in that it excludes the
+upper endpoint.
+
+The implicit comparison against the range endpoints is performed
+using the
+.code less
+and
+.code lequal
+functions, as appropriate.
+
+The following equivalences hold:
+
+.cblk
+  (in-range r x)  <-->  (and (lequal (from r) x)
+                             (lequal (to r) x))
+
+  (in-range* r x)  <-->  (and (lequal (from r) x)
+                              (less (to r) x))
+.cble
 .SS* Characters and Strings
 .coNP Function @ mkstring
 .synb
-- 
cgit v1.2.3