~snowball-yiddish-dev/snowball-yiddish/trunk

« back to all changes in this revision

Viewing changes to snowball/compiler/analyser.c

  • Committer: richard
  • Date: 2003-03-30 12:08:09 UTC
  • Revision ID: svn-v4:633ccae0-01f4-0310-8c99-d3591da6f01f:trunk:216
This module will contain only the code and build system, and documentation
for building and running the stemming library.
All sample data will be in a separate module, and the website will be in
its own module too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
 
 
2
#include <stdio.h>   /* main etc */
 
3
#include <string.h>  /* memmove */
 
4
#include "header.h"
 
5
 
 
6
/* recursive usage: */
 
7
 
 
8
static void read_program_(struct analyser * a, int terminator);
 
9
static struct node * read_C(struct analyser * a);
 
10
static struct node * C_style(struct analyser * a, char * s, int token);
 
11
 
 
12
 
 
13
static void fault(int n) { fprintf(stderr, "fault %d\n", n); exit(1); }
 
14
 
 
15
static void print_node_(struct node * p, int n, char * s)
 
16
{
 
17
    int i;
 
18
    for (i = 0; i < n; i++) printf(i == n - 1 ? s : "  ");
 
19
    printf("%s ", name_of_token(p->type));
 
20
    unless (p->name == 0) report_b(stdout, p->name->b);
 
21
    unless (p->literalstring == 0)
 
22
    {   printf("'");
 
23
        report_b(stdout, p->literalstring);
 
24
        printf("'");
 
25
    }
 
26
    printf("\n");
 
27
    unless (p->AE == 0) print_node_(p->AE, n+1, "# ");
 
28
    unless (p->left == 0) print_node_(p->left, n+1, "  ");
 
29
    unless (p->right == 0) print_node_(p->right, n, "  ");
 
30
    if (p->aux != 0) print_node_(p->aux, n+1, "@ ");
 
31
}
 
32
 
 
33
extern void print_program(struct analyser * a) {
 
34
    print_node_(a->program, 0, "  ");
 
35
}
 
36
 
 
37
static struct node * new_node(struct analyser * a, int type)
 
38
{   NEW(node, p);
 
39
    p->next = a->nodes; a->nodes = p;
 
40
    p->left = 0;
 
41
    p->right = 0;
 
42
    p->aux = 0;
 
43
    p->AE = 0;
 
44
    p->name = 0;
 
45
    p->literalstring = 0;
 
46
    p->mode = a->mode;
 
47
    p->line_number = a->tokeniser->line_number;
 
48
    p->type = type;
 
49
    return p;
 
50
}
 
51
 
 
52
static char * name_of_mode(int n)
 
53
{   switch (n)
 
54
    {
 
55
         default: fault(0);
 
56
         case m_backward: return "string backward";
 
57
         case m_forward:  return "string forward";
 
58
    /*   case m_integer:  return "integer";  */
 
59
    }
 
60
}
 
61
 
 
62
static char * name_of_type(int n)
 
63
{   switch (n)
 
64
    {
 
65
         default: fault(1);
 
66
         case 's': return "string";
 
67
         case 'i': return "integer";
 
68
         case 'r': return "routine";
 
69
         case 'R': return "routine or grouping";
 
70
         case 'g': return "grouping";
 
71
    }
 
72
}
 
73
 
 
74
static void count_error(struct analyser * a)
 
75
{   struct tokeniser * t = a->tokeniser;
 
76
    if (t->error_count >= 20) { fprintf(stderr, "... etc\n"); exit(1); }
 
77
    t->error_count++;
 
78
}
 
79
 
 
80
static void error2(struct analyser * a, int n, int x)
 
