From cbb6c31b11992c715eb791067186cffc5d67b26a Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 22 Apr 2015 19:19:08 -0700 Subject: delay/force overhaul. * eval.c (promise_forced_s, promise_inprogress_s): New symbol variables. (me_delay): Change representation of promises so that the original delay form is stashed there for better reporting in the force function. Also, propagate the debug info from the second argument of the form to the entire form; otherwise it will inherit it from elsewhere. (force): Rewritten to follow new three-state representation to detect the recursive case and diagnose it. (eval_init): Register new symbol variables. --- ChangeLog | 15 +++++++++++++++ eval.c | 37 ++++++++++++++++++++++++++++++------- 2 files changed, 45 insertions(+), 7 deletions(-) diff --git a/ChangeLog b/ChangeLog index 90d84f1c..1025fa7e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,18 @@ +2015-04-22 Kaz Kylheku + + delay/force overhaul. + + * eval.c (promise_forced_s, promise_inprogress_s): New symbol + variables. + (me_delay): Change representation of promises so that the + original delay form is stashed there for better reporting + in the force function. Also, propagate the debug info + from the second argument of the form to the entire form; + otherwise it will inherit it from elsewhere. + (force): Rewritten to follow new three-state representation + to detect the recursive case and diagnose it. + (eval_init): Register new symbol variables. + 2015-04-21 Kaz Kylheku Version 106 diff --git a/eval.c b/eval.c index 35b1c2cc..9d9c7c2a 100644 --- a/eval.c +++ b/eval.c @@ -79,7 +79,8 @@ val dohash_s; val uw_protect_s, return_s, return_from_s; val list_s, append_s, apply_s, iapply_s; val gen_s, gun_s, generate_s, rest_s, plus_s; -val promise_s, op_s, ap_s, identity_s, apf_s, ipf_s; +val promise_s, promise_forced_s, promise_inprogress_s; +val op_s, ap_s, identity_s, apf_s, ipf_s; val ret_s, aret_s; val hash_lit_s, hash_construct_s; val vector_lit_s, vector_list_s; @@ -2163,9 +2164,12 @@ static val me_gun(val form, val menv) static val me_delay(val form, val menv) { (void) menv; + rlcp_tree(rest(form), second(form)); return list(cons_s, cons(quote_s, cons(promise_s, nil)), - cons(lambda_s, cons(nil, rest(form))), nao); + list(cons_s, cons(lambda_s, cons(nil, rest(form))), + cons(quote_s, cons(form, nil)), nao), + nao); } static val me_pprof(val form, val menv) @@ -3630,11 +3634,28 @@ static val weavev(val lists) static val force(val promise) { - if (car(promise) != promise_s) - return cdr(promise); - - rplaca(promise, nil); - return cdr(rplacd(promise, funcall(cdr(promise)))); + loc pstate = car_l(promise); + val cd = cdr(promise); + loc pval = car_l(cd); + + if (deref(pstate) == promise_forced_s) { + return deref(pval); + } else if (deref(pstate) == promise_s) { + val ret; + /* Safe: promise symbols are older generation */ + deref(pstate) = promise_inprogress_s; + ret = funcall(deref(pval)); + deref(pstate) = promise_forced_s; + deref(pval) = ret; + return ret; + } else if (deref(pstate) == promise_inprogress_s) { + val form = second(cdr(cd)); + val sloc = source_loc_str(form); + eval_error(nil, lit("force: recursion forcing delayed form ~s (~a)"), + form, sloc, nao); + } else { + uw_throwf(error_s, lit("force: ~s is not a promise"), promise, nao); + } } static void reg_op(val sym, opfun_t fun) @@ -3894,6 +3915,8 @@ void eval_init(void) gun_s = intern(lit("gun"), user_package); generate_s = intern(lit("generate"), user_package); promise_s = intern(lit("promise"), system_package); + promise_forced_s = intern(lit("promise-forced"), system_package); + promise_inprogress_s = intern(lit("promise-inprogress"), system_package); op_s = intern(lit("op"), user_package); ap_s = intern(lit("ap"), user_package); do_s = intern(lit("do"), user_package); -- cgit v1.2.3