From f9633b0bef26184c5e36eba25d8b3b6bd687ee18 Mon Sep 17 00:00:00 2001 From: Teddy Date: Sat, 17 Aug 2013 16:26:40 +0800 Subject: fixed a bug in the `SpecialOptForce` --- builtin.cpp | 5 +++-- builtin.h | 2 -- test/robust_test.log | 2 ++ test/robust_test.scm | 8 ++++++++ 4 files changed, 13 insertions(+), 4 deletions(-) diff --git a/builtin.cpp b/builtin.cpp index bbc2f93..1ab1d37 100644 --- a/builtin.cpp +++ b/builtin.cpp @@ -564,9 +564,10 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt, args = TO_PAIR(args->cdr); Pair *ret_addr = cont->pc; Pair *nexp = cont->state; + PromObj *prom = static_cast(args->car); if (nexp) { - EvalObj *mem = args->car; + EvalObj *mem = TO_PAIR(args->cdr)->car; prom->feed_mem(mem); gc.expose(*top_ptr); *top_ptr++ = gc.attach(mem); @@ -577,7 +578,6 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt, { if (!args->car->is_prom_obj()) throw TokenError("a promise", RUN_ERR_WRONG_TYPE); - prom = static_cast(args->car); EvalObj *mem = prom->get_mem(); if (mem) // fetch from memorized result { @@ -588,6 +588,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt, } else // force { + gc.attach(static_cast(*(++top_ptr))); gc.attach(static_cast(*(++top_ptr))); top_ptr++; nexp = cont->state = prom->get_exp(); diff --git a/builtin.h b/builtin.h index 67b07a7..b3053cd 100644 --- a/builtin.h +++ b/builtin.h @@ -163,8 +163,6 @@ class SpecialOptDelay: public SpecialOptObj {/*{{{*/ * The implementation of `force` operator */ class SpecialOptForce: public SpecialOptObj {/*{{{*/ - private: - PromObj* prom; public: /** Construct a `force` operator */ SpecialOptForce(); diff --git a/test/robust_test.log b/test/robust_test.log index 6feaa56..7507f2a 100644 --- a/test/robust_test.log +++ b/test/robust_test.log @@ -202,3 +202,5 @@ Test Bibonacci numbers: 218922995834555169026 Test Eval: 92 +hello +world diff --git a/test/robust_test.scm b/test/robust_test.scm index ed5dbfb..9e8c98d 100644 --- a/test/robust_test.scm +++ b/test/robust_test.scm @@ -393,3 +393,11 @@ x (display (queen 8)) (display "\n") + +(define prom (delay (and (display "world\n") (lambda () 3)))) +(define prom2 (delay (and (display "hello\n") (force prom)))) +(force prom2) +(force prom2) +(force prom2) +(force prom2) + -- cgit v1.2.3-70-g09d2