summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog15
-rw-r--r--eval.c37
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 <kaz@kylheku.com>
+
+ 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 <kaz@kylheku.com>
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);