diff --git a/es.h b/es.h index f393629..00b1d19 100644 --- a/es.h +++ b/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 */ diff --git a/eval.c b/eval.c index cbb44dc..28c9749 100644 --- a/eval.c +++ b/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,14 +237,14 @@ 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, "e); + pattern = glom2(patternform, bp, "e, flags); result = listmatch(subject, pattern, quote); RefEnd4(quote, subject, patternform, bp); return result ? ltrue : lfalse; @@ -252,14 +252,14 @@ static List *matchpattern(Tree *subjectform0, Tree *patternform0, /* 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, "e); + pattern = glom2(patternform, bp, "e, 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); } diff --git a/glom.c b/glom.c index 632be93..0f753b9 100644 --- a/glom.c +++ b/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,7 +280,7 @@ 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: @@ -278,14 +288,14 @@ extern List *glom2(Tree *tree, Binding *binding, StrList **quotep) { 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, "e); + list = glom2(tree, binding, "e, evalflags); list = glob(list, quote, binding); RefRemove(binding); RefEnd(quote); RefReturn(list); } else - return glom1(tree, binding); + return glom1(tree, binding, evalflags); } diff --git a/initial.es b/initial.es index b8e422b..74ff9e9 100644 --- a/initial.es +++ b/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 = # 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 +} # diff --git a/input.c b/input.c index 3d83810..336af16 100644 --- a/input.c +++ b/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); diff --git a/main.c b/main.c index 3c8e941..776704b 100644 --- a/main.c +++ b/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")) { diff --git a/prim-ctl.c b/prim-ctl.c index 1b0a86c..e1a3988 100644 --- a/prim-ctl.c +++ b/prim-ctl.c @@ -17,7 +17,15 @@ PRIM(if) { for (; lp != NULL; lp = lp->next) { List *cond = ltrue; if (lp->next != NULL) { - cond = eval1(lp->term, 0); +#if THROW_ON_FALSE + ExceptionHandler +#endif + cond = eval1(lp->term, evalflags & eval_throwonfalse); +#if THROW_ON_FALSE + CatchException (e) + cond = e->next; + EndExceptionHandler +#endif lp = lp->next; } if (istrue(cond)) { @@ -33,7 +41,7 @@ PRIM(if) { PRIM(forever) { Ref(List *, body, list); for (;;) - list = eval(body, NULL, evalflags & eval_exitonfalse); + list = eval(body, NULL, evalflags &~ eval_inchild); RefEnd(body); return list; } diff --git a/prim-etc.c b/prim-etc.c index 23d14a4..a6b3214 100644 --- a/prim-etc.c +++ b/prim-etc.c @@ -169,9 +169,15 @@ PRIM(parse) { return result; } +#if THROW_ON_FALSE +PRIM(throwonfalse) { + return eval(list, NULL, evalflags | eval_throwonfalse); +} +#else PRIM(exitonfalse) { return eval(list, NULL, evalflags | eval_exitonfalse); } +#endif PRIM(batchloop) { Ref(List *, result, ltrue); @@ -297,7 +303,11 @@ extern Dict *initprims_etc(Dict *primdict) { X(internals); X(result); X(isinteractive); +#if THROW_ON_FALSE + X(throwonfalse); +#else X(exitonfalse); +#endif X(noreturn); X(setmaxevaldepth); return primdict;