summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog12
-rw-r--r--eval.c42
-rw-r--r--txr.12
-rw-r--r--txr.vim4
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