Better proc optional arg handling

Allows args and optional parameters in any location,
in addition to being smaller and faster.

Signed-off-by: Steve Bennett <steveb@workware.net.au>

1 files changed, 150 insertions, 193 deletions

diff --git a/jim.c b/jim.c
index cf08246..df2d885 100644
--- a/jim.c
+++ b/jim.c
@@ -3528,28 +3528,32 @@ int Jim_CreateCommand(Jim_Interp *interp, const char *cmdName,
     return JIM_OK;
 }
 
-static int JimCreateProcedure(Jim_Interp *interp, const char *cmdName,
-    Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
-    int leftArity, int optionalArgs, int args, int rightArity)
+static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
+    Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr)
 {
     Jim_Cmd *cmdPtr;
     Jim_HashEntry *he;
+    int argListLen;
+    int i;
 
-    cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
+    if (JimValidName(interp, "procedure", cmdName) != JIM_OK) {
+        return JIM_ERR;
+    }
+
+    argListLen = Jim_ListLength(interp, argListObjPtr);
+
+    /* Allocate space for both the command pointer and the arg list */
+    cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
     memset(cmdPtr, 0, sizeof(*cmdPtr));
     cmdPtr->inUse = 1;
     cmdPtr->isproc = 1;
     cmdPtr->u.proc.argListObjPtr = argListObjPtr;
+    cmdPtr->u.proc.argListLen = argListLen;
     cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
+    cmdPtr->u.proc.argsPos = -1;
+    cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
     Jim_IncrRefCount(argListObjPtr);
     Jim_IncrRefCount(bodyObjPtr);
-    cmdPtr->u.proc.leftArity = leftArity;
-    cmdPtr->u.proc.optionalArgs = optionalArgs;
-    cmdPtr->u.proc.args = args;
-    cmdPtr->u.proc.rightArity = rightArity;
-    cmdPtr->u.proc.staticVars = NULL;
-    cmdPtr->u.proc.prevCmd = NULL;
-    cmdPtr->inUse = 1;
 
     /* Create the statics hash table. */
     if (staticsListObjPtr) {
@@ -3609,6 +3613,59 @@ static int JimCreateProcedure(Jim_Interp *interp, const char *cmdName,
         }
     }
 
+    /* Parse the args out into arglist, validating as we go */
+    /* Examine the argument list for default parameters and 'args' */
+    for (i = 0; i < argListLen; i++) {
+        Jim_Obj *argPtr;
+        Jim_Obj *nameObjPtr;
+        Jim_Obj *defaultObjPtr;
+        int len;
+        int n = 1;
+
+        /* Examine a parameter */
+        Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
+        len = Jim_ListLength(interp, argPtr);
+        if (len == 0) {
+            Jim_SetResultString(interp, "procedure has argument with no name", -1);
+            goto err;
+        }
+        if (len > 2) {
+            Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
+            goto err;
+        }
+
+        if (len == 2) {
+            /* Optional parameter */
+            Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
+            Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
+        }
+        else {
+            /* Required parameter */
+            nameObjPtr = argPtr;
+            defaultObjPtr = NULL;
+        }
+
+
+        if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
+            if (cmdPtr->u.proc.argsPos >= 0) {
+                Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
+                goto err;
+            }
+            cmdPtr->u.proc.argsPos = i;
+        }
+        else {
+            if (len == 2) {
+                cmdPtr->u.proc.optArity += n;
+            }
+            else {
+                cmdPtr->u.proc.reqArity += n;
+            }
+        }
+
+        cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
+        cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
+    }
+
     /* Add the new command */
 
     /* It may already exist, so we try to delete the old one.
@@ -3618,7 +3675,7 @@ static int JimCreateProcedure(Jim_Interp *interp, const char *cmdName,
      * BUT, if 'local' is in force, instead of deleting the existing
      * proc, we stash a reference to the old proc here.
      */
