diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | eval.c | 61 | ||||
| -rw-r--r-- | txr.1 | 59 | ||||
| -rw-r--r-- | txr.vim | 1 |
4 files changed, 131 insertions, 2 deletions
@@ -1,5 +1,17 @@ 2012-01-11 Kaz Kylheku <kaz@kylheku.com> + * 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 <kaz@kylheku.com> + * eval.c (eval_init): list_str registered. * lib.c (list_str): New function. @@ -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)); @@ -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 ({(<sym> <init-form>)}*) <body-form>*) + (each* ({(<sym> <init-form>)}*) <body-form>*) + (collect-each ({(<sym> <init-form>)}*) <body-form>*) + (collect-each* ({(<sym> <init-form>)}*) <body-form>*) + +.TP +Description: + +These operator establish a loop for iterating over the elements of one or more +lists. Each <init-form> must evaluate to a list. The lists are then iterated in +parallel over repeated evaluations of the <body-form>-s, which each <sym> +variable being assigned to successive elements of its list. The shortest list +determines the number of iterations, so if any of the <init-form>-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 <init-form>-s in an environment in which none of the <sym> +variables are yet visible. By contrast, the alternate forms evaluate each +<init-form> in an environment in which bindings for the previous <sym> +variables are visible. In this phase of evaluation, <sym> variables are +list-valued: one by one they are each bound to the list object emanating from +their corresponding <init-form>. Just before the first loop iteration, however, +the <sym> 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 @@ -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 |