81
{   struct tokeniser * t = a->tokeniser;
 
82
    count_error(a);
 
83
    fprintf(stderr, "Line %d", t->line_number);
 
84
    if (t->get_depth > 0) fprintf(stderr, " (of included file)");
 
85
    fprintf(stderr, ": ");
 
86
    if (n >= 30) report_b(stderr, t->b);
 
87
    switch (n)
 
88
    {
 
89
        case 0:
 
90
            fprintf(stderr, "%s omitted", name_of_token(t->omission)); break;
 
91
        case 3:
 
92
            fprintf(stderr, "in among(...), ");
 
93
        case 1:
 
94
            fprintf(stderr, "unexpected %s", name_of_token(t->token));
 
95
            if (t->token == c_number) fprintf(stderr, " %d", t->number);
 
96
            if (t->token == c_name)
 
97
            {   fprintf(stderr, " ");
 
98
                report_b(stderr, t->b);
 
99
            } break;
 
100
        case 2:
 
101
            fprintf(stderr, "string omitted"); break;
 
102
 
 
103
        case 14:
 
104
            fprintf(stderr, "unresolved substring on line %d", x); break;
 
105
        case 15:
 
106
            fprintf(stderr, "%s not allowed inside reverse(...)", name_of_token(t->token)); break;
 
107
        case 16:
 
108
            fprintf(stderr, "empty grouping"); break;
 
109
        case 17:
 
110
            fprintf(stderr, "backwards used when already in this mode"); break;
 
111
        case 18:
 
112
            fprintf(stderr, "empty among(...)"); break;
 
113
        case 19:
 
114
            fprintf(stderr, "two adjacent bracketed expressions in among(...)"); break;
 
115
        case 20:
 
116
            fprintf(stderr, "substring preceded by another substring on line %d", x); break;
 
117
 
 
118
        case 30:
 
119
            fprintf(stderr, " re-declared"); break;
 
120
        case 31:
 
121
            fprintf(stderr, " undeclared"); break;
 
122
        case 32:
 
123
            fprintf(stderr, " declared as %s mode; used as %s mode",
 
124
                            name_of_mode(a->mode), name_of_mode(x)); break;
 
125
        case 33:
 
126
            fprintf(stderr, " not of type %s", name_of_type(x)); break;
 
127
        case 34:
 
128
            fprintf(stderr, " not of type string or integer"); break;
 
129
        case 35:
 
130
            fprintf(stderr, " misplaced"); break;
 
131
        case 36:
 
132
            fprintf(stderr, " redefined"); break;
 
133
        case 37:
 
134
            fprintf(stderr, " mis-used as %s mode",
 
135
                            name_of_mode(x)); break;
 
136
        default:
 
137
            fprintf(stderr, " error %d", n); break;
 
138
 
 
139
    }
 
140
    if (n <= 13 && t->previous_token > 0)
 
141
        fprintf(stderr, " after %s", name_of_token(t->previous_token));
 
142
    fprintf(stderr, "\n");
 
143
}
 
144
 
 
145
static void error(struct analyser * a, int n) { error2(a, n, 0); }
 
146
 
 
147
static void error3(struct analyser * a, struct node * p, symbol * b)
 
148
{   count_error(a);
 
149
    fprintf(stderr, "among(...) on line %d has repeated string '", p->line_number);
 
150
    report_b(stderr, b);
 
151
    fprintf(stderr, "'\n");
 
152
}
 
153
 
 
154
static void error4(struct analyser * a, struct name * q)
 
155
{   count_error(a);
 
156
    report_b(stderr, q->b);
 
157
    fprintf(stderr, " undefined\n");
 
158
}
 
159
 
 
160
static void omission_error(struct analyser * a, int n)
 
161
{   a->tokeniser->omission = n;
 
162
    error(a, 0);
 
163
}
 
164
 
 
165
static int check_token(struct analyser * a, int code)
 
166
{   struct tokeniser * t = a->tokeniser;
 
167
    if (t->token != code) { omission_error(a, code); return false; }
 
168
    return true;
 
169
}
 
170
 
 
171
static int get_token(struct analyser * a, int code)
 
172
{   struct tokeniser * t = a->tokeniser;
 
173
    read_token(t);
 
174
    {   int x = check_token(a, code);
 
175
        unless (x) t->token_held = true;
 
176
        return x;
 
177
    }
 
178
}
 
179
 
 
180
static struct name * look_for_name(struct analyser * a)
 
181
{   struct name * p = a->names;
 
182
    symbol * q = a->tokeniser->b;
 
183
    repeat
 
184
    {   if (p == 0) return 0;
 
185
        {   symbol * b = p->b;
 
186
            int n = SIZE(b);
 
187
            if (n == SIZE(q) && memcmp(q, b, n * sizeof(symbol)) == 0)
 
188
            {   p->referenced = true;
 
189
                return p;
 
190
            }
 
191
        }
 
192
        p = p->next;
 
193
    }
 
194
}
 
195
 
 
196
static struct name * find_name(struct analyser * a)
 
197
{   struct name * p = look_for_name(a);
 
198
    if (p == 0) error(a, 31);
 
199
    return p;
 
200
}
 
201
 
 
202
static void check_routine_mode(struct analyser * a, struct name * p, int mode)
 
203
{   if (p->mode < 0) p->mode = mode; else
 
204
    unless (p->mode == mode) error2(a, 37, mode);
 
205
}
 
206
 
 
207
static void check_name_type(struct analyser * a, struct name * p, int type)
 