-    he = Jim_FindHashEntry(&interp->commands, cmdName);
+    he = Jim_FindHashEntry(&interp->commands, Jim_String(cmdName));
     if (he) {
         /* There was an old procedure with the same name, this requires
          * a 'proc epoch' update. */
@@ -3638,18 +3695,20 @@ static int JimCreateProcedure(Jim_Interp *interp, const char *cmdName,
     else {
         if (he) {
             /* Replace the existing proc */
-            Jim_DeleteHashEntry(&interp->commands, cmdName);
+            Jim_DeleteHashEntry(&interp->commands, Jim_String(cmdName));
         }
 
-        Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
+        Jim_AddHashEntry(&interp->commands, Jim_String(cmdName), cmdPtr);
     }
 
     /* Unlike Tcl, set the name of the proc as the result */
-    Jim_SetResultString(interp, cmdName, -1);
+    Jim_SetResult(interp, cmdName);
     return JIM_OK;
 
   err:
-    Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
+    if (cmdPtr->u.proc.staticVars) {
+        Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
+    }
     Jim_Free(cmdPtr->u.proc.staticVars);
     Jim_DecrRefCount(interp, argListObjPtr);
     Jim_DecrRefCount(interp, bodyObjPtr);
@@ -10115,6 +10174,45 @@ static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argVa
     return retcode;
 }
 
+/**
+ * Sets the interp result to be an error message indicating the required proc args.
+ */
+static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
+{
+    /* Create a nice error message, consistent with Tcl 8.5 */
+    Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
+    int i;
+
+    for (i = 0; i < cmd->u.proc.argListLen; i++) {
+        Jim_AppendString(interp, argmsg, " ", 1);
+
+        if (i == cmd->u.proc.argsPos) {
+            if (cmd->u.proc.arglist[i].defaultObjPtr) {
+                /* Renamed args */
+                Jim_AppendString(interp, argmsg, "?", 1);
+                Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
+                Jim_AppendString(interp, argmsg, " ...?", -1);
+            }
+            else {
+                /* We have plain args */
+                Jim_AppendString(interp, argmsg, "?argument ...?", -1);
+            }
+        }
+        else {
+            if (cmd->u.proc.arglist[i].defaultObjPtr) {
+                Jim_AppendString(interp, argmsg, "?", 1);
+                Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
+                Jim_AppendString(interp, argmsg, "?", 1);
+            }
+            else {
+                Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
+            }
+        }
+    }
+    Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
+    Jim_FreeNewObj(interp, argmsg);
+}
+
 /* Call a procedure implemented in Tcl.
  * It's possible to speed-up a lot this function, currently
  * the callframes are not cached, but allocated and
@@ -10123,52 +10221,17 @@ static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argVa
  *
  * This can be fixed just implementing callframes caching
  * in JimCreateCallFrame() and JimFreeCallFrame(). */
-int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr, int argc,
+static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr, int argc,
     Jim_Obj *const *argv)
 {
-    int i, d, retcode;
     Jim_CallFrame *callFramePtr;
-    Jim_Obj *argObjPtr;
-    Jim_Obj *procname = argv[0];
     Jim_Stack *prevLocalProcs;
+    int i, d, retcode, optargs;
 
     /* Check arity */
-    if (argc - 1 < cmd->u.proc.leftArity + cmd->u.proc.rightArity ||
-        (!cmd->u.proc.args && argc - 1 > cmd->u.proc.leftArity + cmd->u.proc.rightArity + cmd->u.proc.optionalArgs)) {
-        /* Create a nice error message, consistent with Tcl 8.5 */
-        Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
-        int arglen = Jim_ListLength(interp, cmd->u.proc.argListObjPtr);
-
-        for (i = 0; i < arglen; i++) {
-            Jim_Obj *objPtr;
-            Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, i, &argObjPtr, JIM_NONE);
-
-            Jim_AppendString(interp, argmsg, " ", 1);
-
-            if (i < cmd->u.proc.leftArity || i >= arglen - cmd->u.proc.rightArity) {
-                Jim_AppendObj(interp, argmsg, argObjPtr);
-            }
-            else if (i == arglen - cmd->u.proc.rightArity - cmd->u.proc.args) {
-                if (Jim_ListLength(interp, argObjPtr) == 1) {
-                    /* We have plain args */
-                    Jim_AppendString(interp, argmsg, "?argument ...?", -1);
-                }
-                else {
-                    Jim_AppendString(interp, argmsg, "?", 1);
-                    Jim_ListIndex(interp, argObjPtr, 1, &objPtr, JIM_NONE);
-                    Jim_AppendObj(interp, argmsg, objPtr);
-                    Jim_AppendString(interp, argmsg, " ...?", -1);
-                }
-            }
-            else {
-                Jim_AppendString(interp, argmsg, "?", 1);
-                Jim_ListIndex(interp, argObjPtr, 0, &objPtr, JIM_NONE);
-                Jim_AppendObj(interp, argmsg, objPtr);
-                Jim_AppendString(interp, argmsg, "?", 1);
-            }
-        }
-        Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procname, argmsg);
-        Jim_FreeNewObj(interp, argmsg);
+    if (argc - 1 < cmd->u.proc.reqArity ||
+        (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
+        JimSetProcWrongArgs(interp, argv[0], cmd);
         return JIM_ERR;
     }
 
@@ -10191,77 +10254,42 @@ int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int
     Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
     interp->framePtr = callFramePtr;
 
-    /* Simplify arg counting */
-    argv++;
-    argc--;
-
-    /* Set arguments */
+    /* How many optional args are available */
+    optargs = (argc - 1 - cmd->u.proc.reqArity);
 
-    /* Assign in this order:
-     * leftArity required args.
-     * rightArity required args (but actually do it last for simplicity)
-     * optionalArgs optional args
-     * remaining args into 'args' if 'args'
-     */
+    /* Step 'i' along the actual args, and step 'd' along the formal args */
+    i = 1;
+    for (d = 0; d < cmd->u.proc.argListLen; d++) {
+        Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
+        if (d == cmd->u.proc.argsPos) {
+            /* assign $args */
+            int argsLen = 0;
+            if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {
+                argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
+            }
+            Jim_Obj *listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);
 
-    /* Note that 'd' steps along the arg list, whilst argc/argv follow the supplied args */
+            /* It is possible to rename args. */
+            if (cmd->u.proc.arglist[d].defaultObjPtr) {
+                nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;
+            }
+            retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
+            if (retcode != JIM_OK) {
+                goto badargset;
+            }
 
-    /* leftArity required args */
-    for (d = 0; d < cmd->u.proc.leftArity; d++) {
-        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d, &argObjPtr, JIM_NONE);
-        retcode = JimSetProcArg(interp, argObjPtr, *argv++);
-        if (retcode != JIM_OK) {
-            goto badargset;
+            i += argsLen;
+            continue;
         }
-        argc--;
-    }
-
-    /* Shorten our idea of the number of supplied args */
-    argc -= cmd->u.proc.rightArity;
-
-    /* optionalArgs optional args */
-    for (i = 0; i < cmd->u.proc.optionalArgs; i++) {
-        Jim_Obj *nameObjPtr;
-        Jim_Obj *valueObjPtr;
 
-        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d++, &argObjPtr, JIM_NONE);
-
-        /* The name is the first element of the list */
-        Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
-        if (argc) {
-            valueObjPtr = *argv++;
-            argc--;
+        /* Optional or required? */
+        if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
+            retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);
         }
         else {
-            /* No more values, so use default */
-            /* The value is the second element of the list */
-            Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
+            /* Ran out, so use the default */
+            retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
         }
