package provide future 1.0
critcl::ccode {
#include <tcl.h>
#include <stdio.h>
static void futureFreeIntRep(Tcl_Obj *objPtr);
static void futureDupIntRep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void futureUpdateString(Tcl_Obj *objPtr);
static int futureSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static struct Tcl_ObjType FutureType = {
"future",
futureFreeIntRep, /* free storage for the type's internal rep */
futureDupIntRep, /* create a new object as a copy of an existing object. */
futureUpdateString, /* update the string rep from the type's internal representation. */
futureSetFromAny /* convert the object's internal rep to this type. */
};
Tcl_Obj *futureNew (Tcl_Interp *interp, Tcl_Obj *objPtr) {
Tcl_Obj *newp = (Tcl_Obj*)ckalloc(sizeof(Tcl_Obj));
newp->refCount = 0;
newp->bytes = (char*)0;
newp->length = 0;
newp->typePtr = &FutureType;
newp->internalRep.twoPtrValue.ptr1 = (VOID*)objPtr;
newp->internalRep.twoPtrValue.ptr2 = (VOID*)interp;
Tcl_IncrRefCount(objPtr);
return newp;
}
/* free the script object */
static void futureFreeIntRep(Tcl_Obj *objPtr) {
Tcl_DecrRefCount((Tcl_Obj*)(objPtr->internalRep.twoPtrValue.ptr1));
objPtr->internalRep.twoPtrValue.ptr1 = (VOID*)NULL;
objPtr->internalRep.twoPtrValue.ptr2 = (VOID*)NULL;
}
static void futureDupIntRep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) {
dupPtr->typePtr = &FutureType;
dupPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2;
Tcl_IncrRefCount((Tcl_Obj*)(srcPtr->internalRep.twoPtrValue.ptr1));
}
/* when our string rep is wanted, we eval our internal rep */
static void futureUpdateString(Tcl_Obj *objPtr) {
Tcl_Interp *interp = (Tcl_Interp*)(objPtr->internalRep.twoPtrValue.ptr2);
Tcl_Obj *script = (Tcl_Obj*)(objPtr->internalRep.twoPtrValue.ptr1);
int result;
result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT);
Tcl_Obj *value = Tcl_GetObjResult(interp);
const char *string = Tcl_GetStringFromObj(value, &(objPtr->length));
objPtr->bytes = ckalloc(objPtr->length + 1);
memcpy(objPtr->bytes, string, objPtr->length + 1);
}
/* we convert first to a string object, which becomes our internal rep */
static int futureSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
int len = 0;
const char *string;
string = Tcl_GetStringFromObj(objPtr, &len);
objPtr->internalRep.twoPtrValue.ptr1 = Tcl_NewStringObj(string, len);
objPtr->internalRep.twoPtrValue.ptr2 = interp;
objPtr->typePtr = &FutureType;
if (objPtr->bytes) {
ckfree(objPtr->bytes);
objPtr->bytes = NULL;
objPtr->length = 0;
}
}
}
critcl::cproc future {Tcl_Interp* interp Tcl_Obj* obj} ok {
Tcl_Obj *newp = futureNew(interp, obj);
Tcl_SetObjResult(interp, newp);
return TCL_OK;
}Some Tests:
load ./future.so
# standard TCL_OK result
set a 0
set x [future {puts "executing future: [incr a]"; incr a}]
puts "A: $a"
puts "X: $x"
puts "X: $x"Compile thus: critcl -lib future.tcl
Way cool. I tried something similar a long time ago and never got it to work right. It's great to see the dual rep being able to support this.
One Q: why are you using ckalloc i.s.o. Tcl_NewObj - is there some murky detail hidden in there? Another detail is that conversion to string has no way to report an error, perhaps the eval should be guarded (error state push/pop) and the error stashed away for debugging? A similar issue exists inside the vfs core, IIRC. -jcw
(embarrassment) ... I don't know why I'm using ckalloc ... should/could it be something else? -- CMcC
How about the public Tcl_NewObj()? -- schlenk