208
{   switch (type)
 
209
    {   case 's': if (p->type == t_string) return; break;
 
210
        case 'i': if (p->type == t_integer) return; break;
 
211
        case 'b': if (p->type == t_boolean) return; break;
 
212
        case 'R': if (p->type == t_grouping) return;
 
213
        case 'r': if (p->type == t_routine ||
 
214
                      p->type == t_external) return; break;
 
215
        case 'g': if (p->type == t_grouping) return; break;
 
216
    }
 
217
    error2(a, 33, type);
 
218
}
 
219
 
 
220
static void read_names(struct analyser * a, int type)
 
221
{   struct tokeniser * t = a->tokeniser;
 
222
    unless (get_token(a, c_bra)) return;
 
223
    repeat
 
224
    {   if (read_token(t) != c_name) break;
 
225
        if (look_for_name(a) != 0) error(a, 30); else
 
226
        {   NEW(name, p);
 
227
            p->b = copy_b(t->b);
 
228
            p->type = type;
 
229
            p->mode = -1; /* routines, externals */
 
230
            p->count = a->name_count[type];
 
231
            p->referenced = false;
 
232
            p->used = false;
 
233
            p->grouping = 0;
 
234
            p->definition = 0;
 
235
            a->name_count[type] ++;
 
236
            p->next = a->names;
 
237
            a->names = p;
 
238
        }
 
239
    }
 
240
    unless (check_token(a, c_ket)) t->token_held = true;
 
241
}
 
242
 
 
243
static symbol * new_literalstring(struct analyser * a)
 
244
{   NEW(literalstring, p);
 
245
    p->b = copy_b(a->tokeniser->b);
 
246
    p->next = a->literalstrings;
 
247
    a->literalstrings = p;
 
248
    return p->b;
 
249
}
 
250
 
 
251
static int read_AE_test(struct analyser * a)
 
252
{
 
253
    struct tokeniser * t = a->tokeniser;
 
254
    switch (read_token(t))
 
255
    {   case c_assign: return c_mathassign;
 
256
        case c_plusassign:
 
257
        case c_minusassign:
 
258
        case c_multiplyassign:
 
259
        case c_divideassign:
 
260
        case c_eq:
 
261
        case c_ne:
 
262
        case c_gr:
 
263
        case c_ge:
 
264
        case c_ls:
 
265
        case c_le: return t->token;
 
266
        default: error(a, 1); t->token_held = true; return c_eq;
 
267
    }
 
268
}
 
269
 
 
270
static int binding(int t)
 
271
{   switch (t)
 
272
    {   case c_plus: case c_minus: return 1;
 
273
        case c_multiply: case c_divide: return 2;
 
274
        default: return -2;
 
275
    }
 
276
}
 
277
 
 
278
static void name_to_node(struct analyser * a, struct node * p, int type)
 
279
{   struct name * q = find_name(a);
 
280
    unless (q == 0)
 
281
    {   check_name_type(a, q, type);
 
282
        q->used = true;
 
283
    }
 
284
    p->name = q;
 
285
}
 
286
 
 
287
static struct node * read_AE(struct analyser * a, int B)
 
288
{   struct tokeniser * t = a->tokeniser;
 
289
    struct node * p;
 
290
    struct node * q;
 
291
    switch (read_token(t))
 
292
    {
 
293
        case c_minus: /* monadic */
 
294
            p = new_node(a, c_neg);
 
295
            p->right = read_AE(a, 100);
 
296
            break;
 
297
        case c_bra:
 
298
            p = read_AE(a, 0);
 
299
            get_token(a, c_ket);
 
300
            break;
 
301
        case c_name:
 
302
            p = new_node(a, c_name);
 
303
            name_to_node(a, p, 'i');
 
304
            break;
 
305
        case c_maxint:
 
306
        case c_minint:
 
307
        case c_cursor:
 
308
        case c_limit:
 
309
        case c_size:
 
310
            p = new_node(a, t->token);
 
311
            break;
 
312
        case c_number:
 
313
            p = new_node(a, c_number);
 
314
            p->number = t->number;
 
315
            break;
 
316
        case c_sizeof:
 
317
            p = C_style(a, "s", c_sizeof);
 
318
            break;
 
319
        default:
 
320
            error(a, 1);
 
321
            t->token_held = true;
 
322
            return 0;
 
323
    }
 
324
    repeat
 
325
    {   int token = read_token(t);
 
326
        int b = binding(token);
 
327
        unless (binding(token) > B)
 
328
        {   t->token_held = true;
 
329
            return p;
 
330
        }
 
331
        q = new_node(a, token);
 
332
        q->left = p;
 
333
        q->right = read_AE(a, b);
 
334
        p = q;
 
335
    }
 
336
}
 
337
 
 
338
static struct node * read_C_connection(struct analyser * a, struct node * q, int op)
 