-        Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
-    }
-
-    /* Any remaining args go to 'args' */
-    if (cmd->u.proc.args) {
-        Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);
-
-        /* Get the 'args' name from the procedure args */
-        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d, &argObjPtr, JIM_NONE);
-
-        /* It is possible to rename args. */
-        i = Jim_ListLength(interp, argObjPtr);
-        if (i == 2) {
-            Jim_ListIndex(interp, argObjPtr, 1, &argObjPtr, JIM_NONE);
-        }
-
-        Jim_SetVariable(interp, argObjPtr, listObjPtr);
-        argv += argc;
-        d++;
-    }
-
-    /* rightArity required args */
-    for (i = 0; i < cmd->u.proc.rightArity; i++) {
-        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d++, &argObjPtr, JIM_NONE);
-        retcode = JimSetProcArg(interp, argObjPtr, *argv++);
         if (retcode != JIM_OK) {
             goto badargset;
         }
@@ -10307,7 +10335,7 @@ badargset:
     else if (retcode == JIM_ERR) {
         interp->addStackTrace++;
         Jim_DecrRefCount(interp, interp->errorProc);
-        interp->errorProc = procname;
+        interp->errorProc = argv[0];
         Jim_IncrRefCount(interp->errorProc);
     }
     return retcode;
@@ -12453,87 +12481,16 @@ static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const
 /* [proc] */
 static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
