From 0724ed01b5190fcebf0249f81cf79064c472ee91 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 14 Feb 2012 02:13:32 -0800
Subject: * eval.c (rangev): If a descending range is specified, but the step
 is omitted, the step should be negative one rather than one.
 (range_star_v_func, range_star_v): New static functions. (eval_init): New
 function, range*, registered.

* txr.1: Stub section for range is also for range*.

* txr.vim: Recognize range* function.
---
 eval.c | 42 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 41 insertions(+), 1 deletion(-)

(limited to 'eval.c')

diff --git a/eval.c b/eval.c
index 1454d43d..aab3623a 100644
--- a/eval.c
+++ b/eval.c
@@ -1690,12 +1690,51 @@ static val rangev(val args)
   uses_or2;
   val from = or2(first(args), zero);
   val to = second(args);
-  val step = or2(third(args), one);
+  val step = or2(third(args), if3(le(from, to), one, negone));
   val env = cons(from, cons(to, step));
 
   return make_lazy_cons(func_f1(env, rangev_func));
 }
 
+static val range_star_v_func(val env, val lcons)
+{
+  cons_bind (from, to_step, env);
+  cons_bind (to, step, to_step);
+  val next = if3(functionp(step),
+                 funcall1(step, from),
+                 plus(step, from));
+
+  rplaca(lcons, from);
+
+  if (eql(next, to) ||
+      (lt(from, to) && gt(next, to)) ||
+      (gt(from, to) && lt(next, to)))
+  {
+    rplacd(lcons, nil);
+    return nil;
+  }
+
+  rplacd(lcons, make_lazy_cons(lcons_fun(lcons)));
+  rplaca(env, next);
+  return nil;
+}
+
+static val range_star_v(val args)
+{
+  uses_or2;
+  val from = or2(first(args), zero);
+  val to = second(args);
+
+  if (eql(from, to)) {
+    return nil;
+  } else {
+    val step = or2(third(args), if3(le(from, to), one, negone));
+    val env = cons(from, cons(to, step));
+
+    return make_lazy_cons(func_f1(env, range_star_v_func));
+  }
+}
+
 static val generate_func(val env, val lcons)
 {
   cons_bind (while_pred, gen_fun, env);
@@ -2111,6 +2150,7 @@ void eval_init(void)
   reg_fun(intern(lit("random"), user_package), func_n2(random));
 
   reg_fun(intern(lit("range"), user_package), func_n0v(rangev));
+  reg_fun(intern(lit("range*"), user_package), func_n0v(range_star_v));
   reg_fun(generate_s, func_n2(generate));
   reg_fun(intern(lit("repeat"), user_package), func_n1v(repeatv));
   reg_fun(intern(lit("force"), user_package), func_n1(force));
-- 
cgit v1.2.3