339
{   struct tokeniser * t = a->tokeniser;
 
340
    struct node * p = new_node(a, op);
 
341
    struct node * p_end = q;
 
342
    p->left = q;
 
343
    repeat
 
344
    {   q = read_C(a);
 
345
        p_end->right = q; p_end = q;
 
346
        if (read_token(t) != op)
 
347
        {   t->token_held = true;
 
348
            break;
 
349
        }
 
350
    }
 
351
    return p;
 
352
}
 
353
 
 
354
static struct node * read_C_list(struct analyser * a)
 
355
{   struct tokeniser * t = a->tokeniser;
 
356
    struct node * p = new_node(a, c_bra);
 
357
    struct node * p_end = 0;
 
358
    repeat
 
359
    {   int token = read_token(t);
 
360
        if (token == c_ket) return p;
 
361
        if (token < 0) { omission_error(a, c_ket); return p; }
 
362
        t->token_held = true;
 
363
        {   struct node * q = read_C(a);
 
364
            repeat
 
365
            {   token = read_token(t);
 
366
                if (token != c_and && token != c_or)
 
367
                {   t->token_held = true;
 
368
                    break;
 
369
                }
 
370
                q = read_C_connection(a, q, token);
 
371
            }
 
372
            if (p_end == 0) p->left = q; else p_end->right = q;
 
373
            p_end = q;
 
374
        }
 
375
    }
 
376
}
 
377
 
 
378
static struct node * C_style(struct analyser * a, char * s, int token)
 
379
{   int i;
 
380
    struct node * p = new_node(a, token);
 
381
    for (i = 0; s[i] != 0; i++) switch(s[i])
 
382
    {   case 'C':
 
383
            p->left = read_C(a); continue;
 
384
        case 'D':
 
385
            p->aux = read_C(a); continue;
 
386
        case 'A':
 
387
            p->AE = read_AE(a, 0); continue;
 
388
        case 'f':
 
389
            get_token(a, c_for); continue;
 
390
        case 'S':
 
391
            {   int token = read_token(a->tokeniser);
 
392
                if (token == c_name) name_to_node(a, p, 's'); else
 
393
                if (token == c_literalstring) p->literalstring = new_literalstring(a);
 
394
                else error(a, 2);
 
395
            }
 
396
            continue;
 
397
        case 'b':
 
398
        case 's':
 
399
        case 'i':
 
400
            if (get_token(a, c_name)) name_to_node(a, p, s[i]);
 
401
            continue;
 
402
    }
 
403
    return p;
 
404
}
 
405
 
 
406
static struct node * read_literalstring(struct analyser * a)
 
407
{   struct node * p = new_node(a, c_literalstring);
 
408
    p->literalstring = new_literalstring(a);
 
409
    return p;
 
410
}
 
411
 
 
412
 
 
413
 
 
414
static void reverse_b(symbol * b)
 
415
{   int i = 0; int j = SIZE(b) - 1;
 
416
    until (i >= j)
 
417
    {   int ch1 = b[i]; int ch2 = b[j];
 
418
        b[i++] = ch2; b[j--] = ch1;
 
419
    }
 
420
}
 
421
 
 
422
static int compare_amongvec(struct amongvec * p, struct amongvec * q)
 
423
{   symbol * b_p = p->b; int p_size = p->size;
 
424
    symbol * b_q = q->b; int q_size = q->size;
 
425
    int smaller_size = p_size < q_size ? p_size : q_size;
 
426
    int i;
 
427
    for (i = 0; i < smaller_size; i++)
 
428
        if (b_p[i] != b_q[i]) return b_p[i] - b_q[i];
 
429
    return p_size - q_size;
 
430
}
 
431
 
 
432
static void make_among(struct analyser * a, struct node * p, struct node * substring)
 
