* 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.

4 files changed, 56 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index 64c9605f..c84ac72c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2012-02-14  Kaz Kylheku  <kaz@kylheku.com>
 
+	* 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.
+
+2012-02-14  Kaz Kylheku  <kaz@kylheku.com>
+
 	* eval.c (rangev_func): Improved termination test. The sequence
 	not only if it achieves the endpoint, but if it crosses it.
 
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));
diff --git a/txr.1 b/txr.1
index 36b3e00c..87a3fa3a 100644
--- a/txr.1
+++ b/txr.1
@@ -6579,7 +6579,7 @@ Certain object types have a custom equal function.
 
 .SS Function force
 
-.SS Function range
+.SS Functions range and range*
 
 .SS Function generate
 
diff --git a/txr.vim b/txr.vim
index f75ec957..cfae4e2d 100644
--- a/txr.vim
+++ b/txr.vim
@@ -80,7 +80,7 @@ syn keyword txl_keyword contained functionp interp-fun-p *random-state*
 syn keyword txl_keyword contained make-random-state random-state-p
 syn keyword txl_keyword contained random-fixnum random
 
-syn keyword txl_keyword contained range generate repeat force
+syn keyword txl_keyword contained range range* generate repeat force
 
 syn match txr_hash "#" contained
 syn match txr_quote "[,']" contained
@@ -113,7 +113,7 @@ syn region txr_directive matchgroup=Delimiter start="@[ \t]*(" matchgroup=Delimi
 
 syn region txr_list contained matchgroup=Delimiter start="(" matchgroup=Delimiter end=")" contains=txl_keyword,txr_string,txr_regex,txr_num,txr_ident,txr_variable,txr_metanum,txr_meta,txr_metabkt,txr_list,txr_dwim,txr_quasilit,txr_chr,txr_hash,txr_quote,txr_ncomment
 
-syn region txr_dwim contained matchgroup=Delimiter start="\[" matchgroup=Delimiter end="\]" contains=txl_keyword,txr_string,txr_regex,txr_num,txr_ident,txr_variable,txr_metanum,txr_meta,txr_metabkt,txr_list,txr_dwim,txr_dwim,txr_quasilit,txr_chr,txr_hash,txr_quote,txr_ncomment
+ayn region txr_dwim contained matchgroup=Delimiter start="\[" matchgroup=Delimiter end="\]" contains=txl_keyword,txr_string,txr_regex,txr_num,txr_ident,txr_variable,txr_metanum,txr_meta,txr_metabkt,txr_list,txr_dwim,txr_dwim,txr_quasilit,txr_chr,txr_hash,txr_quote,txr_ncomment
 
 syn region txr_meta contained matchgroup=Delimiter start="@[ \t]*(" matchgroup=Delimiter end=")" contains=txl_keyword,txr_string,txr_list,txr_dwim,txr_regex,txr_num,txr_ident,txr_variable,txr_metanum,txr_meta,txr_metabkt,txr_quasilit,txr_chrb,txr_hash,txr_quote,txr_ncomment