1 /* prim-ctl.c -- control flow primitives ($Revision: 1.1.1.1 $) */
2
3 #include "es.h"
4 #include "prim.h"
5
PRIM(seq)6 PRIM(seq) {
7 Ref(List *, result, true);
8 Ref(List *, lp, list);
9 for (; lp != NULL; lp = lp->next)
10 result = eval1(lp->term, evalflags &~ (lp->next == NULL ? 0 : eval_inchild));
11 RefEnd(lp);
12 RefReturn(result);
13 }
14
PRIM(if)15 PRIM(if) {
16 Ref(List *, lp, list);
17 for (; lp != NULL; lp = lp->next) {
18 List *cond = eval1(lp->term, evalflags & (lp->next == NULL ? eval_inchild : 0));
19 lp = lp->next;
20 if (lp == NULL) {
21 RefPop(lp);
22 return cond;
23 }
24 if (istrue(cond)) {
25 List *result = eval1(lp->term, evalflags);
26 RefPop(lp);
27 return result;
28 }
29 }
30 RefEnd(lp);
31 return true;
32 }
33
PRIM(forever)34 PRIM(forever) {
35 Ref(List *, body, list);
36 for (;;)
37 list = eval(body, NULL, evalflags & eval_exitonfalse);
38 RefEnd(body);
39 return list;
40 }
41
PRIM(throw)42 PRIM(throw) {
43 if (list == NULL)
44 fail("$&throw", "usage: throw exception [args ...]");
45 throw(list);
46 NOTREACHED;
47 }
48
PRIM(catch)49 PRIM(catch) {
50 Atomic retry;
51
52 if (list == NULL)
53 fail("$&catch", "usage: catch catcher body");
54
55 Ref(List *, result, NULL);
56 Ref(List *, lp, list);
57
58 do {
59 retry = FALSE;
60
61 ExceptionHandler
62
63 result = eval(lp->next, NULL, evalflags);
64
65 CatchException (frombody)
66
67 blocksignals();
68 ExceptionHandler
69 result
70 = eval(mklist(mkstr("$&noreturn"),
71 mklist(lp->term, frombody)),
72 NULL,
73 evalflags);
74 unblocksignals();
75 CatchException (fromcatcher)
76
77 if (termeq(fromcatcher->term, "retry")) {
78 retry = TRUE;
79 unblocksignals();
80 } else {
81 unblocksignals();
82 throw(fromcatcher);
83 }
84 EndExceptionHandler
85
86 EndExceptionHandler
87 } while (retry);
88 RefEnd(lp);
89 RefReturn(result);
90 }
91
initprims_controlflow(Dict * primdict)92 extern Dict *initprims_controlflow(Dict *primdict) {
93 X(seq);
94 X(if);
95 X(throw);
96 X(forever);
97 X(catch);
98 return primdict;
99 }
100