433
{
 
434
    NEW(among, x);
 
435
    NEWVEC(amongvec, v, p->number);
 
436
    struct node * q = p->left;
 
437
    struct amongvec * w0 = v;
 
438
    struct amongvec * w1 = v;
 
439
    int result = 1;
 
440
 
 
441
    int direction = substring != 0 ? substring->mode : p->mode;
 
442
    int backward = direction == m_backward;
 
443
 
 
444
    if (a->amongs == 0) a->amongs = x; else a->amongs_end->next = x;
 
445
    a->amongs_end = x;
 
446
    x->next = 0;
 
447
    x->b = v;
 
448
    x->number = a->among_count++;
 
449
    x->starter = 0;
 
450
 
 
451
    if (q->type == c_bra) { x->starter = q; q = q->right; }
 
452
 
 
453
    until (q == 0)
 
454
    {   if (q->type == c_literalstring)
 
455
        {   symbol * b = q->literalstring;
 
456
            w1->b = b;           /* pointer to case string */
 
457
            w1->p = 0;           /* pointer to corresponding case expression */
 
458
            w1->size = SIZE(b);  /* number of characters in string */
 
459
            w1->i = -1;          /* index of longest substring */
 
460
            w1->result = -1;     /* number of corresponding case expression */
 
461
            w1->function = q->left == 0 ? 0 : q->left->name;
 
462
            unless (w1->function == 0)
 
463
                check_routine_mode(a, w1->function, direction);
 
464
            w1++;
 
465
        }
 
466
        else
 
467
        if (q->left == 0)  /* empty command: () */
 
468
            w0 = w1;
 
469
        else
 
470
        {   until (w0 == w1)
 
471
            {   w0->p = q;
 
472
                w0->result = result;
 
473
                w0++;
 
474
            }
 
475
            result++;
 
476
        }
 
477
        q = q->right;
 
478
    }
 
479
    unless (w1-v == p->number) { fprintf(stderr, "oh! %d %d\n", w1-v, p->number); exit(1); }
 
480
    if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
 
481
    sort(v, w1, sizeof(struct amongvec), compare_amongvec);
 
482
 
 
483
    /* the following loop is O(n squared) */
 
484
    for (w0 = w1 - 1; w0 >= v; w0--)
 
485
    {   symbol * b = w0->b;
 
486
        int size = w0->size;
 
487
        struct amongvec * w;
 
488
 
 
489
        for (w = w0 - 1; w >= v; w--)
 
490
        {
 
491
            if (w->size < size && memcmp(w->b, b, w->size * sizeof(symbol)) == 0)
 
492
            {   w0->i = w - v;  /* fill in index of longest substring */
 
493
                break;
 
494
            }
 
495
        }
 
496
    }
 
497
    if (backward) for (w0 = v; w0 < w1; w0++) reverse_b(w0->b);
 
498
 
 
499
    for (w0 = v; w0 < w1 - 1; w0++)
 
500
        if (w0->size == (w0 + 1)->size &&
 
501
            memcmp(w0->b, (w0 + 1)->b, w0->size * sizeof(symbol)) == 0) error3(a, p, w0->b);
 
502
 
 
503
    x->literalstring_count = p->number;
 
504
    x->command_count = result - 1;
 
505
    p->among = x;
 
506
 
 
507
    x->substring = substring;
 
508
    if (substring != 0) substring->among = x;
 
509
    unless (x->command_count == 0 && x->starter == 0) a->amongvar_needed = true;
 
510
}
 
511
 
 
512
static struct node * read_among(struct analyser * a)
 
513
{   struct tokeniser * t = a->tokeniser;
 
514
    struct node * p = new_node(a, c_among);
 
515
    struct node * p_end = 0;
 
516
    int previous_token = -1;
 
517
    struct node * substring = a->substring;
 
518
 
 
519
    a->substring = 0;
 
520
    p->number = 0; /* counts the number of literals */
 
521
    unless (get_token(a, c_bra)) return p;
 
522
    repeat
 
523
    {   struct node * q;
 
524
        int token = read_token(t);
 
525
        switch (token)
 
526
        {   case c_literalstring:
 
527
                q = read_literalstring(a);
 
528
                if (read_token(t) == c_name)
 
529
                {   struct node * r = new_node(a, c_name);
 
530
                    name_to_node(a, r, 'r');
 
531
                    q->left = r;
 
532
                }
 
533
                else t->token_held = true;
 
534
                p->number++; break;
 
535
            case c_bra:
 
536
                if (previous_token == c_bra) error(a, 19);
 
537
                q = read_C_list(a); break;
 
538
            default:
 
539
                error(a, 3);
 
540
            case c_ket:
 
541
                if (p->number == 0) error(a, 18);
 
542
                if (t->error_count == 0) make_among(a, p, substring);
 
543
                return p;
 
544
        }
 
545
        previous_token = token;
 
546
        if (p_end == 0) p->left = q; else p_end->right = q;
 
547
        p_end = q;
 
548
    }
 
549
}
 
550
 
 
551
static struct node * read_substring(struct analyser * a)
 
552
{
 
553
    struct node * p = new_node(a, c_substring);
 
554
    if (a->substring != 0) error2(a, 20, a->substring->line_number);
 
555
    a->substring = p;
 
556
    return p;
 
557
}
 
558
 
 
559
static void check_modifyable(struct analyser * a)
 
560
{   unless (a->modifyable) error(a, 15);
 
561
}
 
562
 
 
563
static struct node * read_C(struct analyser * a)
 
