From 7639a095e61af6c9c0f502957b7ff2c3817acab1 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 11 Jan 2012 14:16:36 -0800 Subject: * eval.c (each_s, each_star_s, collect_each_s, collect_each_star_s): New symbol variables. (op_each): New static function. (expand): Handle the four new operators. (eval_init): Intern new symbols, register new operators. * txr.1: Documented each, each*, collect-each and collect-each*. * txr.vim: Updated. --- ChangeLog | 12 ++++++++++++ eval.c | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- txr.1 | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ txr.vim | 1 + 4 files changed, 131 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 50100ddf..39ab1c6d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2012-01-11 Kaz Kylheku + + * eval.c (each_s, each_star_s, collect_each_s, collect_each_star_s): + New symbol variables. + (op_each): New static function. + (expand): Handle the four new operators. + (eval_init): Intern new symbols, register new operators. + + * txr.1: Documented each, each*, collect-each and collect-each*. + + * txr.vim: Updated. + 2012-01-11 Kaz Kylheku * eval.c (eval_init): list_str registered. diff --git a/eval.c b/eval.c index 4cf97c6f..73889a72 100644 --- a/eval.c +++ b/eval.c @@ -54,7 +54,9 @@ val eval_error_s; val progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s; val cond_s, if_s, defvar_s, defun_s; val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, vecref_s; -val for_s, for_star_s, dohash_s, uw_protect_s, return_s, return_from_s; +val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s; +val dohash_s; +val uw_protect_s, return_s, return_from_s; val list_s, append_s, apply_s, gen_s, generate_s; val delay_s, promise_s; @@ -461,6 +463,50 @@ static val op_let(val form, val env) return eval_progn(body, make_env(new_bindings, nil, env), form); } +static val op_each(val form, val env) +{ + uses_or2; + val each = first(form); + val args = rest(form); + val vars = first(args); + val body = rest(args); + val star = or2(eq(each, each_star_s), eq(each, collect_each_star_s)); + val collect = or2(eq(each, collect_each_s), eq(each, collect_each_star_s)); + val new_bindings = bindings_helper(vars, env, star, form); + val lists = mapcar(cdr_f, new_bindings); + list_collect_decl (collection, ptail); + + uw_block_begin (nil, result); + + for (;;) { + val biter, liter; + + for (biter = new_bindings, liter = lists; biter; + biter = cdr(biter), liter = cdr(liter)) + { + val binding = car(biter); + val list = car(liter); + if (!list) + goto out; + rplacd(binding, car(list)); + rplaca(liter, cdr(list)); + } + + { + val res = eval_progn(body, make_env(new_bindings, nil, env), form); + if (collect) + list_collect(ptail, res); + } + } + +out: + result = collection; + + uw_block_end; + + return result; +} + static val op_lambda(val form, val env) { return func_interp(env, form); @@ -1010,7 +1056,10 @@ val expand(val form) } else { val sym = car(form); - if (sym == let_s || sym == let_star_s || sym == lambda_s) { + if (sym == let_s || sym == let_star_s || sym == lambda_s || + sym == each_s || sym == each_star_s || sym == collect_each_s || + sym == collect_each_star_s) + { val body = rest(rest(form)); val vars = second(form); val body_ex = expand_forms(body); @@ -1411,6 +1460,10 @@ void eval_init(void) flip_s = intern(lit("flip"), user_package); for_s = intern(lit("for"), user_package); for_star_s = intern(lit("for*"), user_package); + each_s = intern(lit("each"), user_package); + each_star_s = intern(lit("each*"), user_package); + collect_each_s = intern(lit("collect-each"), user_package); + collect_each_star_s = intern(lit("collect-each*"), user_package); dohash_s = intern(lit("dohash"), user_package); uw_protect_s = intern(lit("unwind-protect"), user_package); return_s = intern(lit("return"), user_package); @@ -1434,6 +1487,10 @@ void eval_init(void) sethash(op_table, progn_s, cptr((mem_t *) op_progn)); sethash(op_table, prog1_s, cptr((mem_t *) op_prog1)); sethash(op_table, let_s, cptr((mem_t *) op_let)); + sethash(op_table, each_s, cptr((mem_t *) op_each)); + sethash(op_table, each_star_s, cptr((mem_t *) op_each)); + sethash(op_table, collect_each_s, cptr((mem_t *) op_each)); + sethash(op_table, collect_each_star_s, cptr((mem_t *) op_each)); sethash(op_table, let_star_s, cptr((mem_t *) op_let)); sethash(op_table, lambda_s, cptr((mem_t *) op_lambda)); sethash(op_table, call_s, cptr((mem_t *) op_call)); diff --git a/txr.1 b/txr.1 index cb54784b..eb816db8 100644 --- a/txr.1 +++ b/txr.1 @@ -4872,6 +4872,65 @@ block foo. Therefore the form does not complete and so the output "not reached!" is not produced. However, the cleanup form excecutes, producing the output "cleanup!". +.SS Operators each, each*, collect-each and collect-each* + +.TP +Syntax: + + (each ({( )}*) *) + (each* ({( )}*) *) + (collect-each ({( )}*) *) + (collect-each* ({( )}*) *) + +.TP +Description: + +These operator establish a loop for iterating over the elements of one or more +lists. Each must evaluate to a list. The lists are then iterated in +parallel over repeated evaluations of the -s, which each +variable being assigned to successive elements of its list. The shortest list +determines the number of iterations, so if any of the -s evaluate to +an empty list, the body is not executed. + +The body forms are enclosed in an anonymous block, allowing the return +operator to terminate the looop prematurely and optionally specify +the return value. + +The collect-each and collect-each* variants are like each and each*, +except that for each iteration, the resulting value of the body is collected +into a list. When the iteration terminates, the return value is this +collection. + +The alternate forms denoted by the adorned symbols each* and collect-each* +variants differ from each and collect-each in the following way. The plain +forms evaluate the -s in an environment in which none of the +variables are yet visible. By contrast, the alternate forms evaluate each + in an environment in which bindings for the previous +variables are visible. In this phase of evaluation, variables are +list-valued: one by one they are each bound to the list object emanating from +their corresponding . Just before the first loop iteration, however, +the variables are assigned the first item from each of their lists. + +.TP +Examples: + + ;; print numbers from 1 to 10 and whether they are even or odd + (each* ((n (range 1 10)) + (even (collect-each ((n m)) (evenp m)))) ;; n is a list here + (format t "~s is ~s\n" n (if even "even" "odd"))) ;; n is an item here + + Output: + + 1 is odd + 2 is even + 3 is odd + 4 is even + 5 is odd + 6 is even + 7 is odd + 8 is even + 9 is odd + 10 is even .SS Operator block diff --git a/txr.vim b/txr.vim index c5a67415..ae777790 100644 --- a/txr.vim +++ b/txr.vim @@ -30,6 +30,7 @@ syn keyword txl_keyword contained cond if and or syn keyword txl_keyword contained defvar defun inc dec set push pop flip syn keyword txl_keyword contained for for* dohash unwind-protect block syn keyword txl_keyword contained return return-from gen delay +syn keyword txl_keyword contained each each* collect-each collect-each* syn keyword txl_keyword contained cons make-lazy-cons lcons-fun car cdr syn keyword txl_keyword contained rplaca rplacd first rest append list -- cgit v1.2.3