Create a $&throwonfalse primitive and false exception handling

es.h

@@ -165,13 +165,14 @@ extern unsigned long evaldepth, maxevaldepth;
 
 #define	eval_inchild		1
 #define	eval_exitonfalse	2
-#define	eval_flags		(eval_inchild|eval_exitonfalse)
+#define	eval_throwonfalse	4
+#define	eval_flags		(eval_inchild|eval_exitonfalse|eval_throwonfalse)
 
 
 /* glom.c */
 
-extern List *glom(Tree *tree, Binding *binding, Boolean globit);
-extern List *glom2(Tree *tree, Binding *binding, StrList **quotep);
+extern List *glom(Tree *tree, Binding *binding, Boolean globit, int evalflags);
+extern List *glom2(Tree *tree, Binding *binding, StrList **quotep, int evalflags);
 
 
 /* glob.c */
@@ -303,11 +304,11 @@ extern List *runfd(int fd, const char *name, int flags);
 extern List *runstring(const char *str, int flags);
 
 /* eval_* flags are also understood as runflags */
-#define	run_interactive		 4	/* -i or $0[0] = '-' */
-#define	run_noexec		 8	/* -n */
-#define	run_echoinput		16	/* -v */
-#define	run_printcmds		32	/* -x */
-#define	run_lisptrees		64	/* -L and defined(LISPTREES) */
+#define	run_interactive		  8	/* -i or $0[0] = '-' */
+#define	run_noexec		 16	/* -n */
+#define	run_echoinput		 32	/* -v */
+#define	run_printcmds		 64	/* -x */
+#define	run_lisptrees		128	/* -L and defined(LISPTREES) */
 
 
 /* opt.c */

eval.c

@@ -47,17 +47,17 @@ extern List *forkexec(char *file, List *list, Boolean inchild) {
 }
 
 /* assign -- bind a list of values to a list of variables */
