summaryrefslogtreecommitdiffstats
path: root/contrib/snowball/compiler/analyser.c
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/snowball/compiler/analyser.c')
-rw-r--r--contrib/snowball/compiler/analyser.c959
1 files changed, 959 insertions, 0 deletions
diff --git a/contrib/snowball/compiler/analyser.c b/contrib/snowball/compiler/analyser.c
new file mode 100644
index 000000000..68c0d2d90
--- /dev/null
+++ b/contrib/snowball/compiler/analyser.c
@@ -0,0 +1,959 @@
+
+#include <stdio.h> /* printf etc */
+#include <stdlib.h> /* exit */
+#include <string.h> /* memmove */
+#include "header.h"
+
+/* recursive usage: */
+
+static void read_program_(struct analyser * a, int terminator);
+static struct node * read_C(struct analyser * a);
+static struct node * C_style(struct analyser * a, char * s, int token);
+
+
+static void fault(int n) { fprintf(stderr, "fault %d\n", n); exit(1); }
+
+static void print_node_(struct node * p, int n, const char * s) {
+
+ int i;
+ for (i = 0; i < n; i++) fputs(i == n - 1 ? s : " ", stdout);
+ printf("%s ", name_of_token(p->type));
+ unless (p->name == 0) report_b(stdout, p->name->b);
+ unless (p->literalstring == 0) {
+ printf("'");
+ report_b(stdout, p->literalstring);
+ printf("'");
+ }
+ printf("\n");
+ unless (p->AE == 0) print_node_(p->AE, n+1, "# ");
+ unless (p->left == 0) print_node_(p->left, n+1, " ");
+ unless (p->right == 0) print_node_(p->right, n, " ");
+ if (p->aux != 0) print_node_(p->aux, n+1, "@ ");
+}
+
+extern void print_program(struct analyser * a) {
+ print_node_(a->program, 0, " ");
+}
+
+static struct node * new_node(struct analyser * a, int type) {
+ NEW(node, p);
+ p->next = a->nodes; a->nodes = p;
+ p->left = 0;
+ p->right = 0;
+ p->aux = 0;
+ p->AE = 0;
+ p->name = 0;
+ p->literalstring = 0;
+ p->mode = a->mode;
+ p->line_number = a->tokeniser->line_number;
+ p->type = type;
+ return p;
+}
+
+static const char * name_of_mode(int n) {
+ switch (n) {
+ default: fault(0);
+ case m_backward: return "string backward";
+ case m_forward: return "string forward";
+ /* case m_integer: return "integer"; */
+ }
+}
+
+static const char * name_of_type(int n) {
+ switch (n) {
+ default: fault(1);
+ case 's': return "string";
+ case 'i': return "integer";
+ case 'r': return "routine";
+ case 'R': return "routine or grouping";
+ case 'g': return "grouping";
+ }
+}
+
+static void count_error(struct analyser * a) {
+ struct tokeniser * t = a->tokeniser;
+ if (t->error_count >= 20) { fprintf(stderr, "... etc\n"); exit(1); }
+ t->error_count++;
+}
+
+static void error2(struct analyser * a, int n, int x) {
+ struct tokeniser * t = a->tokeniser;
+ count_error(a);
+ fprintf(stderr, "%s:%d: ", t->file, t->line_number);
+ if (n >= 30) report_b(stderr, t->b);
+ switch (n) {
+ case 0:
+ fprintf(stderr, "%s omitted", name_of_token(t->omission)); break;
+ case 3:
+ fprintf(stderr, "in among(...), ");
+ case 1:
+ fprintf(stderr, "unexpected %s", name_of_token(t->token));
+ if (t->token == c_number) fprintf(stderr, " %d", t->number);
+ if (t->token == c_name) {
+ fprintf(stderr, " ");
+ report_b(stderr, t->b);
+ } break;
+ case 2:
+ fprintf(stderr, "string omitted"); break;
+
+ case 14:
+ fprintf(stderr, "unresolved substring on line %d", x); break;
+ case 15:
+ fprintf(stderr, "%s not allowed inside reverse(...)", name_of_token(t->token)); break;
+ case 16:
+ fprintf(stderr, "empty grouping"); break;
+ case 17:
+ fprintf(stderr, "backwards used when already in this mode"); break;
+ case 18:
+ fprintf(stderr, "empty among(...)"); break;
+ case 19:
+ fprintf(stderr, "two adjacent bracketed expressions in among(...)"); break;
+ case 20:
+ fprintf(stderr, "substring preceded by another substring on line %d", x); break;
+
+ case 30:
+ fprintf(stderr, " re-declared"); break;
+ case 31:
+ fprintf(stderr, " undeclared"); break;
+ case 32:
+ fprintf(stderr, " declared as %s mode; used as %s mode",
+ name_of_mode(a->mode), name_of_mode(x)); break;
+ case 33:
+ fprintf(stderr, " not of type %s", name_of_type(x)); break;
+ case 34:
+ fprintf(stderr, " not of type string or integer"); break;
+ case 35:
+ fprintf(stderr, " misplaced"); break;
+ case 36:
+ fprintf(stderr, " redefined"); break;
+ case 37:
+ fprintf(stderr, " mis-used as %s mode",
+ name_of_mode(x)); break;
+ default:
+ fprintf(stderr, " error %d", n); break;
+
+ }
+ if (n <= 13 && t->previous_token > 0)
+ fprintf(stderr, " after %s", name_of_token(t->previous_token));
+ fprintf(stderr, "\n");
+}
+
+static void error(struct analyser * a, int n) { error2(a, n, 0); }
+
+static void error3(struct analyser * a, struct node * p, symbol * b) {
+ count_error(a);
+ fprintf(stderr, "%s:%d: among(...) has repeated string '", a->tokeniser->file, p->line_number);
+ report_b(stderr, b);
+ fprintf(stderr, "'\n");
+}
+
+static void error4(struct analyser * a, struct name * q) {
+ count_error(a);
+ report_b(stderr, q->b);
+ fprintf(stderr, " undefined\n");
+}
+
+static void omission_error(struct analyser * a, int n) {
+ a->tokeniser->omission = n;
+ error(a, 0);
+}
+
+static int check_token(struct analyser * a, int code) {
+ struct tokeniser * t = a->tokeniser;
+ if (t->token != code) { omission_error(a, code); return false; }
+ return true;
+}
+
+static int get_token(struct analyser * a, int code) {
+ struct tokeniser * t = a->tokeniser;
+ read_token(t);
+ {
+ int x = check_token(a, code);
+ unless (x) t->token_held = true;
+ return x;
+ }
+}
+
+static struct name * look_for_name(struct analyser * a) {
+ struct name * p = a->names;
+ symbol * q = a->tokeniser->b;
+ repeat {
+ if (p == 0) return 0;
+ { symbol * b = p->b;
+ int n = SIZE(b);
+ if (n == SIZE(q) && memcmp(q, b, n * sizeof(symbol)) == 0) {
+ p->referenced = true;
+ return p;
+ }
+ }
+ p = p->next;
+ }
+}
+
+static struct name * find_name(struct analyser * a) {
+ struct name * p = look_for_name(a);
+ if (p == 0) error(a, 31);
+ return p;
+}
+
+static void check_routine_mode(struct analyser * a, struct name * p, int mode) {
+ if (p->mode < 0) p->mode = mode; else
+ unless (p->mode == mode) error2(a, 37, mode);
+}
+
+static void check_name_type(struct analyser * a, struct name * p, int type) {
+ switch (type) {
+ case 's': if (p->type == t_string) return; break;
+ case 'i': if (p->type == t_integer) return; break;
+ case 'b': if (p->type == t_boolean) return; break;
+ case 'R': if (p->type == t_grouping) return;
+ case 'r': if (p->type == t_routine ||
+ p->type == t_external) return; break;
+ case 'g': if (p->type == t_grouping) return; break;
+ }
+ error2(a, 33, type);
+}
+
+static void read_names(struct analyser * a, int type) {
+ struct tokeniser * t = a->tokeniser;
+ unless (get_token(a, c_bra)) return;
+ repeat {
+ if (read_token(t) != c_name) break;
+ if (look_for_name(a) != 0) error(a, 30); else {
+ NEW(name, p);
+ p->b = copy_b(t->b);
+ p->type = type;
+ p->mode = -1; /* routines, externals */
+ p->count = a->name_count[type];
+ p->referenced = false;
+ p->used = false;
+ p->grouping = 0;
+ p->definition = 0;
+ a->name_count[type] ++;
+ p->next = a->names;
+ a->names = p;
+ }
+ }
+ unless (check_token(a, c_ket)) t->token_held = true;
+}
+
+static symbol * new_literalstring(struct analyser * a) {
+ NEW(literalstring, p);
+ p->b = copy_b(a->tokeniser->b);
+ p->next = a->literalstrings;
+ a->literalstrings = p;
+ return p->b;
+}
+
+static int read_AE_test(struct analyser * a) {
+
+ struct tokeniser * t = a->tokeniser;
+ switch (read_token(t)) {
+ case c_assign: return c_mathassign;
+ case c_plusassign:
+ case c_minusassign:
+ case c_multiplyassign:
+ case c_divideassign:
+ case c_eq:
+ case c_ne:
+ case c_gr:
+ case c_ge:
+ case c_ls:
+ case c_le: return t->token;
+ default: error(a, 1); t->token_held = true; return c_eq;
+ }
+}
+
+static int binding(int t) {
+ switch (t) {
+ case c_plus: case c_minus: return 1;
+ case c_multiply: case c_divide: return 2;
+ default: return -2;
+ }
+}
+
+static void name_to_node(struct analyser * a, struct node * p, int type) {
+ struct name * q = find_name(a);
+ unless (q == 0) {
+ check_name_type(a, q, type);
+ q->used = true;
+ }
+ p->name = q;
+}
+
+static struct node * read_AE(struct analyser * a, int B) {
+ struct tokeniser * t = a->tokeniser;
+ struct node * p;
+ struct node * q;
+ switch (read_token(t)) {
+ case c_minus: /* monadic */
+ p = new_node(a, c_neg);
+ p->right = read_AE(a, 100);
+ break;
+ case c_bra:
+ p = read_AE(a, 0);
+ get_token(a, c_ket);
+ break;
+ case c_name:
+ p = new_node(a, c_name);
+ name_to_node(a, p, 'i');
+ break;
+ case c_maxint:
+ case c_minint:
+ case c_cursor:
+ case c_limit:
+ case c_size:
+ p = new_node(a, t->token);
+ break;
+ case c_number:
+ p = new_node(a, c_number);
+ p->number = t->number;
+ break;
+ case c_sizeof:
+ p = C_style(a, "s", c_sizeof);
+ break;
+ default:
+ error(a, 1);
+ t->token_held = true;
+ return 0;
+ }
+ repeat {
+ int token = read_token(t);
+ int b = binding(token);
+ unless (binding(token) > B) {
+ t->token_held = true;
+ return p;
+ }
+ q = new_node(a, token);
+ q->left = p;
+ q->right = read_AE(a, b);
+ p = q;
+ }
+}
+
+static struct node * read_C_connection(struct analyser * a, struct node * q, int op) {
+ struct tokeniser * t = a->tokeniser;
+ struct node * p = new_node(a, op);
+ struct node * p_end = q;
+ p->left = q;
+ repeat {
+ q = read_C(a);
+ p_end->right = q; p_end = q;
+ if (read_token(t) != op) {
+ t->token_held = true;
+ break;
+ }
+ }
+ return p;
+}
+
+static struct node * read_C_list(struct analyser * a) {
+ struct tokeniser * t = a->tokeniser;
+ struct node * p = new_node(a, c_bra);
+ struct node * p_end = 0;
+ repeat {
+ int token = read_token(t);
+ if (token == c_ket) return p;
+ if (token < 0) { omission_error(a, c_ket); return p; }
+ t->token_held = true;
+ {
+ struct node * q = read_C(a);
+ repeat {
+ token = read_token(t);
+ if (token != c_and && token != c_or) {
+ t->token_held = true;
+ break;
+ }
+ q = read_C_connection(a, q, token);
+ }
+ if (p_end == 0) p->left = q; else p_end->right = q;
+ p_end = q;
+ }
+ }
+}
+
+static struct node * C_style(struct analyser * a, char * s, int token) {
+ int i;
+ struct node * p = new_node(a, token);
+ for (i = 0; s[i] != 0; i++) switch(s[i]) {
+ case 'C':
+ p->left = read_C(a); continue;
+ case 'D':
+ p->aux = read_C(a); continue;
+ case 'A':
+ p->AE = read_AE(a, 0); continue;
+ case 'f':
+ get_token(a, c_for); continue;
+ case 'S':
+ {
+ int str_token = read_token(a->tokeniser);
+ if (str_token == c_name) name_to_node(a, p, 's'); else
+ if (str_token == c_literalstring) p->literalstring = new_literalstring(a);
+ else error(a, 2);
+ }
+ continue;
+ case 'b':
+ case 's':
+ case 'i':
+ if (get_token(a, c_name)) name_to_node(a, p, s[i]);
+ continue;
+ }
+ return p;
+}
+
+static struct node * read_literalstring(struct analyser * a) {
+ struct node * p = new_node(a, c_literalstring);
+ p->literalstring = new_literalstring(a);
+ return p;
+}
+
+static void reverse_b(symbol * b) {
+ int i = 0; int j = SIZE(b) - 1;
+ until (i >= j) {
+ int ch1 = b[i]; int ch2 = b[j];
+ b[i++] = ch2; b[j--] = ch1;
+ }
+}
+
+static int compare_amongvec(const void *pv, const void *qv) {
+ const struct amongvec * p = (const struct amongvec*)pv;
+ const struct amongvec * q = (const struct amongvec*)qv;
+ symbol * b_p = p->b; int p_size = p->size;
+ symbol * b_q = q->b; int q_size = q->size;
+ int smaller_size = p_size < q_size ? p_size : q_size;
+ int i;
+ for (i = 0; i < smaller_size; i++)
+ if (b_p[i] != b_q[i]) return b_p[i] - b_q[i];
+ return p_size - q_size;
+}
+
+static void make_among(struct analyser * a, struct node * p, struct node * substring) {
+
+ NEW(among, x);
+ NEWVEC(amongvec, v, p->number);
+ struct node * q = p->left;
+ struct amongvec * w0 = v;
+ struct amongvec * w1 = v;
+ int result = 1;
+
+ int direction = substring != 0 ? substring->mode : p->mode;
+ int backward = direction == m_backward;
+
+ if (a->amongs == 0) a->amongs = x; else a->amongs_end->next = x;
+ a->amongs_end = x;
+ x->next = 0;
+ x->b = v;
+ x->number = a->among_count++;
+ x->starter = 0;
+
+ if (q->type == c_bra) { x->starter = q; q = q->right; }
+
+ until (q == 0) {
+ if (q->type == c_literalstring) {
+ symbol * b = q->literalstring;
+ w1->b = b; /* pointer to case string */
+ w1->p = 0; /* pointer to corresponding case expression */
+ w1->size = SIZE(b); /* number of characters in string */
+ w1->i = -1; /* index of longest substring */
+ w1->result = -1; /* number of corresponding case expression */
+ w1->function = q->left == 0 ? 0 : q->left->name;
+ unless (w1->function == 0)
+ check_routine_mode(a, w1->function, direction);
+ w1++;
+ }
+ else
+ if (q->left == 0) /* empty command: () */
+ w0 = w1;
+ else {
+ until (w0 == w1) {
+ w0->p = q;
+ w0->result = result;
+ w0++;
+ }
+ result++;
+ }
+ q = q->right;
+ }
+ unless (w1-v == p->number) { fprintf(stderr, "oh! %d %d\n", (int)(w1-v), p->number); exit(1); }
+ if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
+ qsort(v, w1 - v, sizeof(struct amongvec), compare_amongvec);
+
+ /* the following loop is O(n squared) */
+ for (w0 = w1 - 1; w0 >= v; w0--) {
+ symbol * b = w0->b;
+ int size = w0->size;
+ struct amongvec * w;
+
+ for (w = w0 - 1; w >= v; w--) {
+ if (w->size < size && memcmp(w->b, b, w->size * sizeof(symbol)) == 0) {
+ w0->i = w - v; /* fill in index of longest substring */
+ break;
+ }
+ }
+ }
+ if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
+
+ for (w0 = v; w0 < w1 - 1; w0++)
+ if (w0->size == (w0 + 1)->size &&
+ memcmp(w0->b, (w0 + 1)->b, w0->size * sizeof(symbol)) == 0) error3(a, p, w0->b);
+
+ x->literalstring_count = p->number;
+ x->command_count = result - 1;
+ p->among = x;
+
+ x->substring = substring;
+ if (substring != 0) substring->among = x;
+ unless (x->command_count == 0 && x->starter == 0) a->amongvar_needed = true;
+}
+
+static struct node * read_among(struct analyser * a) {
+ struct tokeniser * t = a->tokeniser;
+ struct node * p = new_node(a, c_among);
+ struct node * p_end = 0;
+ int previous_token = -1;
+ struct node * substring = a->substring;
+
+ a->substring = 0;
+ p->number = 0; /* counts the number of literals */
+ unless (get_token(a, c_bra)) return p;
+ repeat {
+ struct node * q;
+ int token = read_token(t);
+ switch (token) {
+ case c_literalstring:
+ q = read_literalstring(a);
+ if (read_token(t) == c_name) {
+ struct node * r = new_node(a, c_name);
+ name_to_node(a, r, 'r');
+ q->left = r;
+ }
+ else t->token_held = true;
+ p->number++; break;
+ case c_bra:
+ if (previous_token == c_bra) error(a, 19);
+ q = read_C_list(a); break;
+ default:
+ error(a, 3);
+ case c_ket:
+ if (p->number == 0) error(a, 18);
+ if (t->error_count == 0) make_among(a, p, substring);
+ return p;
+ }
+ previous_token = token;
+ if (p_end == 0) p->left = q; else p_end->right = q;
+ p_end = q;
+ }
+}
+
+static struct node * read_substring(struct analyser * a) {
+
+ struct node * p = new_node(a, c_substring);
+ if (a->substring != 0) error2(a, 20, a->substring->line_number);
+ a->substring = p;
+ return p;
+}
+
+static void check_modifyable(struct analyser * a) {
+ unless (a->modifyable) error(a, 15);
+}
+
+static struct node * read_C(struct analyser * a) {
+ struct tokeniser * t = a->tokeniser;
+ int token = read_token(t);
+ switch (token) {
+ case c_bra:
+ return read_C_list(a);
+ case c_backwards:
+ {
+ int mode = a->mode;
+ if (a->mode == m_backward) error(a, 17); else a->mode = m_backward;
+ { struct node * p = C_style(a, "C", token);
+ a->mode = mode;
+ return p;
+ }
+ }
+ case c_reverse:
+ {
+ int mode = a->mode;
+ int modifyable = a->modifyable;
+ a->modifyable = false;
+ a->mode = mode == m_forward ? m_backward : m_forward;
+ {
+ struct node * p = C_style(a, "C", token);
+ a->mode = mode;
+ a->modifyable = modifyable;
+ return p;
+ }
+ }
+ case c_not:
+ case c_try:
+ case c_fail:
+ case c_test:
+ case c_do:
+ case c_goto:
+ case c_gopast:
+ case c_repeat:
+ return C_style(a, "C", token);
+ case c_loop:
+ case c_atleast:
+ return C_style(a, "AC", token);
+ case c_setmark:
+ return C_style(a, "i", token);
+ case c_tomark:
+ case c_atmark:
+ case c_hop:
+ return C_style(a, "A", token);
+ case c_delete:
+ check_modifyable(a);
+ case c_next:
+ case c_tolimit:
+ case c_atlimit:
+ case c_leftslice:
+ case c_rightslice:
+ case c_true:
+ case c_false:
+ case c_debug:
+ return C_style(a, "", token);
+ case c_assignto:
+ case c_sliceto:
+ check_modifyable(a);
+ return C_style(a, "s", token);
+ case c_assign:
+ case c_insert:
+ case c_attach:
+ case c_slicefrom:
+ check_modifyable(a);
+ return C_style(a, "S", token);
+ case c_setlimit:
+ return C_style(a, "CfD", token);
+ case c_set:
+ case c_unset:
+ return C_style(a, "b", token);
+ case c_dollar:
+ get_token(a, c_name);
+ {
+ struct node * p;
+ struct name * q = find_name(a);
+ int mode = a->mode;
+ int modifyable = a->modifyable;
+ switch (q ? q->type : t_string)
+ /* above line was: switch (q->type) - bug #1 fix 7/2/2003 */
+ {
+ default: error(a, 34);
+ case t_string:
+ a->mode = m_forward;
+ a->modifyable = true;
+ p = new_node(a, c_dollar);
+ p->left = read_C(a); break;
+ case t_integer:
+ /* a->mode = m_integer; */
+ p = new_node(a, read_AE_test(a));
+ p->AE = read_AE(a, 0); break;
+ }
+ p->name = q;
+ a->mode = mode;
+ a->modifyable = modifyable;
+ return p;
+ }
+ case c_name:
+ {
+ struct name * q = find_name(a);
+ struct node * p = new_node(a, c_name);
+ unless (q == 0) {
+ q->used = true;
+ switch (q->type) {
+ case t_boolean:
+ p->type = c_booltest; break;
+ case t_integer:
+ error(a, 35); /* integer name misplaced */
+ case t_string:
+ break;
+ case t_routine:
+ case t_external:
+ p->type = c_call;
+ check_routine_mode(a, q, a->mode);
+ break;
+ case t_grouping:
+ p->type = c_grouping; break;
+ }
+ }
+ p->name = q;
+ return p;
+ }
+ case c_non:
+ {
+ struct node * p = new_node(a, token);
+ read_token(t);
+ if (t->token == c_minus) read_token(t);
+ unless (check_token(a, c_name)) { omission_error(a, c_name); return p; }
+ name_to_node(a, p, 'g');
+ return p;
+ }
+ case c_literalstring:
+ return read_literalstring(a);
+ case c_among: return read_among(a);
+ case c_substring: return read_substring(a);
+ default: error(a, 1); return 0;
+ }
+}
+
+static int next_symbol(symbol * p, symbol * W, int utf8) {
+ if (utf8) {
+ int ch;
+ int j = get_utf8(p, & ch);
+ W[0] = ch; return j;
+ } else {
+ W[0] = p[0]; return 1;
+ }
+}
+
+static symbol * alter_grouping(symbol * p, symbol * q, int style, int utf8) {
+ int j = 0;
+ symbol W[1];
+ int width;
+ if (style == c_plus) {
+ while (j < SIZE(q)) {
+ width = next_symbol(q + j, W, utf8);
+ p = add_to_b(p, 1, W);
+ j += width;
+ }
+ } else {
+ while (j < SIZE(q)) {
+ int i;
+ width = next_symbol(q + j, W, utf8);
+ for (i = 0; i < SIZE(p); i++) {
+ if (p[i] == W[0]) {
+ memmove(p + i, p + i + 1, (SIZE(p) - i - 1) * sizeof(symbol));
+ SIZE(p)--;
+ }
+ }
+ j += width;
+ }
+ }
+ return p;
+}
+
+static void read_define_grouping(struct analyser * a, struct name * q) {
+ struct tokeniser * t = a->tokeniser;
+ int style = c_plus;
+ {
+ NEW(grouping, p);
+ if (a->groupings == 0) a->groupings = p; else a->groupings_end->next = p;
+ a->groupings_end = p;
+ q->grouping = p;
+ p->next = 0;
+ p->name = q;
+ p->number = q->count;
+ p->b = create_b(0);
+ repeat {
+ switch (read_token(t)) {
+ case c_name:
+ {
+ struct name * r = find_name(a);
+ unless (r == 0) {
+ check_name_type(a, r, 'g');
+ p->b = alter_grouping(p->b, r->grouping->b, style, false);
+ }
+ }
+ break;
+ case c_literalstring:
+ p->b = alter_grouping(p->b, t->b, style, a->utf8);
+ break;
+ default: error(a, 1); return;
+ }
+ switch (read_token(t)) {
+ case c_plus:
+ case c_minus: style = t->token; break;
+ default: goto label0;
+ }
+ }
+ label0:
+ {
+ int i;
+ int max = 0;
+ int min = 1<<16;
+ for (i = 0; i < SIZE(p->b); i++) {
+ if (p->b[i] > max) max = p->b[i];
+ if (p->b[i] < min) min = p->b[i];
+ }
+ p->largest_ch = max;
+ p->smallest_ch = min;
+ if (min == 1<<16) error(a, 16);
+ }
+ t->token_held = true; return;
+ }
+}
+
+static void read_define_routine(struct analyser * a, struct name * q) {
+ struct node * p = new_node(a, c_define);
+ a->amongvar_needed = false;
+ unless (q == 0) {
+ check_name_type(a, q, 'R');
+ if (q->definition != 0) error(a, 36);
+ if (q->mode < 0) q->mode = a->mode; else
+ if (q->mode != a->mode) error2(a, 32, q->mode);
+ }
+ p->name = q;
+ if (a->program == 0) a->program = p; else a->program_end->right = p;
+ a->program_end = p;
+ get_token(a, c_as);
+ p->left = read_C(a);
+ unless (q == 0) q->definition = p->left;
+
+ if (a->substring != 0) {
+ error2(a, 14, a->substring->line_number);
+ a->substring = 0;
+ }
+ p->amongvar_needed = a->amongvar_needed;
+}
+
+static void read_define(struct analyser * a) {
+ unless (get_token(a, c_name)) return;
+ {
+ struct name * q = find_name(a);
+ if (q != 0 && q->type == t_grouping) read_define_grouping(a, q);
+ else read_define_routine(a, q);
+ }
+}
+
+static void read_backwardmode(struct analyser * a) {
+ int mode = a->mode;
+ a->mode = m_backward;
+ if (get_token(a, c_bra)) {
+ read_program_(a, c_ket);
+ check_token(a, c_ket);
+ }
+ a->mode = mode;
+}
+
+static void read_program_(struct analyser * a, int terminator) {
+ struct tokeniser * t = a->tokeniser;
+ repeat {
+ switch (read_token(t)) {
+ case c_strings: read_names(a, t_string); break;
+ case c_booleans: read_names(a, t_boolean); break;
+ case c_integers: read_names(a, t_integer); break;
+ case c_routines: read_names(a, t_routine); break;
+ case c_externals: read_names(a, t_external); break;
+ case c_groupings: read_names(a, t_grouping); break;
+ case c_define: read_define(a); break;
+ case c_backwardmode:read_backwardmode(a); break;
+ case c_ket:
+ if (terminator == c_ket) return;
+ default:
+ error(a, 1); break;
+ case -1:
+ unless (terminator < 0) omission_error(a, c_ket);
+ return;
+ }
+ }
+}
+
+extern void read_program(struct analyser * a) {
+ read_program_(a, -1);
+ {
+ struct name * q = a->names;
+ until (q == 0) {
+ switch(q->type) {
+ case t_external: case t_routine:
+ if (q->used && q->definition == 0) error4(a, q); break;
+ case t_grouping:
+ if (q->used && q->grouping == 0) error4(a, q); break;
+ }
+ q = q->next;
+ }
+ }
+
+ if (a->tokeniser->error_count == 0) {
+ struct name * q = a->names;
+ int warned = false;
+ until (q == 0) {
+ unless (q->referenced) {
+ unless (warned) {
+ fprintf(stderr, "Declared but not used:");
+ warned = true;
+ }
+ fprintf(stderr, " "); report_b(stderr, q->b);
+ }
+ q = q->next;
+ }
+ if (warned) fprintf(stderr, "\n");
+
+ q = a->names;
+ warned = false;
+ until (q == 0) {
+ if (! q->used && (q->type == t_routine ||
+ q->type == t_grouping)) {
+ unless (warned) {
+ fprintf(stderr, "Declared and defined but not used:");
+ warned = true;
+ }
+ fprintf(stderr, " "); report_b(stderr, q->b);
+ }
+ q = q->next;
+ }
+ if (warned) fprintf(stderr, "\n");
+ }
+}
+
+extern struct analyser * create_analyser(struct tokeniser * t) {
+ NEW(analyser, a);
+ a->tokeniser = t;
+ a->nodes = 0;
+ a->names = 0;
+ a->literalstrings = 0;
+ a->program = 0;
+ a->amongs = 0;
+ a->among_count = 0;
+ a->groupings = 0;
+ a->mode = m_forward;
+ a->modifyable = true;
+ { int i; for (i = 0; i < t_size; i++) a->name_count[i] = 0; }
+ a->substring = 0;
+ return a;
+}
+
+extern void close_analyser(struct analyser * a) {
+ {
+ struct node * q = a->nodes;
+ until (q == 0) {
+ struct node * q_next = q->next;
+ FREE(q);
+ q = q_next;
+ }
+ }
+ {
+ struct name * q = a->names;
+ until (q == 0) {
+ struct name * q_next = q->next;
+ lose_b(q->b); FREE(q);
+ q = q_next;
+ }
+ }
+ {
+ struct literalstring * q = a->literalstrings;
+ until (q == 0) {
+ struct literalstring * q_next = q->next;
+ lose_b(q->b); FREE(q);
+ q = q_next;
+ }
+ }
+ {
+ struct among * q = a->amongs;
+ until (q == 0) {
+ struct among * q_next = q->next;
+ FREE(q->b); FREE(q);
+ q = q_next;
+ }
+ }
+ {
+ struct grouping * q = a->groupings;
+ until (q == 0) {
+ struct grouping * q_next = q->next;
+ lose_b(q->b); FREE(q);
+ q = q_next;
+ }
+ }
+ FREE(a);
+}
+
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-07 01:19:53 +0000