diff options
| -rw-r--r-- | ChangeLog | 26 | ||||
| -rw-r--r-- | eval.c | 228 | ||||
| -rw-r--r-- | lib.c | 62 | ||||
| -rw-r--r-- | lib.h | 4 | ||||
| -rw-r--r-- | txr.1 | 140 | ||||
| -rw-r--r-- | txr.vim | 7 |
6 files changed, 451 insertions, 16 deletions
@@ -1,3 +1,29 @@ +2012-01-10 Kaz Kylheku <kaz@kylheku.com> + + Spat of new features having to do with lazy processing. + + * eval.c (prog1_s, gen_s, generate_s, delay_s, promise_s): New symbol + variables. + (eval_prog1, op_prog1, expand_gen, expand_delay): New static functions. + (expand): Handle gen and delay. + (lazy_mapcar_func, lazy_mapcar, lazy_mapcarv_func, lazy_mapcarv, + lazy_mappendv): New static functions. + (rangev_func, rangev, generate_func, generate, repeat_infinite_func, + repeat_times_func, repeatv, force): New static functions. + (eval_init): New operators and functions interned. + lazy-flatten renamed to flatten*. + + * lib.c (null_f): New global variable. + (ltail, lazy_appendv): New functions. + (lazy_appendv_func): New static function. + (obj_init): null_f protected and initialized. + + * lib.h (null_f, ltail, lazy_appendv): Declared. + + * txr.1: Documented. + + * txr.vim: Updated. + 2012-01-09 Kaz Kylheku <kaz@kylheku.com> Non-broken way to achieve intent of previous commit. @@ -51,11 +51,12 @@ val top_vb, top_fb; val op_table; val eval_error_s; -val progn_s, let_s, let_star_s, lambda_s, call_s; +val progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s; val cond_s, if_s, defvar_s, defun_s; val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, vecref_s; val for_s, for_star_s, dohash_s, uw_protect_s, return_s, return_from_s; -val list_s, append_s, apply_s; +val list_s, append_s, apply_s, gen_s, generate_s; +val delay_s, promise_s; val make_env(val vbindings, val fbindings, val up_env) { @@ -373,6 +374,21 @@ val eval_progn(val forms, val env, val ctx_form) return retval; } +static val eval_prog1(val forms, val env, val ctx_form) +{ + val retval = nil; + + if (forms) { + retval = eval(car(forms), env, ctx_form); + forms = cdr(forms); + } + + for (; forms; forms = cdr(forms)) + eval(car(forms), env, ctx_form); + + return retval; +} + static val op_quote(val form, val env) { return second(form); @@ -430,6 +446,11 @@ static val op_progn(val form, val env) return eval_progn(rest(form), env, form); } +static val op_prog1(val form, val env) +{ + return eval_prog1(rest(form), env, form); +} + static val op_let(val form, val env) { val let = first(form); @@ -968,6 +989,20 @@ static val expand_quasi(val quasi_forms) } } +static val expand_gen(val args) +{ + return list(generate_s, + list(lambda_s, nil, first(args), nao), + list(lambda_s, nil, second(args), nao), nao); +} + +static val expand_delay(val args) +{ + return list(cons_s, + cons(quote_s, cons(promise_s, nil)), + cons(lambda_s, cons(nil, args)), nao); +} + val expand(val form) { if (atom(form)) { @@ -1089,9 +1124,14 @@ val expand(val form) if (quasi == quasi_ex) return form; return rlcp(cons(sym, quasi_ex), form); + } else if (sym == gen_s) { + return expand(expand_gen(rest(form))); + } else if (sym == delay_s) { + return expand(expand_delay(rest(form))); } else { - /* funtion call */ - /* also handles: progn, call, if, and, or, unwind-protect, return */ + /* funtion call + also handles: progn, prog1, call, if, and, or, + unwind-protect, return */ val args = rest(form); val args_ex = expand_forms(args); @@ -1153,11 +1193,176 @@ static val mappendv(val fun, val list_of_lists) } } +static val lazy_mapcar_func(val env, val lcons) +{ + cons_bind (fun, list, env); + + rplaca(lcons, funcall1(fun, car(list))); + rplacd(env, cdr(list)); + + if (cdr(list)) + rplacd(lcons, make_lazy_cons(lcons_fun(lcons))); + else + rplacd(lcons, nil); + return nil; +} + +static val lazy_mapcar(val fun, val list) +{ + if (!list) + return nil; + return make_lazy_cons(func_f1(cons(fun, list), lazy_mapcar_func)); +} + +static val lazy_mapcarv_func(val env, val lcons) +{ + cons_bind (fun, lofl, env); + val args = mapcar(car_f, lofl); + val next = mapcar(cdr_f, lofl); + + rplaca(lcons, apply(fun, args, nil)); + rplacd(env, next); + + if (all_satisfy(next, identity_f, identity_f)) + rplacd(lcons, make_lazy_cons(lcons_fun(lcons))); + else + rplacd(lcons, nil); + return nil; +} + +static val lazy_mapcarv(val fun, val list_of_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)) { + return nil; + } else { + val lofl = copy_list(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) +{ + return lazy_appendv(lazy_mapcarv(fun, list_of_lists)); +} + static val symbol_function(val sym) { return lookup_fun(nil, sym); } +static val rangev_func(val env, val lcons) +{ + cons_bind (from, to_step, env); + cons_bind (to, step, to_step); + + rplaca(lcons, from); + + if (equal(from, to)) { + rplacd(lcons, nil); + return nil; + } + + if (functionp(step)) + rplaca(env, funcall1(step, from)); + else + rplaca(env, plus(from, step)); + rplacd(lcons, make_lazy_cons(lcons_fun(lcons))); + return nil; +} + +static val rangev(val args) +{ + uses_or2; + val from = or2(first(args), zero); + val to = second(args); + val step = or2(third(args), one); + val env = cons(from, cons(to, step)); + + return make_lazy_cons(func_f1(env, rangev_func)); +} + +static val generate_func(val env, val lcons) +{ + cons_bind (while_pred, gen_fun, env); + + if (!funcall(while_pred)) { + rplacd(lcons, nil); + } else { + val next_item = funcall(gen_fun); + val lcons_next = make_lazy_cons(lcons_fun(lcons)); + rplacd(lcons, lcons_next); + rplaca(lcons_next, next_item); + } + return nil; +} + +static val generate(val while_pred, val gen_fun) +{ + val first_item = funcall(gen_fun); + if (!funcall(while_pred)) { + return nil; + } else { + val lc = make_lazy_cons(func_f1(cons(while_pred, gen_fun), generate_func)); + rplaca(lc, first_item); + return lc; + } +} + +static val repeat_infinite_func(val env, val lcons) +{ + if (!car(env)) + rplaca(env, cdr(env)); + rplaca(lcons, pop(car_l(env))); + rplacd(lcons, make_lazy_cons(lcons_fun(lcons))); + return nil; +} + +static val repeat_times_func(val env, val lcons) +{ + cons_bind (stack, list_count, env); + cons_bind (list, count, list_count); + + if (!stack) { + rplaca(env, list); + rplacd(list_count, count = minus(count, one)); + } + + rplaca(lcons, pop(car_l(env))); + + if (!car(env) && count == one) { + rplacd(lcons, nil); + return nil; + } + + rplacd(lcons, make_lazy_cons(lcons_fun(lcons))); + return nil; +} + +static val repeatv(val list, val rest) +{ + if (!list) + return nil; + if (rest) { + val count = car(rest); + if (count == zero) + return nil; + return make_lazy_cons(func_f1(cons(list, cons(list, count)), + repeat_times_func)); + } + return make_lazy_cons(func_f1(cons(list, list), repeat_infinite_func)); +} + +static val force(val promise) +{ + if (car(promise) != promise_s) + return cdr(promise); + + rplaca(promise, nil); + return rplacd(promise, funcall(cdr(promise))); +} + static void reg_fun(val sym, val fun) { sethash(top_fb, sym, cons(sym, fun)); @@ -1176,6 +1381,7 @@ void eval_init(void) op_table = make_hash(nil, nil, nil); progn_s = intern(lit("progn"), user_package); + prog1_s = intern(lit("prog1"), user_package); let_s = intern(lit("let"), user_package); let_star_s = intern(lit("let*"), user_package); lambda_s = intern(lit("lambda"), user_package); @@ -1202,12 +1408,17 @@ 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); + gen_s = intern(lit("gen"), user_package); + generate_s = intern(lit("generate"), user_package); + delay_s = intern(lit("delay"), user_package); + promise_s = intern(lit("promise"), system_package); sethash(op_table, quote_s, cptr((mem_t *) op_quote)); sethash(op_table, qquote_s, cptr((mem_t *) op_qquote_error)); sethash(op_table, unquote_s, cptr((mem_t *) op_unquote_error)); sethash(op_table, splice_s, cptr((mem_t *) op_unquote_error)); sethash(op_table, progn_s, cptr((mem_t *) op_progn)); + sethash(op_table, prog1_s, cptr((mem_t *) op_prog1)); sethash(op_table, let_s, cptr((mem_t *) op_let)); sethash(op_table, let_star_s, cptr((mem_t *) op_let)); sethash(op_table, lambda_s, cptr((mem_t *) op_lambda)); @@ -1257,7 +1468,9 @@ void eval_init(void) reg_fun(intern(lit("length-list"), user_package), func_n1(length_list)); reg_fun(intern(lit("mapcar"), user_package), func_n1v(mapcarv)); + reg_fun(intern(lit("mapcar*"), user_package), func_n1v(lazy_mapcarv)); 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_n2(apply_intrinsic)); reg_fun(intern(lit("reduce-left"), user_package), func_n4(reduce_left)); reg_fun(intern(lit("reduce-right"), user_package), func_n4(reduce_right)); @@ -1272,7 +1485,7 @@ void eval_init(void) reg_fun(intern(lit("reverse"), user_package), func_n1(reverse)); reg_fun(intern(lit("ldiff"), user_package), func_n2(ldiff)); reg_fun(intern(lit("flatten"), user_package), func_n1(flatten)); - reg_fun(intern(lit("lazy-flatten"), user_package), func_n1(lazy_flatten)); + reg_fun(intern(lit("flatten*"), user_package), func_n1(lazy_flatten)); reg_fun(intern(lit("memq"), user_package), func_n2(memq)); reg_fun(intern(lit("memql"), user_package), func_n2(memql)); reg_fun(intern(lit("memqual"), user_package), func_n2(memqual)); @@ -1445,6 +1658,11 @@ void eval_init(void) reg_fun(intern(lit("random-fixnum"), user_package), func_n1(random_fixnum)); reg_fun(intern(lit("random"), user_package), func_n2(random)); + reg_fun(intern(lit("range"), user_package), func_n0v(rangev)); + reg_fun(generate_s, func_n2(generate)); + reg_fun(intern(lit("repeat"), user_package), func_n1v(repeatv)); + reg_fun(intern(lit("force"), user_package), func_n1(force)); + eval_error_s = intern(lit("eval-error"), user_package); uw_register_subtype(eval_error_s, error_s); } @@ -82,7 +82,7 @@ val null_string; val nil_string; val null_list; -val identity_f, equal_f, eql_f, eq_f, car_f, cdr_f; +val identity_f, equal_f, eql_f, eq_f, car_f, cdr_f, null_f; val gensym_counter; @@ -308,6 +308,13 @@ val *tail(val cons) return cdr_l(cons); } +val *ltail(val *cons) +{ + while (cdr(*cons)) + cons = cdr_l(*cons); + return cons; +} + val pop(val *plist) { val ret = car(*plist); @@ -394,6 +401,56 @@ val nappend2(val list1, val list2) return out; } +static val lazy_appendv_func(val env, val lcons) +{ + cons_bind (last, lists, env); + val nonempty = nil; + + while (lists) { + nonempty = pop(&lists); + if (nonempty) + break; + } + + rplaca(lcons, last); + + if (atom(nonempty)) { + rplacd(lcons, nonempty); + return nil; + } + + rplacd(env, lists); + + { + val *ptail = ltail(&nonempty); + rplaca(env, car(*ptail)); + *ptail = make_lazy_cons(lcons_fun(lcons)); + rplacd(lcons, nonempty); + } + return nil; +} + +val lazy_appendv(val lists) +{ + val nonempty = nil; + + while (lists) { + nonempty = pop(&lists); + if (nonempty) + break; + } + + if (atom(nonempty)) + return nonempty; + + { + val *ptail = ltail(&nonempty); + *ptail = make_lazy_cons(func_f1(cons(car(*ptail), lists), + lazy_appendv_func)); + return nonempty; + } +} + val ldiff(val list1, val list2) { list_collect_decl (out, ptail); @@ -3166,7 +3223,7 @@ static void obj_init(void) protect(&packages, &system_package, &keyword_package, &user_package, &null_string, &nil_string, - &null_list, &equal_f, &eq_f, &eql_f, &car_f, &cdr_f, + &null_list, &equal_f, &eq_f, &eql_f, &car_f, &cdr_f, &null_f, &identity_f, &prog_string, &env_list, (val *) 0); @@ -3284,6 +3341,7 @@ static void obj_init(void) identity_f = func_n1(identity); car_f = func_n1(car); cdr_f = func_n1(cdr); + null_f = func_n1(nullp); gensym_counter = zero; prog_string = string(progname); } @@ -296,7 +296,7 @@ extern val nothrow_k, args_k; extern val null_string; extern val null_list; /* (nil) */ -extern val identity_f, equal_f, eql_f, eq_f, car_f, cdr_f; +extern val identity_f, equal_f, eql_f, eq_f, car_f, cdr_f, null_f; extern val gensym_counter; @@ -325,6 +325,7 @@ val fourth(val cons); val fifth(val cons); val sixth(val cons); val *tail(val cons); +val *ltail(val *cons); val pop(val *plist); val push(val v, val *plist); val copy_list(val list); @@ -333,6 +334,7 @@ val reverse(val in); val append2(val list1, val list2); val nappend2(val list1, val list2); val appendv(val lists); +val lazy_appendv(val lists); val ldiff(val list1, val list2); val flatten(val list); val lazy_flatten(val list); @@ -4394,12 +4394,13 @@ alternative1 | alternative2 | ... | alternativeN Multiple syntactic variations allowed in one place are indicated as bar-separated items. -.SS Operator progn +.SS Operators progn and prog1 .TP Syntax: (progn <form>*) + (prog1 <form>*) .TP Description @@ -4407,6 +4408,9 @@ Description The progn operator evaluates forms in order, and returns the value of the last form. The return value of (progn) is nil. +The prog1 operator evaluates forms in order, and returns the value +of the first form. The return value of (prog1) is nil. + Various other operators such as let also arrange for the evaluation of a body of forms, the value of the last of which is returned. These operators are said to feature an "implicit progn". @@ -4951,6 +4955,99 @@ Here, the output produced is "abc". The value of b is not printed because the return-from terminates block foo, and so the second pprint form is not evaluated. +.SS Operator delay + +.TP +Syntax: + + (delay <expression>) + +.TP +Description: + +The delay operator arranges for the delayed (or "lazy") evaluation of +<expression>. This means that the expression is not evaluated immediately. +Rather, the delay expression produces a promise object. + +The promise object can later be passed to the force function (described +later in this document). The force function will trigger the evaluation +of the expression and retrieve the value. + +The expression is evaluated in the original scope, no mater where +the force takes place. + +The expression is evaluated at most once, by the first call to force. +Additional calls to force only retrieve a cached value. + +.TP +Example: + + @(do + ;; list is popped only once: the value is computed + ;; just once when force is called on a given promise + ;; for the first time. + + (defun get-it (promise) + (format t "*list* is ~s\en" *list*) + (format t "item is ~s\en" (force promise)) + (format t "item is ~s\en" (force promise)) + (format t "*list* is ~s\en" *list*)) + + + (defvar *list* '(1 2 3)) + + (get-it (delay (pop *list*)))) + + Output: + + *list* is (1 2 3) + item is 1 + item is 1 + *list* is (2 3) + +.SS Operator gen + +.TP +Syntax: + + (gen <while-expression> <produce-item-expression>) + +.TP +Description: + +The gen operator produces a lazy list, in a manner similar to the generate +function. Whereas the generate function (documented later in this manual) +takes functional arguments, the gen operator takes two expressions, which is +often more convenient. + +The return value of gen is a lazy list. When the lazy list is accessed, for +instance with the functions car and cdr, it produces items on demand. Prior to +producing each item, the <while-expression> is evaluated, in its original +lexical scope. If the expression yields true, then <produce-item-expression> +is evaluated, and its return value is incorporated as the next item of the lazy +list. If the expression yields false, then the lazy list immediately +terminates. + +The gen operator itself immediately evaluates <while-expression> before +producing the lazy list. If the expression yields false, then the operator +returns the empty list nil. Otherwise, it instantiates the lazy list and +invokes the <produce-item-expression> to force the first item. + +.TP + +Example: + + @(do + ;; Make a lazy list of integers up to 1000 + ;; access and print the first three. + (let* ((counter 0) + (list (gen (< counter 1000) (inc counter)))) + (format t "~s ~s ~s\en" (pop list) (pop list) (pop list)))) + + Output: + 1 2 3 + + .SS Lisp Functions and Variables When the first element of a compound form is a symbol denoting a function, @@ -5434,13 +5531,15 @@ Description: The length-list function returns the length of a proper or improper list. The length of a list is the number of conses in that list. -.SS Functions mapcar and mappend +.SS Functions mapcar, mappend, mapcar* and mappend* .TP Syntax: (mapcar <function> <list> <list>*) (mappend <function> <list> <list>*) + (mapcar* <function> <list> <list>*) + (mappend* <function> <list> <list>*) .TP Description: @@ -5464,6 +5563,27 @@ are catenated with append, and the resulting list is returned. That is to say, (mappend f a b c) is equivalent to (apply (fun append) (mapcar f a b c)). +The mapcar* and mappend* functions work like mapcar and mappend, respectively. +However, they return lazy lists rather than generating the entire +output list prior to returning. + +.TP +Caveats: + +Like mappend, mappend* must "consume" empty lists. For instance, +if the function being mapped put out a sequence of nil values, +then the result must be the empty list nil, because +(append nil nil nil nil ...) is nil. + +Suppose that mappend* is used on inputs which are infinite lazy +lists, such that the function returns nil values indefinitely. +For instance: + + ;; Danger: infinite loop!!! + (mappend* (fun identity) (repeat '(nil))) + +The mappend* function is caught in a loop trying to consume +and squash an infinite stream of nil values. .TP Examples: @@ -5646,21 +5766,21 @@ Examples: (ldiff a b)) -> (1) -.SS Functions flatten, lazy-flatten +.SS Functions flatten, flatten* .TP Syntax: (flatten <list>) - (lazy-flatten <list>) + (flatten* <list>) .TP Description: The flatten function produces a list whose elements are all of the non-nil -atoms contained in the structure of <list>. The lazy-flatten function +atoms contained in the structure of <list>. The flatten* function works like flatten except that flatten creates and returns a complete -flattened list, whereas lazy-flatten produces a lazy list which is +flattened list, whereas flatten* produces a lazy list which is instantiated on demand. This is particularly useful when the input structure is itself lazy. @@ -6054,6 +6174,14 @@ Certain object types have a custom equal function. .SS Functions random-fixnum and random +.SS Function force + +.SS Function range + +.SS Function generate + +.SS Function repeat + .SH APPENDIX A: NOTES ON EXOTIC REGULAR EXPRESSIONS Users familiar with regular expressions may not be familiar with the complement @@ -25,16 +25,17 @@ syn keyword txr_keyword contained repeat rep first last single empty mod modlast syn keyword txr_keyword contained define try catch finally throw syn keyword txr_keyword contained defex throw deffilter filter eof eol do -syn keyword txl_keyword contained progn let syn let* lambda call fun +syn keyword txl_keyword contained progn prog1 let syn let* lambda call fun syn keyword txl_keyword contained cond if and or syn keyword txl_keyword contained defvar defun inc dec set push pop flip syn keyword txl_keyword contained for for* dohash unwind-protect block -syn keyword txl_keyword contained return return-from +syn keyword txl_keyword contained return return-from gen delay syn keyword txl_keyword contained cons make-lazy-cons lcons-fun car cdr syn keyword txl_keyword contained rplaca rplacd first rest append list syn keyword txl_keyword contained identity typeof atom null not consp listp syn keyword txl_keyword contained proper-listp length-list mapcar mappend apply +syn keyword txl_keyword contained mapcar* mappend* syn keyword txl_keyword contained reduce-left reduce-right syn keyword txl_keyword contained second third fourth fifth sixth copy-list nreverse syn keyword txl_keyword contained reverse ldiff flatten lazy-flatten @@ -76,6 +77,8 @@ syn keyword txl_keyword contained functionp interp-fun-p *random-state* syn keyword txl_keyword contained make-random-state random-state-p syn keyword txl_keyword contained random-fixnum random +syn keyword txl_keyword contained range generate repeat force + syn match txr_hash "#" contained syn match txr_quote "[,']" contained |