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_NewObj();
newp->bytes = NULL;
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
Thanks both - done. CMcC
Tcl_NewObj does the basic init already, you don't need to do it by hand, look at the TclNewObj Macro in tclInt.h for what it already does. schlenk
Yes, thanks. bytes needs to be set to NULL, but the rest is unnecessary CMcC