bool A_UNUSED
jhc_valid_lazy(sptr_t s)
{
if(jhc_valid_whnf((wptr_t)s))
return true;
assert(GET_PTYPE(s) == P_LAZY);
node_t *ds = (node_t *)FROM_SPTR(s);
assert(jhc_malloc_sanity(ds,P_LAZY));
if(IS_LAZY(ds->head)) {
if(ds->head == BLACK_HOLE) return true;
assert(GET_PTYPE(ds->head) == P_FUNC);
return true;
} else
return jhc_valid_whnf((wptr_t)ds->head);
}
sptr_t A_STD
demote(wptr_t s)
{
assert(!IS_LAZY(s));
assert(jhc_valid_whnf(s));
return (sptr_t)s;
}
wptr_t A_STD
promote(sptr_t s)
{
assert(!IS_LAZY(s));
assert(jhc_valid_whnf((wptr_t)s));
return (wptr_t)s;
}
eval(sptr_t s)
#endif
{
assert(jhc_valid_lazy(s));
if(IS_LAZY(s)) {
assert(GET_PTYPE(s) == P_LAZY);
void *ds = FROM_SPTR(s);
sptr_t h = (sptr_t)(GETHEAD(ds));
assert((fptr_t)h != BLACK_HOLE);
if(IS_LAZY(h)) {
eval_fn fn = (eval_fn)FROM_SPTR(h);
assert(GET_PTYPE(h) == P_FUNC);
#if _JHC_DEBUG
GETHEAD(ds) = BLACK_HOLE;
#endif
#if _JHC_GC == _JHC_GC_JGC
wptr_t r = (*fn)(gc,NODEP(ds));
#else
wptr_t r = (*fn)(NODEP(ds));
#endif
#if _JHC_DEBUG
assert(GETHEAD(ds) != BLACK_HOLE);
#endif
return r;
}
return (wptr_t)h;
}
assert(jhc_valid_whnf((wptr_t)s));
return (wptr_t)s;
}
