The body of ##force in lib/_std.scm is actually dead code (because ##force is an inlined primitive), and as you have noticed the body contains a bug.
The actual implementation of ##force is in include/gambit.h.in :
#define ___FORCE1(n,src) \ if (___TYP((___temp=(src)))==___tSUBTYPED&&___SUBTYPE(___temp)==___FIX(___sPROMISE)){___ps->temp1=___LBL(n);___ps->temp2=___temp;___JUMPEXTPRM(___NOTHING,___GSTATE->handler_force); #define ___FORCE2 ___temp=___ps->temp2;} #define ___FORCE3 ___temp
and lib/_kernel.scm :
… (##c-code #<<end-of-code
/* * ___LBL(10) * * This is the force handler. It is invoked when a promise is forced. */
___SCMOBJ ra; ___SCMOBJ promise; ___SCMOBJ result;
ra = ___ps->temp1; promise = ___ps->temp2; result = ___FIELD(promise,___PROMISE_RESULT);
if (promise != result) { /* promise is determined, return cached result */
___COVER_FORCE_HANDLER_DETERMINED;
___ps->temp2 = result; ___JUMPEXTPRM(___NOTHING,ra) } else { /* promise is not determined */
/* setup internal return continuation frame */
int fs;
___RETI_GET_CFS(ra,fs)
___ADJFP(___ROUND_TO_MULT(fs,___FRAME_ALIGN)-fs)
___PUSH_REGS /* push all GVM registers (live or not) */ ___PUSH(ra) /* push return address */
___ADJFP(-___RETI_RA)
___SET_R0(___GSTATE->internal_return)
/* tail call to ##force-undetermined */
___PUSH_ARGS2(promise,___FIELD(promise,___PROMISE_THUNK))
___COVER_FORCE_HANDLER_NOT_DETERMINED;
___JUMPPRM(___SET_NARGS(2), ___PRMCELL(___G__23__23_force_2d_undetermined.prm)) }
end-of-code …
;;; Implementation of promises.
(define-prim (##make-promise thunk)) (define-prim (##promise-thunk promise)) (define-prim (##promise-thunk-set! promise thunk)) (define-prim (##promise-result promise)) (define-prim (##promise-result-set! promise result))
(define-prim (##force-undetermined promise thunk) (let ((result (##force (thunk)))) (##c-code #<<end-of-code
if (___PROMISERESULT(___ARG1) == ___ARG1) { ___PROMISERESULTSET(___ARG1,___ARG2) ___PROMISETHUNKSET(___ARG1,___FAL) } ___RESULT = ___PROMISERESULT(___ARG1);
end-of-code
promise result)))
))
Marc
On Mar 25, 2018, at 3:45 AM, Dimitris Vyzovitis vyzo@hackzen.org wrote:
Marc,
in _std.scm you have the following code implementing force:
(define-prim (##force obj) (if (##promise? obj) (let ((result (##promise-result obj))) (if (##eq? result obj) (let* ((r ((##promise-thunk obj))) (result2 (##promise-result obj))) (if (##eq? result2 obj) (begin (##promise-result-set! obj r) (##promise-thunk-set! obj #f) r) result2)))) ;; XXX -- value is unspecified when (not (##eq? result obj)) obj))
I find it very strange that the first if eq test of the result to the promise is lacking the else part; that's where I marked with XXX. Shouldn't the code return result in this case? What am I missing here?
-- vyzo