#include <scheme.h>

/*  weak.c defines a type "weak-reference" with operations
    (cons-weak-ref [default [initial]])
	-- if initial is omitted, it is the same as default
	-- if default is omitted, it is #F
    (weak-ref? object)
    (weak-contents weak-ref)
	-- returns the current value of the weak-ref
    (weak-default weak-ref)
	-- returns the default value of the object
    (weak-set-contents! weak-ref value)
	-- updates the current value of the object
    (weak-set-default! weak-ref value)
	-- updates the default value of the object
    A weak reference is just like a pair except that when a garbage
    collection occurs, the current value is replaced by the default
    value.  The point of this is to let you define "pools".
*/

static int T_Weak;

#define WEAK(x)   ((struct S_Weak *)POINTER(x))

struct S_Weak {
    Object defalt;
    Object curval;
};

static Object P_Weak_Cons(argc, argv)
    int argc;
    Object *argv;
    {
	Object defalt = argc < 1 ? False : argv[0];
	Object curval = argc < 2 ? defalt : argv[1];
	Object h;
	GC_Node2;

	GC_Link2(defalt, curval);
	h = Alloc_Object(sizeof (struct S_Weak), T_Weak, 0);
	WEAK(h)->defalt = defalt;
	WEAK(h)->curval = curval;
	GC_Unlink;
	return h;
    }

static Object P_Weakp(x)
    Object x;
    {
	return TYPE(x) == T_Weak ? True : False;
    }

static Object P_Weak_Contents(h)
    Object h;
    {
	Check_Type(h, T_Weak);
	return WEAK(h)->curval;
    }

static Object P_Weak_Default(h)
    Object h;
    {
	Check_Type(h, T_Weak);
	return WEAK(h)->defalt;
    }

static Object P_Weak_Set_Cont(h, val)
    Object h, val;
    {
	Check_Type(h, T_Weak);
	WEAK(h)->curval = val;
	return h;
    }

static Object P_Weak_Set_Dflt(h, val)
    Object h, val;
    {
	Check_Type(h, T_Weak);
	WEAK(h)->defalt = val;
	return h;
    }


static int Weak_Eqv(a, b)
    Object a, b;
    {
	return EQ(a, b);
    }

static int Weak_Equal(a, b)
    Object a, b;
    {
	return	Equal(WEAK(a)->defalt, WEAK(b)->defalt)  &&
		Equal(WEAK(a)->curval, WEAK(b)->curval);
    }

static Weak_Print(h, port, raw, depth, length)
    Object h, port;
    int raw, depth, length;
    {
	Printf(port, "#[hunk3 %u: ", POINTER(h));
	Print_Object(WEAK(h)->defalt, port, raw, depth-1, length);
	Printf(port, "]");
    }

static Weak_Visit(hp, f)
    Object *hp;
    int (*f)();
    {
	struct S_Weak *p = WEAK(*hp);
	p->curval = p->defalt;
	(*f)(&(p->defalt));
    }

init_lib_weak()
    {
	T_Weak = Define_Type(0, "weak-ref", NOFUNC, sizeof (struct S_Weak),
			     Weak_Eqv, Weak_Equal, Weak_Print, Weak_Visit);
	Define_Primitive(P_Weak_Cons,	  "cons-weak-ref",      0, 2, VARARGS);
	Define_Primitive(P_Weakp,	  "weak-ref?",	        1, 1, EVAL);
	Define_Primitive(P_Weak_Contents, "weak-contents",      1, 1, EVAL);
	Define_Primitive(P_Weak_Default,  "weak-default",       1, 1, EVAL);
	Define_Primitive(P_Weak_Set_Cont, "weak-set-contents!", 2, 2, EVAL);
	Define_Primitive(P_Weak_Set_Dflt, "weak-set-default!",  2, 2, EVAL);
    }