564
{   struct tokeniser * t = a->tokeniser;
 
565
    int token = read_token(t);
 
566
    switch (token)
 
567
    {
 
568
        case c_bra:
 
569
            return read_C_list(a);
 
570
        case c_backwards:
 
571
            {   int mode = a->mode;
 
572
                if (a->mode == m_backward) error(a, 17); else a->mode = m_backward;
 
573
                {   struct node * p = C_style(a, "C", token);
 
574
                    a->mode = mode;
 
575
                    return p;
 
576
                }
 
577
            }
 
578
        case c_reverse:
 
579
            {   int mode = a->mode;
 
580
                int modifyable = a->modifyable;
 
581
                a->mode = mode == m_forward ? m_backward : m_forward;
 
582
                {   struct node * p = C_style(a, "C", token);
 
583
                    a->mode = mode;
 
584
                    a->modifyable = modifyable;
 
585
                    return p;
 
586
                }
 
587
            }
 
588
        case c_not:
 
589
        case c_try:
 
590
        case c_fail:
 
591
        case c_test:
 
592
        case c_do:
 
593
        case c_goto:
 
594
        case c_gopast:
 
595
        case c_repeat:
 
596
            return C_style(a, "C", token);
 
597
        case c_loop:
 
598
        case c_atleast:
 
599
            return C_style(a, "AC", token);
 
600
        case c_setmark:
 
601
            return C_style(a, "i", token);
 
602
        case c_tomark:
 
603
        case c_atmark:
 
604
        case c_hop:
 
605
            return C_style(a, "A", token);
 
606
        case c_delete:
 
607
            check_modifyable(a);
 
608
        case c_next:
 
609
        case c_tolimit:
 
610
        case c_atlimit:
 
611
        case c_leftslice:
 
612
        case c_rightslice:
 
613
        case c_true:
 
614
        case c_false:
 
615
        case c_debug:
 
616
            return C_style(a, "", token);
 
617
        case c_assignto:
 
618
        case c_sliceto:
 
619
            check_modifyable(a);
 
620
            return C_style(a, "s", token);
 
621
        case c_assign:
 
622
        case c_insert:
 
623
        case c_attach:
 
624
        case c_slicefrom:
 
625
            check_modifyable(a);
 
626
            return C_style(a, "S", token);
 
627
        case c_setlimit:
 
628
            return C_style(a, "CfD", token);
 
629
        case c_set:
 
630
        case c_unset:
 
631
            return C_style(a, "b", token);
 
632
        case c_dollar:
 
633
            get_token(a, c_name);
 
634
            {   struct node * p;
 
635
                struct name * q = find_name(a);
 
636
                int mode = a->mode;
 
637
                int modifyable = a->modifyable;
 
638
                switch (q ? q->type : t_string)
 
639
                    /* above line was: switch (q->type) - bug #1 fix 7/2/2003 */
 
640
                {   default: error(a, 34);
 
641
                    case t_string:
 
642
                        a->mode = m_forward;
 
643
                        a->modifyable = true;
 
644
                        p = new_node(a, c_dollar);
 
645
                        p->left = read_C(a); break;
 
646
                    case t_integer:
 
647
                    /*  a->mode = m_integer;  */
 
648
                        p = new_node(a, read_AE_test(a));
 
649
                        p->AE = read_AE(a, 0); break;
 
650
                }
 
651
                p->name = q;
 
652
                a->mode = mode;
 
653
                a->modifyable = modifyable;
 
654
                return p;
 
655
            }
 
656
        case c_name:
 
657
            {   struct name * q = find_name(a);
 
658
                struct node * p = new_node(a, c_name);
 
659
                unless (q == 0)
 
660
                {   q->used = true;
 
661
                    switch (q->type)
 
662
                    {
 
663
                        case t_boolean:
 
664
                            p->type = c_booltest; break;
 
665
                        case t_integer:
 
666
                            error(a, 35); /* integer name misplaced */
 
667
                        case t_string:
 
668
                            break;
 
669
                        case t_routine:
 
670
                        case t_external:
 
671
                            p->type = c_call;
 
672
                            check_routine_mode(a, q, a->mode);
 
673
                            break;
 
674
                        case t_grouping:
 
675
                            p->type = c_grouping; break;
 
676
                    }
 
677
                }
 
678
                p->name = q;
 
679
                return p;
 
680
            }
 
681
        case c_non:
 
682
            {   struct node * p = new_node(a, token);
 
683
                read_token(t);
 
684
                if (t->token == c_minus) read_token(t);
 
685
                unless (check_token(a, c_name)) { omission_error(a, c_name); return p; }
 
686
                name_to_node(a, p, 'g');
 
687
                return p;
 
688
            }
 
689
        case c_literalstring:
 
690
            return read_literalstring(a);
 
691
        case c_among: return read_among(a);
 
692
        case c_substring: return read_substring(a);
 
693
        default: error(a, 1); return 0;
 
694
    }
 
695
}
 
