[FM] This page is to discuss here about the interest to have a typing for Tcl variables.

Well, as a script programmer, I don't need to know what is the object type of the TclOO struct internaly. But very often I need some extra information about the variable I use. Sometimes a name convention is sufficient, but sometimes it's not.

I've tried an '''experiment''' about introducing a "type" on a Tcl variable. This is based on the 8.5.8 tcl source, here it is :

======
# file tclInt.h

typedef struct Var {
    int flags;                        /* Miscellaneous bits of information about
                                 * variable. See below for definitions. */
    Tcl_Obj *userTypeObjPtr;   /* additional user type to variable */
    union {
        Tcl_Obj *objPtr;        /* The variable's object value. Used for
                                 * scalar variables and array elements. */
        TclVarHashTable *tablePtr;/* For array variables, this points to
                                 * information about the hash table used to
                                 * implement the associative array. Points to
                                 * ckalloc-ed data. */
        struct Var *linkPtr;        /* If this is a global variable being referred
                                 * to in a procedure, or a variable created by
                                 * "upvar", this field points to the
                                 * referenced variable's Var struct. */
    } value;
} Var;

MODULE_SCOPE int        Tcl_SetUserTypeObjCmd(ClientData clientData,
                            Tcl_Interp *interp, int objc,
                            Tcl_Obj *const objv[]);


# file tclVar.c

int
Tcl_SetUserTypeObjCmd(
   ClientData dummy,                /* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int objc,                        /* Number of arguments. */
    Tcl_Obj *const objv[])        /* Argument objects. */
{
    Tcl_Obj *userTypeObj;

    if (objc == 2) {
        userTypeObj = Tcl_ObjGetUserType2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
        if (userTypeObj == NULL) {
            return TCL_ERROR;
        } else {
            Tcl_SetObjResult(interp, userTypeObj);
        }
    } else if (objc == 3) { 
        userTypeObj = Tcl_ObjSetUserType2(interp, objv[1], NULL, objv[2],
                                          TCL_LEAVE_ERR_MSG);
        if (userTypeObj == NULL) {
            return TCL_ERROR;
        }
        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    } else {
        Tcl_WrongNumArgs(interp, 1, objv, "varName ?newType?");
        return TCL_ERROR;
             
    } 
}

Tcl_Obj *
Tcl_ObjGetUserType2 (
    Tcl_Interp *interp,                /* Command interpreter in which variable is to
                                 * be found. */
    register Tcl_Obj *part1Ptr,        /* Points to an object holding the name of an
                                 * array (if part2 is non-NULL) or the name of
                                 * a variable. */
    register Tcl_Obj *part2Ptr,        /* If non-NULL, points to an object holding
                                 * the name of an element in the array
                                 * part1Ptr. */
    int flags)        
{
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
            |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set the type of",
            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
        return NULL;
    }
    return varPtr->userTypeObjPtr;
}

Tcl_Obj *
Tcl_ObjSetUserType2 (
    Tcl_Interp *interp,                /* Command interpreter in which variable is to
                                 * be found. */
    register Tcl_Obj *part1Ptr,        /* Points to an object holding the name of an
                                 * array (if part2 is non-NULL) or the name of
                                 * a variable. */
    register Tcl_Obj *part2Ptr,        /* If non-NULL, points to an object holding
                                 * the name of an element in the array
                                 * part1Ptr. */
    Tcl_Obj *TypePtr,             /* Type for variable. */
    int flags)        
{
    Var *varPtr, *arrayPtr;

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG
            |TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
            /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
        if (TypePtr->refCount == 0) {
            Tcl_DecrRefCount(TypePtr);
        }
        return NULL;
    }
    Tcl_IncrRefCount(TypePtr);
    varPtr->userTypeObjPtr = TypePtr;
    return varPtr->userTypeObjPtr;
}

# file tclDecls.h

#ifndef Tcl_ObjSetUserType2_TCL_DECLARED
#define Tcl_ObjSetUserType2_TCL_DECLARED
EXTERN Tcl_Obj *        Tcl_ObjSetUserType2 (Tcl_Interp * interp, 
                                Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, 
                                Tcl_Obj * TypePtr, int flags);
#endif
#ifndef Tcl_ObjGetUserType2_TCL_DECLARED
#define Tcl_ObjGetUserType2_TCL_DECLARED
EXTERN Tcl_Obj *        Tcl_ObjGetUserType2 (Tcl_Interp * interp, 
                                Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, 
                                int flags);
#endif

# file tclBasic.c
# added to : static const CmdInfo builtInCmds

    {"type",            Tcl_SetUserTypeObjCmd,  NULL,                   1},
======

Test
======
type A; #can't set the type of "A": no such variable
type A [list this is the type]; # A
set A [list this is the A value]; # this is the A value
type A ;# this is the type
set A ; this is the A value
set [type A [list this is the type]] [list this is the A value]; # this is the A value
set B [list this is the B value]
type B [type A]; # B
type [type B [type A]]; # this is the type
type [type D [type [type C [type [type B [type A]]]]]]; # this is the type
type D; #this is the type
type C; #this is the type
type [type D [type [type C [type [type B [type A]]]]]]; # this is the type
set D;# can't read "D": no such variable (bug)
set C [list 1 2 3];# 1 2 3
type C; #this is the type (no bug ???)

type A [list I'am A]
type B [list I'am B]
type C [list I'am C]

proc tester {var} {
    upvar $var v
    if {[type v] eq "I'am B"} {
        puts "$v"
    } elseif {[type v] eq "I'am A"} {
        puts $v
    } else {
        puts stderr "unexpected type '[type v]'"
    }
}
tester A; #this is the A value
tester B; #this is the B value
tester C; #unexpected type 'I'am C'
======

There is still some bugs... Comments are welcome.

<<categories>>Internals