diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2015-04-11 19:22:37 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2015-04-11 19:22:37 -0700 |
commit | f1a5e50f78927a362f244f0adfc1d23813c93073 (patch) | |
tree | 7a4207a469342a77c0653e9f6041de516af2ba4c | |
parent | 387d9c08e44db206e995bbbf272b7b8ea8580ad7 (diff) | |
download | txr-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-- | ChangeLog | 13 | ||||
-rw-r--r-- | eval.c | 28 | ||||
-rw-r--r-- | tl.vim | 20 | ||||
-rw-r--r-- | txr.1 | 30 | ||||
-rw-r--r-- | txr.vim | 20 |
5 files changed, 90 insertions, 21 deletions
@@ -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> @@ -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); @@ -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 @@ -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 )}+) @@ -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 |