summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2015-04-22 19:19:08 -0700
committerKaz Kylheku <kaz@kylheku.com>2015-04-22 19:19:08 -0700
commitcbb6c31b11992c715eb791067186cffc5d67b26a (patch)
tree38aadae6fda014524482f503bb958d4c2aab13ab
parentcfcad668007de34c8c06f030aaba74e0336de75b (diff)
downloadtxr-cbb6c31b11992c715eb791067186cffc5d67b26a.tar.gz
txr-cbb6c31b11992c715eb791067186cffc5d67b26a.tar.bz2
txr-cbb6c31b11992c715eb791067186cffc5d67b26a.zip
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.
-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);