diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2015-08-23 09:50:39 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2015-08-23 09:50:39 -0700 |
commit | 6d0af6ae2af0003716581ed23b486f26ac809e0c (patch) | |
tree | d7b87cfcbb89f31ba2bcd8ad99e524244d18443d | |
parent | 115b8bc97f8d0d2ec8ed3cde46d8b567ea437e81 (diff) | |
download | txr-6d0af6ae2af0003716581ed23b486f26ac809e0c.tar.gz txr-6d0af6ae2af0003716581ed23b486f26ac809e0c.tar.bz2 txr-6d0af6ae2af0003716581ed23b486f26ac809e0c.zip |
Large scale conversion to new way of handling arguments.
Function arguments are now allocated on the stack using alloca,
in conjunction with the struct alloc header structure.
The generic_funcall and apply functions are refactored
for this, as are most functions that take variadic arguments.
* args.c (args_add_list, args_cons_list): Functions removed.
(args_normalize, args_normalize_fill): New functions.
(args_get_checked): Draw arguments from list when array runs out.
(args_copy, args_copy_zap): New functions.
* args.h (ARGS_MAX): Reduced to 32.
(ARGS_MIN): New preprocessor symbol.
(args_init): Call args_init_list.
(args_add2, args_add3, args_add4): New inline functions.
(args_more): Take into account list, which may hold additional arguments.
(args_two_more): New inline function.
(args_normalize, args_normalize_fill): Declared.
(args_get_list): Normalize all arguments into one list and return it.
(args_get_rest, args_at, args_atz): New inline functions.
(args_get): Draw arguments from list when array runs out.
(args_clear): New inline function.
* arith.c (maskv): Convert to new args.
* eval.c (APPLY_ARGS): Preprocessor symbol removed.
(bind_args): Converted to accept struct args.
(apply): Function reduced down to trivial adapter which
converts a list of arguments to args, and calls the new
generic_funcall.
(applyv): New static function: struct args wrapper
around apply_intrinsic.
(iapply): Converted to struct args.
(call): Static function removed. The call intrinsic
function binding now goes directly to generic_funcall.
(list_star_intrinsic, interp_fun): Converted to struct args.
(op_catch): Adjustments for bind_args, which requires
a struct args arglist.
(me_op): Must use the new minl and maxl, since minv and maxv
don't take lists any more.
(mapcarv, mappendv, lazy_mapcarv, lazy_mappendv, mapdov,
weavev, or_fun, and_fun, tf, nilf, do_retf, do_apf,
do_ipf, callf, do_mapf, mapf): Converted.
(mapcarl): New function, like the old mapcarv.
(eval_init): call_f initialized from generic_funcall
rather than call. apply registered to applyv rather than
apply_intrinsic. Registrations for zip, hash_from_pairs, vec,
alist-remove, alist-nremove, and throw similarly updated to
new or renamed functions.
* eval.h (interp_fun, mapcarv): Declarations updated.
(mapcarl): Declard.
* hash.c (hashv): Converted to struct args.
(hashl): New function.
(hash_construct): Use hashl, not hashv.
(hash_from_pairs, hash_list, group_by): Converted.
* hash.h (hashv, hash_construct, hash_from_pairs, hash_list,
group_by): Declarations updated.
(hashl): Declared.
* lib.c (appendv, nconcv, lazy_appendv): Converted to
struct args.
(lazy_appendl): New function.
(multi): Converted.
(listv): New function.
(nary_op, plusv, mulv, logandv, logiorv, gtv, ltv, gev, lev,
numeqv, numneqv, maxv, minv): Converted.
(maxl, minl): New functions, like old maxv and minv.
(exptv, gcdv, lcmv, lessv, greaterv, lequalv, gequalv): Converted.
(func_f0v, func_f1v, func_f2v, func_f3v, func_f4v): Converted.
(func_n0v, func_n1v, func_n2v, func_n3v, func_n4v): Converted.
(func_n0v, func_n1v, func_n2v, func_n3v, func_n4v): Converted.
(func_n1ov, func_n2ov, func_n3ov): Converted.
(generic_funcall): Converted to take struct args.
(funcall, funcall1, funcall2, funcall4): Pass stack-allocated
struct args as trailing arguments to variadic functions, and to
generic_funcall.
(do_curry_12_1_v): New struct-args-based static function,
needed to implement curry_12_1_v now.
(curry_12_1_v): Converted.
(transposev): New function based on previous tranpose.
(transpose): Now a wrapper for transposev.
(do_chain, chainv, do_chand, chandv, do_juxt, juxtv,
do_and, andv, do_or, orv, do_not, do_iff): Converted.
(vectorv): New function. Implementation basis for vec intrinsic function.
(alist_removev, alist_nremovev): New functions.
(multi_sort): Switch from mapcarv to mapcarl.
(unique): Converted.
(uniq): Allocate struct args for calling unique.
(obj_init): list_f function now based on new listv, rather than
identity.
* list.h (varg): New typedef.
(struct func): All variadic function pointers converted to use
struct args.
(appendv, nconcv, lazy_appendv, multi, nary_op, plusv, minusv,
mulv, gtv, ltv, gev, lev, numeqv, numneqv, maxv, minv, exptv,
gcdv, lcmv, logadnv, logiorv, maskv, lessv, greaterv, lequalv,
gequalv, func_f0v, func_f1v, func_f2v, func_f3v, func_f4v,
func_n0v, func_n1v, func_n2v, func_n3v, func_n4v, func_n0v,
func_n1v, func_n2v, func_n3v, func_n4v, func_n1ov, func_n2ov,
func_n3ov, generic_funcall, chainv, chandv, juxtv, adnv, orv,
unique): Declarations updated.
(lazy_appendl, listv, maxl, minl, transposev,
vectorv, alist_removev, alist_nremovev): Declared.
* stream.c (make_catenated_stream_v): New function.
(aformat): Renamed to formatv. The recognition of the nil
and t streams (standard output and string) is done here now.
(vformat): Follow rename of aformat to formatv.
(formatv): Function removed. Nobody calls this anymore.
(stream_init): make-catenated-stream re-registered to new
make_catenated_stream_v function.
* stream.h (formatv): Declaration updated.
(make_catenated_v): Declared.
* syslog.c (syslog_init): syslog registred to syslog_wrapv.
(syslog_wrapv): New function based on syslog_wrap converted to struct
args.
(syslog_wrap): Now wrapper for syslog_wrapv.
* syslog.h (syslog_wrapv): Declared.
* unwind.h (uw_throwv): New function.
(uw_throwfv, uw_errorfv): Converted to struct args.
* unwind.h (uw_throwv): Declared.
(uw_throwfv, uw_errorfv): Declarations updated.
-rw-r--r-- | args.c | 50 | ||||
-rw-r--r-- | args.h | 93 | ||||
-rw-r--r-- | arith.c | 8 | ||||
-rw-r--r-- | eval.c | 317 | ||||
-rw-r--r-- | eval.h | 5 | ||||
-rw-r--r-- | hash.c | 33 | ||||
-rw-r--r-- | hash.h | 11 | ||||
-rw-r--r-- | lib.c | 624 | ||||
-rw-r--r-- | lib.h | 134 | ||||
-rw-r--r-- | stream.c | 40 | ||||
-rw-r--r-- | stream.h | 3 | ||||
-rw-r--r-- | syslog.c | 14 | ||||
-rw-r--r-- | syslog.h | 1 | ||||
-rw-r--r-- | unwind.c | 11 | ||||
-rw-r--r-- | unwind.h | 5 |
15 files changed, 775 insertions, 574 deletions
@@ -27,11 +27,12 @@ #include <stddef.h> #include <setjmp.h> #include <signal.h> +#include <string.h> #include "config.h" #include "lib.h" #include "signal.h" #include "unwind.h" -#include ALLOCA_H +#include "gc.h" #include "args.h" val args_cons_list(struct args *args); @@ -44,12 +45,6 @@ cnum args_limit(val name, cnum in) name, num(ARGS_MAX), nao); } -void args_add_list(struct args *args, val list) -{ - for (; list; list = cdr(list)) - args_add(args, car(list)); -} - val args_add_checked(val name, struct args *args, val arg) { if (args->fill >= args->argc) @@ -57,22 +52,45 @@ val args_add_checked(val name, struct args *args, val arg) return args_add(args, arg); } -val args_cons_list(struct args *args) +void args_normalize(struct args *args, cnum fill) { - cnum i; - list_collect_decl (out, ptail); + bug_unless (fill <= args->argc); + + while (args->fill > fill) + args->list = cons(args->arg[--args->fill], args->list); + + while (args->fill < fill && args->list) + args_add(args, pop(&args->list)); + +} - for (i = 0; i < args->argc; i++) - ptail = list_collect(ptail, args->arg[i]); +void args_normalize_fill(struct args *args, cnum minfill, cnum maxfill) +{ + args_normalize(args, maxfill); - return args->list = out; + if (args->fill >= minfill) + while (args->fill < maxfill) + args_add(args, colon_k); } val args_get_checked(val name, struct args *args, cnum *arg_index) { - if (args->fill == 0 && args->list) - args_add_list(args, args->list); - if (*arg_index >= args->fill) + if (*arg_index >= args->fill && !args->list) uw_throwf(assert_s, lit("~a: insufficient arguments"), name, nao); return args_get(args, arg_index); } + +struct args *args_copy(struct args *to, struct args *from) +{ + to->fill = from->fill; + to->list = from->list; + memcpy(to->arg, from->arg, sizeof *to->arg * to->fill); + return to; +} + +struct args *args_copy_zap(struct args *to, struct args *from) +{ + args_copy(to, from); + memset(from->arg, 0, sizeof *to->arg * to->fill); + return to; +} @@ -33,7 +33,8 @@ struct args { typedef int arg_index; -#define ARGS_MAX 1024 +#define ARGS_MAX 32 +#define ARGS_MIN 4 #define args_alloc(N) \ (coerce(struct args *, \ @@ -41,18 +42,16 @@ typedef int arg_index; cnum args_limit(val name, cnum in); -INLINE void args_init(struct args *args, cnum argc) +INLINE void args_init_list(struct args *args, cnum argc, val list) { args->argc = argc; args->fill = 0; - args->list = nil; + args->list = list; } -INLINE void args_init_list(struct args *args, cnum argc, val list) +INLINE void args_init(struct args *args, cnum argc) { - args->argc = argc; - args->fill = 0; - args->list = list; + args_init_list(args, argc, nil); } INLINE val args_add(struct args *args, val arg) @@ -60,24 +59,94 @@ INLINE val args_add(struct args *args, val arg) return args->arg[args->fill++] = arg; } -void args_add_list(struct args *args, val list); +INLINE void args_add2(struct args *args, val arg1, val arg2) +{ + val *arg = args->arg + args->fill; + args->fill += 2; + *arg++ = arg1; + *arg++ = arg2; +} + +INLINE void args_add3(struct args *args, val arg1, val arg2, val arg3) +{ + val *arg = args->arg + args->fill; + args->fill += 3; + *arg++ = arg1; + *arg++ = arg2; + *arg++ = arg3; +} + +INLINE void args_add4(struct args *args, val arg1, val arg2, val arg3, val arg4) +{ + val *arg = args->arg + args->fill; + args->fill += 4; + *arg++ = arg1; + *arg++ = arg2; + *arg++ = arg3; + *arg++ = arg4; +} val args_add_checked(val name, struct args *args, val arg); INLINE int args_more(struct args *args, cnum index) { - return index < args->fill; + return index < args->fill || args->list; +} + +INLINE int args_two_more(struct args *args, cnum index) +{ + return + index + 1 < args->fill || + (index + 1 == args->fill && args->list) || + cdr(args->list); } +void args_normalize(struct args *args, cnum fill); +void args_normalize_fill(struct args *args, cnum minfill, cnum maxfill); + INLINE val args_get_list(struct args *args) { - extern val args_cons_list(struct args *args); - return (args->fill == 0 || args->list) ? args->list : args_cons_list(args); + if (args->fill == 0) + return z(args->list); + args_normalize(args, 0); + return z(args->list); +} + +INLINE val args_get_rest(struct args *args, cnum index) +{ + if (args->fill == index) + return z(args->list); + args_normalize(args, index); + return z(args->list); +} + + +INLINE val args_at(struct args *args, cnum arg_index) +{ + if (arg_index < args->fill) + return args->arg[arg_index]; + return car(args->list); +} + +INLINE val args_atz(struct args *args, cnum arg_index) +{ + if (arg_index < args->fill) + return z(args->arg[arg_index]); + return car(z(args->list)); } INLINE val args_get(struct args *args, cnum *arg_index) { - return args->arg[(*arg_index)++]; + if (*arg_index < args->fill) + return z(args->arg[(*arg_index)++]); + return pop(&args->list); +} + +INLINE void args_clear(struct args *args) +{ + args->fill = 0; } val args_get_checked(val name, struct args *args, cnum *arg_index); +struct args *args_copy(struct args *to, struct args *from); +struct args *args_copy_zap(struct args *to, struct args *from); @@ -40,6 +40,7 @@ #include "signal.h" #include "unwind.h" #include "gc.h" +#include "args.h" #include "eval.h" #include "arith.h" @@ -2049,12 +2050,13 @@ bad4: uw_throwf(error_s, lit("bit: operation failed on ~s, bit ~s"), a, bit, nao); } -val maskv(val bits) +val maskv(struct args *bits) { + cnum index = 0; val accum = zero; - for (; bits; bits = cdr(bits)) { - val num = car(bits); + while (args_more(bits, index)) { + val num = args_get(bits, &index); val mask = ash(one, num); accum = logior(accum, mask); } @@ -24,6 +24,7 @@ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +#include <stddef.h> #include <stdio.h> #include <stdlib.h> #include <string.h> @@ -34,8 +35,10 @@ #include <signal.h> #include <time.h> #include "config.h" +#include ALLOCA_H #include "lib.h" #include "gc.h" +#include "args.h" #include "arith.h" #include "signal.h" #include "unwind.h" @@ -51,8 +54,6 @@ #include "lisplib.h" #include "eval.h" -#define APPLY_ARGS 32 - typedef val (*opfun_t)(val, val); typedef val (*mefun_t)(val, val); @@ -437,14 +438,16 @@ static val env_vbind_special(val env, val sym, val obj, } } -static val bind_args(val env, val params, val args, val ctx_form) +static val bind_args(val env, val params, struct args *args, val ctx_form) { val new_env = make_env(nil, nil, env); val optargs = nil; val special_list = nil; + cnum index = 0; - for (; args && consp(params); params = cdr(params)) { + for (; args_more(args, index) && consp(params); params = cdr(params)) { val param = car(params); + val arg; val initform = nil; val presentsym = nil; @@ -478,8 +481,9 @@ static val bind_args(val env, val params, val args, val ctx_form) eval_error(ctx_form, lit("~s: ~s is not a bindable symbol"), car(ctx_form), presentsym, nao); + arg = args_get_checked(ctx_form, args, &index); + if (optargs) { - val arg = car(args); val initval = nil; val present = nil; @@ -496,14 +500,13 @@ static val bind_args(val env, val params, val args, val ctx_form) if (presentsym) env_vbind_special(new_env, presentsym, present, special_list, ctx_form); } else { - env_vbind_special(new_env, param, car(args), special_list, ctx_form); + env_vbind_special(new_env, param, arg, special_list, ctx_form); } - - args = cdr(args); } if (bindable(params)) { - env_vbind_special(new_env, params, args, special_list, ctx_form); + env_vbind_special(new_env, params, args_get_rest(args, index), + special_list, ctx_form); } else if (consp(params)) { if (car(params) == colon_k) { if (optargs) @@ -545,7 +548,7 @@ static val bind_args(val env, val params, val args, val ctx_form) } else if (params) { eval_error(ctx_form, lit("~s: ~s is not a bindable symbol"), car(ctx_form), params, nao); - } else if (args) { + } else if (args_more(args, index)) { eval_error(ctx_form, lit("~s: too many arguments for ~!~s"), car(ctx_form), ctx_form, nao); } @@ -664,133 +667,9 @@ static val get_param_syms(val params) val apply(val fun, val arglist, val ctx_form) { - val arg[APPLY_ARGS], *p = arg; - int fixparam, reqargs, nargs; - val ctx = if3(ctx_form, car(ctx_form), apply_s); - - if (fun && symbolp(fun)) { - val binding = gethash(top_fb, fun); - if (!binding) - eval_error(ctx_form, lit("~s: no such function ~s"), ctx, fun, nao); - fun = cdr(binding); - } - - if (!functionp(fun)) { - for (nargs = 0; - (p < arg + APPLY_ARGS) && consp(arglist); - nargs++, p++, arglist = cdr(arglist)) - { - *p = car(arglist); - } - return generic_funcall(fun, arg, nargs); - } - - type_check (fun, FUN); - - if (!listp(arglist)) { - val arglist_conv = tolist(arglist); - type_assert (listp(arglist_conv), - (lit("~s: arglist ~s is not a list"), ctx, - arglist, nao)); - arglist = arglist_conv; - } - - fixparam = fun->f.fixparam; - reqargs = fixparam - fun->f.optargs; - - if (!fun->f.variadic) { - for (; arglist && p < arg + APPLY_ARGS; arglist = cdr(arglist)) - *p++ = car(arglist); - - nargs = p - arg; - - if (nargs < reqargs) - eval_error(ctx_form, lit("~s: missing required arguments for ~!~s"), - ctx, func_get_name(fun, nil), nao); - - if (nargs > fixparam) - eval_error(ctx_form, lit("~s: too many arguments for ~!~s"), - ctx, func_get_name(fun, nil), nao); - - for (; nargs < fixparam; nargs++) - *p++ = colon_k; - - switch (fun->f.functype) { - case F0: - return fun->f.f.f0(fun->f.env); - case F1: - return fun->f.f.f1(fun->f.env, z(arg[0])); - case F2: - return fun->f.f.f2(fun->f.env, z(arg[0]), z(arg[1])); - case F3: - return fun->f.f.f3(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2])); - case F4: - return fun->f.f.f4(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3])); - case N0: - return fun->f.f.n0(); - case N1: - return fun->f.f.n1(z(arg[0])); - case N2: - return fun->f.f.n2(z(arg[0]), z(arg[1])); - case N3: - return fun->f.f.n3(z(arg[0]), z(arg[1]), z(arg[2])); - case N4: - return fun->f.f.n4(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3])); - case N5: - return fun->f.f.n5(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4])); - case N6: - return fun->f.f.n6(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5])); - case N7: - return fun->f.f.n7(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5]), z(arg[6])); - case FINTERP: - internal_error("unsupported function type"); - } - } else { - for (; arglist && p - arg < fixparam; arglist = cdr(arglist)) - *p++ = car(arglist); - - nargs = p - arg; - - if (nargs < reqargs) - eval_error(ctx_form, lit("~s: missing required arguments for ~!~s"), - ctx, func_get_name(fun, nil), nao); - - for (; nargs < fixparam; nargs++) - *p++ = colon_k; - - switch (fun->f.functype) { - case FINTERP: - return interp_fun(fun->f.env, fun->f.f.interp_fun, z(arglist)); - case F0: - return fun->f.f.f0v(fun->f.env, z(arglist)); - case F1: - return fun->f.f.f1v(fun->f.env, z(arg[0]), z(arglist)); - case F2: - return fun->f.f.f2v(fun->f.env, z(arg[0]), z(arg[1]), z(arglist)); - case F3: - return fun->f.f.f3v(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2]), z(arglist)); - case F4: - return fun->f.f.f4v(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arglist)); - case N0: - return fun->f.f.n0v(z(arglist)); - case N1: - return fun->f.f.n1v(z(arg[0]), z(arglist)); - case N2: - return fun->f.f.n2v(z(arg[0]), z(arg[1]), z(arglist)); - case N3: - return fun->f.f.n3v(z(arg[0]), z(arg[1]), z(arg[2]), z(arglist)); - case N4: - return fun->f.f.n4v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arglist)); - case N5: - return fun->f.f.n5v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arglist)); - case N6: - return fun->f.f.n6v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5]), z(arglist)); - case N7: - return fun->f.f.n7v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5]), z(arg[6]), z(arglist)); - } - } - - internal_error("corrupt function type field"); + struct args *args = args_alloc(ARGS_MAX); + args_init_list(args, ARGS_MAX, arglist); + return generic_funcall(fun, args); } static val apply_frob_args(val args) @@ -813,17 +692,27 @@ val apply_intrinsic(val fun, val args) return apply(fun, apply_frob_args(z(args)), nil); } -static val iapply(val fun, val args) +static val applyv(val fun, struct args *args) +{ + return apply_intrinsic(fun, args_get_list(args)); +} + +static val iapply(val fun, struct args *args) { + cnum index = 0; list_collect_decl (mod_args, ptail); loc saved_ptail; + val last_arg = nil; - for (; cdr(args); args = cdr(args)) - ptail = list_collect(ptail, car(args)); + while (args_two_more(args, index)) + ptail = list_collect(ptail, args_get(args, &index)); saved_ptail = ptail; - ptail = list_collect_nconc(ptail, car(args)); + if (args_more(args, index)) { + last_arg = args_get(args, &index); + ptail = list_collect_nconc(ptail, last_arg); + } { loc pterm = term(ptail); @@ -831,7 +720,7 @@ static val iapply(val fun, val args) if (tatom) { deref(ptail) = nil; - ptail = list_collect_nconc(saved_ptail, copy_list(car(args))); + ptail = list_collect_nconc(saved_ptail, copy_list(last_arg)); set(term(ptail), cons(tatom, nil)); } } @@ -839,14 +728,9 @@ static val iapply(val fun, val args) return apply(fun, z(mod_args), nil); } -static val call(val fun, val args) -{ - return apply(fun, z(args), cons(apply_s, nil)); -} - -static val list_star_intrinsic(val args) +static val list_star_intrinsic(struct args *args) { - return apply_frob_args(args); + return apply_frob_args(args_get_list(args)); } static val bind_macro_params(val env, val menv, val params, val form, @@ -1037,7 +921,7 @@ static val set_dyn_env(val de) return old; } -val interp_fun(val env, val fun, val args) +val interp_fun(val env, val fun, struct args *args) { val def = cdr(fun); val params = car(def); @@ -1948,9 +1832,12 @@ static val op_catch(val form, val env) result = eval(try_form, env, try_form); uw_catch(exsym, exvals) { + struct args *args = args_alloc(ARGS_MIN); val catches = rest(rest(rest(form))); val iter; + args_init_list(args, ARGS_MIN, exvals); + for (iter = catches; iter; iter = cdr(iter)) { val clause = car(iter); val type = first(clause); @@ -1958,7 +1845,7 @@ static val op_catch(val form, val env) if (uw_exception_subtype_p(exsym, type)) { val params = second(clause); val saved_de = set_dyn_env(make_env(nil, nil, dyn_env)); - val clause_env = bind_args(env, params, exvals, clause); + val clause_env = bind_args(env, params, args, clause); result = eval_progn(rest(rest(clause)), clause_env, clause); set_dyn_env(saved_de); break; @@ -2600,8 +2487,8 @@ static val me_op(val form, val menv) cons_bind (syms, body_trans, transform_op(body_ex, nil, rest_gensym)); val ssyms = sort(syms, func_n2(lt), car_f); val nums = mapcar(car_f, ssyms); - val max = if3(nums, maxv(car(nums), cdr(nums)), zero); - val min = if3(nums, minv(car(nums), cdr(nums)), zero); + val max = if3(nums, maxl(car(nums), cdr(nums)), zero); + val min = if3(nums, minl(car(nums), cdr(nums)), zero); val has_rest = cons_find(rest_gensym, body_trans, eq_f); val is_op = and3(sym == do_s, consp(body_trans), gethash(op_table, car(body_trans))); @@ -3335,11 +3222,14 @@ static val constantp(val form, val env_in) } } -val mapcarv(val fun, val list_of_lists) +val mapcarv(val fun, struct args *lists) { - if (!cdr(list_of_lists)) { - return mapcar(fun, nullify(car(list_of_lists))); + if (!args_more(lists, 0)) { + return nil; + } else if (!args_two_more(lists, 0)) { + return mapcar(fun, nullify(args_atz(lists, 0))); } else { + val list_of_lists = args_get_list(lists); val lofl = mapcar_listout(func_n1(nullify), list_of_lists); val list_orig = car(list_of_lists); list_collect_decl (out, otail); @@ -3361,11 +3251,21 @@ val mapcarv(val fun, val list_of_lists) } } -static val mappendv(val fun, val list_of_lists) +val mapcarl(val fun, val list_of_lists) +{ + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, list_of_lists); + return mapcarv(fun, args); +} + +static val mappendv(val fun, struct args *lists) { - if (!cdr(list_of_lists)) { - return mappend(fun, car(list_of_lists)); + if (!args_more(lists, 0)) { + return nil; + } else if (!args_two_more(lists, 0)) { + return mappend(fun, args_atz(lists, 0)); } else { + val list_of_lists = args_get_list(lists); val lofl = mapcar(func_n1(nullify), list_of_lists); val list_orig = car(list_of_lists); list_collect_decl (out, otail); @@ -3425,28 +3325,43 @@ static val lazy_mapcarv_func(val env, val lcons) return nil; } -static val lazy_mapcarv(val fun, val list_of_lists) +static val lazy_mapcarv(val fun, struct args *lists) { - if (!cdr(list_of_lists)) { - return lazy_mapcar(fun, car(list_of_lists)); - } else if (some_satisfy(list_of_lists, null_f, identity_f)) { + if (!args_more(lists, 0)) { return nil; + } else if (!args_two_more(lists, 0)) { + return lazy_mapcar(fun, args_atz(lists, 0)); } else { - val lofl = mapcar(func_n1(nullify), list_of_lists); - return make_lazy_cons(func_f1(cons(fun, lofl), lazy_mapcarv_func)); + val list_of_lists = args_get_list(lists); + if (some_satisfy(list_of_lists, null_f, identity_f)) { + return nil; + } else { + val lofl = mapcar(func_n1(nullify), list_of_lists); + return make_lazy_cons(func_f1(cons(fun, lofl), lazy_mapcarv_func)); + } } } -static val lazy_mappendv(val fun, val list_of_lists) +static val lazy_mapcarl(val fun, val list_of_lists) { - return lazy_appendv(lazy_mapcarv(fun, list_of_lists)); + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, list_of_lists); + return lazy_mapcarv(fun, args); } -static val mapdov(val fun, val list_of_lists) +static val lazy_mappendv(val fun, struct args *lists) { - if (!cdr(list_of_lists)) { - return mapdo(fun, car(list_of_lists)); + return lazy_appendl(lazy_mapcarv(fun, lists)); +} + +static val mapdov(val fun, struct args *lists) +{ + if (!args_more(lists, 0)) { + return nil; + } else if (!args_two_more(lists, 0)) { + return mapdo(fun, args_atz(lists, 0)); } else { + val list_of_lists = args_get_list(lists); val lofl = mapcar_listout(func_n1(nullify), list_of_lists); for (;;) { @@ -3753,15 +3668,16 @@ static val weave_gen(val env) return ret; } -static val weavev(val lists) +static val weavev(struct args *args) { + val lists = args_get_list(args); val uniq = cons(nil, nil); val padded_lists = mapcar(curry_123_1(func_n3(pad), uniq, colon_k), lists); - val tuples = lazy_mapcarv(list_f, padded_lists); + val tuples = lazy_mapcarl(list_f, padded_lists); val env = cons(uniq, tuples); val whil = func_f0(env, weave_while); val gen = func_f0(env, weave_gen); - return lazy_appendv(generate(whil, gen)); + return lazy_appendl(generate(whil, gen)); } static val force(val promise) @@ -3827,22 +3743,25 @@ static val if_fun(val cond, val then, val alt) return if3(cond, then, default_bool_arg(alt)); } -static val or_fun(val vals) +static val or_fun(struct args *vals) { - for (; vals != nil; vals = cdr(vals)) { - val item = car(vals); + cnum index = 0; + + while (args_more(vals, index)) { + val item = args_get(vals, &index); if (item) return item; } return nil; } -static val and_fun(val vals) +static val and_fun(struct args *vals) { val item = t; + cnum index = 0; - for (; vals != nil; vals = cdr(vals)) { - item = car(vals); + while (args_more(vals, index)) { + item = args_get(vals, &index); if (!item) return nil; } @@ -3855,19 +3774,19 @@ static val not_null(val obj) return if3(nilp(obj), nil, t); } -static val tf(val args) +static val tf(struct args *args) { (void) args; return t; } -static val nilf(val args) +static val nilf(struct args *args) { (void) args; return nil; } -static val do_retf(val ret, val args) +static val do_retf(val ret, struct args *args) { (void) args; return ret; @@ -3878,9 +3797,9 @@ static val retf(val ret) return func_f0v(ret, do_retf); } -static val do_apf(val fun, val args) +static val do_apf(val fun, struct args *args) { - return apply_intrinsic(fun, z(args)); + return apply_intrinsic(fun, args_get_list(args)); } static val apf(val fun) @@ -3888,9 +3807,9 @@ static val apf(val fun) return func_f0v(fun, do_apf); } -static val do_ipf(val fun, val args) +static val do_ipf(val fun, struct args *args) { - return iapply(fun, z(args)); + return iapply(fun, args); } static val ipf(val fun) @@ -3898,23 +3817,23 @@ static val ipf(val fun) return func_f0v(fun, do_ipf); } -static val callf(val func, val funlist) +static val callf(val func, struct args *funlist) { val juxt_fun = juxtv(funlist); val apf_fun = apf(func); return chain(juxt_fun, apf_fun, nao); } -static val do_mapf(val env, val args) +static val do_mapf(val env, struct args *args) { cons_bind (fun, funlist, env); - val mapped_args = mapcarv(call_f, cons(funlist, cons(z(args), nil))); + val mapped_args = mapcarl(call_f, cons(funlist, cons(args_get_list(args), nil))); return apply(fun, z(mapped_args), nil); } -static val mapf(val fun, val funlist) +static val mapf(val fun, struct args *funlist) { - return func_f0v(cons(fun, funlist), do_mapf); + return func_f0v(cons(fun, args_get_list(funlist)), do_mapf); } val prinl(val obj, val stream) @@ -3992,7 +3911,7 @@ void eval_init(void) eval_initing = t; - call_f = func_n1v(call); + call_f = func_n1v(generic_funcall); dwim_s = intern(lit("dwim"), user_package); progn_s = intern(lit("progn"), user_package); @@ -4225,13 +4144,13 @@ 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(intern(lit("mapdo"), user_package), func_n1v(mapdov)); - reg_fun(apply_s, func_n1v(apply_intrinsic)); + reg_fun(apply_s, func_n1v(applyv)); reg_fun(iapply_s, func_n1v(iapply)); reg_fun(call_s, call_f); 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)); reg_fun(intern(lit("transpose"), user_package), func_n1(transpose)); - reg_fun(intern(lit("zip"), user_package), func_n0v(transpose)); + reg_fun(intern(lit("zip"), user_package), func_n0v(transposev)); reg_fun(intern(lit("interpose"), user_package), func_n2(interpose)); reg_fun(intern(lit("second"), user_package), func_n1(second)); @@ -4383,7 +4302,7 @@ void eval_init(void) reg_fun(intern(lit("copy-hash"), user_package), func_n1(copy_hash)); reg_fun(intern(lit("hash"), user_package), func_n0v(hashv)); reg_fun(intern(lit("hash-construct"), user_package), func_n2(hash_construct)); - reg_fun(intern(lit("hash-from-pairs"), user_package), func_n1v(hash_from_pairs)); + reg_fun(intern(lit("hash-from-pairs"), user_package), func_n1v(hash_from_pairs_v)); reg_fun(intern(lit("hash-list"), user_package), func_n1v(hash_list)); reg_fun(gethash_s, func_n3o(gethash_n, 2)); reg_fun(intern(lit("inhash"), user_package), func_n3o(inhash, 2)); @@ -4567,7 +4486,7 @@ void eval_init(void) reg_fun(intern(lit("length-str-<="), user_package), func_n2(length_str_le)); reg_fun(intern(lit("vector"), user_package), func_n2o(vector, 1)); - reg_fun(intern(lit("vec"), user_package), func_n0v(vector_list)); + reg_fun(intern(lit("vec"), user_package), func_n0v(vectorv)); reg_fun(intern(lit("vectorp"), user_package), func_n1(vectorp)); reg_fun(intern(lit("vec-set-length"), user_package), func_n2(vec_set_length)); reg_fun(vecref_s, func_n2(vecref)); @@ -4586,8 +4505,8 @@ void eval_init(void) reg_fun(intern(lit("acons"), user_package), func_n3(acons)); reg_fun(intern(lit("acons-new"), user_package), func_n3(acons_new)); reg_fun(intern(lit("aconsql-new"), user_package), func_n3(aconsql_new)); - reg_fun(intern(lit("alist-remove"), user_package), func_n1v(alist_remove)); - reg_fun(intern(lit("alist-nremove"), user_package), func_n1v(alist_nremove)); + reg_fun(intern(lit("alist-remove"), user_package), func_n1v(alist_removev)); + reg_fun(intern(lit("alist-nremove"), user_package), func_n1v(alist_nremovev)); reg_fun(intern(lit("copy-cons"), user_package), func_n1(copy_cons)); reg_fun(intern(lit("copy-alist"), user_package), func_n1(copy_alist)); reg_fun(intern(lit("prop"), user_package), func_n2(getplist)); @@ -4655,7 +4574,7 @@ void eval_init(void) reg_fun(intern(lit("comb"), user_package), func_n2(comb)); reg_fun(intern(lit("rcomb"), user_package), func_n2(rcomb)); - reg_fun(throw_s, func_n1v(uw_throw)); + reg_fun(throw_s, func_n1v(uw_throwv)); reg_fun(intern(lit("throwf"), user_package), func_n2v(uw_throwfv)); reg_fun(error_s, func_n1v(uw_errorfv)); @@ -37,7 +37,7 @@ val lookup_global_var(val sym); loc lookup_var_l(val env, val sym); loc lookup_global_var_l(val sym); val lookup_fun(val env, val sym); -val interp_fun(val env, val fun, val args); +val interp_fun(val env, val fun, struct args *); val fboundp(val sym); val special_operator_p(val sym); val macro_form_p(val form, val menv); @@ -54,7 +54,8 @@ val load(val target); val expand(val form, val menv); val expand_forms(val forms, val menv); val bindable(val obj); -val mapcarv(val fun, val list_of_lists); +val mapcarv(val fun, struct args *lists); +val mapcarl(val fun, val list_of_lists); val lazy_mapcar(val fun, val list); val generate(val while_pred, val gen_fun); val prinl(val obj, val stream); @@ -24,6 +24,7 @@ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +#include <stddef.h> #include <stdio.h> #include <string.h> #include <dirent.h> @@ -33,8 +34,10 @@ #include <limits.h> #include <signal.h> #include "config.h" +#include ALLOCA_H #include "lib.h" #include "gc.h" +#include "args.h" #include "signal.h" #include "unwind.h" #include "stream.h" @@ -872,17 +875,25 @@ void hash_process_weak(void) do_iters(); } -val hashv(val args) +val hashv(struct args *args) { - val wkeys = memq(weak_keys_k, args); - val wvals = memq(weak_vals_k, args); - val equal = memq(equal_based_k, args); + val arglist = args_get_list(args); + val wkeys = memq(weak_keys_k, arglist); + val wvals = memq(weak_vals_k, arglist); + val equal = memq(equal_based_k, arglist); return make_hash(wkeys, wvals, equal); } -val hash_construct(val hashv_args, val pairs) +val hashl(val arglist) { - val hash = hashv(hashv_args); + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, arglist); + return hashv(args); +} + +val hash_construct(val hashl_args, val pairs) +{ + val hash = hashl(hashl_args); pairs = nullify(pairs); @@ -894,14 +905,14 @@ val hash_construct(val hashv_args, val pairs) return hash; } -val hash_from_pairs(val pairs, val hashv_args) +val hash_from_pairs_v(val pairs, struct args *hashv_args) { - return hash_construct(default_bool_arg(hashv_args), pairs); + return hash_construct(args_get_list(hashv_args), pairs); } -val hash_list(val keys, val hashv_args) +val hash_list(val keys, struct args *hashv_args) { - val hash = hashv(default_bool_arg(hashv_args)); + val hash = hashv(hashv_args); keys = nullify(keys); @@ -913,7 +924,7 @@ val hash_list(val keys, val hashv_args) return hash; } -val group_by(val func, val seq, val hashv_args) +val group_by(val func, val seq, struct args *hashv_args) { val hash = hashv(hashv_args); @@ -46,11 +46,12 @@ val hash_begin(val hash); val hash_next(val iter); val hash_eql(val obj); val hash_equal(val obj); -val hashv(val args); -val hash_construct(val hashv_args, val pairs); -val hash_from_pairs(val pairs, val hashv_args); -val hash_list(val keys, val hashv_args); -val group_by(val func, val seq, val hashv_args); +val hashv(struct args *args); +val hashl(val args); +val hash_construct(val hashl_args, val pairs); +val hash_from_pairs_v(val pairs, struct args *hashv_args); +val hash_list(val keys, struct args *hashv_args); +val group_by(val func, val seq, struct args *hashv_args); val hash_keys(val hash); val hash_values(val hash); val hash_pairs(val hash); @@ -26,6 +26,7 @@ #include <stdio.h> #include <stdlib.h> +#include <stddef.h> #include <string.h> #include <wctype.h> #include <limits.h> @@ -40,6 +41,7 @@ #include <sys/time.h> #include <assert.h> #include "config.h" +#include ALLOCA_H #ifdef HAVE_GETENVIRONMENTSTRINGS #define NOMINMAX #include <windows.h> @@ -51,6 +53,7 @@ #include "hash.h" #include "signal.h" #include "unwind.h" +#include "args.h" #include "stream.h" #include "utf8.h" #include "filter.h" @@ -768,12 +771,13 @@ val append2(val list1, val list2) return out; } -val appendv(val lists) +val appendv(struct args *lists) { + cnum index = 0; list_collect_decl (out, ptail); - for (; lists; lists = cdr(lists)) { - val item = car(lists); + while (args_more(lists, index)) { + val item = args_get(lists, &index); ptail = list_collect_append(ptail, item); } @@ -790,14 +794,13 @@ val nappend2(val list1, val list2) return out; } -val nconcv(val lists) +val nconcv(struct args *lists) { + cnum index = 0; list_collect_decl (out, ptail); - for (; lists; lists = cdr(lists)) { - val item = car(lists); - ptail = list_collect_nconc(ptail, item); - } + while (args_more(lists, index)) + ptail = list_collect_nconc(ptail, args_get(lists, &index)); return out; } @@ -990,17 +993,18 @@ static val lazy_appendv_func(val env, val lcons) return nil; } -val lazy_appendv(val lists) +val lazy_appendv(struct args *args) { val nonempty = nil; + cnum index = 0; - while (lists) { - nonempty = nullify(pop(&lists)); + while (args_more(args, index)) { + nonempty = args_get(args, &index); if (nonempty) break; } - if (nilp(lists)) + if (!args_more(args, index)) return nonempty; if (atom(nonempty)) @@ -1009,12 +1013,20 @@ val lazy_appendv(val lists) { loc ptail = ltail(mkcloc(nonempty)); - set(ptail, make_lazy_cons(func_f1(cons(car(deref(ptail)), lists), + set(ptail, make_lazy_cons(func_f1(cons(car(deref(ptail)), + args_get_rest(args, index)), lazy_appendv_func))); return nonempty; } } +val lazy_appendl(val lists) +{ + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, lists); + return lazy_appendv(args); +} + val ldiff(val list1, val list2) { val list_orig = list1; @@ -1368,11 +1380,11 @@ val none_satisfy(val list, val pred, val key) return t; } -val multi(val func, val lists) +val multi(val func, struct args *lists) { val transposed = mapcarv(list_f, lists); val processed = funcall1(func, transposed); - return mapcarv(list_f, processed); + return mapcarl(list_f, processed); } val flatten(val list) @@ -1974,6 +1986,11 @@ val list(val first, ...) return list; } +val listv(struct args *args) +{ + return args_get_list(args); +} + val consp(val obj) { type_t ty = type(obj); @@ -2155,48 +2172,55 @@ val numberp(val num) } } -val nary_op(val (*cfunc)(val, val), val args, val emptyval) +val nary_op(val (*cfunc)(val, val), struct args *args, val emptyval) { - if (!args) + val fi, re; + cnum index = 0; + + if (!args_more(args, 0)) return emptyval; - else if (!cdr(args)) - return car(args); - return reduce_left(func_n2(cfunc), cdr(args), car(args), nil); + else if (!args_two_more(args, 0)) + return args_atz(args, 0); + + fi = args_get(args, &index); + re = args_get_rest(args, index); + + return reduce_left(func_n2(cfunc), re, fi, nil); } -val plusv(val nlist) +val plusv(struct args *nlist) { return nary_op(plus, nlist, zero); } -val minusv(val minuend, val nlist) +val minusv(val minuend, struct args *nlist) { - if (nlist) - return reduce_left(func_n2(minus), nlist, minuend, nil); + if (args_more(nlist, 0)) + return reduce_left(func_n2(minus), args_get_list(nlist), minuend, nil); return neg(minuend); } -val mulv(val nlist) +val mulv(struct args *nlist) { return nary_op(mul, nlist, one); } -val logandv(val nlist) +val logandv(struct args *nlist) { return nary_op(logand, nlist, negone); } -val logiorv(val nlist) +val logiorv(struct args *nlist) { return nary_op(logior, nlist, zero); } -val gtv(val first, val rest) +val gtv(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!gt(first, elem)) return nil; first = elem; @@ -2205,12 +2229,12 @@ val gtv(val first, val rest) return t; } -val ltv(val first, val rest) +val ltv(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!lt(first, elem)) return nil; first = elem; @@ -2219,12 +2243,12 @@ val ltv(val first, val rest) return t; } -val gev(val first, val rest) +val gev(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!ge(first, elem)) return nil; first = elem; @@ -2233,12 +2257,12 @@ val gev(val first, val rest) return t; } -val lev(val first, val rest) +val lev(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!le(first, elem)) return nil; first = elem; @@ -2247,12 +2271,12 @@ val lev(val first, val rest) return t; } -val numeqv(val first, val rest) +val numeqv(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!numeq(first, elem)) return nil; first = elem; @@ -2261,9 +2285,10 @@ val numeqv(val first, val rest) return t; } -val numneqv(val list) +val numneqv(struct args *args) { val i, j; + val list = args_get_list(args); for (i = list; i; i = cdr(i)) for (j = cdr(i); j; j = cdr(j)) @@ -2283,14 +2308,28 @@ val min2(val a, val b) return if3(less(a, b), a, b); } -val maxv(val first, val rest) +val maxv(val first, struct args *rest) +{ + return reduce_left(func_n2(max2), args_get_list(rest), first, nil); +} + +val minv(val first, struct args *rest) +{ + return reduce_left(func_n2(min2), args_get_list(rest), first, nil); +} + +val maxl(val first, val rest) { - return reduce_left(func_n2(max2), rest, first, nil); + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, rest); + return maxv(first, args); } -val minv(val first, val rest) +val minl(val first, val rest) { - return reduce_left(func_n2(min2), rest, first, nil); + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, rest); + return minv(first, args); } val clamp(val low, val high, val num) @@ -2298,27 +2337,27 @@ val clamp(val low, val high, val num) return max2(low, min2(high, num)); } -val exptv(val nlist) +val exptv(struct args *nlist) { - return reduce_right(func_n2(expt), nlist, one, nil); + return reduce_right(func_n2(expt), args_get_list(nlist), one, nil); } -val gcdv(val nlist) +val gcdv(struct args *nlist) { - if (!nlist) + if (!args_more(nlist, 0)) return zero; - if (!cdr(nlist)) - return abso(car(nlist)); - return reduce_left(func_n2(gcd), nlist, colon_k, nil); + if (!args_two_more(nlist, 0)) + return abso(args_atz(nlist, 0)); + return reduce_left(func_n2(gcd), args_get_list(nlist), colon_k, nil); } -val lcmv(val nlist) +val lcmv(struct args *nlist) { - if (!nlist) + if (!args_more(nlist, 0)) return one; - if (!cdr(nlist)) - return abso(car(nlist)); - return reduce_left(func_n2(lcm), nlist, colon_k, nil); + if (!args_two_more(nlist, 0)) + return abso(args_atz(nlist, 0)); + return reduce_left(func_n2(lcm), args_get_list(nlist), colon_k, nil); } val string_own(wchar_t *str) @@ -3426,12 +3465,12 @@ val gequal(val left, val right) return or2(equal(left, right), less(right, left)); } -val lessv(val first, val rest) +val lessv(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!less(first, elem)) return nil; first = elem; @@ -3440,12 +3479,12 @@ val lessv(val first, val rest) return t; } -val greaterv(val first, val rest) +val greaterv(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!less(elem, first)) return nil; first = elem; @@ -3454,12 +3493,12 @@ val greaterv(val first, val rest) return t; } -val lequalv(val first, val rest) +val lequalv(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!equal(first, elem) && !less(first, elem)) return nil; first = elem; @@ -3468,12 +3507,12 @@ val lequalv(val first, val rest) return t; } -val gequalv(val first, val rest) +val gequalv(val first, struct args *rest) { - val iter; + cnum index = 0; - for (iter = rest; iter; iter = cdr(iter)) { - val elem = car(iter); + while (args_more(rest, index)) { + val elem = args_get(rest, &index); if (!equal(first, elem) && !less(elem, first)) return nil; first = elem; @@ -4001,7 +4040,7 @@ val func_n7(val (*fun)(val, val, val, val, val, val, val)) return obj; } -val func_f0v(val env, val (*fun)(val, val)) +val func_f0v(val env, val (*fun)(val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4014,7 +4053,7 @@ val func_f0v(val env, val (*fun)(val, val)) return obj; } -val func_f1v(val env, val (*fun)(val env, val, val rest)) +val func_f1v(val env, val (*fun)(val env, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4027,7 +4066,7 @@ val func_f1v(val env, val (*fun)(val env, val, val rest)) return obj; } -val func_f2v(val env, val (*fun)(val env, val, val, val rest)) +val func_f2v(val env, val (*fun)(val env, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4040,7 +4079,7 @@ val func_f2v(val env, val (*fun)(val env, val, val, val rest)) return obj; } -val func_f3v(val env, val (*fun)(val env, val, val, val, val rest)) +val func_f3v(val env, val (*fun)(val env, val, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4053,7 +4092,7 @@ val func_f3v(val env, val (*fun)(val env, val, val, val, val rest)) return obj; } -val func_f4v(val env, val (*fun)(val env, val, val, val, val, val rest)) +val func_f4v(val env, val (*fun)(val env, val, val, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4066,7 +4105,7 @@ val func_f4v(val env, val (*fun)(val env, val, val, val, val, val rest)) return obj; } -val func_n0v(val (*fun)(val rest)) +val func_n0v(val (*fun)(varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4079,7 +4118,7 @@ val func_n0v(val (*fun)(val rest)) return obj; } -val func_n1v(val (*fun)(val, val rest)) +val func_n1v(val (*fun)(val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4092,7 +4131,7 @@ val func_n1v(val (*fun)(val, val rest)) return obj; } -val func_n2v(val (*fun)(val, val, val rest)) +val func_n2v(val (*fun)(val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4105,7 +4144,7 @@ val func_n2v(val (*fun)(val, val, val rest)) return obj; } -val func_n3v(val (*fun)(val, val, val, val rest)) +val func_n3v(val (*fun)(val, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4118,7 +4157,7 @@ val func_n3v(val (*fun)(val, val, val, val rest)) return obj; } -val func_n4v(val (*fun)(val, val, val, val, val rest)) +val func_n4v(val (*fun)(val, val, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4131,7 +4170,7 @@ val func_n4v(val (*fun)(val, val, val, val, val rest)) return obj; } -val func_n5v(val (*fun)(val, val, val, val, val, val rest)) +val func_n5v(val (*fun)(val, val, val, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4144,7 +4183,7 @@ val func_n5v(val (*fun)(val, val, val, val, val, val rest)) return obj; } -val func_n6v(val (*fun)(val, val, val, val, val, val, val rest)) +val func_n6v(val (*fun)(val, val, val, val, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4157,7 +4196,7 @@ val func_n6v(val (*fun)(val, val, val, val, val, val, val rest)) return obj; } -val func_n7v(val (*fun)(val, val, val, val, val, val, val, val rest)) +val func_n7v(val (*fun)(val, val, val, val, val, val, val, varg)) { val obj = make_obj(); obj->f.type = FUN; @@ -4198,21 +4237,21 @@ val func_n4o(val (*fun)(val, val, val, val), int reqargs) return obj; } -val func_n1ov(val (*fun)(val, val rest), int reqargs) +val func_n1ov(val (*fun)(val, varg), int reqargs) { val obj = func_n1v(fun); obj->f.optargs = 1 - reqargs; return obj; } -val func_n2ov(val (*fun)(val, val, val rest), int reqargs) +val func_n2ov(val (*fun)(val, val, varg), int reqargs) { val obj = func_n2v(fun); obj->f.optargs = 2 - reqargs; return obj; } -val func_n3ov(val (*fun)(val, val, val, val rest), int reqargs) +val func_n3ov(val (*fun)(val, val, val, varg), int reqargs) { val obj = func_n3v(fun); obj->f.optargs = 3 - reqargs; @@ -4277,9 +4316,10 @@ static noreturn void callerror(val fun, val msg) abort(); } -val generic_funcall(val fun, val arg[], int nargs) +val generic_funcall(val fun, struct args *args_in) { int variadic, fixparam, reqargs; + struct args *args = args_in; switch (type(fun)) { case FUN: @@ -4291,21 +4331,24 @@ val generic_funcall(val fun, val arg[], int nargs) case STR: case LIT: case LSTR: - switch (nargs) { + bug_unless (args->argc >= ARGS_MIN); + args_normalize(args, 3); + + switch (args->fill) { case 0: callerror(fun, lit("missing required arguments")); case 1: - if (consp(arg[0])) { - cons_bind (x, y, arg[0]); + if (consp(args->arg[0])) { + cons_bind (x, y, args->arg[0]); if (atom(y)) return sub(fun, x, y); - return sel(fun, arg[0]); + return sel(fun, args->arg[0]); } - if (vectorp(arg[0])) - return sel(fun, arg[0]); - return ref(fun, arg[0]); + if (vectorp(args->arg[0])) + return sel(fun, args->arg[0]); + return ref(fun, args->arg[0]); case 2: - return sub(fun, arg[0], arg[1]); + return sub(fun, args->arg[0], args->arg[1]); default: callerror(fun, lit("too many arguments")); } @@ -4319,13 +4362,16 @@ val generic_funcall(val fun, val arg[], int nargs) break; case COBJ: if (fun->co.cls == hash_s) { - switch (nargs) { + bug_unless (args->argc >= ARGS_MIN); + args_normalize(args, 3); + + switch (args->fill) { case 0: callerror(fun, lit("missing required arguments")); case 1: - return gethash(fun, arg[0]); + return gethash(fun, args->arg[0]); case 2: - return gethash_n(fun, arg[0], arg[1]); + return gethash_n(fun, args->arg[0], args->arg[1]); default: callerror(fun, lit("too many arguments")); } @@ -4340,14 +4386,23 @@ val generic_funcall(val fun, val arg[], int nargs) reqargs = fixparam - fun->f.optargs; if (!variadic) { - if (nargs < reqargs) + val *arg = 0; + + if (args->argc < fixparam) { + args = args_alloc(fixparam); + args_init(args, fixparam); + args_copy_zap(args, args_in); + } + + args_normalize_fill(args, reqargs, fixparam); + + if (args->fill < reqargs) callerror(fun, lit("missing required arguments")); - if (nargs > fixparam) + if (args->list) callerror(fun, lit("too many arguments")); - for (; nargs < fixparam; ) - arg[nargs++] = colon_k; + arg = args->arg; switch (fun->f.functype) { case F0: @@ -4380,46 +4435,51 @@ val generic_funcall(val fun, val arg[], int nargs) internal_error("unsupported function type"); } } else { - val arglist = nil; + val *arg = 0; - if (nargs < reqargs) - callerror(fun, lit("missing required arguments")); + if (args->argc < fixparam) { + args = args_alloc(fixparam); + args_init(args, fixparam); + args_copy_zap(args, args_in); + } - for (; nargs < fixparam; ) - arg[nargs++] = colon_k; + args_normalize_fill(args, reqargs, fixparam); + + if (args->fill < reqargs) + callerror(fun, lit("missing required arguments")); - for (; nargs > fixparam; ) - arglist = cons(arg[--nargs], arglist); + arg = args->arg; + args_clear(args); switch (fun->f.functype) { case FINTERP: - return interp_fun(fun->f.env, fun->f.f.interp_fun, z(arglist)); + return interp_fun(fun->f.env, fun->f.f.interp_fun, args); case F0: - return fun->f.f.f0v(fun->f.env, z(arglist)); + return fun->f.f.f0v(fun->f.env, args); case F1: - return fun->f.f.f1v(fun->f.env, z(arg[0]), z(arglist)); + return fun->f.f.f1v(fun->f.env, z(arg[0]), args); case F2: - return fun->f.f.f2v(fun->f.env, z(arg[0]), z(arg[1]), z(arglist)); + return fun->f.f.f2v(fun->f.env, z(arg[0]), z(arg[1]), args); case F3: - return fun->f.f.f3v(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2]), z(arglist)); + return fun->f.f.f3v(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2]), args); case F4: - return fun->f.f.f4v(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arglist)); + return fun->f.f.f4v(fun->f.env, z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), args); case N0: - return fun->f.f.n0v(z(arglist)); + return fun->f.f.n0v(args); case N1: - return fun->f.f.n1v(z(arg[0]), z(arglist)); + return fun->f.f.n1v(z(arg[0]), args); case N2: - return fun->f.f.n2v(z(arg[0]), z(arg[1]), z(arglist)); + return fun->f.f.n2v(z(arg[0]), z(arg[1]), args); case N3: - return fun->f.f.n3v(z(arg[0]), z(arg[1]), z(arg[2]), z(arglist)); + return fun->f.f.n3v(z(arg[0]), z(arg[1]), z(arg[2]), args); case N4: - return fun->f.f.n4v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arglist)); + return fun->f.f.n4v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), args); case N5: - return fun->f.f.n5v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arglist)); + return fun->f.f.n5v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), args); case N6: - return fun->f.f.n6v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5]), z(arglist)); + return fun->f.f.n6v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5]), args); case N7: - return fun->f.f.n7v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5]), z(arg[6]), z(arglist)); + return fun->f.f.n7v(z(arg[0]), z(arg[1]), z(arg[2]), z(arg[3]), z(arg[4]), z(arg[5]), z(arg[6]), args); } } @@ -4433,19 +4493,25 @@ static noreturn void wrongargs(val fun) val funcall(val fun) { + struct args *args; + if (type(fun) != FUN || fun->f.optargs) { - val arg[32] = { nil }; - return generic_funcall(fun, arg, 0); + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + return generic_funcall(fun, args); } if (fun->f.variadic) { + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + switch (fun->f.functype) { case FINTERP: - return interp_fun(fun->f.env, fun->f.f.interp_fun, nil); + return interp_fun(fun->f.env, fun->f.f.interp_fun, args); case F0: - return fun->f.f.f0v(fun->f.env, nil); + return fun->f.f.f0v(fun->f.env, args); case N0: - return fun->f.f.n0v(nil); + return fun->f.f.n0v(args); default: break; } @@ -4464,24 +4530,33 @@ val funcall(val fun) val funcall1(val fun, val arg) { + struct args *args; + if (type(fun) != FUN || fun->f.optargs) { - val args[32]; - args[0] = z(arg); - return generic_funcall(fun, args, 1); + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + args_add(args, arg); + return generic_funcall(fun, args); } if (fun->f.variadic) { + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + switch (fun->f.functype) { case FINTERP: - return interp_fun(fun->f.env, fun->f.f.interp_fun, cons(arg, nil)); + args_add(args, arg); + return interp_fun(fun->f.env, fun->f.f.interp_fun, args); case F0: - return fun->f.f.f0v(fun->f.env, cons(arg, nil)); + args_add(args, arg); + return fun->f.f.f0v(fun->f.env, args); case N0: - return fun->f.f.n0v(cons(arg, nil)); + args_add(args, arg); + return fun->f.f.n0v(args); case F1: - return fun->f.f.f1v(fun->f.env, z(arg), nil); + return fun->f.f.f1v(fun->f.env, z(arg), args); case N1: - return fun->f.f.n1v(z(arg), nil); + return fun->f.f.n1v(z(arg), args); default: break; } @@ -4500,30 +4575,39 @@ val funcall1(val fun, val arg) val funcall2(val fun, val arg1, val arg2) { + struct args *args; + if (type(fun) != FUN || fun->f.optargs) { - val arg[32]; - arg[0] = z(arg1); - arg[1] = z(arg2); - return generic_funcall(fun, arg, 2); + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + args_add2(args, arg1, arg2); + return generic_funcall(fun, args); } if (fun->f.variadic) { + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + switch (fun->f.functype) { case FINTERP: - return interp_fun(fun->f.env, fun->f.f.interp_fun, - cons(z(arg1), cons(z(arg2), nil))); + args_add2(args, arg1, arg2); + return interp_fun(fun->f.env, fun->f.f.interp_fun, args); case F0: - return fun->f.f.f0v(fun->f.env, cons(z(arg1), cons(z(arg2), nil))); + args_add2(args, arg1, arg2); + return fun->f.f.f0v(fun->f.env, args); case N0: - return fun->f.f.n0v(cons(z(arg1), cons(z(arg2), nil))); + args_add2(args, arg1, arg2); + return fun->f.f.n0v(args); case F1: - return fun->f.f.f1v(fun->f.env, z(arg1), cons(z(arg2), nil)); + args_add(args, arg2); + return fun->f.f.f1v(fun->f.env, z(arg1), args); case N1: - return fun->f.f.n1v(z(arg1), cons(z(arg2), nil)); + args_add(args, arg2); + return fun->f.f.n1v(z(arg1), args); case F2: - return fun->f.f.f2v(fun->f.env, z(arg1), z(arg2), nil); + return fun->f.f.f2v(fun->f.env, z(arg1), z(arg2), args); case N2: - return fun->f.f.n2v(z(arg1), z(arg2), nil); + return fun->f.f.n2v(z(arg1), z(arg2), args); default: break; } @@ -4542,35 +4626,45 @@ val funcall2(val fun, val arg1, val arg2) val funcall3(val fun, val arg1, val arg2, val arg3) { + struct args *args; + if (type(fun) != FUN || fun->f.optargs) { - val arg[32]; - arg[0] = z(arg1); - arg[1] = z(arg2); - arg[2] = z(arg3); - return generic_funcall(fun, arg, 3); + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + args_add3(args, arg1, arg2, arg3); + return generic_funcall(fun, args); } if (fun->f.variadic) { + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + switch (fun->f.functype) { case FINTERP: - return interp_fun(fun->f.env, fun->f.f.interp_fun, - cons(z(arg1), cons(z(arg2), cons(z(arg3), nil)))); + args_add3(args, arg1, arg2, arg3); + return interp_fun(fun->f.env, fun->f.f.interp_fun, args); case F0: - return fun->f.f.f0v(fun->f.env, cons(z(arg1), cons(z(arg2), cons(z(arg3), nil)))); + args_add3(args, arg1, arg2, arg3); + return fun->f.f.f0v(fun->f.env, args); case N0: - return fun->f.f.n0v(cons(z(arg1), cons(z(arg2), cons(z(arg3), nil)))); + args_add3(args, arg1, arg2, arg3); + return fun->f.f.n0v(args); case F1: - return fun->f.f.f1v(fun->f.env, z(arg1), cons(z(arg2), cons(z(arg3), nil))); + args_add2(args, arg2, arg3); + return fun->f.f.f1v(fun->f.env, z(arg1), args); case N1: - return fun->f.f.n1v(z(arg1), cons(z(arg2), cons(z(arg3), nil))); + args_add2(args, arg2, arg3); + return fun->f.f.n1v(z(arg1), args); case F2: - return fun->f.f.f2v(fun->f.env, z(arg1), z(arg2), cons(z(arg3), nil)); + args_add(args, arg3); + return fun->f.f.f2v(fun->f.env, z(arg1), z(arg2), args); case N2: - return fun->f.f.n2v(z(arg1), z(arg2), cons(z(arg3), nil)); + args_add(args, arg3); + return fun->f.f.n2v(z(arg1), z(arg2), args); case F3: - return fun->f.f.f3v(fun->f.env, z(arg1), z(arg2), z(arg3), nil); + return fun->f.f.f3v(fun->f.env, z(arg1), z(arg2), z(arg3), args); case N3: - return fun->f.f.n3v(z(arg1), z(arg2), z(arg3), nil); + return fun->f.f.n3v(z(arg1), z(arg2), z(arg3), args); default: break; } @@ -4589,40 +4683,52 @@ val funcall3(val fun, val arg1, val arg2, val arg3) val funcall4(val fun, val arg1, val arg2, val arg3, val arg4) { + struct args *args; + if (type(fun) != FUN || fun->f.optargs) { - val arg[32]; - arg[0] = z(arg1); - arg[1] = z(arg2); - arg[2] = z(arg3); - arg[3] = z(arg4); - return generic_funcall(fun, arg, 4); + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + args_add4(args, arg1, arg2, arg3, arg4); + return generic_funcall(fun, args); } if (fun->f.variadic) { + args = args_alloc(ARGS_MIN); + args_init(args, ARGS_MIN); + switch (fun->f.functype) { case FINTERP: + args_add4(args, arg1, arg2, arg3, arg4); return interp_fun(fun->f.env, fun->f.f.interp_fun, - cons(z(arg1), cons(z(arg2), cons(z(arg3), cons(z(arg4), nil))))); + args); case F0: - return fun->f.f.f0v(fun->f.env, cons(z(arg1), cons(z(arg2), cons(z(arg3), cons(z(arg4), nil))))); + args_add4(args, arg1, arg2, arg3, arg4); + return fun->f.f.f0v(fun->f.env, args); case N0: - return fun->f.f.n0v(cons(z(arg1), cons(z(arg2), cons(z(arg3), cons(z(arg4), nil))))); + args_add4(args, arg1, arg2, arg3, arg4); + return fun->f.f.n0v(args); case F1: - return fun->f.f.f1v(fun->f.env, z(arg1), cons(z(arg2), cons(z(arg3), cons(z(arg4), nil)))); + args_add3(args, arg2, arg3, arg4); + return fun->f.f.f1v(fun->f.env, z(arg1), args); case N1: - return fun->f.f.n1v(z(arg1), cons(z(arg2), cons(z(arg3), cons(z(arg4), nil)))); + args_add3(args, arg2, arg3, arg4); + return fun->f.f.n1v(z(arg1), args); case F2: - return fun->f.f.f2v(fun->f.env, z(arg1), z(arg2), cons(z(arg3), cons(z(arg4), nil))); + args_add2(args, arg3, arg4); + return fun->f.f.f2v(fun->f.env, z(arg1), z(arg2), args); case N2: - return fun->f.f.n2v(z(arg1), z(arg2), cons(z(arg3), cons(z(arg4), nil))); + args_add2(args, arg3, arg4); + return fun->f.f.n2v(z(arg1), z(arg2), args); case F3: - return fun->f.f.f3v(fun->f.env, z(arg1), z(arg2), z(arg3), cons(z(arg4), nil)); + args_add(args, arg4); + return fun->f.f.f3v(fun->f.env, z(arg1), z(arg2), z(arg3), args); case N3: - return fun->f.f.n3v(z(arg1), z(arg2), z(arg3), cons(z(arg4), nil)); + args_add(args, arg4); + return fun->f.f.n3v(z(arg1), z(arg2), z(arg3), args); case F4: - return fun->f.f.f4v(fun->f.env, z(arg1), z(arg2), z(arg3), z(arg4), nil); + return fun->f.f.f4v(fun->f.env, z(arg1), z(arg2), z(arg3), z(arg4), args); case N4: - return fun->f.f.n4v(z(arg1), z(arg2), z(arg3), z(arg4), nil); + return fun->f.f.n4v(z(arg1), z(arg2), z(arg3), z(arg4), args); default: break; } @@ -4710,9 +4816,14 @@ val curry_12_1(val fun2, val arg2) return func_f1(cons(fun2, arg2), do_curry_12_1); } +static val do_curry_12_1_v(val fcons, struct args *args) +{ + return funcall2(car(fcons), args_get_list(args), cdr(fcons)); +} + static val curry_12_1_v(val fun2, val arg2) { - return func_f0v(cons(fun2, arg2), do_curry_12_1); + return func_f0v(cons(fun2, arg2), do_curry_12_1_v); } static val do_curry_123_3(val fcons, val arg3) @@ -4765,34 +4876,44 @@ val curry_1234_34(val fun4, val arg1, val arg2) return func_f2(cons(fun4, cons(arg1, arg2)), do_curry_1234_34); } -val transpose(val list) +val transposev(struct args *list) { val func = list_f; - switch (type(car(list))) { + if (!args_more(list, 0)) + return nil; + + switch (type(args_at(list, 0))) { case STR: case LSTR: case LIT: func = curry_12_1_v(func_n2(cat_str), nil); break; case VEC: - func = func_n0v(vector_list); + func = func_n0v(vectorv); break; default: break; } - return make_like(mapcarv(func, list), list); + return mapcarv(func, list); +} + +val transpose(val list) +{ + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, list); + return make_like(transposev(args), list); } -static val do_chain(val fun1_list, val args) +static val do_chain(val fun1_list, struct args *args) { val arg = nil; fun1_list = nullify(fun1_list); if (fun1_list) { - arg = apply(car(fun1_list), args, nil); + arg = generic_funcall(car(fun1_list), args); fun1_list = cdr(fun1_list); } @@ -4821,19 +4942,19 @@ val chain(val first_fun, ...) return func_f0v(out, do_chain); } -val chainv(val funlist) +val chainv(struct args *funlist) { - return func_f0v(nullify(funlist), do_chain); + return func_f0v(args_get_list(funlist), do_chain); } -static val do_chand(val fun1_list, val args) +static val do_chand(val fun1_list, struct args *args) { val arg = nil; fun1_list = nullify(fun1_list); if (fun1_list) { - arg = apply(car(fun1_list), args, nil); + arg = generic_funcall(car(fun1_list), args); fun1_list = cdr(fun1_list); } @@ -4844,29 +4965,35 @@ static val do_chand(val fun1_list, val args) } -val chandv(val funlist) +val chandv(struct args *funlist) { - return func_f0v(nullify(funlist), do_chand); + return func_f0v(args_get_list(funlist), do_chand); } -static val do_juxt(val funcs, val args) +static val do_juxt(val funcs, struct args *args) { - return mapcar(curry_123_1(func_n3(apply), args, nil), funcs); + return mapcar(curry_123_1(func_n3(apply), args_get_list(args), nil), funcs); } -val juxtv(val funlist) +val juxtv(struct args *funlist) { - return func_f0v(nullify(funlist), do_juxt); + return func_f0v(args_get_list(funlist), do_juxt); } -static val do_and(val fun1_list, val args) +static val do_and(val fun1_list, struct args *args_in) { - fun1_list = nullify(fun1_list); + cnum argc = args_in->argc; + struct args *args = args_alloc(argc); val ret = t; - for (; fun1_list; fun1_list = cdr(fun1_list)) - if (nilp((ret = apply(car(fun1_list), args, nil)))) + fun1_list = nullify(fun1_list); + args_init(args, argc); + + for (; fun1_list; fun1_list = cdr(fun1_list)) { + args_copy(args, args_in); + if (nilp((ret = generic_funcall(car(fun1_list), args)))) break; + } return ret; } @@ -4890,9 +5017,9 @@ val andf(val first_fun, ...) return func_f0v(out, do_and); } -val andv(val funlist) +val andv(struct args *funlist) { - return func_f0v(nullify(funlist), do_and); + return func_f0v(args_get_list(funlist), do_and); } static val do_swap_12_21(val fun, val left, val right) @@ -4905,14 +5032,20 @@ val swap_12_21(val fun) return func_f2(fun, do_swap_12_21); } -static val do_or(val fun1_list, val args) +static val do_or(val fun1_list, struct args *args_in) { - fun1_list = nullify(fun1_list); + cnum argc = args_in->argc; + struct args *args = args_alloc(argc); val ret = nil; - for (; fun1_list; fun1_list = cdr(fun1_list)) - if ((ret = apply(car(fun1_list), args, nil))) + fun1_list = nullify(fun1_list); + args_init(args, argc); + + for (; fun1_list; fun1_list = cdr(fun1_list)) { + args_copy(args, args_in); + if ((ret = generic_funcall(car(fun1_list), args))) break; + } return ret; } @@ -4936,14 +5069,14 @@ val orf(val first_fun, ...) return func_f0v(out, do_or); } -val orv(val funlist) +val orv(struct args *funlist) { - return func_f0v(nullify(funlist), do_or); + return func_f0v(args_get_list(funlist), do_or); } -static val do_not(val fun, val args) +static val do_not(val fun, struct args *args) { - return null(apply(fun, z(args), nil)); + return null(apply(fun, args_get_list(args), nil)); } val notf(val fun) @@ -4951,14 +5084,19 @@ val notf(val fun) return func_f0v(fun, do_not); } -static val do_iff(val env, val args) +static val do_iff(val env, struct args *args_in) { cons_bind (condfun, choices, env); cons_bind (thenfun, elsefun, choices); + cnum argc = args_in->argc; + struct args *args = args_alloc(argc); + + args_init(args, argc); + args_copy(args, args_in); - return if3(apply(condfun, args, nil), - apply(thenfun, z(args), nil), - if2(elsefun, apply(elsefun, z(args), nil))); + return if3(generic_funcall(condfun, args_in), + generic_funcall(thenfun, args), + if2(elsefun, generic_funcall(elsefun, args))); } val iff(val condfun, val thenfun, val elsefun) @@ -5095,6 +5233,17 @@ val size_vec(val vec) return vec->v.vec[vec_alloc]; } +val vectorv(struct args *args) +{ + cnum index = 0; + val vec = vector(zero, nil); + + while (args_more(args, index)) + vec_push(vec, args_get(args, &index)); + + return vec; +} + val vector_list(val list) { val vec = vector(zero, nil); @@ -5727,6 +5876,11 @@ val alist_remove(val list, val keys) return set_diff(list, keys, func_n2(alist_remove_test), nil); } +val alist_removev(val list, struct args *keys) +{ + return alist_remove(list, args_get_list(keys)); +} + val alist_remove1(val list, val key) { return alist_remove(list, cons(key, nil)); @@ -5746,6 +5900,11 @@ val alist_nremove(val list, val keys) return list; } +val alist_nremovev(val list, struct args *keys) +{ + return alist_nremove(list, args_get_list(keys)); +} + val alist_nremove1(val list, val key) { loc plist = mkcloc(list); @@ -6032,7 +6191,7 @@ static val multi_sort_less(val funcs_cons, val llist, val rlist) val multi_sort(val lists, val funcs, val key_funcs) { - val tuples = mapcarv(list_f, nullify(lists)); + val tuples = mapcarl(list_f, nullify(lists)); key_funcs = default_bool_arg(key_funcs); @@ -6042,7 +6201,7 @@ val multi_sort(val lists, val funcs, val key_funcs) tuples = sort_list(tuples, func_f2(cons(funcs, key_funcs), multi_sort_less), identity_f); - return mapcarv(list_f, tuples); + return mapcarl(list_f, tuples); } val sort_group(val seq, val keyfun, val lessfun) @@ -6054,9 +6213,9 @@ val sort_group(val seq, val keyfun, val lessfun) return partition_by(kf, sorted); } -val unique(val seq, val keyfun, val hashargs) +val unique(val seq, val keyfun, struct args *hashv_args) { - val hash = hashv(default_bool_arg(hashargs)); + val hash = hashv(hashv_args); val kf = default_arg(keyfun, identity_f); list_collect_decl (out, ptail); @@ -6090,7 +6249,10 @@ val unique(val seq, val keyfun, val hashargs) val uniq(val seq) { - return unique(seq, identity_f, cons(equal_based_k, nil)); + struct args *hashv_args = args_alloc(1); + args_init(hashv_args, 1); + args_add(hashv_args, equal_based_k); + return unique(seq, identity_f, hashv_args); } val find(val item, val list, val testfun, val keyfun) @@ -6921,7 +7083,7 @@ static void obj_init(void) car_f = func_n1(car); cdr_f = func_n1(cdr); null_f = func_n1(null); - list_f = func_n0v(identity); + list_f = func_n0v(listv); less_f = func_n2(less); greater_f = func_n2(greater); prog_string = string(progname); @@ -111,6 +111,8 @@ struct package { val symhash; }; +typedef struct args *varg; + struct func { obj_common; unsigned fixparam : 7; /* total non-variadic parameters */ @@ -134,19 +136,19 @@ struct func { val (*n5)(val, val, val, val, val); val (*n6)(val, val, val, val, val, val); val (*n7)(val, val, val, val, val, val, val); - val (*f0v)(val, val); - val (*f1v)(val, val, val); - val (*f2v)(val, val, val, val); - val (*f3v)(val, val, val, val, val); - val (*f4v)(val, val, val, val, val, val); - val (*n0v)(val); - val (*n1v)(val, val); - val (*n2v)(val, val, val); - val (*n3v)(val, val, val, val); - val (*n4v)(val, val, val, val, val); - val (*n5v)(val, val, val, val, val, val); - val (*n6v)(val, val, val, val, val, val, val); - val (*n7v)(val, val, val, val, val, val, val, val); + val (*f0v)(val, varg); + val (*f1v)(val, val, varg); + val (*f2v)(val, val, val, varg); + val (*f3v)(val, val, val, val, varg); + val (*f4v)(val, val, val, val, val, varg); + val (*n0v)(varg); + val (*n1v)(val, varg); + val (*n2v)(val, val, varg); + val (*n3v)(val, val, val, varg); + val (*n4v)(val, val, val, val, varg); + val (*n5v)(val, val, val, val, val, varg); + val (*n6v)(val, val, val, val, val, val, varg); + val (*n7v)(val, val, val, val, val, val, val, varg); } f; }; @@ -472,11 +474,12 @@ val nreverse(val in); val reverse(val in); val append2(val list1, val list2); val nappend2(val list1, val list2); -val appendv(val lists); -val nconcv(val lists); +val appendv(struct args *lists); +val nconcv(struct args *lists); val sub_list(val list, val from, val to); val replace_list(val list, val items, val from, val to); -val lazy_appendv(val lists); +val lazy_appendl(val lists); +val lazy_appendv(struct args *lists); val ldiff(val list1, val list2); val flatten(val list); val lazy_flatten(val list); @@ -508,7 +511,7 @@ val count_if(val pred, val list, val key); val some_satisfy(val list, val pred, val key); val all_satisfy(val list, val pred, val key); val none_satisfy(val list, val pred, val key); -val multi(val func, val lists); +val multi(val func, struct args *lists); val eql(val left, val right); val equal(val left, val right); mem_t *chk_malloc(size_t size); @@ -523,6 +526,7 @@ val make_lazy_cons(val func); val make_half_lazy_cons(val func, val car); val lcons_fun(val lcons); val list(val first, ...); /* terminated by nao */ +val listv(struct args *); val consp(val obj); val lconsp(val obj); val atom(val obj); @@ -542,15 +546,15 @@ val bignump(val num); val floatp(val num); val integerp(val num); val numberp(val num); -val nary_op(val (*cfunc)(val, val), val args, val emptyval); +val nary_op(val (*cfunc)(val, val), struct args *args, val emptyval); val plus(val anum, val bnum); -val plusv(val nlist); +val plusv(struct args *); val minus(val anum, val bnum); -val minusv(val minuend, val nlist); +val minusv(val minuend, struct args *nlist); val neg(val num); val abso(val num); val mul(val anum, val bnum); -val mulv(val nlist); +val mulv(struct args *); val trunc(val anum, val bnum); val mod(val anum, val bnum); val trunc_rem(val anum, val bnum); @@ -573,26 +577,28 @@ val lt(val anum, val bnum); val ge(val anum, val bnum); val le(val anum, val bnum); val numeq(val anum, val bnum); -val gtv(val first, val rest); -val ltv(val first, val rest); -val gev(val first, val rest); -val lev(val first, val rest); -val numeqv(val first, val rest); -val numneqv(val list); +val gtv(val first, struct args *rest); +val ltv(val first, struct args *rest); +val gev(val first, struct args *rest); +val lev(val first, struct args *rest); +val numeqv(val first, struct args *rest); +val numneqv(struct args *list); val max2(val a, val b); val min2(val a, val b); -val maxv(val first, val rest); -val minv(val first, val rest); +val maxv(val first, struct args *rest); +val minv(val first, struct args *rest); +val maxl(val first, val rest); +val minl(val first, val rest); val clamp(val low, val high, val num); val expt(val base, val exp); -val exptv(val nlist); +val exptv(struct args *nlist); val exptmod(val base, val exp, val mod); val sqroot(val anum); val isqrt(val anum); val gcd(val anum, val bnum); -val gcdv(val nlist); +val gcdv(struct args *nlist); val lcm(val anum, val bnum); -val lcmv(val nlist); +val lcmv(struct args *nlist); val floorf(val); val ceili(val); val sine(val); @@ -608,8 +614,8 @@ val logtwo(val num); val expo(val); val logand(val, val); val logior(val, val); -val logandv(val nlist); -val logiorv(val nlist); +val logandv(struct args *nlist); +val logiorv(struct args *nlist); val logxor(val, val); val logtest(val, val); val lognot(val, val); @@ -617,7 +623,7 @@ val logtrunc(val a, val bits); val sign_extend(val num, val nbits); val ash(val a, val bits); val bit(val a, val bit); -val maskv(val bits); +val maskv(struct args *bits); val string_own(wchar_t *str); val string(const wchar_t *str); val string_utf8(const char *str); @@ -660,10 +666,10 @@ val less(val left, val right); val greater(val left, val right); val lequal(val left, val right); val gequal(val left, val right); -val lessv(val first, val rest); -val greaterv(val first, val rest); -val lequalv(val first, val rest); -val gequalv(val first, val rest); +val lessv(val first, struct args *rest); +val greaterv(val first, struct args *rest); +val lequalv(val first, struct args *rest); +val gequalv(val first, struct args *rest); val chrp(val chr); wchar_t c_chr(val chr); val chr_isalnum(val ch); @@ -717,33 +723,33 @@ val func_n4(val (*fun)(val, val, val, val)); val func_n5(val (*fun)(val, val, val, val, val)); val func_n6(val (*fun)(val, val, val, val, val, val)); val func_n7(val (*fun)(val, val, val, val, val, val, val)); -val func_f0v(val, val (*fun)(val env, val rest)); -val func_f1v(val, val (*fun)(val env, val, val rest)); -val func_f2v(val, val (*fun)(val env, val, val, val rest)); -val func_f3v(val, val (*fun)(val env, val, val, val, val rest)); -val func_f4v(val, val (*fun)(val env, val, val, val, val, val rest)); -val func_n0v(val (*fun)(val rest)); -val func_n1v(val (*fun)(val, val rest)); -val func_n2v(val (*fun)(val, val, val rest)); -val func_n3v(val (*fun)(val, val, val, val rest)); -val func_n4v(val (*fun)(val, val, val, val, val rest)); -val func_n5v(val (*fun)(val, val, val, val, val, val rest)); -val func_n6v(val (*fun)(val, val, val, val, val, val, val rest)); -val func_n7v(val (*fun)(val, val, val, val, val, val, val, val rest)); +val func_f0v(val, val (*fun)(val env, varg)); +val func_f1v(val, val (*fun)(val env, val, varg)); +val func_f2v(val, val (*fun)(val env, val, val, varg)); +val func_f3v(val, val (*fun)(val env, val, val, val, varg)); +val func_f4v(val, val (*fun)(val env, val, val, val, val, varg)); +val func_n0v(val (*fun)(varg)); +val func_n1v(val (*fun)(val, varg)); +val func_n2v(val (*fun)(val, val, varg)); +val func_n3v(val (*fun)(val, val, val, varg)); +val func_n4v(val (*fun)(val, val, val, val, varg)); +val func_n5v(val (*fun)(val, val, val, val, val, varg)); +val func_n6v(val (*fun)(val, val, val, val, val, val, varg)); +val func_n7v(val (*fun)(val, val, val, val, val, val, val, varg)); val func_n1o(val (*fun)(val), int reqargs); val func_n2o(val (*fun)(val, val), int reqargs); val func_n3o(val (*fun)(val, val, val), int reqargs); val func_n4o(val (*fun)(val, val, val, val), int reqargs); -val func_n1ov(val (*fun)(val, val rest), int reqargs); -val func_n2ov(val (*fun)(val, val, val rest), int reqargs); -val func_n3ov(val (*fun)(val, val, val, val rest), int reqargs); +val func_n1ov(val (*fun)(val, varg), int reqargs); +val func_n2ov(val (*fun)(val, val, varg), int reqargs); +val func_n3ov(val (*fun)(val, val, val, varg), int reqargs); val func_interp(val env, val form); val func_get_form(val fun); val func_get_env(val fun); val func_set_env(val fun, val env); val functionp(val); val interp_fun_p(val); -val generic_funcall(val fun, val arg[], int nargs); +val generic_funcall(val fun, struct args *); val funcall(val fun); val funcall1(val fun, val arg); val funcall2(val fun, val arg1, val arg2); @@ -751,6 +757,7 @@ val funcall3(val fun, val arg1, val arg2, val arg3); val funcall4(val fun, val arg1, val arg2, val arg3, val arg4); val reduce_left(val fun, val list, val init, val key); val reduce_right(val fun, val list, val init, val key); +val transposev(struct args *lists); val transpose(val lists); /* The notation curry_12_2 means take some function f(arg1, arg2) and fix a value for argument 1 to create a g(arg2). @@ -763,13 +770,13 @@ val curry_123_1(val fun3, val arg2, val arg3); val curry_123_23(val fun3, val arg1); val curry_1234_34(val fun3, val arg1, val arg2); val chain(val first_fun, ...); -val chainv(val funlist); -val chandv(val funlist); -val juxtv(val funlist); +val chainv(struct args *funlist); +val chandv(struct args *funlist); +val juxtv(struct args *funlist); val andf(val first_fun, ...); -val andv(val funlist); +val andv(struct args *funlist); val orf(val first_fun, ...); -val orv(val funlist); +val orv(struct args *funlist); val notf(val fun); val iff(val condfun, val thenfun, val elsefun); val iffi(val condfun, val thenfun, val elsefun); @@ -783,6 +790,7 @@ loc vecref_l(val vec, val ind); val vec_push(val vec, val item); val length_vec(val vec); val size_vec(val vec); +val vectorv(struct args *); val vector_list(val list); val list_vector(val vector); val copy_vec(val vec); @@ -812,8 +820,10 @@ val acons_new_c(val key, loc new_p, loc list); val aconsql_new(val key, val value, val list); val aconsql_new_c(val key, loc new_p, loc list); val alist_remove(val list, val keys); +val alist_removev(val list, struct args *keys); val alist_remove1(val list, val key); val alist_nremove(val list, val keys); +val alist_nremovev(val list, struct args *keys); val alist_nremove1(val list, val key); val copy_cons(val cons); val copy_alist(val list); @@ -827,7 +837,7 @@ val merge(val list1, val list2, val lessfun, val keyfun); val sort(val seq, val lessfun, val keyfun); val multi_sort(val lists, val funcs, val key_funcs); val sort_group(val seq, val keyfun, val lessfun); -val unique(val seq, val keyfun, val hashargs); +val unique(val seq, val keyfun, struct args *hashv_args); val uniq(val seq); val find(val list, val key, val testfun, val keyfun); val find_if(val pred, val list, val key); @@ -50,11 +50,11 @@ #if HAVE_WINDOWS_H #include <windows.h> #endif +#include ALLOCA_H #include "lib.h" #include "gc.h" #include "signal.h" #include "unwind.h" -#include ALLOCA_H #include "args.h" #include "stream.h" #include "utf8.h" @@ -1863,6 +1863,11 @@ val make_catenated_stream(val stream_list) return cobj(coerce(mem_t *, s), stream_s, &cat_stream_ops.cobj_ops); } +val make_catenated_stream_v(struct args *streams) +{ + return make_catenated_stream(args_get_list(streams)); +} + val catenated_stream_p(val obj) { return if2(streamp(obj), c_true(obj->co.ops == &cat_stream_ops.cobj_ops)); @@ -2135,8 +2140,12 @@ static void vformat_str(val stream, val str, int width, enum align align, rel1(&str); } -static val aformat(val stream, val fmtstr, struct args *al) +val formatv(val stream_in, val fmtstr, struct args *al) { + uses_or2; + val stream = if3(stream_in == t, + std_output, + or2(stream_in, make_string_output_stream())); val save_indent = get_indent(stream); val save_mode = nil; val name = lit("format"); @@ -2503,7 +2512,7 @@ static val aformat(val stream, val fmtstr, struct args *al) uw_catch_end; - return t; + return (stream_in) ? t : get_string_from_stream(stream); } val vformat(val stream, val fmtstr, va_list vl) @@ -2515,7 +2524,7 @@ val vformat(val stream, val fmtstr, va_list vl) while ((arg = va_arg(vl, val)) != nao) args_add_checked(lit("format"), args, arg); - return aformat(stream, fmtstr, args); + return formatv(stream, fmtstr, args); } val vformat_to_string(val fmtstr, va_list vl) @@ -2543,27 +2552,6 @@ val format(val stream, val str, ...) } } -val formatv(val stream, val string, val arglist) -{ - uses_or2; - val st = if3(stream == t, - std_output, - or2(stream, make_string_output_stream())); - cnum argc = args_limit(lit("format"), c_num(length_list(arglist))); - struct args *args = args_alloc(argc); - val ret; - - class_check(st, stream_s); - args_init(args, argc); - - for (; arglist; arglist = cdr(arglist)) - args_add(args, car(arglist)); - - ret = aformat(st, string, args); - - return (stream) ? ret : get_string_from_stream(st); -} - static val put_indent(val stream, struct strm_ops *ops, cnum chars) { while (chars--) @@ -3293,7 +3281,7 @@ void stream_init(void) reg_fun(intern(lit("stream-set-prop"), user_package), func_n3(stream_set_prop)); reg_fun(intern(lit("stream-get-prop"), user_package), func_n2(stream_get_prop)); reg_fun(intern(lit("fileno"), user_package), curry_12_1(func_n2(stream_get_prop), fd_k)); - reg_fun(intern(lit("make-catenated-stream"), user_package), func_n0v(make_catenated_stream)); + reg_fun(intern(lit("make-catenated-stream"), user_package), func_n0v(make_catenated_stream_v)); reg_fun(intern(lit("cat-streams"), user_package), func_n1(make_catenated_stream)); reg_fun(intern(lit("catenated-stream-p"), user_package), func_n1(catenated_stream_p)); reg_fun(intern(lit("catenated-stream-push"), user_package), func_n2(catenated_stream_push)); @@ -126,7 +126,7 @@ val unget_byte(val byte, val stream); val vformat(val stream, val string, va_list); val vformat_to_string(val string, va_list); val format(val stream, val string, ...); -val formatv(val stream, val string, val args); +val formatv(val stream, val string, struct args *args); val put_string(val string, val stream); val put_line(val string, val stream); val put_char(val ch, val stream); @@ -150,6 +150,7 @@ val open_tail(val path, val mode_str, val seek_end_p); val open_command(val path, val mode_str); val open_process(val path, val mode_str, val args); val make_catenated_stream(val stream_list); +val make_catenated_stream_v(struct args *streams); val catenated_stream_p(val obj); val catenated_stream_push(val new_stream, val cat_stream); val remove_path(val path); @@ -24,6 +24,7 @@ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +#include <stddef.h> #include <stdio.h> #include <stdlib.h> #include <stdarg.h> @@ -33,10 +34,12 @@ #include <dirent.h> #include <syslog.h> #include "config.h" +#include ALLOCA_H #include "lib.h" #include "stream.h" #include "hash.h" #include "gc.h" +#include "args.h" #include "signal.h" #include "unwind.h" #include "utf8.h" @@ -80,7 +83,7 @@ void syslog_init(void) reg_fun(intern(lit("openlog"), user_package), func_n3o(openlog_wrap, 1)); reg_fun(intern(lit("closelog"), user_package), func_n0(closelog_wrap)); reg_fun(intern(lit("setlogmask"), user_package), func_n1(setlogmask_wrap)); - reg_fun(intern(lit("syslog"), user_package), func_n2v(syslog_wrap)); + reg_fun(intern(lit("syslog"), user_package), func_n2v(syslog_wrapv)); prio_k = intern(lit("prio"), keyword_package); @@ -109,7 +112,7 @@ val setlogmask_wrap(val mask) return num(setlogmask(c_num(mask))); } -val syslog_wrap(val prio, val fmt, val args) +val syslog_wrapv(val prio, val fmt, struct args *args) { val text = formatv(nil, fmt, args); char *u8text = utf8_dup_to(c_str(text)); @@ -117,6 +120,13 @@ val syslog_wrap(val prio, val fmt, val args) return nil; } +val syslog_wrap(val prio, val fmt, val arglist) +{ + struct args *args = args_alloc(ARGS_MIN); + args_init_list(args, ARGS_MIN, arglist); + return syslog_wrapv(prio, fmt, args); +} + val closelog_wrap(void) { closelog(); @@ -40,4 +40,5 @@ val openlog_wrap(val ident, val optmask, val facility); val closelog_wrap(void); val setlogmask_wrap(val mask); val syslog_wrap(val prio, val fmt, val args); +val syslog_wrapv(val prio, val fmt, struct args *args); val make_syslog_stream(val prio); @@ -24,6 +24,7 @@ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ +#include <stddef.h> #include <stdio.h> #include <stdlib.h> #include <string.h> @@ -35,6 +36,7 @@ #include "config.h" #include "lib.h" #include "gc.h" +#include "args.h" #include "stream.h" #include "txr.h" #include "signal.h" @@ -349,6 +351,11 @@ val uw_throw(val sym, val args) abort(); } +val uw_throwv(val sym, struct args *arglist) +{ + uw_throw(sym, args_get_list(arglist)); +} + val uw_throwf(val sym, val fmt, ...) { va_list vl; @@ -362,7 +369,7 @@ val uw_throwf(val sym, val fmt, ...) abort(); } -val uw_throwfv(val sym, val fmt, val args) +val uw_throwfv(val sym, val fmt, struct args *args) { val stream = make_string_output_stream(); (void) formatv(stream, fmt, args); @@ -383,7 +390,7 @@ val uw_errorf(val fmt, ...) abort(); } -val uw_errorfv(val fmt, val args) +val uw_errorfv(val fmt, struct args *args) { val stream = make_string_output_stream(); (void) formatv(stream, fmt, args); @@ -99,10 +99,11 @@ INLINE val uw_block_return(val tag, val result) } void uw_push_catch(uw_frame_t *, val matches); noreturn val uw_throw(val sym, val exception); +noreturn val uw_throwv(val sym, struct args *); noreturn val uw_throwf(val sym, val fmt, ...); -noreturn val uw_throwfv(val sym, val fmt, val args); +noreturn val uw_throwfv(val sym, val fmt, struct args *); noreturn val uw_errorf(val fmt, ...); -noreturn val uw_errorfv(val fmt, val args); +noreturn val uw_errorfv(val fmt, struct args *args); val uw_register_subtype(val sub, val super); val uw_exception_subtype_p(val sub, val sup); void uw_continue(uw_frame_t *curr, uw_frame_t *target); |