696
 
 
697
static symbol * alter_grouping(symbol * p, symbol * q, int style)
 
698
{   if (style == c_plus) return add_to_b(p, SIZE(q), q);
 
699
 
 
700
    {   int j;
 
701
        for (j = 0; j < SIZE(q); j++)
 
702
        {   int ch = q[j];
 
703
            int i;
 
704
            for (i = 0; i < SIZE(p); i++) if (ch == p[i])
 
705
            {   memmove(p + i, p + i + 1, (SIZE(p) - i - 1) * sizeof(symbol));
 
706
                SIZE(p)--;
 
707
            }
 
708
        }
 
709
        return p;
 
710
    }
 
711
}
 
712
 
 
713
static void read_define_grouping(struct analyser * a, struct name * q)
 
714
{   struct tokeniser * t = a->tokeniser;
 
715
    int style = c_plus;
 
716
    {   NEW(grouping, p);
 
717
        if (a->groupings == 0) a->groupings = p; else a->groupings_end->next = p;
 
718
        a->groupings_end = p;
 
719
        q->grouping = p;
 
720
        p->next = 0;
 
721
        p->name = q;
 
722
        p->number = q->count;
 
723
        p->b = create_b(0);
 
724
        repeat
 
725
        {   switch (read_token(t))
 
726
            {   case c_name:
 
727
                    {   struct name * r = find_name(a);
 
728
                        unless (r == 0)
 
729
                        {   check_name_type(a, r, 'g');
 
730
                            p->b = alter_grouping(p->b, r->grouping->b, style);
 
731
                        }
 
732
                    }
 
733
                    break;
 
734
                case c_literalstring:
 
735
                    p->b = alter_grouping(p->b, t->b, style);
 
736
                    break;
 
737
                default: error(a, 1); return;
 
738
            }
 
739
            switch (read_token(t))
 
740
            {   case c_plus:
 
741
                case c_minus: style = t->token; break;
 
742
                default: goto label0;
 
743
            }
 
744
        }
 
745
    label0:
 
746
        {   int i;
 
747
            int max = 0;
 
748
            int min = 1<<16;
 
749
            for (i = 0; i < SIZE(p->b); i++)
 
750
            {   if (p->b[i] > max) max = p->b[i];
 
751
                if (p->b[i] < min) min = p->b[i];
 
752
            }
 
753
            p->largest_ch = max;
 
754
            p->smallest_ch = min;
 
755
            if (min == 1<<16) error(a, 16);
 
756
        }
 
757
        t->token_held = true; return;
 
758
    }
 
759
}
 
760
 
 
761
static void read_define_routine(struct analyser * a, struct name * q)
 
762
{   struct node * p = new_node(a, c_define);
 
763
    a->amongvar_needed = false;
 
764
    unless (q == 0)
 
765
    {
 
766
        check_name_type(a, q, 'R');
 
767
        if (q->definition != 0) error(a, 36);
 
768
        if (q->mode < 0) q->mode = a->mode; else
 
769
        if (q->mode != a->mode) error2(a, 32, q->mode);
 
770
    }
 
771
    p->name = q;
 
772
    if (a->program == 0) a->program = p; else a->program_end->right = p;
 
773
    a->program_end = p;
 
774
    get_token(a, c_as);
 
775
    p->left = read_C(a);
 
776
    unless (q == 0) q->definition = p->left;
 
777
 
 
778
    if (a->substring != 0)
 
779
    {    error2(a, 14, a->substring->line_number);
 
780
         a->substring = 0;
 
781
    }
 
782
    p->amongvar_needed = a->amongvar_needed;
 
783
}
 
784
 
 
785
static void read_define(struct analyser * a)
 
786
{   unless (get_token(a, c_name)) return;
 
787
    {   struct name * q = find_name(a);
 
788
        if (q != 0 && q->type == t_grouping) read_define_grouping(a, q);
 
789
            else read_define_routine(a, q);
 
790
    }
 
791
}
 
792
 
 
793
static void read_backwardmode(struct analyser * a)
 
794
{   int mode = a->mode;
 
795
    a->mode = m_backward;
 
796
    if (get_token(a, c_bra))
 
797
    {   read_program_(a, c_ket);
 
798
        check_token(a, c_ket);
 
799
    }
 
800
    a->mode = mode;
 
801
}
 
802
 
 
803
static void read_program_(struct analyser * a, int terminator)
 
