Updated 2015-03-20 02:14:04 by APN
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

DKF: In fact, Tcl_Objs should always be allocated by Tcl_NewObj (or rather the allocator used by it) since they come from a special thread-managed pool. Directly allocating them causes a memory leak.

APN Interesting stuff. However, I think there is a serious bug in there. Afaik, you cannot / must not reset objPtr->bytes to NULL or even change it to point somewhere else unless you first ensure the object is unshared (paraphrasing advice from miguel on the chat in a different context). With this restriction, the implementation seems unworkable, at least without significant change, because once objPtr->bytes is not set to NULL, the interpreter will not call updateString to generate the next value. As an aside, I wonder if the same effect could be achieved in pure Tcl in 8.6 with a combination of coros and/or traces.