1 /*-
2 * Copyright (c) 1980, 1993
3 * The Regents of the University of California. All rights reserved.
4 *
5 * %sccs.include.redist.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)rmothers.c 8.1 (Berkeley) 06/06/93";
10 #endif /* not lint */
11
12 #ifdef RMOTHERS
13 /* and the rest of the file */
14
15 #include "0.h"
16 #include "tree.h"
17
18 /*
19 * translate extended case statements to pascal (for tex).
20 * don knuth should know better. enough said.
21 * ... peter 5/4/83
22 *
23 * extended case statements have the form:
24 * case expresion of
25 * label1,label2,...: statement1;
26 * ...
27 * others: otherstatement
28 * end
29 * which i am going to translate to:
30 * if expression in [ label1,label2,...] then
31 * case expression of
32 * label1,label2,...: statement1;
33 * ...
34 * end
35 * else otherstatement
36 * which has the effect that the expression will be evaluated twice.
37 * i've looked very briefly at all cases in tex and
38 * they seem to be variables or pure functions.
39 * for simplicity i'm assuming that the others is the last labeled
40 * statement, and that no other labels appear with the label others.
41 * this appears correct from the tex82 documentation.
42 */
43
44 /*
45 * given a case statement tree and the address of an others pointer,
46 * amputate the others statement from the case statement tree
47 * and hang it on the the others pointer.
48 *
49 * Case statement
50 * r [0] T_CASE
51 * [1] lineof "case"
52 * [2] expression
53 * [3] list of cased statements:
54 * cstat [0] T_CSTAT
55 * [1] lineof ":"
56 * [2] list of constant labels
57 * [3] statement
58 */
needscaseguard(r,otherspp)59 needscaseguard(r, otherspp)
60 int *r;
61 int **otherspp;
62 {
63 int *statlistp;
64 int *cutpointer;
65 int *lstatementp;
66 int *lablistp;
67 int *label;
68 int hasothers;
69
70 *otherspp = NIL;
71 hasothers = 0;
72 if (!rmothers) {
73 return hasothers;
74 }
75 for (cutpointer = &r[3], statlistp = r[3];
76 statlistp != NIL;
77 cutpointer = &statlistp[2], statlistp = statlistp[2]) {
78 lstatementp = statlistp[1];
79 if (lstatementp == NIL)
80 continue;
81 lablistp = lstatementp[2];
82 if (lablistp != NIL) {
83 label = lablistp[1];
84 /* only look at the first label */
85 if (label != NIL &&
86 label[0] == T_ID && !strcmp(label[1],"others")) {
87 hasothers = 1;
88 *otherspp = lstatementp[3];
89 *cutpointer = NIL;
90 if (statlistp[2] != NIL) {
91 panic("others not last case");
92 }
93 if (lablistp[2] != NIL) {
94 panic("others not only case label");
95 }
96 }
97 }
98 }
99 return hasothers;
100 }
101
precaseguard(r)102 precaseguard(r)
103 int *r;
104 {
105 int *statlistp;
106 int *cutpointer;
107 int *lstatementp;
108 int *lablistp;
109 int *label;
110 int hadsome;
111 int counter;
112
113 if (!rmothers) {
114 return;
115 }
116 ppkw("if");
117 ppspac();
118 rvalue(r[2], NIL);
119 ppspac();
120 ppkw("in");
121 ppgoin(DECL);
122 ppnl();
123 indent();
124 ppsep("[");
125 hadsome = 0;
126 counter = 0;
127 for (statlistp = r[3]; statlistp != NIL; statlistp = statlistp[2]) {
128 lstatementp = statlistp[1];
129 if (lstatementp == NIL)
130 continue;
131 for (lablistp = lstatementp[2];lablistp != NIL;lablistp = lablistp[2]) {
132 label = lablistp[1];
133 if (hadsome) {
134 if (counter < 8) {
135 ppsep(", ");
136 } else {
137 ppsep(",");
138 ppnl();
139 indent();
140 ppspac();
141 counter = 0;
142 }
143 } else {
144 hadsome = 1;
145 }
146 gconst(label);
147 counter += 1;
148 }
149 }
150 ppsep("]");
151 ppspac();
152 ppkw("then");
153 ppgoout(DECL);
154 ppgoin(STAT);
155 ppnl();
156 indent();
157 }
158
159 /*
160 * given an others statement, hang it on the else branch of the guard.
161 */
postcaseguard(othersp)162 postcaseguard(othersp)
163 int *othersp;
164 {
165 if (!rmothers) {
166 return;
167 }
168 ppgoout(STAT);
169 ppnl();
170 indent();
171 ppkw("else");
172 ppgoin(STAT);
173 if (othersp == NIL) {
174 /*
175 * this will print a call to the routine ``null''.
176 * but it has to be checked first, or we will indirect through
177 * NIL to check the statement type.
178 */
179 statement(NIL);
180 ppgoout(STAT);
181 return;
182 }
183 if (othersp[0] == T_BLOCK) {
184 ppnl();
185 indent();
186 ppstbl1(othersp, STAT);
187 ppstbl2();
188 } else {
189 statement(othersp);
190 }
191 ppgoout(STAT);
192 }
193 #endif RMOTHERS
194