00001
00002 #include <stdio.h>
00003 #include <stdlib.h>
00004 #include <string.h>
00005 #include "header.h"
00006
00007
00008
00009 static void read_program_(struct analyser * a, int terminator);
00010 static struct node * read_C(struct analyser * a);
00011 static struct node * C_style(struct analyser * a, char * s, int token);
00012
00013
00014 static void fault(int n) { fprintf(stderr, "fault %d\n", n); exit(1); }
00015
00016 static void print_node_(struct node * p, int n, char * s) {
00017
00018 int i;
00019 for (i = 0; i < n; i++) printf(i == n - 1 ? s : " ");
00020 printf("%s ", name_of_token(p->type));
00021 unless (p->name == 0) report_b(stdout, p->name->b);
00022 unless (p->literalstring == 0) {
00023 printf("'");
00024 report_b(stdout, p->literalstring);
00025 printf("'");
00026 }
00027 printf("\n");
00028 unless (p->AE == 0) print_node_(p->AE, n+1, "# ");
00029 unless (p->left == 0) print_node_(p->left, n+1, " ");
00030 unless (p->right == 0) print_node_(p->right, n, " ");
00031 if (p->aux != 0) print_node_(p->aux, n+1, "@ ");
00032 }
00033
00034 extern void print_program(struct analyser * a) {
00035 print_node_(a->program, 0, " ");
00036 }
00037
00038 static struct node * new_node(struct analyser * a, int type) {
00039 NEW(node, p);
00040 p->next = a->nodes; a->nodes = p;
00041 p->left = 0;
00042 p->right = 0;
00043 p->aux = 0;
00044 p->AE = 0;
00045 p->name = 0;
00046 p->literalstring = 0;
00047 p->mode = a->mode;
00048 p->line_number = a->tokeniser->line_number;
00049 p->type = type;
00050 return p;
00051 }
00052
00053 static char * name_of_mode(int n) {
00054 switch (n) {
00055 default: fault(0);
00056 case m_backward: return "string backward";
00057 case m_forward: return "string forward";
00058
00059 }
00060 }
00061
00062 static char * name_of_type(int n) {
00063 switch (n) {
00064 default: fault(1);
00065 case 's': return "string";
00066 case 'i': return "integer";
00067 case 'r': return "routine";
00068 case 'R': return "routine or grouping";
00069 case 'g': return "grouping";
00070 }
00071 }
00072
00073 static void count_error(struct analyser * a) {
00074 struct tokeniser * t = a->tokeniser;
00075 if (t->error_count >= 20) { fprintf(stderr, "... etc\n"); exit(1); }
00076 t->error_count++;
00077 }
00078
00079 static void error2(struct analyser * a, int n, int x) {
00080 struct tokeniser * t = a->tokeniser;
00081 count_error(a);
00082 fprintf(stderr, "Line %d", t->line_number);
00083 if (t->get_depth > 0) fprintf(stderr, " (of included file)");
00084 fprintf(stderr, ": ");
00085 if (n >= 30) report_b(stderr, t->b);
00086 switch (n) {
00087 case 0:
00088 fprintf(stderr, "%s omitted", name_of_token(t->omission)); break;
00089 case 3:
00090 fprintf(stderr, "in among(...), ");
00091 case 1:
00092 fprintf(stderr, "unexpected %s", name_of_token(t->token));
00093 if (t->token == c_number) fprintf(stderr, " %d", t->number);
00094 if (t->token == c_name) {
00095 fprintf(stderr, " ");
00096 report_b(stderr, t->b);
00097 } break;
00098 case 2:
00099 fprintf(stderr, "string omitted"); break;
00100
00101 case 14:
00102 fprintf(stderr, "unresolved substring on line %d", x); break;
00103 case 15:
00104 fprintf(stderr, "%s not allowed inside reverse(...)", name_of_token(t->token)); break;
00105 case 16:
00106 fprintf(stderr, "empty grouping"); break;
00107 case 17:
00108 fprintf(stderr, "backwards used when already in this mode"); break;
00109 case 18:
00110 fprintf(stderr, "empty among(...)"); break;
00111 case 19:
00112 fprintf(stderr, "two adjacent bracketed expressions in among(...)"); break;
00113 case 20:
00114 fprintf(stderr, "substring preceded by another substring on line %d", x); break;
00115
00116 case 30:
00117 fprintf(stderr, " re-declared"); break;
00118 case 31:
00119 fprintf(stderr, " undeclared"); break;
00120 case 32:
00121 fprintf(stderr, " declared as %s mode; used as %s mode",
00122 name_of_mode(a->mode), name_of_mode(x)); break;
00123 case 33:
00124 fprintf(stderr, " not of type %s", name_of_type(x)); break;
00125 case 34:
00126 fprintf(stderr, " not of type string or integer"); break;
00127 case 35:
00128 fprintf(stderr, " misplaced"); break;
00129 case 36:
00130 fprintf(stderr, " redefined"); break;
00131 case 37:
00132 fprintf(stderr, " mis-used as %s mode",
00133 name_of_mode(x)); break;
00134 default:
00135 fprintf(stderr, " error %d", n); break;
00136
00137 }
00138 if (n <= 13 && t->previous_token > 0)
00139 fprintf(stderr, " after %s", name_of_token(t->previous_token));
00140 fprintf(stderr, "\n");
00141 }
00142
00143 static void error(struct analyser * a, int n) { error2(a, n, 0); }
00144
00145 static void error3(struct analyser * a, struct node * p, symbol * b) {
00146 count_error(a);
00147 fprintf(stderr, "among(...) on line %d has repeated string '", p->line_number);
00148 report_b(stderr, b);
00149 fprintf(stderr, "'\n");
00150 }
00151
00152 static void error4(struct analyser * a, struct name * q) {
00153 count_error(a);
00154 report_b(stderr, q->b);
00155 fprintf(stderr, " undefined\n");
00156 }
00157
00158 static void omission_error(struct analyser * a, int n) {
00159 a->tokeniser->omission = n;
00160 error(a, 0);
00161 }
00162
00163 static int check_token(struct analyser * a, int code) {
00164 struct tokeniser * t = a->tokeniser;
00165 if (t->token != code) { omission_error(a, code); return false; }
00166 return true;
00167 }
00168
00169 static int get_token(struct analyser * a, int code) {
00170 struct tokeniser * t = a->tokeniser;
00171 read_token(t);
00172 {
00173 int x = check_token(a, code);
00174 unless (x) t->token_held = true;
00175 return x;
00176 }
00177 }
00178
00179 static struct name * look_for_name(struct analyser * a) {
00180 struct name * p = a->names;
00181 symbol * q = a->tokeniser->b;
00182 repeat {
00183 if (p == 0) return 0;
00184 { symbol * b = p->b;
00185 int n = SIZE(b);
00186 if (n == SIZE(q) && memcmp(q, b, n * sizeof(symbol)) == 0) {
00187 p->referenced = true;
00188 return p;
00189 }
00190 }
00191 p = p->next;
00192 }
00193 }
00194
00195 static struct name * find_name(struct analyser * a) {
00196 struct name * p = look_for_name(a);
00197 if (p == 0) error(a, 31);
00198 return p;
00199 }
00200
00201 static void check_routine_mode(struct analyser * a, struct name * p, int mode) {
00202 if (p->mode < 0) p->mode = mode; else
00203 unless (p->mode == mode) error2(a, 37, mode);
00204 }
00205
00206 static void check_name_type(struct analyser * a, struct name * p, int type) {
00207 switch (type) {
00208 case 's': if (p->type == t_string) return; break;
00209 case 'i': if (p->type == t_integer) return; break;
00210 case 'b': if (p->type == t_boolean) return; break;
00211 case 'R': if (p->type == t_grouping) return;
00212 case 'r': if (p->type == t_routine ||
00213 p->type == t_external) return; break;
00214 case 'g': if (p->type == t_grouping) return; break;
00215 }
00216 error2(a, 33, type);
00217 }
00218
00219 static void read_names(struct analyser * a, int type) {
00220 struct tokeniser * t = a->tokeniser;
00221 unless (get_token(a, c_bra)) return;
00222 repeat {
00223 if (read_token(t) != c_name) break;
00224 if (look_for_name(a) != 0) error(a, 30); else {
00225 NEW(name, p);
00226 p->b = copy_b(t->b);
00227 p->type = type;
00228 p->mode = -1;
00229 p->count = a->name_count[type];
00230 p->referenced = false;
00231 p->used = false;
00232 p->grouping = 0;
00233 p->definition = 0;
00234 p->routine_called_from_among = false;
00235 a->name_count[type] ++;
00236 p->next = a->names;
00237 a->names = p;
00238 }
00239 }
00240 unless (check_token(a, c_ket)) t->token_held = true;
00241 }
00242
00243 static symbol * new_literalstring(struct analyser * a) {
00244 NEW(literalstring, p);
00245 p->b = copy_b(a->tokeniser->b);
00246 p->next = a->literalstrings;
00247 a->literalstrings = p;
00248 return p->b;
00249 }
00250
00251 static int read_AE_test(struct analyser * a) {
00252
00253 struct tokeniser * t = a->tokeniser;
00254 switch (read_token(t)) {
00255 case c_assign: return c_mathassign;
00256 case c_plusassign:
00257 case c_minusassign:
00258 case c_multiplyassign:
00259 case c_divideassign:
00260 case c_eq:
00261 case c_ne:
00262 case c_gr:
00263 case c_ge:
00264 case c_ls:
00265 case c_le: return t->token;
00266 default: error(a, 1); t->token_held = true; return c_eq;
00267 }
00268 }
00269
00270 static int binding(int t) {
00271 switch (t) {
00272 case c_plus: case c_minus: return 1;
00273 case c_multiply: case c_divide: return 2;
00274 default: return -2;
00275 }
00276 }
00277
00278 static void name_to_node(struct analyser * a, struct node * p, int type) {
00279 struct name * q = find_name(a);
00280 unless (q == 0) {
00281 check_name_type(a, q, type);
00282 q->used = true;
00283 }
00284 p->name = q;
00285 }
00286
00287 static struct node * read_AE(struct analyser * a, int B) {
00288 struct tokeniser * t = a->tokeniser;
00289 struct node * p;
00290 struct node * q;
00291 switch (read_token(t)) {
00292 case c_minus:
00293 p = new_node(a, c_neg);
00294 p->right = read_AE(a, 100);
00295 break;
00296 case c_bra:
00297 p = read_AE(a, 0);
00298 get_token(a, c_ket);
00299 break;
00300 case c_name:
00301 p = new_node(a, c_name);
00302 name_to_node(a, p, 'i');
00303 break;
00304 case c_maxint:
00305 case c_minint:
00306 case c_cursor:
00307 case c_limit:
00308 case c_size:
00309 p = new_node(a, t->token);
00310 break;
00311 case c_number:
00312 p = new_node(a, c_number);
00313 p->number = t->number;
00314 break;
00315 case c_sizeof:
00316 p = C_style(a, "s", c_sizeof);
00317 break;
00318 default:
00319 error(a, 1);
00320 t->token_held = true;
00321 return 0;
00322 }
00323 repeat {
00324 int token = read_token(t);
00325 int b = binding(token);
00326 unless (binding(token) > B) {
00327 t->token_held = true;
00328 return p;
00329 }
00330 q = new_node(a, token);
00331 q->left = p;
00332 q->right = read_AE(a, b);
00333 p = q;
00334 }
00335 }
00336
00337 static struct node * read_C_connection(struct analyser * a, struct node * q, int op) {
00338 struct tokeniser * t = a->tokeniser;
00339 struct node * p = new_node(a, op);
00340 struct node * p_end = q;
00341 p->left = q;
00342 repeat {
00343 q = read_C(a);
00344 p_end->right = q; p_end = q;
00345 if (read_token(t) != op) {
00346 t->token_held = true;
00347 break;
00348 }
00349 }
00350 return p;
00351 }
00352
00353 static struct node * read_C_list(struct analyser * a) {
00354 struct tokeniser * t = a->tokeniser;
00355 struct node * p = new_node(a, c_bra);
00356 struct node * p_end = 0;
00357 repeat {
00358 int token = read_token(t);
00359 if (token == c_ket) return p;
00360 if (token < 0) { omission_error(a, c_ket); return p; }
00361 t->token_held = true;
00362 {
00363 struct node * q = read_C(a);
00364 repeat {
00365 token = read_token(t);
00366 if (token != c_and && token != c_or) {
00367 t->token_held = true;
00368 break;
00369 }
00370 q = read_C_connection(a, q, token);
00371 }
00372 if (p_end == 0) p->left = q; else p_end->right = q;
00373 p_end = q;
00374 }
00375 }
00376 }
00377
00378 static struct node * C_style(struct analyser * a, char * s, int token) {
00379 int i;
00380 struct node * p = new_node(a, token);
00381 for (i = 0; s[i] != 0; i++) switch(s[i]) {
00382 case 'C':
00383 p->left = read_C(a); continue;
00384 case 'D':
00385 p->aux = read_C(a); continue;
00386 case 'A':
00387 p->AE = read_AE(a, 0); continue;
00388 case 'f':
00389 get_token(a, c_for); continue;
00390 case 'S':
00391 {
00392 int str_token = read_token(a->tokeniser);
00393 if (str_token == c_name) name_to_node(a, p, 's'); else
00394 if (str_token == c_literalstring) p->literalstring = new_literalstring(a);
00395 else error(a, 2);
00396 }
00397 continue;
00398 case 'b':
00399 case 's':
00400 case 'i':
00401 if (get_token(a, c_name)) name_to_node(a, p, s[i]);
00402 continue;
00403 }
00404 return p;
00405 }
00406
00407 static struct node * read_literalstring(struct analyser * a) {
00408 struct node * p = new_node(a, c_literalstring);
00409 p->literalstring = new_literalstring(a);
00410 return p;
00411 }
00412
00413 static void reverse_b(symbol * b) {
00414 int i = 0; int j = SIZE(b) - 1;
00415 until (i >= j) {
00416 int ch1 = b[i]; int ch2 = b[j];
00417 b[i++] = ch2; b[j--] = ch1;
00418 }
00419 }
00420
00421 static int compare_amongvec(const void *pv, const void *qv) {
00422 const struct amongvec * p = (const struct amongvec*)pv;
00423 const struct amongvec * q = (const struct amongvec*)qv;
00424 symbol * b_p = p->b; int p_size = p->size;
00425 symbol * b_q = q->b; int q_size = q->size;
00426 int smaller_size = p_size < q_size ? p_size : q_size;
00427 int i;
00428 for (i = 0; i < smaller_size; i++)
00429 if (b_p[i] != b_q[i]) return b_p[i] - b_q[i];
00430 return p_size - q_size;
00431 }
00432
00433 static void make_among(struct analyser * a, struct node * p, struct node * substring) {
00434
00435 NEW(among, x);
00436 NEWVEC(amongvec, v, p->number);
00437 struct node * q = p->left;
00438 struct amongvec * w0 = v;
00439 struct amongvec * w1 = v;
00440 int result = 1;
00441
00442 int direction = substring != 0 ? substring->mode : p->mode;
00443 int backward = direction == m_backward;
00444
00445 if (a->amongs == 0) a->amongs = x; else a->amongs_end->next = x;
00446 a->amongs_end = x;
00447 x->next = 0;
00448 x->b = v;
00449 x->number = a->among_count++;
00450 x->starter = 0;
00451
00452 if (q->type == c_bra) { x->starter = q; q = q->right; }
00453
00454 until (q == 0) {
00455 if (q->type == c_literalstring) {
00456 symbol * b = q->literalstring;
00457 w1->b = b;
00458 w1->p = 0;
00459 w1->size = SIZE(b);
00460 w1->i = -1;
00461 w1->result = -1;
00462 w1->function = q->left == 0 ? 0 : q->left->name;
00463 unless (w1->function == 0) {
00464 check_routine_mode(a, w1->function, direction);
00465 w1->function->routine_called_from_among = true;
00466 }
00467 w1++;
00468 }
00469 else
00470 if (q->left == 0)
00471 w0 = w1;
00472 else {
00473 until (w0 == w1) {
00474 w0->p = q;
00475 w0->result = result;
00476 w0++;
00477 }
00478 result++;
00479 }
00480 q = q->right;
00481 }
00482 unless (w1-v == p->number) { fprintf(stderr, "oh! %d %d\n", (int)(w1-v), p->number); exit(1); }
00483 if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
00484 qsort(v, w1 - v, sizeof(struct amongvec), compare_amongvec);
00485
00486
00487 for (w0 = w1 - 1; w0 >= v; w0--) {
00488 symbol * b = w0->b;
00489 int size = w0->size;
00490 struct amongvec * w;
00491
00492 for (w = w0 - 1; w >= v; w--) {
00493 if (w->size < size && memcmp(w->b, b, w->size * sizeof(symbol)) == 0) {
00494 w0->i = w - v;
00495 break;
00496 }
00497 }
00498 }
00499 if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
00500
00501 for (w0 = v; w0 < w1 - 1; w0++)
00502 if (w0->size == (w0 + 1)->size &&
00503 memcmp(w0->b, (w0 + 1)->b, w0->size * sizeof(symbol)) == 0) error3(a, p, w0->b);
00504
00505 x->literalstring_count = p->number;
00506 x->command_count = result - 1;
00507 p->among = x;
00508
00509 x->substring = substring;
00510 if (substring != 0) substring->among = x;
00511 unless (x->command_count == 0 && x->starter == 0) a->amongvar_needed = true;
00512 }
00513
00514 static struct node * read_among(struct analyser * a) {
00515 struct tokeniser * t = a->tokeniser;
00516 struct node * p = new_node(a, c_among);
00517 struct node * p_end = 0;
00518 int previous_token = -1;
00519 struct node * substring = a->substring;
00520
00521 a->substring = 0;
00522 p->number = 0;
00523 unless (get_token(a, c_bra)) return p;
00524 repeat {
00525 struct node * q;
00526 int token = read_token(t);
00527 switch (token) {
00528 case c_literalstring:
00529 q = read_literalstring(a);
00530 if (read_token(t) == c_name) {
00531 struct node * r = new_node(a, c_name);
00532 name_to_node(a, r, 'r');
00533 q->left = r;
00534 }
00535 else t->token_held = true;
00536 p->number++; break;
00537 case c_bra:
00538 if (previous_token == c_bra) error(a, 19);
00539 q = read_C_list(a); break;
00540 default:
00541 error(a, 3);
00542 case c_ket:
00543 if (p->number == 0) error(a, 18);
00544 if (t->error_count == 0) make_among(a, p, substring);
00545 return p;
00546 }
00547 previous_token = token;
00548 if (p_end == 0) p->left = q; else p_end->right = q;
00549 p_end = q;
00550 }
00551 }
00552
00553 static struct node * read_substring(struct analyser * a) {
00554
00555 struct node * p = new_node(a, c_substring);
00556 if (a->substring != 0) error2(a, 20, a->substring->line_number);
00557 a->substring = p;
00558 return p;
00559 }
00560
00561 static void check_modifyable(struct analyser * a) {
00562 unless (a->modifyable) error(a, 15);
00563 }
00564
00565 static struct node * read_C(struct analyser * a) {
00566 struct tokeniser * t = a->tokeniser;
00567 int token = read_token(t);
00568 switch (token) {
00569 case c_bra:
00570 return read_C_list(a);
00571 case c_backwards:
00572 {
00573 int mode = a->mode;
00574 if (a->mode == m_backward) error(a, 17); else a->mode = m_backward;
00575 { struct node * p = C_style(a, "C", token);
00576 a->mode = mode;
00577 return p;
00578 }
00579 }
00580 case c_reverse:
00581 {
00582 int mode = a->mode;
00583 int modifyable = a->modifyable;
00584 a->modifyable = false;
00585 a->mode = mode == m_forward ? m_backward : m_forward;
00586 {
00587 struct node * p = C_style(a, "C", token);
00588 a->mode = mode;
00589 a->modifyable = modifyable;
00590 return p;
00591 }
00592 }
00593 case c_not:
00594 case c_try:
00595 case c_fail:
00596 case c_test:
00597 case c_do:
00598 case c_goto:
00599 case c_gopast:
00600 case c_repeat:
00601 return C_style(a, "C", token);
00602 case c_loop:
00603 case c_atleast:
00604 return C_style(a, "AC", token);
00605 case c_setmark:
00606 return C_style(a, "i", token);
00607 case c_tomark:
00608 case c_atmark:
00609 case c_hop:
00610 return C_style(a, "A", token);
00611 case c_delete:
00612 check_modifyable(a);
00613 case c_next:
00614 case c_tolimit:
00615 case c_atlimit:
00616 case c_leftslice:
00617 case c_rightslice:
00618 case c_true:
00619 case c_false:
00620 case c_debug:
00621 return C_style(a, "", token);
00622 case c_assignto:
00623 case c_sliceto:
00624 check_modifyable(a);
00625 return C_style(a, "s", token);
00626 case c_assign:
00627 case c_insert:
00628 case c_attach:
00629 case c_slicefrom:
00630 check_modifyable(a);
00631 return C_style(a, "S", token);
00632 case c_setlimit:
00633 return C_style(a, "CfD", token);
00634 case c_set:
00635 case c_unset:
00636 return C_style(a, "b", token);
00637 case c_dollar:
00638 get_token(a, c_name);
00639 {
00640 struct node * p;
00641 struct name * q = find_name(a);
00642 int mode = a->mode;
00643 int modifyable = a->modifyable;
00644 switch (q ? q->type : t_string)
00645
00646 {
00647 default: error(a, 34);
00648 case t_string:
00649 a->mode = m_forward;
00650 a->modifyable = true;
00651 p = new_node(a, c_dollar);
00652 p->left = read_C(a); break;
00653 case t_integer:
00654
00655 p = new_node(a, read_AE_test(a));
00656 p->AE = read_AE(a, 0); break;
00657 }
00658 p->name = q;
00659 a->mode = mode;
00660 a->modifyable = modifyable;
00661 return p;
00662 }
00663 case c_name:
00664 {
00665 struct name * q = find_name(a);
00666 struct node * p = new_node(a, c_name);
00667 unless (q == 0) {
00668 q->used = true;
00669 switch (q->type) {
00670 case t_boolean:
00671 p->type = c_booltest; break;
00672 case t_integer:
00673 error(a, 35);
00674 case t_string:
00675 break;
00676 case t_routine:
00677 case t_external:
00678 p->type = c_call;
00679 check_routine_mode(a, q, a->mode);
00680 break;
00681 case t_grouping:
00682 p->type = c_grouping; break;
00683 }
00684 }
00685 p->name = q;
00686 return p;
00687 }
00688 case c_non:
00689 {
00690 struct node * p = new_node(a, token);
00691 read_token(t);
00692 if (t->token == c_minus) read_token(t);
00693 unless (check_token(a, c_name)) { omission_error(a, c_name); return p; }
00694 name_to_node(a, p, 'g');
00695 return p;
00696 }
00697 case c_literalstring:
00698 return read_literalstring(a);
00699 case c_among: return read_among(a);
00700 case c_substring: return read_substring(a);
00701 default: error(a, 1); return 0;
00702 }
00703 }
00704
00705 static int next_symbol(symbol * p, symbol * W, int utf8) {
00706 if (utf8) {
00707 int ch;
00708 int j = get_utf8(p, & ch);
00709 W[0] = ch; return j;
00710 } else {
00711 W[0] = p[0]; return 1;
00712 }
00713 }
00714
00715 static symbol * alter_grouping(symbol * p, symbol * q, int style, int utf8) {
00716 int j = 0;
00717 symbol W[1];
00718 int width;
00719 if (style == c_plus) {
00720 while (j < SIZE(q)) {
00721 width = next_symbol(q + j, W, utf8);
00722 p = add_to_b(p, 1, W);
00723 j += width;
00724 }
00725 } else {
00726 while (j < SIZE(q)) {
00727 int i;
00728 width = next_symbol(q + j, W, utf8);
00729 for (i = 0; i < SIZE(p); i++) {
00730 if (p[i] == W[0]) {
00731 memmove(p + i, p + i + 1, (SIZE(p) - i - 1) * sizeof(symbol));
00732 SIZE(p)--;
00733 }
00734 }
00735 j += width;
00736 }
00737 }
00738 return p;
00739 }
00740
00741 static void read_define_grouping(struct analyser * a, struct name * q) {
00742 struct tokeniser * t = a->tokeniser;
00743 int style = c_plus;
00744 {
00745 NEW(grouping, p);
00746 if (a->groupings == 0) a->groupings = p; else a->groupings_end->next = p;
00747 a->groupings_end = p;
00748 q->grouping = p;
00749 p->next = 0;
00750 p->name = q;
00751 p->number = q->count;
00752 p->b = create_b(0);
00753 repeat {
00754 switch (read_token(t)) {
00755 case c_name:
00756 {
00757 struct name * r = find_name(a);
00758 unless (r == 0) {
00759 check_name_type(a, r, 'g');
00760 p->b = alter_grouping(p->b, r->grouping->b, style, false);
00761 }
00762 }
00763 break;
00764 case c_literalstring:
00765 p->b = alter_grouping(p->b, t->b, style, a->utf8);
00766 break;
00767 default: error(a, 1); return;
00768 }
00769 switch (read_token(t)) {
00770 case c_plus:
00771 case c_minus: style = t->token; break;
00772 default: goto label0;
00773 }
00774 }
00775 label0:
00776 {
00777 int i;
00778 int max = 0;
00779 int min = 1<<16;
00780 for (i = 0; i < SIZE(p->b); i++) {
00781 if (p->b[i] > max) max = p->b[i];
00782 if (p->b[i] < min) min = p->b[i];
00783 }
00784 p->largest_ch = max;
00785 p->smallest_ch = min;
00786 if (min == 1<<16) error(a, 16);
00787 }
00788 t->token_held = true; return;
00789 }
00790 }
00791
00792 static void read_define_routine(struct analyser * a, struct name * q) {
00793 struct node * p = new_node(a, c_define);
00794 a->amongvar_needed = false;
00795 unless (q == 0) {
00796 check_name_type(a, q, 'R');
00797 if (q->definition != 0) error(a, 36);
00798 if (q->mode < 0) q->mode = a->mode; else
00799 if (q->mode != a->mode) error2(a, 32, q->mode);
00800 }
00801 p->name = q;
00802 if (a->program == 0) a->program = p; else a->program_end->right = p;
00803 a->program_end = p;
00804 get_token(a, c_as);
00805 p->left = read_C(a);
00806 unless (q == 0) q->definition = p->left;
00807
00808 if (a->substring != 0) {
00809 error2(a, 14, a->substring->line_number);
00810 a->substring = 0;
00811 }
00812 p->amongvar_needed = a->amongvar_needed;
00813 }
00814
00815 static void read_define(struct analyser * a) {
00816 unless (get_token(a, c_name)) return;
00817 {
00818 struct name * q = find_name(a);
00819 if (q != 0 && q->type == t_grouping) read_define_grouping(a, q);
00820 else read_define_routine(a, q);
00821 }
00822 }
00823
00824 static void read_backwardmode(struct analyser * a) {
00825 int mode = a->mode;
00826 a->mode = m_backward;
00827 if (get_token(a, c_bra)) {
00828 read_program_(a, c_ket);
00829 check_token(a, c_ket);
00830 }
00831 a->mode = mode;
00832 }
00833
00834 static void read_program_(struct analyser * a, int terminator) {
00835 struct tokeniser * t = a->tokeniser;
00836 repeat {
00837 switch (read_token(t)) {
00838 case c_strings: read_names(a, t_string); break;
00839 case c_booleans: read_names(a, t_boolean); break;
00840 case c_integers: read_names(a, t_integer); break;
00841 case c_routines: read_names(a, t_routine); break;
00842 case c_externals: read_names(a, t_external); break;
00843 case c_groupings: read_names(a, t_grouping); break;
00844 case c_define: read_define(a); break;
00845 case c_backwardmode:read_backwardmode(a); break;
00846 case c_ket:
00847 if (terminator == c_ket) return;
00848 default:
00849 error(a, 1); break;
00850 case -1:
00851 unless (terminator < 0) omission_error(a, c_ket);
00852 return;
00853 }
00854 }
00855 }
00856
00857 extern void read_program(struct analyser * a) {
00858 read_program_(a, -1);
00859 {
00860 struct name * q = a->names;
00861 until (q == 0) {
00862 switch(q->type) {
00863 case t_external: case t_routine:
00864 if (q->used && q->definition == 0) error4(a, q); break;
00865 case t_grouping:
00866 if (q->used && q->grouping == 0) error4(a, q); break;
00867 }
00868 q = q->next;
00869 }
00870 }
00871
00872 if (a->tokeniser->error_count == 0) {
00873 struct name * q = a->names;
00874 int warned = false;
00875 until (q == 0) {
00876 unless (q->referenced) {
00877 unless (warned) {
00878 fprintf(stderr, "Declared but not used:");
00879 warned = true;
00880 }
00881 fprintf(stderr, " "); report_b(stderr, q->b);
00882 }
00883 q = q->next;
00884 }
00885 if (warned) fprintf(stderr, "\n");
00886
00887 q = a->names;
00888 warned = false;
00889 until (q == 0) {
00890 if (! q->used && (q->type == t_routine ||
00891 q->type == t_grouping)) {
00892 unless (warned) {
00893 fprintf(stderr, "Declared and defined but not used:");
00894 warned = true;
00895 }
00896 fprintf(stderr, " "); report_b(stderr, q->b);
00897 }
00898 q = q->next;
00899 }
00900 if (warned) fprintf(stderr, "\n");
00901 }
00902 }
00903
00904 extern struct analyser * create_analyser(struct tokeniser * t) {
00905 NEW(analyser, a);
00906 a->tokeniser = t;
00907 a->nodes = 0;
00908 a->names = 0;
00909 a->literalstrings = 0;
00910 a->program = 0;
00911 a->amongs = 0;
00912 a->among_count = 0;
00913 a->groupings = 0;
00914 a->mode = m_forward;
00915 a->modifyable = true;
00916 { int i; for (i = 0; i < t_size; i++) a->name_count[i] = 0; }
00917 a->substring = 0;
00918 return a;
00919 }
00920
00921 extern void close_analyser(struct analyser * a) {
00922 {
00923 struct node * q = a->nodes;
00924 until (q == 0) {
00925 struct node * q_next = q->next;
00926 FREE(q);
00927 q = q_next;
00928 }
00929 }
00930 {
00931 struct name * q = a->names;
00932 until (q == 0) {
00933 struct name * q_next = q->next;
00934 lose_b(q->b); FREE(q);
00935 q = q_next;
00936 }
00937 }
00938 {
00939 struct literalstring * q = a->literalstrings;
00940 until (q == 0) {
00941 struct literalstring * q_next = q->next;
00942 lose_b(q->b); FREE(q);
00943 q = q_next;
00944 }
00945 }
00946 {
00947 struct among * q = a->amongs;
00948 until (q == 0) {
00949 struct among * q_next = q->next;
00950 FREE(q->b); FREE(q);
00951 q = q_next;
00952 }
00953 }
00954 {
00955 struct grouping * q = a->groupings;
00956 until (q == 0) {
00957 struct grouping * q_next = q->next;
00958 lose_b(q->b); FREE(q);
00959 q = q_next;
00960 }
00961 }
00962 FREE(a);
00963 }
00964