-static List *assign(Tree *varform, Tree *valueform0, Binding *binding0) {
+static List *assign(Tree *varform, Tree *valueform0, Binding *binding0, int flags) {
 	Ref(List *, result, NULL);
 
 	Ref(Tree *, valueform, valueform0);
 	Ref(Binding *, binding, binding0);
-	Ref(List *, vars, glom(varform, binding, FALSE));
+	Ref(List *, vars, glom(varform, binding, FALSE, flags));
 
 	if (vars == NULL)
 		fail("es:assign", "null variable name");
 
-	Ref(List *, values, glom(valueform, binding, TRUE));
+	Ref(List *, values, glom(valueform, binding, TRUE, flags));
 	result = values;
 
 	for (; vars != NULL; vars = vars->next) {
@@ -83,7 +83,7 @@ static List *assign(Tree *varform, Tree *valueform0, Binding *binding0) {
 
 /* letbindings -- create a new Binding containing let-bound variables */
 static Binding *letbindings(Tree *defn0, Binding *outer0,
-			    Binding *context0, int UNUSED evalflags) {
+			    Binding *context0, int evalflags) {
 	Ref(Binding *, binding, outer0);
 	Ref(Binding *, context, context0);
 	Ref(Tree *, defn, defn0);
@@ -95,8 +95,8 @@ static Binding *letbindings(Tree *defn0, Binding *outer0,
 
 		Ref(Tree *, assign, defn->u[0].p);
 		assert(assign->kind == nAssign);
-		Ref(List *, vars, glom(assign->u[0].p, context, FALSE));
-		Ref(List *, values, glom(assign->u[1].p, context, TRUE));
+		Ref(List *, vars, glom(assign->u[0].p, context, FALSE, evalflags));
+		Ref(List *, values, glom(assign->u[1].p, context, TRUE, evalflags));
 
 		if (vars == NULL)
 			fail("es:let", "null variable name");
@@ -177,8 +177,8 @@ static List *forloop(Tree *defn0, Tree *body0,
 			continue;
 		Ref(Tree *, assign, defn->u[0].p);
 		assert(assign->kind == nAssign);
-		Ref(List *, vars, glom(assign->u[0].p, outer, FALSE));
-		Ref(List *, list, glom(assign->u[1].p, outer, TRUE));
+		Ref(List *, vars, glom(assign->u[0].p, outer, FALSE, evalflags));
+		Ref(List *, list, glom(assign->u[1].p, outer, TRUE, evalflags));
 		if (vars == NULL)
 			fail("es:for", "null variable name");
 		for (; vars != NULL; vars = vars->next) {
@@ -237,29 +237,29 @@ static List *forloop(Tree *defn0, Tree *body0,
 
 /* matchpattern -- does the text match a pattern? */
 static List *matchpattern(Tree *subjectform0, Tree *patternform0,
-			  Binding *binding) {
+			  Binding *binding, int flags) {
 	Boolean result;
 	List *pattern;
 	Ref(Binding *, bp, binding);
 	Ref(Tree *, patternform, patternform0);
-	Ref(List *, subject, glom(subjectform0, bp, TRUE));
+	Ref(List *, subject, glom(subjectform0, bp, TRUE, flags));
 	Ref(StrList *, quote, NULL);
-	pattern = glom2(patternform, bp, &quote);
+	pattern = glom2(patternform, bp, &quote, flags);
 	result = listmatch(subject, pattern, quote);
 	RefEnd4(quote, subject, patternform, bp);
 	return result ? ltrue : lfalse;
 }
 
 /* extractpattern -- Like matchpattern, but returns matches */
 static List *extractpattern(Tree *subjectform0, Tree *patternform0,
-			    Binding *binding) {
+			    Binding *binding, int flags) {
 	List *pattern;
 	Ref(List *, result, NULL);
 	Ref(Binding *, bp, binding);
 	Ref(Tree *, patternform, patternform0);
-	Ref(List *, subject, glom(subjectform0, bp, TRUE));
+	Ref(List *, subject, glom(subjectform0, bp, TRUE, flags));
 	Ref(StrList *, quote, NULL);
-	pattern = glom2(patternform, bp, &quote);
+	pattern = glom2(patternform, bp, &quote, flags);
 	result = (List *) extractmatches(subject, pattern, quote);
 	RefEnd4(quote, subject, patternform, bp);
 	RefReturn(result);
@@ -282,14 +282,14 @@ extern List *walk(Tree *tree0, Binding *binding0, int flags) {
 	    case nWord: case nThunk: case nLambda: case nCall: case nPrim: {
 		List *list;
 		Ref(Binding *, bp, binding);
-		list = glom(tree, binding, TRUE);
+		list = glom(tree, binding, TRUE, flags);
 		binding = bp;
 		RefEnd(bp);
 		return eval(list, binding, flags);
 	    }
 
 	    case nAssign:
-		return assign(tree->u[0].p, tree->u[1].p, binding);
+		return assign(tree->u[0].p, tree->u[1].p, binding, flags);
 
 	    case nLet: case nClosure:
 		Ref(Tree *, body, tree->u[1].p);
@@ -305,10 +305,10 @@ extern List *walk(Tree *tree0, Binding *binding0, int flags) {
 		return forloop(tree->u[0].p, tree->u[1].p, binding, flags);
 
 	    case nMatch:
-		return matchpattern(tree->u[0].p, tree->u[1].p, binding);
+		return matchpattern(tree->u[0].p, tree->u[1].p, binding, flags);
 
 	    case nExtract:
-		return extractpattern(tree->u[0].p, tree->u[1].p, binding);
+		return extractpattern(tree->u[0].p, tree->u[1].p, binding, flags);
 
 	    default:
 		panic("walk: bad node kind %d", tree->kind);
@@ -421,7 +421,7 @@ extern List *eval(List *list0, Binding *binding0, int flags) {
 			EndExceptionHandler
 			break;
 		    case nList: {
-			Ref(List *, lp, glom(cp->tree, cp->binding, TRUE));
+			Ref(List *, lp, glom(cp->tree, cp->binding, TRUE, flags));
 			list = append(lp, list->next);
 			RefEnd(lp);
 			goto restart;
@@ -483,6 +483,10 @@ extern List *eval(List *list0, Binding *binding0, int flags) {
 	--evaldepth;
 	if ((flags & eval_exitonfalse) && !istrue(list) && !did_assign)
 		esexit(exitstatus(list));
+	if ((flags & eval_throwonfalse) && !istrue(list) && !did_assign) {
+		Term *t = mkstr("false");
+		throw(mklist(t, list));
+	}
 	RefEnd2(funcname, binding);
 	RefReturn(list);
 }

glom.c

@@ -149,7 +149,7 @@ static List *subscript(List *list, List *subs) {
 }
 
 /* glom1 -- glom when we don't need to produce a quote list */
-static List *glom1(Tree *tree, Binding *binding) {
+static List *glom1(Tree *tree, Binding *binding, int evalflags) {
 	Ref(List *, result, NULL);
 	Ref(List *, tail, NULL);
 	Ref(Tree *, tp, tree);
@@ -179,7 +179,7 @@ static List *glom1(Tree *tree, Binding *binding) {
 			tp = NULL;
 			break;
 		case nVar:
-			Ref(List *, var, glom1(tp->u[0].p, bp));
+			Ref(List *, var, glom1(tp->u[0].p, bp, evalflags));
 			tp = NULL;
 			for (; var != NULL; var = var->next) {
 				list = listcopy(varlookup(getstr(var->term), bp));
@@ -196,29 +196,39 @@ static List *glom1(Tree *tree, Binding *binding) {
 			RefEnd(var);
 			break;
 		case nVarsub:
-			list = glom1(tp->u[0].p, bp);
+			list = glom1(tp->u[0].p, bp, evalflags);
 			if (list == NULL)
 				fail("es:glom", "null variable name in subscript");
 			if (list->next != NULL)
 				fail("es:glom", "multi-word variable name in subscript");
 			Ref(char *, name, getstr(list->term));
 			list = varlookup(name, bp);
-			Ref(List *, sub, glom1(tp->u[1].p, bp));
+			Ref(List *, sub, glom1(tp->u[1].p, bp, evalflags));
 			tp = NULL;
 			list = subscript(list, sub);
 			RefEnd2(sub, name);
 			break;
 		case nCall:
-			list = listcopy(walk(tp->u[0].p, bp, 0));
+#if THROW_ON_FALSE
+			ExceptionHandler
+#endif
+				list = listcopy(walk(tp->u[0].p, bp,
+						evalflags & eval_throwonfalse));
+#if THROW_ON_FALSE
+			CatchException (e)
+				if (termeq(e->term, "false")) list = e->next;
+				else throw(e);
+			EndExceptionHandler
+#endif
 			tp = NULL;
 			break;
 		case nList:
-			list = glom1(tp->u[0].p, bp);
+			list = glom1(tp->u[0].p, bp, evalflags);
 			tp = tp->u[1].p;
 			break;
 		case nConcat:
-			Ref(List *, l, glom1(tp->u[0].p, bp));
-			Ref(List *, r, glom1(tp->u[1].p, bp));
+			Ref(List *, l, glom1(tp->u[0].p, bp, evalflags));
+			Ref(List *, r, glom1(tp->u[1].p, bp, evalflags));
 			tp = NULL;
 			list = concat(l, r);
 			RefEnd2(r, l);
@@ -243,7 +253,7 @@ static List *glom1(Tree *tree, Binding *binding) {
 }
 
 /* glom2 -- glom and produce a quoting list */
-extern List *glom2(Tree *tree, Binding *binding, StrList **quotep) {
+extern List *glom2(Tree *tree, Binding *binding, StrList **quotep, int evalflags) {
 	Ref(List *, result, NULL);
 	Ref(List *, tail, NULL);
 	Ref(StrList *, qtail, NULL);
@@ -270,22 +280,22 @@ extern List *glom2(Tree *tree, Binding *binding, StrList **quotep) {
 			tp = NULL;
 			break;
 		case nList:
-			list = glom2(tp->u[0].p, bp, &qlist);
+			list = glom2(tp->u[0].p, bp, &qlist, evalflags);
 			tp = tp->u[1].p;
 			break;
 		case nConcat:
 			Ref(List *, l, NULL);
 			Ref(List *, r, NULL);
 			Ref(StrList *, ql, NULL);
 			Ref(StrList *, qr, NULL);
-			l = glom2(tp->u[0].p, bp, &ql);
-			r = glom2(tp->u[1].p, bp, &qr);
+			l = glom2(tp->u[0].p, bp, &ql, evalflags);
+			r = glom2(tp->u[1].p, bp, &qr, evalflags);
 			list = qconcat(l, r, ql, qr, &qlist);
 			RefEnd4(qr, ql, r, l);
 			tp = NULL;
 			break;
 		default:
-			list = glom1(tp, bp);
+			list = glom1(tp, bp, evalflags);
 			Ref(List *, lp, list);
 			for (; lp != NULL; lp = lp->next)
 				qlist = mkstrlist(QUOTED, qlist);
@@ -316,16 +326,16 @@ extern List *glom2(Tree *tree, Binding *binding, StrList **quotep) {
 }
 
 /* glom -- top level glom dispatching */
-extern List *glom(Tree *tree, Binding *binding, Boolean globit) {
+extern List *glom(Tree *tree, Binding *binding, Boolean globit, int evalflags) {
 	if (globit) {
 		Ref(List *, list, NULL);
 		Ref(StrList *, quote, NULL);
 		RefAdd(binding);
-		list = glom2(tree, binding, &quote);
+		list = glom2(tree, binding, &quote, evalflags);
 		list = glob(list, quote, binding);
 		RefRemove(binding);
 		RefEnd(quote);
 		RefReturn(list);
 	} else
-		return glom1(tree, binding);
+		return glom1(tree, binding, evalflags);
 }

initial.es

@@ -65,7 +65,6 @@
 
 fn-.		= $&dot
 fn-access	= $&access
-fn-break	= $&break
 fn-catch	= $&catch
 fn-echo		= $&echo
 fn-exec		= $&exec
@@ -190,20 +189,33 @@ fn whatis {
 #	does not catch the return exception.  It does, however, catch break.
 
 fn-while = $&noreturn @ cond body {
+	let (result = <=true)
 	catch @ e value {
-		if {!~ $e break} {
+		if {~ $e break} {
+			result = $value
+		} {~ $e caught-false} {
+			throw false $value
+		} {
 			throw $e $value
 		}
-		result $value
 	} {
-		let (result = <=true)
-			forever {
-				if {!$cond} {
-					throw break $result
-				} {
-					result = <=$body
+		forever {
+			if {!$cond} {
+				throw break $result
+			} {
+				result = <={
+					catch @ e rest {
+						if {~ $e false} {
+							throw caught-false $rest
+						} {
+							throw $e $rest
+						}
+					} {
+						$body
+					}
 				}
 			}
+		}
 	}
 }
 
@@ -702,7 +714,6 @@ fn %interactive-loop {
 				throw $e $type $msg
 			} {~ $e error} {
 				echo >[1=2] $msg
-				$fn-%dispatch false
 			} {~ $e signal} {
 				if {!~ $type sigint sigterm sigquit} {
 					echo >[1=2] caught unexpected signal: $type
@@ -735,7 +746,11 @@ fn-%eval-noprint	=					# <default>
 fn-%eval-print		= $&noreturn @ { echo $* >[1=2]; $* }	# -x
 fn-%noeval-noprint	= { }					# -n
 fn-%noeval-print	= @ { echo $* >[1=2] }			# -n -x
-fn-%exit-on-false	= $&exitonfalse				# -e
+if {~ <=$&primitives throwonfalse} {
+	fn-%exit-on-false	= $&throwonfalse		# -e
+} {
+	fn-%exit-on-false	= $&exitonfalse			# -e
+}
 
 
 #

input.c

@@ -243,6 +243,9 @@ extern List *runinput(Input *in, int runflags) {
 		if (flags & eval_exitonfalse) {
 			dispatch = mklist(mkstr("%exit-on-false"), dispatch);
 			flags &= ~eval_exitonfalse;
+		} else if (flags & eval_throwonfalse) {
+			dispatch = mklist(mkstr("%exit-on-false"), dispatch);
+			flags &= ~eval_throwonfalse;
 		}
 		varpush(&push, "fn-%dispatch", dispatch);
 

main.c

@@ -54,7 +54,7 @@ static void runesrc(void) {
 		ExceptionHandler
 			runfd(fd, esrc, 0);
 		CatchException (e)
-			if (termeq(e->term, "exit"))
+			if (termeq(e->term, "exit") || termeq(e->term, "false"))
 				exit(exitstatus(e->next));
 			else if (termeq(e->term, "error")) {
 				eprint("%L\n",
@@ -216,7 +216,7 @@ int main(int argc, char **argv0) {
 
 	CatchException (e)
 
-		if (termeq(e->term, "exit")) {
+		if (termeq(e->term, "exit") || termeq(e->term, "false")) {
 			status = exitstatus(e->next);
 			goto return_main;
 		} else if (termeq(e->term, "error")) {