summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2015-04-11 19:22:37 -0700
committerKaz Kylheku <kaz@kylheku.com>2015-04-11 19:22:37 -0700
commitf1a5e50f78927a362f244f0adfc1d23813c93073 (patch)
tree7a4207a469342a77c0653e9f6041de516af2ba4c
parent387d9c08e44db206e995bbbf272b7b8ea8580ad7 (diff)
downloadtxr-f1a5e50f78927a362f244f0adfc1d23813c93073.tar.gz
txr-f1a5e50f78927a362f244f0adfc1d23813c93073.tar.bz2
txr-f1a5e50f78927a362f244f0adfc1d23813c93073.zip
Implementing while* and until* loops.
* eval.c (while_star_s, until_star_s): New symbol variables. (me_while_star, me_until_star): New static functions. (eval_init): Initialize new variables. Register while* and until* macros. * txr.1: Documented while* and until*. * txr.vim, tl.vim: Regenerated.
-rw-r--r--ChangeLog13
-rw-r--r--eval.c28
-rw-r--r--tl.vim20
-rw-r--r--txr.130
-rw-r--r--txr.vim20
5 files changed, 90 insertions, 21 deletions
diff --git a/ChangeLog b/ChangeLog
index a4898893..4df75cc6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
2015-04-11 Kaz Kylheku <kaz@kylheku.com>
+ Implementing while* and until* loops.
+
+ * eval.c (while_star_s, until_star_s): New symbol variables.
+ (me_while_star, me_until_star): New static functions.
+ (eval_init): Initialize new variables. Register while* and
+ until* macros.
+
+ * txr.1: Documented while* and until*.
+
+ * txr.vim, tl.vim: Regenerated.
+
+2015-04-11 Kaz Kylheku <kaz@kylheku.com>
+
* sysif.c: Use HAVE_FORK_STUFF to wrap fork, waitpid and dup/dup2.
2015-04-11 Kaz Kylheku <kaz@kylheku.com>
diff --git a/eval.c b/eval.c
index 1236a84d..4c44614b 100644
--- a/eval.c
+++ b/eval.c
@@ -74,7 +74,7 @@ val eq_s, eql_s, equal_s;
val inc_s, dec_s, push_s, pop_s, flip_s, zap_s, gethash_s, car_s, cdr_s, not_s;
val del_s, vecref_s;
val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s;
-val append_each_s, append_each_star_s, while_s;
+val append_each_s, append_each_star_s, while_s, while_star_s, until_star_s;
val dohash_s;
val uw_protect_s, return_s, return_from_s;
val list_s, append_s, apply_s, iapply_s;
@@ -2204,6 +2204,16 @@ static val me_while(val form, val menv)
rest(rest(form)), nao));
}
+static val me_while_star(val form, val menv)
+{
+ val once = gensym(lit("once-"));
+ (void) menv;
+ return apply_frob_args(list(for_s, cons(list(once, t, nao), nil),
+ list(or_s, once, second(form), nao),
+ cons(list(zap_s, once, nao), nil),
+ rest(rest(form)), nao));
+}
+
static val me_until(val form, val menv)
{
val inv = cons(not_s, cons(second(form), nil));
@@ -2212,6 +2222,18 @@ static val me_until(val form, val menv)
rest(rest(form)), nao));
}
+static val me_until_star(val form, val menv)
+{
+ val once = gensym(lit("once-"));
+ val inv = cons(not_s, cons(second(form), nil));
+ (void) menv;
+ return apply_frob_args(list(for_s, cons(list(once, t, nao), nil),
+ list(or_s, once, inv, nao),
+ cons(list(zap_s, once, nao), nil),
+ rest(rest(form)), nao));
+}
+
+
static val me_quasilist(val form, val menv)
{
return cons(list_s, cdr(form));
@@ -3823,6 +3845,8 @@ void eval_init(void)
append_each_star_s = intern(lit("append-each*"), user_package);
dohash_s = intern(lit("dohash"), user_package);
while_s = intern(lit("while"), user_package);
+ while_star_s = intern(lit("while*"), user_package);
+ until_star_s = intern(lit("until*"), user_package);
uw_protect_s = intern(lit("unwind-protect"), user_package);
return_s = intern(lit("return"), user_package);
return_from_s = intern(lit("return-from"), user_package);
@@ -3935,7 +3959,9 @@ void eval_init(void)
reg_mac(when_s, me_when);
reg_mac(intern(lit("unless"), user_package), me_unless);
reg_mac(while_s, me_while);
+ reg_mac(while_star_s, me_while_star);
reg_mac(until_s, me_until);
+ reg_mac(until_star_s, me_until_star);
reg_mac(quasilist_s, me_quasilist);
reg_mac(flet_s, me_flet_labels);
reg_mac(labels_s, me_flet_labels);
diff --git a/tl.vim b/tl.vim
index 419a20a1..3d238f63 100644
--- a/tl.vim
+++ b/tl.vim
@@ -189,16 +189,16 @@ syn keyword txl_keyword contained trim-str true trunc trunc-rem
syn keyword txl_keyword contained tuples txr-case txr-if txr-when
syn keyword txl_keyword contained typeof unget-byte unget-char uniq
syn keyword txl_keyword contained unique unless unquote until
-syn keyword txl_keyword contained upcase-str update url-decode url-encode
-syn keyword txl_keyword contained usleep uw-protect vec vec-push
-syn keyword txl_keyword contained vec-set-length vecref vector vector-list
-syn keyword txl_keyword contained vectorp w-continued w-coredump w-exitstatus
-syn keyword txl_keyword contained w-ifcontinued w-ifexited w-ifsignaled w-ifstopped
-syn keyword txl_keyword contained w-nohang w-stopsig w-termsig w-untraced
-syn keyword txl_keyword contained wait weave when whenlet
-syn keyword txl_keyword contained where while whilet width
-syn keyword txl_keyword contained with-saved-vars wrap wrap* zap
-syn keyword txl_keyword contained zerop zip
+syn keyword txl_keyword contained until* upcase-str update url-decode
+syn keyword txl_keyword contained url-encode usleep uw-protect vec
+syn keyword txl_keyword contained vec-push vec-set-length vecref vector
+syn keyword txl_keyword contained vector-list vectorp w-continued w-coredump
+syn keyword txl_keyword contained w-exitstatus w-ifcontinued w-ifexited w-ifsignaled
+syn keyword txl_keyword contained w-ifstopped w-nohang w-stopsig w-termsig
+syn keyword txl_keyword contained w-untraced wait weave when
+syn keyword txl_keyword contained whenlet where while while*
+syn keyword txl_keyword contained whilet width with-saved-vars wrap
+syn keyword txl_keyword contained wrap* zap zerop zip
syn match txr_metanum "@[0-9]\+"
syn match txr_nested_error "[^\t `]\+" contained
diff --git a/txr.1 b/txr.1
index b23961d7..6b7c013c 100644
--- a/txr.1
+++ b/txr.1
@@ -10201,6 +10201,36 @@ is if the
operator is used to terminate the implicit anonymous block,
and is given an argument, which becomes the result value.
+.coNP Macros @ while* and @ until*
+.synb
+.mets (while* < expression << form *)
+.mets (until* < expression << form *)
+.syne
+.desc
+The
+.code while*
+and
+.code until*
+macros are similar, respectively, to the macros
+.code while
+and
+.codn until .
+
+They differ in one respect: they begin by evaluating the
+.metn form -s
+one time unconditionally, without first evaluating
+.metn expression .
+After this evaluation, the subsequent behavior is
+like that of
+.code while
+or
+.codn until .
+
+Another way to regard the behavior is that that these forms execute
+one iteration unconditionally, without evaluating the termination test prior to
+the first iteration. Yet another view is that these constructs relocate the
+test from the "top of the loop" to the "bottom of the loop".
+
.coNP Macro @ whilet
.synb
.mets (whilet ({ sym | >> ( sym << init-form )}+)
diff --git a/txr.vim b/txr.vim
index 182d3fd9..39abd499 100644
--- a/txr.vim
+++ b/txr.vim
@@ -189,16 +189,16 @@ syn keyword txl_keyword contained trim-str true trunc trunc-rem
syn keyword txl_keyword contained tuples txr-case txr-if txr-when
syn keyword txl_keyword contained typeof unget-byte unget-char uniq
syn keyword txl_keyword contained unique unless unquote until
-syn keyword txl_keyword contained upcase-str update url-decode url-encode
-syn keyword txl_keyword contained usleep uw-protect vec vec-push
-syn keyword txl_keyword contained vec-set-length vecref vector vector-list
-syn keyword txl_keyword contained vectorp w-continued w-coredump w-exitstatus
-syn keyword txl_keyword contained w-ifcontinued w-ifexited w-ifsignaled w-ifstopped
-syn keyword txl_keyword contained w-nohang w-stopsig w-termsig w-untraced
-syn keyword txl_keyword contained wait weave when whenlet
-syn keyword txl_keyword contained where while whilet width
-syn keyword txl_keyword contained with-saved-vars wrap wrap* zap
-syn keyword txl_keyword contained zerop zip
+syn keyword txl_keyword contained until* upcase-str update url-decode
+syn keyword txl_keyword contained url-encode usleep uw-protect vec
+syn keyword txl_keyword contained vec-push vec-set-length vecref vector
+syn keyword txl_keyword contained vector-list vectorp w-continued w-coredump
+syn keyword txl_keyword contained w-exitstatus w-ifcontinued w-ifexited w-ifsignaled
+syn keyword txl_keyword contained w-ifstopped w-nohang w-stopsig w-termsig
+syn keyword txl_keyword contained w-untraced wait weave when
+syn keyword txl_keyword contained whenlet where while while*
+syn keyword txl_keyword contained whilet width with-saved-vars wrap
+syn keyword txl_keyword contained wrap* zap zerop zip
syn keyword txr_keyword contained accept all and assert
syn keyword txr_keyword contained bind block cases cat