804
{   struct tokeniser * t = a->tokeniser;
 
805
    repeat
 
806
    {
 
807
        switch (read_token(t))
 
808
        {   case c_strings:     read_names(a, t_string); break;
 
809
            case c_booleans:    read_names(a, t_boolean); break;
 
810
            case c_integers:    read_names(a, t_integer); break;
 
811
            case c_routines:    read_names(a, t_routine); break;
 
812
            case c_externals:   read_names(a, t_external); break;
 
813
            case c_groupings:   read_names(a, t_grouping); break;
 
814
            case c_define:      read_define(a); break;
 
815
            case c_backwardmode:read_backwardmode(a); break;
 
816
            case c_ket:
 
817
                if (terminator == c_ket) return;
 
818
            default:
 
819
                error(a, 1); break;
 
820
            case -1:
 
821
                unless (terminator < 0) omission_error(a, c_ket);
 
822
                return;
 
823
        }
 
824
    }
 
825
}
 
826
 
 
827
extern void read_program(struct analyser * a)
 
828
{   read_program_(a, -1);
 
829
 
 
830
    {   struct name * q = a->names;
 
831
        until (q == 0)
 
832
        {   switch(q->type)
 
833
            {   case t_external: case t_routine:
 
834
                    if (q->used && q->definition == 0) error4(a, q); break;
 
835
                case t_grouping:
 
836
                    if (q->used && q->grouping == 0) error4(a, q); break;
 
837
            }
 
838
            q = q->next;
 
839
        }
 
840
    }
 
841
 
 
842
    if (a->tokeniser->error_count == 0)
 
843
    {   struct name * q = a->names;
 
844
        int warned = false;
 
845
        until (q == 0)
 
846
        {   unless (q->referenced)
 
847
            {   unless (warned)
 
848
                {   fprintf(stderr, "Declared but not used:");
 
849
                    warned = true;
 
850
                }
 
851
                fprintf(stderr, " "); report_b(stderr, q->b);
 
852
            }
 
853
            q = q->next;
 
854
        }
 
855
        if (warned) fprintf(stderr, "\n");
 
856
 
 
857
        q = a->names;
 
858
        warned = false;
 
859
        until (q == 0)
 
860
        {   if (! q->used && (q->type == t_routine ||
 
861
                              q->type == t_grouping))
 
862
            {   unless (warned)
 
863
                {   fprintf(stderr, "Declared and defined but not used:");
 
864
                    warned = true;
 
865
                }
 
866
                fprintf(stderr, " "); report_b(stderr, q->b);
 
867
            }
 
868
            q = q->next;
 
869
        }
 
870
        if (warned) fprintf(stderr, "\n");
 
871
    }
 
872
}
 
873
 
 
874
extern struct analyser * create_analyser(struct tokeniser * t)
 
875
{   NEW(analyser, a);
 
876
    a->tokeniser = t;
 
877
    a->nodes = 0;
 
878
    a->names = 0;
 
879
    a->literalstrings = 0;
 
880
    a->program = 0;
 
881
    a->amongs = 0;
 
882
    a->among_count = 0;
 
883
    a->groupings = 0;
 
884
    a->mode = m_forward;
 
885
    a->modifyable = true;
 
886
    { int i; for (i = 0; i < t_size; i++) a->name_count[i] = 0; }
 
887
    a->substring = 0;
 
888
    return a;
 
889
}
 
890
 
 
891
extern void close_analyser(struct analyser * a)
 
892
{
 
893
    {   struct node * q = a->nodes;
 
894
        until (q == 0)
 
895
        {   struct node * q_next = q->next;
 
896
            FREE(q);
 
897
            q = q_next;
 
898
        }
 
899
    }
 
900
    {   struct name * q = a->names;
 
901
        until (q == 0)
 
902
        {   struct name * q_next = q->next;
 
903
            lose_b(q->b); FREE(q);
 
904
            q = q_next;
 
905
        }
 
906
    }
 
907
    {   struct literalstring * q = a->literalstrings;
 
908
        until (q == 0)
 
909
        {   struct literalstring * q_next = q->next;
 
910
            lose_b(q->b); FREE(q);
 
911
            q = q_next;
 
912
        }
 
913
    }
 
914
    {   struct among * q = a->amongs;
 
915
        until (q == 0)
 
916
        {   struct among * q_next = q->next;
 
917
            FREE(q->b); FREE(q);
 
918
            q = q_next;
 
919
        }
 
920
    }
 
921
    {   struct grouping * q = a->groupings;
 
922
        until (q == 0)
 
923
        {   struct grouping * q_next = q->next;
 
924
            lose_b(q->b); FREE(q);
 
925
            q = q_next;
 
926
        }
 
927
    }
 
928
    FREE(a);
 
929
}
 
930