diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | eval.c | 51 | ||||
| -rw-r--r-- | txr.1 | 34 |
3 files changed, 88 insertions, 8 deletions
@@ -1,3 +1,14 @@ +2014-06-26 kaz kylheku <kaz@kylheku.com> + + * eval.c (iapply_s): new global variable. + (iapply, me_ip): new static functions. + (do_apf): Bugfix: use apply_intrinsic, not apply. + (do_ipf, ipf): New static functions. + (eval_init): initialize iapply_s. register me_ip macro + expander, and the iapply and ipf functions. + + * txr.1: Documented iapply, ipf and ip. + 2014-06-26 Kaz Kylheku <kaz@kylheku.com> * lib.c (last): Bugfix: reversed null test. @@ -78,7 +78,8 @@ 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; val dohash_s; val uw_protect_s, return_s, return_from_s; -val list_s, append_s, apply_s, gen_s, gun_s, generate_s, rest_s, plus_s; +val list_s, append_s, apply_s, iapply_s; +val gen_s, gun_s, generate_s, rest_s, plus_s; val promise_s, op_s, identity_s; val hash_lit_s, hash_construct_s; val vector_lit_s, vector_list_s; @@ -659,6 +660,31 @@ val apply_intrinsic(val fun, val args) return apply(fun, apply_frob_args(args), nil); } +static val iapply(val fun, val args) +{ + if (args && atom(args)) { + args = cons(args, nil); + } else { + loc plast = lastcons(args); + if (!nullocp(plast)) { + deref(plast) = car(deref(plast)); + } else { + args = car(args); + } + + if (args && atom(args)) { + args = cons(args, nil); + } else if (args) { + val la = last(args); + val cd = cdr(la); + if (cd && atom(cd)) + rplacd(la, cons(cd, nil)); + } + } + + return apply(fun, args, nil); +} + static val call(val fun, val args) { return apply(fun, args, cons(apply_s, nil)); @@ -2395,6 +2421,13 @@ static val me_ap(val form, val menv) list(apply_s, cons(op_s, rest(form)), args, nao), nao); } +static val me_ip(val form, val menv) +{ + val args = gensym(lit("args-")); + return list(lambda_s, cons(args, nil), + list(iapply_s, cons(op_s, rest(form)), args, nao), nao); +} + static val me_ret(val form, val menv) { return cons(op_s, cons(identity_s, rest(form))); @@ -3120,7 +3153,7 @@ static val retf(val ret) static val do_apf(val fun, val args) { - return apply(fun, args, nil); + return apply_intrinsic(fun, args); } static val apf(val fun) @@ -3128,6 +3161,16 @@ static val apf(val fun) return func_f1(fun, do_apf); } +static val do_ipf(val fun, val args) +{ + return iapply(fun, args); +} + +static val ipf(val fun) +{ + return func_f1(fun, do_ipf); +} + static val prinl(val obj, val stream) { val ret = obj_print(obj, stream); @@ -3194,6 +3237,7 @@ void eval_init(void) list_s = intern(lit("list"), user_package); append_s = intern(lit("append"), user_package); apply_s = intern(lit("apply"), user_package); + iapply_s = intern(lit("iapply"), user_package); gen_s = intern(lit("gen"), user_package); gun_s = intern(lit("gun"), user_package); generate_s = intern(lit("generate"), user_package); @@ -3269,6 +3313,7 @@ void eval_init(void) reg_mac(op_s, me_op); reg_mac(do_s, me_op); reg_mac(intern(lit("ap"), user_package), me_ap); + reg_mac(intern(lit("ip"), user_package), me_ip); reg_mac(intern(lit("ret"), user_package), me_ret); reg_mac(qquote_s, me_qquote); reg_mac(sys_qquote_s, me_qquote); @@ -3312,6 +3357,7 @@ void eval_init(void) reg_fun(intern(lit("mappend"), user_package), func_n1v(mappendv)); reg_fun(intern(lit("mappend*"), user_package), func_n1v(lazy_mappendv)); reg_fun(apply_s, func_n1v(apply_intrinsic)); + reg_fun(iapply_s, func_n1v(iapply)); reg_fun(call_s, func_n1v(call)); reg_fun(intern(lit("reduce-left"), user_package), func_n4o(reduce_left, 2)); reg_fun(intern(lit("reduce-right"), user_package), func_n4o(reduce_right, 2)); @@ -3484,6 +3530,7 @@ void eval_init(void) reg_fun(intern(lit("and"), user_package), func_n0v(and_fun)); reg_fun(intern(lit("retf"), user_package), func_n1(retf)); reg_fun(intern(lit("apf"), user_package), func_n1(apf)); + reg_fun(intern(lit("ipf"), user_package), func_n1(ipf)); reg_fun(intern(lit("tf"), user_package), func_n0v(tf)); reg_fun(intern(lit("nilf"), user_package), func_n0v(nilf)); @@ -8153,12 +8153,13 @@ can be expressed as: (mapcar function (conses list0) (conses list1) ... (conses listn)) -.SS Function apply +.SS Functions apply and iapply .TP Syntax: (apply <function> [ <arg>* <trailing-args> ]) + (iapply <function> [ <arg>* <trailing-args> ]) .TP Description: @@ -8180,6 +8181,16 @@ these arguments is interpreted as <trailing-args>. The previous arguments represent leading arguments which are applied to <function>, prior to the arguments taken from <trailing-args>. +The iapply function ("improper apply") is similar to apply, except with regard +to the treatment of <trailing-args>. Firstly, under iapply, if <trailing-args> +is an atom other than nil (possibly a sequence, such as a vector or string), +then it is treated as an ordinary argument: <function> is invoked with a proper +argument list, whose last element is <trailing-args>. Secondly, if +<trailing-args> is a list, but an improper list, then the terminating atom of +<trailing-args> becomes an ordinary argument. Thus, in all possible cases, +iapply treats an extra non-nil atom as an argument, and never calls +<function> with an improper argument list. + .TP Examples: @@ -12003,12 +12014,13 @@ is the first argument of the inner function. Of course, if there are three levels of nesting, then three metas are needed to insert a parameter from the outermost op, into the innermost op. -.SS Macro ap +.SS Macros ap and ip .TP Syntax: (ap <form>+) + (ip <form>+) .TP Description: @@ -12016,7 +12028,7 @@ Description: The ap macro is based on the op macro and has identical argument conventions. -The ap macro analyzes its argumetns and produces a function, in exactly the +The ap macro analyzes its arguments and produces a function, in exactly the same same way as the op macro. It then returns a different one-argument function which accepts a list, and calls that function, applying the list as arguments. @@ -12030,7 +12042,13 @@ except that the symbol args is to be understood as a generated symbol (gensym). The ap macro nests properly with op and do, in any combination, in regard to the @@n notation. -See also: the apf function. +The ip macro is very similar to the ap macro, except that it is based +on the semantics of the function iapply rather than apply, according +to the following equivalence: + + (ap form ...) <--> (lambda (args) (iapply (op form ...))) + +See also: the apf function .SS Macro ret @@ -12232,21 +12250,25 @@ Example: ;; the function returned by (retf 42) ignores 1 2 3 and returns 42. (call (retf 42) 1 2 3) -> 42 -.SH Function apf +.SH Functions apf and ipf .TP Syntax: (apf <function>) + (ipf <function>) .TP Description: The apf function returns a one-argument function which accepts a list. When the function is called, it treats the list as -argument which are applied to <function>. It returns whatever +argument which are applied to <function> as if by apply. It returns whatever <function> returns. +The ipf function is similar to apf, except that the returned +function applies arguments as if by iapply rather than apply. + See also: the ap macro. .TP |