diff options
| -rw-r--r-- | ChangeLog | 19 | ||||
| -rw-r--r-- | eval.c | 5 | ||||
| -rw-r--r-- | lib.c | 42 | ||||
| -rw-r--r-- | lib.h | 4 | ||||
| -rw-r--r-- | txr.1 | 6 | ||||
| -rw-r--r-- | txr.vim | 3 |
6 files changed, 72 insertions, 7 deletions
@@ -1,5 +1,24 @@ 2012-03-16 Kaz Kylheku <kaz@kylheku.com> + * eval.c (eval_init): New intrinsic functions + chain, andf, orf, iff. + + * lib.c (chainv): New function. + (do_and, do_or): Generalized to handle functions of + any arguments via apply. + (andf, orf): Turn do_and and do_or into variadic function instead of a + monadic function. + (do_iff): New static function. + (andv, orv, iff): New functions. + + * lib.h (chainv, andv, orv, iff): New functions declared. + + * txr.1: Doc stubs created. + + * txr.vim: Updated. + +2012-03-16 Kaz Kylheku <kaz@kylheku.com> + * lib.c (quicksort): Bugfix: incorrect loop from 0 rather than from leading to unbounded recursion. @@ -2227,6 +2227,11 @@ void eval_init(void) reg_fun(intern(lit("eval"), user_package), func_n2o(eval_intrinsic, 1)); + reg_fun(intern(lit("chain"), user_package), func_n0v(chainv)); + reg_fun(intern(lit("andf"), user_package), func_n0v(andv)); + reg_fun(intern(lit("orf"), user_package), func_n0v(orv)); + reg_fun(intern(lit("iff"), user_package), func_n3o(iff, 2)); + reg_var(intern(lit("*stdout*"), user_package), &std_output); reg_var(intern(lit("*stddebug*"), user_package), &std_debug); reg_var(intern(lit("*stdin*"), user_package), &std_input); @@ -2842,10 +2842,15 @@ val chain(val first_fun, ...) return func_f1(out, do_chain); } -static val do_and(val fun1_list, val arg) +val chainv(val funlist) +{ + return func_f1(funlist, do_chain); +} + +static val do_and(val fun1_list, val args) { for (; fun1_list; fun1_list = cdr(fun1_list)) - if (nullp(funcall1(car(fun1_list), arg))) + if (nullp(apply(car(fun1_list), args, nil))) return nil; return t; @@ -2867,7 +2872,12 @@ val andf(val first_fun, ...) va_end (vl); } - return func_f1(out, do_and); + return func_f0v(out, do_and); +} + +val andv(val funlist) +{ + return func_f0v(funlist, do_and); } static val do_swap_12_21(val fun, val left, val right) @@ -2880,10 +2890,10 @@ val swap_12_21(val fun) return func_f2(fun, do_swap_12_21); } -static val do_or(val fun1_list, val arg) +static val do_or(val fun1_list, val args) { for (; fun1_list; fun1_list = cdr(fun1_list)) - if (funcall1(car(fun1_list), arg)) + if (apply(car(fun1_list), args, nil)) return t; return nil; @@ -2905,7 +2915,27 @@ val orf(val first_fun, ...) va_end (vl); } - return func_f1(out, do_or); + return func_f0v(out, do_or); +} + +val orv(val funlist) +{ + return func_f0v(funlist, do_or); +} + +static val do_iff(val env, val args) +{ + cons_bind (condfun, choices, env); + cons_bind (thenfun, elsefun, choices); + + return if3(apply(condfun, args, nil), + apply(thenfun, args, nil), + if2(elsefun, apply(elsefun, args, nil))); +} + +val iff(val condfun, val elsefun, val thenfun) +{ + return func_f0v(cons(condfun, cons(elsefun, thenfun)), do_iff); } val vector(val length) @@ -517,8 +517,12 @@ 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 andf(val first_fun, ...); +val andv(val funlist); val orf(val first_fun, ...); +val orv(val funlist); +val iff(val condfun, val thenfun, val elsefun); val swap_12_21(val fun); val vector(val length); val vectorp(val vec); @@ -6673,6 +6673,12 @@ Certain object types have a custom equal function. .SS Function eval +.SS Function chain + +.SS Functions andf and orf + +.SS Function iff + .SS Variables *stdout*, *stddebug*, *stdin* and *stderr* .SS Function format @@ -49,7 +49,8 @@ syn keyword txl_keyword contained zerop evenp oddp > < >= <= max min syn keyword txl_keyword contained search-regex match-regex regsub syn keyword txl_keyword contained make-hash hash hash-construct gethash sethash pushhash remhash syn keyword txl_keyword contained hash-count get-hash-userdata set-hash-userdata hashp maphash -syn keyword txl_keyword contained hash-eql hash-equal eval *stdout* *stdin* *stddebug* +syn keyword txl_keyword contained hash-eql hash-equal eval chain andf orf iff +syn keyword txl_keyword contained *stdout* *stdin* *stddebug* syn keyword txl_keyword contained *stderr* format print pprint tostring tostringp syn keyword txl_keyword contained make-string-input-stream syn keyword txl_keyword contained make-string-byte-input-stream make-string-output-stream |