Revised Tip#479. Renamed new commands, added an info argspec command. @proc -> procx. @args -> argsx. @method ->methodx.

Properties for named arguments now end in :

doc/proc.n

@@ -38,6 +38,15 @@ arguments become required arguments; enough actual arguments must be
 supplied to allow all arguments up to and including the last required
 formal argument.
 .PP
+If the \fIargs\fR is the last formal argument, and it is given a default
+value, that default value is interpreted to be the specification for
+how named parameters beyond the last formal argument will be interpreted
+(an argspec). An argspec is a dict where every key calls out a local variable
+to be defined. The values are a dict which can contain one or more of the
+following options: default (a default value), mandatory (boolean, when false
+an error will not be thrown if the parameter is missing), and aliases (a
+list of alternative names for this parameter.)
+.PP
 When \fIname\fR is invoked a local variable
 will be created for each of the formal arguments to the procedure; its
 value will be the value of corresponding argument in the invoking command
@@ -62,6 +71,14 @@ starting at the one that would be assigned to \fBargs\fR are combined into
 a list (as if the \fBlist\fR command had been used); this combined value
 is assigned to the local variable \fBargs\fR.
 .PP
+When an argspec is defined elements beyond the last formal
+argument are a dict. A variable with the name of every field will be
+fill with the contents of every value. An argspec can provide a default value
+for missing named parameters, or state that parameter is non-mandatory.
+Non-mandatory fields will not be mapped as local variables. The value of
+\fIargs\fR is still a verbatim record of elements beyond the final formal
+argument.
+.PP
 When \fIbody\fR is being executed, variable names normally refer to
 local variables, which are created automatically when referenced and
 deleted when the procedure returns.  One local variable is automatically

generic/tcl.decls

