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