? generic/tclObj.c.ORIG
? unix/ERR
? unix/dltest.marker
? unix/tclsh-head
? unix/tclsh-noAsync
? unix/tclsh-noStart
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.99
diff -u -r1.99 tclBasic.c
--- generic/tclBasic.c	6 Apr 2004 22:25:48 -0000	1.99
+++ generic/tclBasic.c	21 Apr 2004 19:05:45 -0000
@@ -50,6 +50,10 @@
  * The built-in commands, and the procedures that implement them:
  */
 
+EXTERN int		Tcl_LambdaObjCmd _ANSI_ARGS_((ClientData clientData, 
+				Tcl_Interp * interp, int objc, 
+				Tcl_Obj *CONST objv[]));
+
 static CmdInfo builtInCmds[] = {
     /*
      * Commands in the generic core. Note that at least one of the proc or
@@ -489,6 +493,14 @@
     iPtr->flags |= EXPR_INITIALIZED;
 
     /*
+     * Create the Lambda command.
+     */
+
+    Tcl_CreateObjCommand(interp, "::tcl::lambda::Lambda",
+	    Tcl_LambdaObjCmd, NULL,NULL);
+    
+    
+    /*
      * Do Multiple/Safe Interps Tcl init stuff
      */
 
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.58
diff -u -r1.58 tclObj.c
--- generic/tclObj.c	19 Apr 2004 18:40:59 -0000	1.58
+++ generic/tclObj.c	21 Apr 2004 19:05:45 -0000
@@ -3217,7 +3217,22 @@
 	     */
 
             Command *cmdPtr = resPtr->cmdPtr;
-            TclCleanupCommand(cmdPtr);
+	    
+	    TclCleanupCommand(cmdPtr);
+
+	    /*
+	     * If the second pointer is not NULL, this is the name of
+	     * a self-cleaning proc (a lambda). In that case, if the
+	     * only reference to the command is in the hash table,
+	     * delete the command.
+	     */
+
+	    if (objPtr->internalRep.twoPtrValue.ptr2 != NULL
+		    && cmdPtr->refCount == 1) {
+		Tcl_DeleteCommandFromToken(resPtr->refNsPtr->interp,
+			(Tcl_Command)cmdPtr);
+	    }
+	    
             ckfree((char *) resPtr);
         }
     }
@@ -3252,7 +3267,7 @@
         (ResolvedCmdName *) srcPtr->internalRep.twoPtrValue.ptr1;
 
     copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
-    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    copyPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2;
     if (resPtr != NULL) {
         resPtr->refCount++;
     }
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.50
diff -u -r1.50 tclProc.c
--- generic/tclProc.c	9 Mar 2004 12:59:05 -0000	1.50
+++ generic/tclProc.c	21 Apr 2004 19:05:45 -0000
@@ -42,6 +42,46 @@
     ProcBodySetFromAny		/* SetFromAny procedure */
 };
 
+
+int
+Tcl_LambdaObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;		/* Not used. */
+    Tcl_Interp *interp;		/* Current interpreter. */
+    int objc;			/* Number of arguments. */
+    Tcl_Obj *CONST objv[];	/* Argument objects. */
+{
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetCommandFromObj(interp, objv[1]) != NULL) {
+	/* the lambda exists already: mark as lambda and
+	 * exit. */
+	goto exit;
+    }
+    
+
+    if (Tcl_ProcObjCmd(dummy, interp, objc, objv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now convert the name obj to cmdNameType, and set its
+     * ptr2 to not-NULL, indicating it is a self-cleaning
+     * proc.
+     */
+    
+    if (Tcl_GetCommandFromObj(interp, objv[1]) == NULL) {
+	/* FIXME: error message? Should never happen ...*/
+	return TCL_ERROR;
+    }
+
+    exit:
+    objv[1]->internalRep.twoPtrValue.ptr2 = (VOID *) 1;
+    return TCL_OK;
+}
+
 /*
  *----------------------------------------------------------------------
  *
Index: library/init.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/init.tcl,v
retrieving revision 1.60
diff -u -r1.60 init.tcl
--- library/init.tcl	17 Mar 2004 18:14:14 -0000	1.60
+++ library/init.tcl	21 Apr 2004 19:05:45 -0000
@@ -167,10 +167,24 @@
     global auto_noexec auto_noload env unknown_pending tcl_interactive
     global errorCode errorInfo
 
+    set cmd [lindex $args 0]
+
+    # If the command is in the ::tcl::lambda namespace, try to create
+    # a lambda expression.
+
+    if {[namespace qualifiers $cmd] eq "::tcl::lambda"} {
+	set ret [catch {uplevel 1 [linsert $args 0 ::tcl::lambda::Create]} result]
+        if {$ret == 0} {
+            return $result
+        } else {
+	    return -code $ret -errorcode $errorCode $result
+        }
+    }
+
+
     # If the command word has the form "namespace inscope ns cmd"
     # then concatenate its arguments onto the end and evaluate it.
 
-    set cmd [lindex $args 0]
     if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
         set arglist [lrange $args 1 end]
 	set ret [catch {uplevel 1 ::$cmd $arglist} result]
@@ -732,3 +746,26 @@
     }
     return
 }
+
+# Prepare the lambda machinery
+
+namespace eval ::tcl::lambda {
+    proc Create {name args} {
+	set locName [namespace tail $name]
+	if {[llength $locName] != 2} {
+	    error "FIXME: error message?"
+	}
+
+	set argList [lindex $locName 0]
+	set body [lindex $locName 1]
+	Lambda $name $argList $body
+	uplevel 1 [linsert $args 0 $name]
+    }
+}
+
+proc lambda {argList body} {
+    set name [list ::tcl::lambda:: $argList $body] 
+    ::tcl::lambda::Lambda $name $argList $body
+    set name
+}
+