-    int argListLen;
-    int leftArity, rightArity;
-    int i;
-    int optionalArgs = 0;
-    int args = 0;
-
     if (argc != 4 && argc != 5) {
         Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
         return JIM_ERR;
     }
 
-    if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
-        return JIM_ERR;
-    }
-
-    argListLen = Jim_ListLength(interp, argv[2]);
-    leftArity = 0;
-    rightArity = 0;
-
-    /* Examine the argument list for default parameters and 'args' */
-    for (i = 0; i < argListLen; i++) {
-        Jim_Obj *argPtr;
-        int len;
-
-        /* Examine a parameter */
-        Jim_ListIndex(interp, argv[2], i, &argPtr, JIM_NONE);
-        len = Jim_ListLength(interp, argPtr);
-        if (len == 0) {
-            Jim_SetResultString(interp, "procedure has argument with no name", -1);
-            return JIM_ERR;
-        }
-        if (len > 2) {
-            Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
-            return JIM_ERR;
-        }
-
-        if (len == 2) {
-            /* May be {args newname} */
-            Jim_ListIndex(interp, argPtr, 0, &argPtr, JIM_NONE);
-        }
-
-        if (Jim_CompareStringImmediate(interp, argPtr, "args")) {
-            if (args) {
-                Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
-                return JIM_ERR;
-            }
-            if (rightArity) {
-                Jim_SetResultString(interp, "procedure has 'args' in invalid position", -1);
-                return JIM_ERR;
-            }
-            args = 1;
-            continue;
-        }
-
-        /* Does this parameter have a default? */
-        if (len == 1) {
-            /* A required arg. Is it part of leftArity or rightArity? */
-            if (optionalArgs || args) {
-                rightArity++;
-            }
-            else {
-                leftArity++;
-            }
-        }
-        else {
-            /* Optional arg. Can't be after rightArity */
-            if (rightArity || args) {
-                Jim_SetResultString(interp, "procedure has optional arg in invalid position", -1);
-                return JIM_ERR;
-            }
-            optionalArgs++;
-        }
-    }
-
     if (argc == 4) {
-        return JimCreateProcedure(interp, Jim_String(argv[1]),
-            argv[2], NULL, argv[3], leftArity, optionalArgs, args, rightArity);
+        return JimCreateProcedure(interp, argv[1], argv[2], NULL, argv[3]);
     }
     else {
-        return JimCreateProcedure(interp, Jim_String(argv[1]),
-            argv[2], argv[3], argv[4], leftArity, optionalArgs, args, rightArity);
+        return JimCreateProcedure(interp, argv[1], argv[2], argv[3], argv[4]);
     }
 }