From 768d2c055a10a48ad2b3087475e8a9f1bffbeacf Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Tue, 5 Jul 2011 12:27:13 +1000
Subject: Implement the lassign command in C

For efficiency since it can be heavily used

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 jim.c      | 34 ++++++++++++++++++++++++++++++++++
 stdlib.tcl |  8 --------
 2 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/jim.c b/jim.c
index a4923b2..fb05b6b 100644
--- a/jim.c
+++ b/jim.c
@@ -11501,6 +11501,39 @@ static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
     return JimForeachMapHelper(interp, argc, argv, 1);
 }
 
+/* [lassign] */
+static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+    int result = JIM_ERR;
+    int i;
+    Jim_ListIter iter;
+    Jim_Obj *resultObj;
+
+    if (argc < 2) {
+        Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?");
+        return JIM_ERR;
+    }
+
+    JimListIterInit(&iter, argv[1]);
+
+    for (i = 2; i < argc; i++) {
+        Jim_Obj *valObj = JimListIterNext(interp, &iter);
+        result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj);
+        if (result != JIM_OK) {
+            return result;
+        }
+    }
+
+    resultObj = Jim_NewListObj(interp, NULL, 0);
+    while (!JimListIterDone(interp, &iter)) {
+        Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter));
+    }
+
+    Jim_SetResult(interp, resultObj);
+
+    return JIM_OK;
+}
+
 /* [if] */
 static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
 {
@@ -14432,6 +14465,7 @@ static const struct {
     {"for", Jim_ForCoreCommand},
     {"foreach", Jim_ForeachCoreCommand},
     {"lmap", Jim_LmapCoreCommand},
+    {"lassign", Jim_LassignCoreCommand},
     {"if", Jim_IfCoreCommand},
     {"switch", Jim_SwitchCoreCommand},
     {"list", Jim_ListCoreCommand},
diff --git a/stdlib.tcl b/stdlib.tcl
index 177373d..5dbdce6 100644
--- a/stdlib.tcl
+++ b/stdlib.tcl
@@ -28,14 +28,6 @@ proc function {value} {
 	return $value
 }
 
-# Tcl 8.5 lassign
-proc lassign {list args} {
-	# in case the list is empty...
-	lappend list {}
-	uplevel 1 [list foreach $args $list break]
-	lrange $list [llength $args] end-1
-}
-
 # Returns a list of proc filename line ...
 # with 3 entries for each stack frame (proc),
 # (deepest level first)
-- 
cgit v1.1