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

« back to all changes in this revision

Viewing changes to website/p/analyser.c

  • Committer: Jason Spashett
  • Date: 2012-04-14 13:12:57 UTC
  • Revision ID: jason@spashett.com-20120414131257-rv3ugy4u2iyoczdk
Add ISO 639-2, and 639-1 language codes

Show diffs side-by-side

added added

removed removed

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