Exemplo n.º 1
0
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);
}
Exemplo n.º 2
0
sptr_t A_STD
demote(wptr_t s)
{
        assert(!IS_LAZY(s));
        assert(jhc_valid_whnf(s));
        return (sptr_t)s;
}
Exemplo n.º 3
0
wptr_t A_STD
promote(sptr_t s)
{
        assert(!IS_LAZY(s));
        assert(jhc_valid_whnf((wptr_t)s));
        return (wptr_t)s;
}
Exemplo n.º 4
0
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;
}