2
#include <stdio.h> /* main etc */
3
#include <stdlib.h> /* exit */
4
#include <string.h> /* memmove */
9
static void read_program_(struct analyser * a, int terminator);
10
static struct node * read_C(struct analyser * a);
11
static struct node * C_style(struct analyser * a, char * s, int token);
14
static void fault(int n) { fprintf(stderr, "fault %d\n", n); exit(1); }
16
static void print_node_(struct node * p, int n, char * s)
19
for (i = 0; i < n; i++) printf(i == n - 1 ? s : " ");
20
printf("%s ", name_of_token(p->type));
21
unless (p->name == 0) report_b(stdout, p->name->b);
22
unless (p->literalstring == 0)
24
report_b(stdout, p->literalstring);
28
unless (p->AE == 0) print_node_(p->AE, n+1, "# ");
29
unless (p->left == 0) print_node_(p->left, n+1, " ");
30
unless (p->right == 0) print_node_(p->right, n, " ");
31
if (p->aux != 0) print_node_(p->aux, n+1, "@ ");
34
extern void print_program(struct analyser * a) {
35
print_node_(a->program, 0, " ");
38
static struct node * new_node(struct analyser * a, int type)
40
p->next = a->nodes; a->nodes = p;
48
p->line_number = a->tokeniser->line_number;
53
static char * name_of_mode(int n)
57
case m_backward: return "string backward";
58
case m_forward: return "string forward";
59
/* case m_integer: return "integer"; */
63
static char * name_of_type(int n)
67
case 's': return "string";
68
case 'i': return "integer";
69
case 'r': return "routine";
70
case 'R': return "routine or grouping";
71
case 'g': return "grouping";
75
static void count_error(struct analyser * a)
76
{ struct tokeniser * t = a->tokeniser;
77
if (t->error_count >= 20) { fprintf(stderr, "... etc\n"); exit(1); }
81
static void error2(struct analyser * a, int n, int x)
82
{ struct tokeniser * t = a->tokeniser;
84
fprintf(stderr, "Line %d", t->line_number);
85
if (t->get_depth > 0) fprintf(stderr, " (of included file)");
86
fprintf(stderr, ": ");
87
if (n >= 30) report_b(stderr, t->b);
91
fprintf(stderr, "%s omitted", name_of_token(t->omission)); break;
93
fprintf(stderr, "in among(...), ");
95
fprintf(stderr, "unexpected %s", name_of_token(t->token));
96
if (t->token == c_number) fprintf(stderr, " %d", t->number);
97
if (t->token == c_name)
98
{ fprintf(stderr, " ");
99
report_b(stderr, t->b);
102
fprintf(stderr, "string omitted"); break;
105
fprintf(stderr, "unresolved substring on line %d", x); break;
107
fprintf(stderr, "%s not allowed inside reverse(...)", name_of_token(t->token)); break;
109
fprintf(stderr, "empty grouping"); break;
111
fprintf(stderr, "backwards used when already in this mode"); break;
113
fprintf(stderr, "empty among(...)"); break;
115
fprintf(stderr, "two adjacent bracketed expressions in among(...)"); break;
117
fprintf(stderr, "substring preceded by another substring on line %d", x); break;
120
fprintf(stderr, " re-declared"); break;
122
fprintf(stderr, " undeclared"); break;
124
fprintf(stderr, " declared as %s mode; used as %s mode",
125
name_of_mode(a->mode), name_of_mode(x)); break;
127
fprintf(stderr, " not of type %s", name_of_type(x)); break;
129
fprintf(stderr, " not of type string or integer"); break;
131
fprintf(stderr, " misplaced"); break;
133
fprintf(stderr, " redefined"); break;
135
fprintf(stderr, " mis-used as %s mode",
136
name_of_mode(x)); break;
138
fprintf(stderr, " error %d", n); break;
141
if (n <= 13 && t->previous_token > 0)
142
fprintf(stderr, " after %s", name_of_token(t->previous_token));
143
fprintf(stderr, "\n");
146
static void error(struct analyser * a, int n) { error2(a, n, 0); }
148
static void error3(struct analyser * a, struct node * p, symbol * b)
150
fprintf(stderr, "among(...) on line %d has repeated string '", p->line_number);
152
fprintf(stderr, "'\n");
155
static void error4(struct analyser * a, struct name * q)
157
report_b(stderr, q->b);
158
fprintf(stderr, " undefined\n");
161
static void omission_error(struct analyser * a, int n)
162
{ a->tokeniser->omission = n;
166
static int check_token(struct analyser * a, int code)
167
{ struct tokeniser * t = a->tokeniser;
168
if (t->token != code) { omission_error(a, code); return false; }
172
static int get_token(struct analyser * a, int code)
173
{ struct tokeniser * t = a->tokeniser;
175
{ int x = check_token(a, code);
176
unless (x) t->token_held = true;
181
static struct name * look_for_name(struct analyser * a)
182
{ struct name * p = a->names;
183
symbol * q = a->tokeniser->b;
185
{ if (p == 0) return 0;
188
if (n == SIZE(q) && memcmp(q, b, n * sizeof(symbol)) == 0)
189
{ p->referenced = true;
197
static struct name * find_name(struct analyser * a)
198
{ struct name * p = look_for_name(a);
199
if (p == 0) error(a, 31);
203
static void check_routine_mode(struct analyser * a, struct name * p, int mode)
204
{ if (p->mode < 0) p->mode = mode; else
205
unless (p->mode == mode) error2(a, 37, mode);
208
static void check_name_type(struct analyser * a, struct name * p, int type)
210
{ case 's': if (p->type == t_string) return; break;
211
case 'i': if (p->type == t_integer) return; break;
212
case 'b': if (p->type == t_boolean) return; break;
213
case 'R': if (p->type == t_grouping) return;
214
case 'r': if (p->type == t_routine ||
215
p->type == t_external) return; break;
216
case 'g': if (p->type == t_grouping) return; break;
221
static void read_names(struct analyser * a, int type)
222
{ struct tokeniser * t = a->tokeniser;
223
unless (get_token(a, c_bra)) return;
225
{ if (read_token(t) != c_name) break;
226
if (look_for_name(a) != 0) error(a, 30); else
230
p->mode = -1; /* routines, externals */
231
p->count = a->name_count[type];
232
p->referenced = false;
236
a->name_count[type] ++;
241
unless (check_token(a, c_ket)) t->token_held = true;
244
static symbol * new_literalstring(struct analyser * a)
245
{ NEW(literalstring, p);
246
p->b = copy_b(a->tokeniser->b);
247
p->next = a->literalstrings;
248
a->literalstrings = p;
252
static int read_AE_test(struct analyser * a)
254
struct tokeniser * t = a->tokeniser;
255
switch (read_token(t))
256
{ case c_assign: return c_mathassign;
259
case c_multiplyassign:
266
case c_le: return t->token;
267
default: error(a, 1); t->token_held = true; return c_eq;
271
static int binding(int t)
273
{ case c_plus: case c_minus: return 1;
274
case c_multiply: case c_divide: return 2;
279
static void name_to_node(struct analyser * a, struct node * p, int type)
280
{ struct name * q = find_name(a);
282
{ check_name_type(a, q, type);
288
static struct node * read_AE(struct analyser * a, int B)
289
{ struct tokeniser * t = a->tokeniser;
292
switch (read_token(t))
294
case c_minus: /* monadic */
295
p = new_node(a, c_neg);
296
p->right = read_AE(a, 100);
303
p = new_node(a, c_name);
304
name_to_node(a, p, 'i');
311
p = new_node(a, t->token);
314
p = new_node(a, c_number);
315
p->number = t->number;
318
p = C_style(a, "s", c_sizeof);
322
t->token_held = true;
326
{ int token = read_token(t);
327
int b = binding(token);
328
unless (binding(token) > B)
329
{ t->token_held = true;
332
q = new_node(a, token);
334
q->right = read_AE(a, b);
339
static struct node * read_C_connection(struct analyser * a, struct node * q, int op)
340
{ struct tokeniser * t = a->tokeniser;
341
struct node * p = new_node(a, op);
342
struct node * p_end = q;
346
p_end->right = q; p_end = q;
347
if (read_token(t) != op)
348
{ t->token_held = true;
355
static struct node * read_C_list(struct analyser * a)
356
{ struct tokeniser * t = a->tokeniser;
357
struct node * p = new_node(a, c_bra);
358
struct node * p_end = 0;
360
{ int token = read_token(t);
361
if (token == c_ket) return p;
362
if (token < 0) { omission_error(a, c_ket); return p; }
363
t->token_held = true;
364
{ struct node * q = read_C(a);
366
{ token = read_token(t);
367
if (token != c_and && token != c_or)
368
{ t->token_held = true;
371
q = read_C_connection(a, q, token);
373
if (p_end == 0) p->left = q; else p_end->right = q;
379
static struct node * C_style(struct analyser * a, char * s, int token)
381
struct node * p = new_node(a, token);
382
for (i = 0; s[i] != 0; i++) switch(s[i])
384
p->left = read_C(a); continue;
386
p->aux = read_C(a); continue;
388
p->AE = read_AE(a, 0); continue;
390
get_token(a, c_for); continue;
392
{ int token = read_token(a->tokeniser);
393
if (token == c_name) name_to_node(a, p, 's'); else
394
if (token == c_literalstring) p->literalstring = new_literalstring(a);
401
if (get_token(a, c_name)) name_to_node(a, p, s[i]);
407
static struct node * read_literalstring(struct analyser * a)
408
{ struct node * p = new_node(a, c_literalstring);
409
p->literalstring = new_literalstring(a);
415
static void reverse_b(symbol * b)
416
{ int i = 0; int j = SIZE(b) - 1;
418
{ int ch1 = b[i]; int ch2 = b[j];
419
b[i++] = ch2; b[j--] = ch1;
423
static int compare_amongvec(struct amongvec * p, struct amongvec * q)
424
{ symbol * b_p = p->b; int p_size = p->size;
425
symbol * b_q = q->b; int q_size = q->size;
426
int smaller_size = p_size < q_size ? p_size : q_size;
428
for (i = 0; i < smaller_size; i++)
429
if (b_p[i] != b_q[i]) return b_p[i] - b_q[i];
430
return p_size - q_size;
433
static void make_among(struct analyser * a, struct node * p, struct node * substring)
436
NEWVEC(amongvec, v, p->number);
437
struct node * q = p->left;
438
struct amongvec * w0 = v;
439
struct amongvec * w1 = v;
442
int direction = substring != 0 ? substring->mode : p->mode;
443
int backward = direction == m_backward;
445
if (a->amongs == 0) a->amongs = x; else a->amongs_end->next = x;
449
x->number = a->among_count++;
452
if (q->type == c_bra) { x->starter = q; q = q->right; }
455
{ if (q->type == c_literalstring)
456
{ symbol * b = q->literalstring;
457
w1->b = b; /* pointer to case string */
458
w1->p = 0; /* pointer to corresponding case expression */
459
w1->size = SIZE(b); /* number of characters in string */
460
w1->i = -1; /* index of longest substring */
461
w1->result = -1; /* number of corresponding case expression */
462
w1->function = q->left == 0 ? 0 : q->left->name;
463
unless (w1->function == 0)
464
check_routine_mode(a, w1->function, direction);
468
if (q->left == 0) /* empty command: () */
480
unless (w1-v == p->number) { fprintf(stderr, "oh! %d %d\n", w1-v, p->number); exit(1); }
481
if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
482
sort(v, w1, sizeof(struct amongvec), compare_amongvec);
484
/* the following loop is O(n squared) */
485
for (w0 = w1 - 1; w0 >= v; w0--)
486
{ symbol * b = w0->b;
490
for (w = w0 - 1; w >= v; w--)
492
if (w->size < size && memcmp(w->b, b, w->size * sizeof(symbol)) == 0)
493
{ w0->i = w - v; /* fill in index of longest substring */
498
if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
500
for (w0 = v; w0 < w1 - 1; w0++)
501
if (w0->size == (w0 + 1)->size &&
502
memcmp(w0->b, (w0 + 1)->b, w0->size * sizeof(symbol)) == 0) error3(a, p, w0->b);
504
x->literalstring_count = p->number;
505
x->command_count = result - 1;
508
x->substring = substring;
509
if (substring != 0) substring->among = x;
510
unless (x->command_count == 0 && x->starter == 0) a->amongvar_needed = true;
513
static struct node * read_among(struct analyser * a)
514
{ struct tokeniser * t = a->tokeniser;
515
struct node * p = new_node(a, c_among);
516
struct node * p_end = 0;
517
int previous_token = -1;
518
struct node * substring = a->substring;
521
p->number = 0; /* counts the number of literals */
522
unless (get_token(a, c_bra)) return p;
525
int token = read_token(t);
527
{ case c_literalstring:
528
q = read_literalstring(a);
529
if (read_token(t) == c_name)
530
{ struct node * r = new_node(a, c_name);
531
name_to_node(a, r, 'r');
534
else t->token_held = true;
537
if (previous_token == c_bra) error(a, 19);
538
q = read_C_list(a); break;
542
if (p->number == 0) error(a, 18);
543
if (t->error_count == 0) make_among(a, p, substring);
546
previous_token = token;
547
if (p_end == 0) p->left = q; else p_end->right = q;
552
static struct node * read_substring(struct analyser * a)
554
struct node * p = new_node(a, c_substring);
555
if (a->substring != 0) error2(a, 20, a->substring->line_number);
560
static void check_modifyable(struct analyser * a)
561
{ unless (a->modifyable) error(a, 15);
564
static struct node * read_C(struct analyser * a)
565
{ struct tokeniser * t = a->tokeniser;
566
int token = read_token(t);
570
return read_C_list(a);
572
{ int mode = a->mode;
573
if (a->mode == m_backward) error(a, 17); else a->mode = m_backward;
574
{ struct node * p = C_style(a, "C", token);
580
{ int mode = a->mode;
581
int modifyable = a->modifyable;
582
a->modifyable = false;
583
a->mode = mode == m_forward ? m_backward : m_forward;
584
{ struct node * p = C_style(a, "C", token);
586
a->modifyable = modifyable;
598
return C_style(a, "C", token);
601
return C_style(a, "AC", token);
603
return C_style(a, "i", token);
607
return C_style(a, "A", token);
618
return C_style(a, "", token);
622
return C_style(a, "s", token);
628
return C_style(a, "S", token);
630
return C_style(a, "CfD", token);
633
return C_style(a, "b", token);
635
get_token(a, c_name);
637
struct name * q = find_name(a);
639
int modifyable = a->modifyable;
640
switch (q ? q->type : t_string)
641
/* above line was: switch (q->type) - bug #1 fix 7/2/2003 */
642
{ default: error(a, 34);
645
a->modifyable = true;
646
p = new_node(a, c_dollar);
647
p->left = read_C(a); break;
649
/* a->mode = m_integer; */
650
p = new_node(a, read_AE_test(a));
651
p->AE = read_AE(a, 0); break;
655
a->modifyable = modifyable;
659
{ struct name * q = find_name(a);
660
struct node * p = new_node(a, c_name);
666
p->type = c_booltest; break;
668
error(a, 35); /* integer name misplaced */
674
check_routine_mode(a, q, a->mode);
677
p->type = c_grouping; break;
684
{ struct node * p = new_node(a, token);
686
if (t->token == c_minus) read_token(t);
687
unless (check_token(a, c_name)) { omission_error(a, c_name); return p; }
688
name_to_node(a, p, 'g');
691
case c_literalstring:
692
return read_literalstring(a);
693
case c_among: return read_among(a);
694
case c_substring: return read_substring(a);
695
default: error(a, 1); return 0;
699
static symbol * alter_grouping(symbol * p, symbol * q, int style)
700
{ if (style == c_plus) return add_to_b(p, SIZE(q), q);
703
for (j = 0; j < SIZE(q); j++)
706
for (i = 0; i < SIZE(p); i++) if (ch == p[i])
707
{ memmove(p + i, p + i + 1, (SIZE(p) - i - 1) * sizeof(symbol));
715
static void read_define_grouping(struct analyser * a, struct name * q)
716
{ struct tokeniser * t = a->tokeniser;
719
if (a->groupings == 0) a->groupings = p; else a->groupings_end->next = p;
720
a->groupings_end = p;
724
p->number = q->count;
727
{ switch (read_token(t))
729
{ struct name * r = find_name(a);
731
{ check_name_type(a, r, 'g');
732
p->b = alter_grouping(p->b, r->grouping->b, style);
736
case c_literalstring:
737
p->b = alter_grouping(p->b, t->b, style);
739
default: error(a, 1); return;
741
switch (read_token(t))
743
case c_minus: style = t->token; break;
744
default: goto label0;
751
for (i = 0; i < SIZE(p->b); i++)
752
{ if (p->b[i] > max) max = p->b[i];
753
if (p->b[i] < min) min = p->b[i];
756
p->smallest_ch = min;
757
if (min == 1<<16) error(a, 16);
759
t->token_held = true; return;
763
static void read_define_routine(struct analyser * a, struct name * q)
764
{ struct node * p = new_node(a, c_define);
765
a->amongvar_needed = false;
768
check_name_type(a, q, 'R');
769
if (q->definition != 0) error(a, 36);
770
if (q->mode < 0) q->mode = a->mode; else
771
if (q->mode != a->mode) error2(a, 32, q->mode);
774
if (a->program == 0) a->program = p; else a->program_end->right = p;
778
unless (q == 0) q->definition = p->left;
780
if (a->substring != 0)
781
{ error2(a, 14, a->substring->line_number);
784
p->amongvar_needed = a->amongvar_needed;
787
static void read_define(struct analyser * a)
788
{ unless (get_token(a, c_name)) return;
789
{ struct name * q = find_name(a);
790
if (q != 0 && q->type == t_grouping) read_define_grouping(a, q);
791
else read_define_routine(a, q);
795
static void read_backwardmode(struct analyser * a)
796
{ int mode = a->mode;
797
a->mode = m_backward;
798
if (get_token(a, c_bra))
799
{ read_program_(a, c_ket);
800
check_token(a, c_ket);
805
static void read_program_(struct analyser * a, int terminator)
806
{ struct tokeniser * t = a->tokeniser;
809
switch (read_token(t))
810
{ case c_strings: read_names(a, t_string); break;
811
case c_booleans: read_names(a, t_boolean); break;
812
case c_integers: read_names(a, t_integer); break;
813
case c_routines: read_names(a, t_routine); break;
814
case c_externals: read_names(a, t_external); break;
815
case c_groupings: read_names(a, t_grouping); break;
816
case c_define: read_define(a); break;
817
case c_backwardmode:read_backwardmode(a); break;
819
if (terminator == c_ket) return;
823
unless (terminator < 0) omission_error(a, c_ket);
829
extern void read_program(struct analyser * a)
830
{ read_program_(a, -1);
832
{ struct name * q = a->names;
835
{ case t_external: case t_routine:
836
if (q->used && q->definition == 0) error4(a, q); break;
838
if (q->used && q->grouping == 0) error4(a, q); break;
844
if (a->tokeniser->error_count == 0)
845
{ struct name * q = a->names;
848
{ unless (q->referenced)
850
{ fprintf(stderr, "Declared but not used:");
853
fprintf(stderr, " "); report_b(stderr, q->b);
857
if (warned) fprintf(stderr, "\n");
862
{ if (! q->used && (q->type == t_routine ||
863
q->type == t_grouping))
865
{ fprintf(stderr, "Declared and defined but not used:");
868
fprintf(stderr, " "); report_b(stderr, q->b);
872
if (warned) fprintf(stderr, "\n");
876
extern struct analyser * create_analyser(struct tokeniser * t)
881
a->literalstrings = 0;
887
a->modifyable = true;
888
{ int i; for (i = 0; i < t_size; i++) a->name_count[i] = 0; }
893
extern void close_analyser(struct analyser * a)
895
{ struct node * q = a->nodes;
897
{ struct node * q_next = q->next;
902
{ struct name * q = a->names;
904
{ struct name * q_next = q->next;
905
lose_b(q->b); FREE(q);
909
{ struct literalstring * q = a->literalstrings;
911
{ struct literalstring * q_next = q->next;
912
lose_b(q->b); FREE(q);
916
{ struct among * q = a->amongs;
918
{ struct among * q_next = q->next;
923
{ struct grouping * q = a->groupings;
925
{ struct grouping * q_next = q->next;
926
lose_b(q->b); FREE(q);