From 17c8e76951ea9dc407f07bf2173e8f60ac5efd80 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 6 Oct 2013 23:56:02 -0700 Subject: Improving behavior of op and fixing a bug. Explicitly specifying @rest using (op ... . @rest) did not work at all. The then-func agument of iff and iffi may now be nil. * eval.c (format_op_arg): New static function. (transform_op): Handle dotted lists ending in @rest or @. (supplement_op_syms): New static function. (expand_op): Add missing numeric arguments, so that all 1 through n are in the list. Trailing rest is now added under different conditions. * lib.c (do_iff): Give thenfun the same behavior on nil that elsefun enjoys. * txr.1: Updated. --- ChangeLog | 23 +++++++++++++++++++++++ eval.c | 42 +++++++++++++++++++++++++++++++++++++----- lib.c | 2 +- txr.1 | 52 +++++++++++++++++++++++++++++++++++----------------- 4 files changed, 96 insertions(+), 23 deletions(-) diff --git a/ChangeLog b/ChangeLog index c6023a90..2f038d88 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,26 @@ +2013-10-06 Kaz Kylheku + + Improving behavior of op and fixing a bug. + + Explicitly specifying @rest using (op ... . @rest) + did not work at all. + + The then-func agument of iff and iffi may now be nil. + + * eval.c (format_op_arg): New static function. + (transform_op): Handle dotted lists ending in @rest + or @. + (supplement_op_syms): New static function. + (expand_op): Add missing numeric arguments, + so that all 1 through n are in the list. + Trailing rest is now added under different + conditions. + + * lib.c (do_iff): Give thenfun the same + behavior on nil that elsefun enjoys. + + * txr.1: Updated. + 2013-10-06 Kaz Kylheku New feature: :vars argument in repeat and rep directives in an output diff --git a/eval.c b/eval.c index 3aeeefda..1471e9be 100644 --- a/eval.c +++ b/eval.c @@ -1493,6 +1493,11 @@ static val expand_delay(val args) cons(lambda_s, cons(nil, args)), nao); } +static val format_op_arg(val num) +{ + return format(nil, lit("arg-~,02s-"), num, nao); +} + static val transform_op(val forms, val syms, val rg) { if (atom(forms)) { @@ -1501,15 +1506,19 @@ static val transform_op(val forms, val syms, val rg) val fi = first(forms); val re = rest(forms); + if (fi == var_s) { + cons_bind (outsyms, outforms, transform_op(cons(forms, nil), syms, rg)); + return cons(outsyms, rlcp(car(outforms), outforms)); + } + if (consp(fi) && car(fi) == var_s && consp(cdr(fi))) { val vararg = car(cdr(fi)); if (integerp(vararg)) { - val prefix = format(nil, lit("arg-~,02s-"), vararg, nao); val newsyms = syms; val new_p; val *place = acons_new_l(vararg, &new_p, &newsyms); - val sym = if3(new_p, set(*place, gensym(prefix)), *place); + val sym = if3(new_p, set(*place, gensym(format_op_arg(vararg))), *place); cons_bind (outsyms, outforms, transform_op(re, newsyms, rg)); return cons(outsyms, rlcp(cons(sym, outforms), outforms)); } else if (eq(vararg, rest_s)) { @@ -1538,6 +1547,25 @@ static val cons_find(val obj, val structure, val test) cons_find(obj, cdr(structure), test)); } +static val supplement_op_syms(val ssyms, val max) +{ + list_collect_decl (outsyms, tl); + val si, ni; + + for (si = ssyms, ni = one; + ssyms; + ni = plus(ni, one), ssyms = cdr(ssyms)) + { + val entry = car(si); + val num = car(entry); + + for (; lt(ni, num); ni = plus(ni, one)) + list_collect(tl, cons(ni, gensym(format_op_arg(ni)))); + list_collect(tl, entry); + } + + return outsyms; +} static val expand_op(val body) { @@ -1551,14 +1579,18 @@ static val expand_op(val body) val has_rest = cons_find(rest_gensym, body_trans, eq_f); if (!eql(max, length(nums)) && !zerop(min)) - eval_error(body, lit("op: missing numeric arguments"), nao); + ssyms = supplement_op_syms(ssyms, max); rlcp(body_trans, body); { + uses_or2; val dwim_body = rlcp(cons(dwim_s, - append2(body_trans, if3(has_rest, nil, - rest_gensym))), + if3(or3(has_rest, + ssyms, + nullp(proper_listp(body_trans))), + body_trans, + append2(body_trans, rest_gensym))), body_trans); return cons(lambda_s, diff --git a/lib.c b/lib.c index 25ecb91d..2b90b60a 100644 --- a/lib.c +++ b/lib.c @@ -3375,7 +3375,7 @@ static val do_iff(val env, val args) cons_bind (thenfun, elsefun, choices); return if3(apply(condfun, args, nil), - apply(thenfun, args, nil), + if2(thenfun, apply(thenfun, args, nil)), if2(elsefun, apply(elsefun, args, nil))); } diff --git a/txr.1 b/txr.1 index 15dc65f3..080759cb 100644 --- a/txr.1 +++ b/txr.1 @@ -9609,11 +9609,11 @@ construct is erroneous. .IP @rest The meta-symbol @rest indicates that any trailing arguments to the -function are to be inserted. If the @ syntax is not used anywhere, -it means that the function only has trailing arguments. If @1 is used, -it means that the second and subsequent arguments are trailing arguments. -If @rest is not used anywhere, then the rest arguments are automatically -applied to the op form. If @rest appears, then this is suppressed. +function are to be inserted there. If the form does not contain +any @ syntax or @ syntax, then @ is implicitly +inserted. What this means is that, for example, since the form (op foo) does +not contain any numeric positional arguments like @1, and does not contain +@rest, it is actually a shorthand for (op foo . @rest). The actions of form may be understood by these examples, which show how op is rewritten to lambda. However, note that the real translator @@ -9624,13 +9624,27 @@ symbols in the program. (op +) -> (lambda rest [+ . rest]) - (op @1 @2) -> (lambda (arg1 arg2 . rest) [arg1 arg2 . rest]) + (op + foo) -> (lambda rest [+ foo . rest]) + + (op @1 @2) -> (lambda (arg1 arg2 . rest) [arg1 arg2]) + + (op @1 . @rest) -> (lambda (arg1 . rest) [arg1 . @rest]) + + (op @1 @rest) -> (lambda (arg1 . rest) [arg1 @rest]) + + (op @1 @2) -> (lambda (arg1 arg2 . rest) [arg1 arg2]) (op foo @1 (@2) (bar @3)) -> (lambda (arg1 arg2 arg3 . rest) - [foo arg1 (arg2) (bar arg3) . rest]) + [foo arg1 (arg2) (bar arg3)]) (op foo @rest @1) -> (lambda (arg1 . rest) [foo rest arg1]) +Note that if argument @ appears, it is not necessary +for arguments @1 through @ to appear. The function +will have n arguments: + + (op @3) -> (lambda (arg1 arg2 arg3 . rest) [arg3]) + .PP .TP @@ -9738,22 +9752,26 @@ The iff function is the functional equivalent of the if operator. It accepts functional arguments and returns a function. The resulting function takes its arguments and applies them to . If - yields true, then the arguments are passed to and the -resulting value is returned. Otherwise if yields a false result, -and there is no , then nil is returned. If yields false, -and an exists, then the original arguments are passed to - and the resulting value is returned. + yields true, then the arguments are passed to and the +resulting value is returned. Otherwise the arguments are passed to +and the resulting value is returned. + +If needs to be called, but is nil, then nil is returned +immediately. Likewise, if needs to be calld, but is nil, then nil +is returned. The iffi function differs from iff only in the defaulting behavior with respect -to the argument. The following equivalence holds: +to the argument. The following equivalences hold: + + (iffi a b c) <--> (iff a b c) - (iffi a b c) <--> (iff a b c) + (iffi a b) <--> (iff a b identity) - (iffi a b) <--> (iff a b identity) + (iffi a b nil) <--> (iff a b identity) The iffi function defaults to the identity function when is -omitted, and therefore is useful in situations when one value is to be replaced -with another one when the condition is true, otherwise left alone. +omitted or nil, and therefore is useful in situations when one value is to be +replaced with another one when the condition is true, otherwise left alone. .SH INPUT AND OUTPUT -- cgit v1.2.3