@@ -2335,8 +2335,6 @@ declare 631 {
 
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
 
-
-
 ##############################################################################
 
 # Define the platform specific public Tcl interface. These functions are only

generic/tclBasic.c

@@ -200,6 +200,7 @@ static const CmdInfo builtInCmds[] = {
      * Commands in the generic core.
      */
 
+    {"argsx",           Tcl_ArgsxObjCmd,       NULL,                   NULL,   CMD_IS_SAFE},
     {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
     {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
     {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
@@ -822,6 +823,10 @@ Tcl_CreateInterp(void)
 
     TclClockInit(interp);
 
+    /* Tip 479 - Register literals for the argsx command */
+    TclProcInit(interp);
+
+
     /*
      * Register the built-in functions. This is empty now that they are
      * implemented as commands in the ::tcl::mathfunc namespace.
@@ -7722,7 +7727,7 @@ ExprRandFunc(
 	iPtr->flags |= RAND_SEED_INITIALIZED;
 
 	/*
-	 * To ensure different seeds in different threads (bug #416643), 
+	 * To ensure different seeds in different threads (bug #416643),
 	 * take into consideration the thread this interp is running in.
 	 */
 

generic/tclCmdIL.c

@@ -108,6 +108,8 @@ static int		DictionaryCompare(const char *left, const char *right);
 static Tcl_NRPostProc	IfConditionCallback;
 static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
+static int		InfoArgSpecCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
@@ -161,6 +163,7 @@ static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
 
 static const EnsembleImplMap defaultInfoMap[] = {
     {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"argspec",		   InfoArgSpecCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
     {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
@@ -514,6 +517,72 @@ InfoArgsCmd(
     Tcl_SetObjResult(interp, listObjPtr);
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoArgspecCmd --
+ *
+ *	Called to implement the "info argspec" command that returns the argument
+ *	list for a procedure. Handles the following syntax:
+ *
+ *	    info argspec procName
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a result in the interpreter's result object. If there is an
+ *	error, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoArgSpecCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    register Interp *iPtr = (Interp *) interp;
+    const char *name;
+    Proc *procPtr;
+    CompiledLocal *localPtr;
+    Tcl_Obj *resultObjPtr=NULL;
+
+    if (objc != 1 && objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "procname");
+	return TCL_ERROR;
+    }
+    if(objc==2) {
+            name = TclGetString(objv[1]);
+        procPtr = TclFindProc(iPtr, name);
+    } else {
+        procPtr = iPtr->framePtr->procPtr;
+    }
+    if (procPtr == NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"\"%s\" isn't a procedure", name));
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Build a return list containing the arguments.
+     */
+
+    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
+	    localPtr = localPtr->nextPtr) {
+	if (localPtr->flags & VAR_IS_ARGS) {
+	    if(localPtr->defValuePtr) {
+  	        Tcl_IncrRefCount(localPtr->defValuePtr);
+	        Tcl_SetObjResult(interp, localPtr->defValuePtr);
+	    }
+	}
+    }
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------

generic/tclInt.h

@@ -739,6 +739,7 @@ typedef struct VarInHash {
 #define VAR_TEMPORARY		0x200	/* KEEP OLD VALUE! See tclProc.c */
 #define VAR_IS_ARGS		0x400
 #define VAR_RESOLVED		0x8000
+#define VAR_NAMED_ARGUMENT	0x10000
 
 /*
  * Macros to ensure that various flag bits are set properly for variables.
@@ -3283,6 +3284,11 @@ MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
 MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+/* Tip 479 */
+MODULE_SCOPE int	TclProcInit(Tcl_Interp *interp);
+MODULE_SCOPE int	Tcl_ArgsxObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 
 /* Assemble command function */
 MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,

generic/tclProc.c

@@ -47,6 +47,7 @@ static void		MakeProcError(Tcl_Interp *interp,
 static void		MakeLambdaError(Tcl_Interp *interp,
 			    Tcl_Obj *procNameObj);
 static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static int              ProcEatArgs(Tcl_Interp *interp,CallFrame *framePtr,Tcl_Obj *argspec,Tcl_Obj *values);
 
 static Tcl_NRPostProc ApplyNR2;
 static Tcl_NRPostProc InterpProcNR2;
@@ -96,6 +97,233 @@ const Tcl_ObjType tclLambdaType = {
     NULL,			/* updateStringProc */
     SetLambdaFromAny		/* setFromAnyProc */
 };
+
+/* Literal Pool */
+static Tcl_Obj *obj_const_aliases;
+static Tcl_Obj *obj_const_args;
+static Tcl_Obj *obj_const_default;
+static Tcl_Obj *obj_const_mandatory;
+static Tcl_Obj *obj_const_atspec;
+
+int TclProcInit(Tcl_Interp *interp) {
+  static int once=0;
+  if(!once) {
+    obj_const_aliases=Tcl_NewStringObj("aliases:",-1);
+    Tcl_IncrRefCount(obj_const_aliases);
+    obj_const_args=Tcl_NewStringObj("args",-1);
+    Tcl_IncrRefCount(obj_const_args);
+    obj_const_default=Tcl_NewStringObj("default:",-1);
+    Tcl_IncrRefCount(obj_const_default);
+    obj_const_mandatory=Tcl_NewStringObj("mandatory:",-1);
+    Tcl_IncrRefCount(obj_const_mandatory);
+    obj_const_atspec=Tcl_NewStringObj("argspec",-1);
+    Tcl_IncrRefCount(obj_const_atspec);
+    once=1;
+  }
+  return TCL_OK;
+}
+
+/*
+** Code to support TIP 479
+*/
+
+/*
+** TIP 479
+** A simplified TclLookupSimpleVar
+*/
+/*
+ * NOTE: VarHashCreateVar increments the recount of its key argument.
+ * All callers that will call Tcl_DecrRefCount on that argument must
+ * call Tcl_IncrRefCount on it before passing it in.  This requirement
+ * can bubble up to callers of callers .... etc.
+ */
+#define VarHashGetValue(hPtr) \
+    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+
+static inline Var *
+VarHashCreateVar(
+    TclVarHashTable *tablePtr,
+    Tcl_Obj *key,
+    int *newPtr)
+{
+    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr);
+
+    if (hPtr) {
+	return VarHashGetValue(hPtr);
+    } else {
+	return NULL;
+    }
+}
+
+void ProcSetLocalVar (
+    CallFrame *framePtr,
+    Tcl_Obj *varNamePtr, 	/* Scaler name */
+    Tcl_Obj *valuePtr           /* Value to set */
+) {
+    int i, varLen, idx, isNew;
+    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);
+    int localLen, localCt = framePtr->numCompiledLocals;
+    Tcl_Obj **objPtrPtr = &framePtr->localCachePtr->varName0;
+    const char *localNameStr;
+    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
+				 * to look up the variable. */
+    Var *varPtr;		/* Points to the Var structure returned for
+				 * the variable. */
+    varPtr = NULL;
+    idx=-1;
+    isNew=-1;
+    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
+	register Tcl_Obj *objPtr = *objPtrPtr;
+
+	if (objPtr) {
+	    localNameStr = TclGetStringFromObj(objPtr, &localLen);
+	    if ((varLen == localLen) && (varName[0] == localNameStr[0])
+			&& !memcmp(varName, localNameStr, varLen)) {
+		idx=i;
+		varPtr=(Var *) &framePtr->compiledLocals[i];
+		break;
+	    }
+	}
+    }
+    if(!varPtr) {
+        tablePtr = framePtr->varTablePtr;
+        if (tablePtr == NULL) {
+            tablePtr = ckalloc(sizeof(TclVarHashTable));
+            TclInitVarHashTable(tablePtr, NULL);
+            framePtr->varTablePtr = tablePtr;
+        }
+        varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
+    }
+    varPtr->flags=VAR_NAMED_ARGUMENT;
+    varPtr->value.objPtr=valuePtr;
+    Tcl_IncrRefCount(valuePtr);
+}
+
+int ProcEatArgs(
+    Tcl_Interp *interp,
+    CallFrame *framePtr,
+    Tcl_Obj *argspec,
+    Tcl_Obj *argsValuePtr
+) {
+    Tcl_DictSearch search;
+    Tcl_Obj *fieldname, *fieldspec;
+    int done=0;
+    int isNew=0,idx=-1;
+    if (Tcl_DictObjFirst(interp, argspec, &search,
+        &fieldname, &fieldspec, &done) != TCL_OK) {
+        return TCL_ERROR;
+    }
+    for (; !done ; Tcl_DictObjNext(&search, &fieldname, &fieldspec, &done)) {
+        Tcl_Obj *iVal;
+        Tcl_Obj *aliases,*defaultObj,*mandatoryObj;
+        int mandatory=1;
+
+        if(Tcl_DictObjGet(interp,argsValuePtr,fieldname,&iVal)!=TCL_OK) return TCL_ERROR;
+        if(iVal) {
+            ProcSetLocalVar(framePtr,fieldname,iVal);
+            continue;
+        }
+        /* Fight for another day - Look through the aliases */
+        if(Tcl_DictObjGet(interp,fieldspec,obj_const_aliases,&aliases)!=TCL_OK) return TCL_ERROR;
+        if(aliases) {
+            Tcl_Obj **varv;
+            int varc,vargi;
+            if (Tcl_ListObjGetElements(interp, aliases, &varc, &varv) != TCL_OK) return TCL_ERROR;
+            for(vargi=0;vargi<varc;vargi++) {
+                if(Tcl_DictObjGet(interp,argsValuePtr,varv[vargi],&iVal)!=TCL_OK) return TCL_ERROR;
+                if(iVal) {
+                    ProcSetLocalVar(framePtr,fieldname,iVal);
+                    break;
+                }
+            }
+        }
+        if(iVal) {
+            continue;
+        }
+        if(Tcl_DictObjGet(interp,fieldspec,obj_const_default,&defaultObj)!=TCL_OK) return TCL_ERROR;
+        if(defaultObj) {
+            ProcSetLocalVar(framePtr,fieldname,defaultObj);
+            continue;
+        }
+        if(Tcl_DictObjGet(interp,fieldspec,obj_const_mandatory,&mandatoryObj)!=TCL_OK) return TCL_ERROR;
+        if(mandatoryObj) {
+            if(Tcl_GetBooleanFromObj(interp,mandatoryObj,&mandatory)) return TCL_ERROR;
+        }
+        if(mandatory) {
+            Tcl_AppendResult(interp,"Error: ", Tcl_GetString(fieldname), " is required", (char *)NULL);
+            return TCL_ERROR;
+        }
+    }
+    Tcl_DictObjDone(&search);
+    return TCL_OK;
+}
+
+int Tcl_ArgsxObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *CONST objv[]
+) {
+    Tcl_DictSearch search;
+    Tcl_Obj *fieldname, *fieldspec, *argspec, *argdat;
+    int done=0;
+
+    if(objc!=3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "argspec argdat");
+        return TCL_ERROR;
+    }
+    argspec=objv[1];
+    argdat=objv[2];
+    Tcl_ObjSetVar2(interp,obj_const_atspec,NULL,argspec,0);
+
+    if (Tcl_DictObjFirst(interp, argspec, &search,
+        &fieldname, &fieldspec, &done) != TCL_OK) {
+        return TCL_ERROR;
+    }
+    for (; !done ; Tcl_DictObjNext(&search, &fieldname, &fieldspec, &done)) {
+        Tcl_Obj *iVal;
+        Tcl_Obj *aliases,*defaultObj,*mandatoryObj;
+        int mandatory=1;
+        if(Tcl_DictObjGet(interp,argdat,fieldname,&iVal)!=TCL_OK) return TCL_ERROR;
+        if(iVal) {
+            Tcl_ObjSetVar2(interp,fieldname,NULL,iVal,0);
+            continue;
+        }
+        /* Fight for another day - Look through the aliases */
+        if(Tcl_DictObjGet(interp,fieldspec,obj_const_aliases,&aliases)!=TCL_OK) return TCL_ERROR;
+        if(aliases) {
+            Tcl_Obj **varv;
+            int varc,vargi;
+            if (Tcl_ListObjGetElements(interp, aliases, &varc, &varv) != TCL_OK) return TCL_ERROR;
+            for(vargi=0;vargi<varc;vargi++) {
+                if(Tcl_DictObjGet(interp,argdat,varv[vargi],&iVal)!=TCL_OK) return TCL_ERROR;
+                if(iVal) {
+                      Tcl_ObjSetVar2(interp,fieldname,NULL,iVal,0);
+                      break;
+                }
+            }
+        }
+        if(iVal) {
+            continue;
+        }
+        if(Tcl_DictObjGet(interp,fieldspec,obj_const_default,&defaultObj)!=TCL_OK) return TCL_ERROR;
+        if(defaultObj) {
+            Tcl_ObjSetVar2(interp,fieldname,NULL,defaultObj,0);
+            continue;
+        }
+        if(Tcl_DictObjGet(interp,fieldspec,obj_const_mandatory,&mandatoryObj)!=TCL_OK) return TCL_ERROR;
+        if(mandatoryObj) {
+            if(Tcl_GetBooleanFromObj(interp,mandatoryObj,&mandatory)) return TCL_ERROR;
+        }
+        if(mandatory) {
+            Tcl_AppendResult(interp,"Error: ", Tcl_GetString(fieldname), " is required", (char *)NULL);
+            return TCL_ERROR;
+        }
+    }
+    Tcl_DictObjDone(&search);
+    return TCL_OK;
+}
+
 
 /*
  *----------------------------------------------------------------------
@@ -359,6 +587,7 @@ Tcl_ProcObjCmd(
     return TCL_OK;
 }
 
+
 /*
  *----------------------------------------------------------------------
  *
@@ -476,11 +705,10 @@ TclCreateProc(
      *
      * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
      */
-
     args = TclGetStringFromObj(argsPtr, &length);
     result = Tcl_SplitList(interp, args, &numArgs, &argArray);
     if (result != TCL_OK) {
-	goto procError;
+        goto procError;
     }
 
     if (precompiled) {
@@ -658,9 +886,65 @@ TclCreateProc(
 		    && (localPtr->name[0] == 'a')
 		    && (strcmp(localPtr->name, "args") == 0)) {
 		localPtr->flags |= VAR_IS_ARGS;
+		if(fieldCount == 2) {
+		    /*
+		    ** TIP 479
+		    ** Use the otherwise ignored default field for the last
+		    ** parameter named args as a dict-based specification for
+		    ** named parameters
+		    */
+		    Tcl_DictSearch search;
+                    Tcl_Obj *fieldname, *fieldspec;
+                    int done=0;
+                    char *Fieldname;
+                    int FieldLen;
+                    Tcl_Obj *argspec;
+
+                    /*
+                    ** Create entries in runtime procedure frame's array for
+                    ** each named parameter
+                    */
+                    argspec=localPtr->defValuePtr;
+                    if(Tcl_DictObjFirst(NULL, argspec, &search,&fieldname, &fieldspec, &done) != TCL_OK) goto procError;
+
+                    for (; !done ; Tcl_DictObjNext(&search, &fieldname, &fieldspec, &done)) {
+                        /* Allocate one slot for each of the other named parameters */
+                        Tcl_Obj *defaultObj,*mandatoryObj;
+                        int mandatory=1;
+
+                        defaultObj=NULL;
+                        mandatoryObj=NULL;
+                        Tcl_DictObjGet(NULL,fieldspec,obj_const_default,&defaultObj);
+                        Tcl_DictObjGet(NULL,fieldspec,obj_const_mandatory,&mandatoryObj);
+                        if(mandatoryObj) {
+                            if(Tcl_GetBooleanFromObj(interp,mandatoryObj,&mandatory)) {
+                                mandatory=1;
+                            }
+                        }
+                        /* Non-mandatory fields are not tracked */
+                        if(!defaultObj && !mandatory) continue;
+
+                        procPtr->numCompiledLocals++;
+                        Fieldname=Tcl_GetStringFromObj(fieldname,&FieldLen);
+     	                localPtr = ckalloc(TclOffset(CompiledLocal, name) + FieldLen+1);
+        	        procPtr->lastLocalPtr->nextPtr = localPtr;
+ 		        procPtr->lastLocalPtr = localPtr;
+ 		     	memcpy(localPtr->name, Fieldname, FieldLen + 1);
+                        localPtr->nextPtr = NULL;
+                        localPtr->nameLength = FieldLen;
+                        localPtr->frameIndex = i;
+	                localPtr->flags = VAR_NAMED_ARGUMENT;
+                        localPtr->resolveInfo = NULL;
+                        if(defaultObj) {
+                            localPtr->defValuePtr=defaultObj;
+                            Tcl_IncrRefCount(localPtr->defValuePtr);
+                        } else {
+                            localPtr->defValuePtr=NULL;
+                        }
+		    }
+		}
 	    }
 	}
-
 	ckfree(fieldValues);
     }
 
@@ -1154,7 +1438,6 @@ TclInitCompiledLocals(
     Var *varPtr = framePtr->compiledLocals;
     Tcl_Obj *bodyPtr;
     ByteCode *codePtr;
-
     bodyPtr = framePtr->procPtr->bodyPtr;
     if (bodyPtr->typePtr != &tclByteCodeType) {
 	Tcl_Panic("body object for proc attached to frame is not a byte code type");
@@ -1168,7 +1451,6 @@ TclInitCompiledLocals(
 	framePtr->localCachePtr = codePtr->localCachePtr;
 	framePtr->localCachePtr->refCount++;
     }
-
     InitResolvedLocals(interp, codePtr, varPtr, nsPtr);
 }
 
@@ -1202,7 +1484,6 @@ InitResolvedLocals(
     CompiledLocal *firstLocalPtr, *localPtr;
     int varNum;
     Tcl_ResolvedVarInfo *resVarInfo;
-
     /*
      * Find the localPtr corresponding to varPtr
      */
@@ -1235,7 +1516,7 @@ InitResolvedLocals(
 	localPtr->flags &= ~VAR_RESOLVED;
 
 	if (haveResolvers &&
-		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
+		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_NAMED_ARGUMENT))) {
 	    ResolverScheme *resPtr = iPtr->resolverPtr;
 	    Tcl_ResolvedVarInfo *vinfo;
 	    int result;
@@ -1354,7 +1635,6 @@ InitLocalCache(
 		    &new, /* nsPtr */ NULL, 0, NULL);
 	    Tcl_IncrRefCount(*namePtr);
 	}
-
 	if (i < numArgs) {
 	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
 	    varPtr->value.objPtr = localPtr->defValuePtr;
@@ -1403,12 +1683,11 @@ InitArgsAndLocals(
     register Var *varPtr, *defPtr;
     int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
     Tcl_Obj *const *argObjs;
-
+    Tcl_Obj *argSpec=NULL,*argsValuePtr=NULL;
     /*
      * Make sure that the local cache of variable names and initial values has
      * been initialised properly .
      */
-
     if (localCt) {
 	if (!codePtr->localCachePtr) {
 	    InitLocalCache(procPtr) ;
@@ -1425,7 +1704,6 @@ InitArgsAndLocals(
      * all the procedure's compiled local variables, including its formal
      * parameters.
      */
-
     varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var)));
     framePtr->compiledLocals = varPtr;
     framePtr->numCompiledLocals = localCt;
@@ -1484,10 +1762,15 @@ InitArgsAndLocals(
 
     varPtr->flags = 0;
     if (defPtr && defPtr->flags & VAR_IS_ARGS) {
-	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);
-
-	varPtr->value.objPtr = listPtr;
-	Tcl_IncrRefCount(listPtr);	/* Local var is a reference. */
+        /*
+        ** Build a conventional list of arguments
+        ** past the last positional argument, and call it
+        ** args
+        */
+        argsValuePtr = Tcl_NewListObj(argCt-i, argObjs+i);
+        varPtr->value.objPtr = argsValuePtr;
+        argSpec=defPtr->value.objPtr;
+        Tcl_IncrRefCount(argsValuePtr);	/* Local var is a reference. */
     } else if (argCt == numArgs) {
 	Tcl_Obj *objPtr = argObjs[i];
 
@@ -1517,7 +1800,16 @@ InitArgsAndLocals(
 	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
 	}
     }
-
+    if(argSpec) {
+        /*
+        ** TIP 479
+        ** Feed dict values into compiled locals
+        ** If a required parameter is missing ProcEatArgs
+        ** will return TCL_ERROR.
+        */
+        if(ProcEatArgs(interp,framePtr,argSpec,argsValuePtr)
+           != TCL_OK) goto incorrectArgs;
+    }
     return TCL_OK;
 
     /*
@@ -1993,7 +2285,6 @@ TclProcCompileProc(
 	 */
 
 	iPtr->compiledProcPtr = procPtr;
-
 	if (procPtr->numCompiledLocals > procPtr->numArgs) {
 	    CompiledLocal *clPtr = procPtr->firstLocalPtr;
 	    CompiledLocal *lastPtr = NULL;
@@ -2025,7 +2316,6 @@ TclProcCompileProc(
 	    }
 	    procPtr->numCompiledLocals = procPtr->numArgs;
 	}
-
 	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
 		/* isProcCallFrame */ 0);
 

library/init.tcl

@@ -836,3 +836,9 @@ proc tcl::CopyDirectory {action src dest} {
     }
     return
 }
+
+proc procx {name argspec body} { proc $name [list [list args $argspec]] $body }
+proc ::oo::define::methodx {name argspec body} {
+  set class [lindex [::info level -1] 1]
+  oo::define $class method $name [list [list args $argspec]] $body
+}

tests/proc.test

@@ -383,10 +383,112 @@ test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
     interp delete slave
     unset lambda
 } {}
+
 
 # cleanup
 catch {rename p ""}
 catch {rename t ""}
+
+
+test proc-8.0 {Named parameters tip-479 map named parameters to local vars} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return [list $color $flavor]
+    }
+    p
+} -result {red strawberry} -cleanup {
+  rename p ""
+}
+
+test proc-8.1 {Named parameters tip-479 map named parameters to args} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return $args
+    }
+    p
+} -result {} -cleanup {
+  rename p ""
+}
+
+test proc-8.2 {Named parameters tip-479 present in info locals} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return [info locals]
+    }
+    p
+} -result {args flavor color} -cleanup {
+  rename p ""
+}
+
+test proc-8.3 {Named parameters tip-479 fail on lack of a named parameter} -body {
+    proc p {{args {color {} flavor {default: strawberry}}}} {
+       return $args
+    }
+    p
+} -returnCodes 1 -result {wrong # args: should be "p ?args?"} -cleanup {
+  rename p ""
+}
+
+test proc-8.4 {Named parameters tip-479 accept additional named parameters} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return $args
+    }
+    p shape oval
+} -result {shape oval} -cleanup {
+  rename p ""
+}
+
+test proc-8.5 {Named parameters tip-479 do not map fields outside of the spec} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return [info locals]
+    }
+    p shape oval
+} -result {args flavor color} -cleanup {
+  rename p ""
+}
+
+test proc-8.6 {Named parameters tip-479 non-manditory fields are not mapped} -body {
+    proc p {{args {color {default: red} flavor {mandatory: 0}}}} {
+       return [info locals]
+    }
+    p
+} -result {args color} -cleanup {
+  rename p ""
+}
+
+test proc-8.7 {Named parameters tip-479 named parameters can be in any order} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return [list $color $flavor]
+    }
+    p flavor cherry color blue
+} -result {blue cherry} -cleanup {
+  rename p ""
+}
+
+test proc-8.8 {Named parameters tip-479 order of parameters preserved in args} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return $args
+    }
+    p flavor cherry color blue
+} -result {flavor cherry color blue} -cleanup {
+  rename p ""
+}
+
+test proc-8.9 {Named parameters tip-479 spec available in [info argspec]} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return [info argspec]
+    }
+    info argspec p
+} -result {color {default: red} flavor {default: strawberry}} -cleanup {
+  rename p ""
+}
+
+test proc-8.10 {Named parameters tip-479 spec available in [info argspec]} -body {
+    proc p {{args {color {default: red} flavor {default: strawberry}}}} {
+       return [info argspec]
+    }
+    p
+} -result {color {default: red} flavor {default: strawberry}} -cleanup {
+  rename p ""
+}
+
 ::tcltest::cleanupTests
 return