Perform lexical binding of $0 in functions

doc/es.1

@@ -1279,7 +1279,9 @@ is introduced with the syntax
 .PP
 If the function name appears as the first word of a command,
 the commands are run, with the named parameters bound to the
-arguments to the function.
+arguments to the function and
+.Cr $0
+bound to the function's name.
 .PP
 The similarity between functions and lambdas is not coincidental.
 A function in
@@ -1306,11 +1308,6 @@ which is equivalent to the assignment
 .Ci fn\- name =
 .De
 .PP
-If, as the most common case, a function variable is bound to a lambda,
-when the function is invoked, the variable
-.Cr $0
-is bound (dynamically, see below) to the name of the function.
-.PP
 Lambdas are just another form of code fragment, and, as such, can be
 exported in the environment, passed as arguments, etc.
 The central difference between the two forms is that lambdas bind their arguments,
@@ -1431,11 +1428,10 @@ A settor function is a variable of the form
 .Ci set- var\fR,
 which is typically bound to a lambda.
 Whenever a value is assigned to the named variable,
-the lambda is invoked with its arguments bound to the new value.
-While the settor function is running,
-the variable
+the lambda is invoked with its arguments bound to the new value
+and
 .Cr $0
-is bound to the name of the variable being assigned.
+bound to the name of the variable being assigned.
 The result of the settor function is used as the actual value in
 the assignment.
 .PP
@@ -1574,12 +1570,11 @@ Holds the value of
 with which
 .I es
 was invoked.
-Additionally,
+Additionally, within a function body,
 .Cr $0
-is set to the name of a function for the duration of
-the execution of that function, and
+is lexically bound to the name of the function, and
 .Cr $0
-is also set to the name of the
+is also dynamically bound to the name of the
 file being interpreted for the duration of a
 .Cr "." " command."
 .TP

es.h

@@ -192,6 +192,7 @@ extern void hidevariables(void);
 extern void validatevar(const char *var);
 extern List *varlookup(const char *name, Binding *binding);
 extern List *varlookup2(char *name1, char *name2, Binding *binding);
+extern List *fnlookup(char *prefix, char *name, List *args, Binding *binding);
 extern void vardef(char *, Binding *, List *);
 extern Vector *mkenv(void);
 extern void setnoexport(List *list);

eval.c

@@ -391,20 +391,12 @@ extern List *eval(List *list0, Binding *binding0, int flags) {
 		    case nLambda:
 			ExceptionHandler
 
-				Push p;
 				Ref(Tree *, tree, cp->tree);
 				Ref(Binding *, context,
 					       bindargs(tree->u[0].p,
 							list->next,
 							cp->binding));
-				if (funcname != NULL)
-					varpush(&p, "0",
-						    mklist(mkterm(funcname,
-								  NULL),
-							   NULL));
 				list = walk(tree->u[1].p, context, flags);
-				if (funcname != NULL)
-					varpop(&p);
 				RefEnd2(context, tree);
 
 			CatchException (e)
@@ -442,10 +434,10 @@ extern List *eval(List *list0, Binding *binding0, int flags) {
 	/* the logic here is duplicated in $&whatis */
 
 	Ref(char *, name, getstr(list->term));
-	fn = varlookup2("fn-", name, binding);
+	fn = fnlookup("fn-", name, list->next, binding);
 	if (fn != NULL) {
 		funcname = name;
-		list = append(fn, list->next);
+		list = fn;
 		RefPop(name);
 		goto restart;
 	}

test/tests/trip.es

@@ -265,7 +265,27 @@ test 'exit with signal codes' {
 		'die from a thrown signal even if we would ignore it externally'
 }
 
-test '$0 assignment' {
+test 'lexical $0' {
+	local (0 = es) {
+		assert {~ `{echo echo $0} es}
+		assert {if {~ $0 es} {true} {false}}
+		assert {let (fn if {$&if $*}) {if {~ $0 es} {true} {false}}}
+		assert {let (fn-if = $&noreturn @ {$&if $*}) {
+			if {~ $0 es} {true} {false}
+		}}
+		assert {~ <={true && result $0} es}
+
+		let (fn x {result $0 <={$*}})
+		let (result = <={x {result $0}})
+		assert {~ $result(1) x && ~ $result(2) es}
+
+		let (fn x {$*})
+		let (fn-doit = x @ {result $0})
+		assert {~ <=doit doit}
+	}
+}
+
+test 'binary $0' {
 	local (path = .)
 		assert {~ `{testrun a} 'testrun'} '$0 from hacked path is ok'
 	local (fn %pathsearch bin {result ./testrun a})

var.c

@@ -152,7 +152,7 @@ extern List *varlookup(const char *name, Binding *bp) {
 
 extern List *varlookup2(char *name1, char *name2, Binding *bp) {
 	Var *var;
-	
+
 	for (; bp != NULL; bp = bp->next)
 		if (streq2(bp->name, name1, name2))
 			return bp->defn;
@@ -163,22 +163,42 @@ extern List *varlookup2(char *name1, char *name2, Binding *bp) {
 	return var->defn;
 }
 
+/* fnlookup -- look up a function by name and prefix, lexically bind $0 to name,
+ * and append arguments while we're at it. */
+extern List *fnlookup(char *prefix, char *name, List *args, Binding *bp) {
+	List *lname, *lp, **prevp;
+	List *defn = varlookup2(prefix, name, bp);
+	if (defn == NULL)
+		return NULL;
+	gcdisable();
+
+	lname = mklist(mkstr(name), NULL);
+	for (prevp = &lp; defn != NULL; defn = defn->next) {
+		List *np;
+		Term *t = defn->term;
+		Closure *c = getclosure(t);
+		if (c != NULL && (c->tree->kind == nLambda || c->tree->kind == nThunk)) {
+			c = mkclosure(c->tree, mkbinding("0", lname, c->binding));
+			t = mkterm(NULL, c);
+		}
+		np = mklist(t, NULL);
+		*prevp = np;
+		prevp = &np->next;
+	}
+	*prevp = args;
+
+	Ref(List *, result, lp);
+	gcenable();
+	RefReturn(result);
+}
+
 static List *callsettor(char *name, List *defn) {
-	Push p;
 	List *settor;
 
-	if (specialvar(name) || (settor = varlookup2("set-", name, NULL)) == NULL)
+	if (specialvar(name) || (settor = fnlookup("set-", name, defn, NULL)) == NULL)
 		return defn;
 
-	Ref(List *, lp, defn);
-	Ref(List *, fn, settor);
-	varpush(&p, "0", mklist(mkstr(name), NULL));
-
-	lp = listcopy(eval(append(fn, lp), NULL, 0));
-
-	varpop(&p);
-	RefEnd(fn);
-	RefReturn(lp);
+	return listcopy(eval(settor, NULL, 0));
 }
 
 static void vardef0(char *name, Binding *binding, List *defn, Boolean startup) {