2 #include <stdio.h> /* printf etc */
3 #include <stdlib.h> /* exit */
4 #include <string.h> /* memmove */
9 e_unexpected_token
= 1,
11 e_unexpected_token_in_among
= 3,
12 /* For codes above here, report "after " t->previous_token after the error. */
13 e_unresolved_substring
= 14,
14 e_not_allowed_inside_reverse
= 15,
15 e_empty_grouping
= 16,
16 e_already_backwards
= 17,
18 e_adjacent_bracketed_in_among
= 19,
19 e_substring_preceded_by_substring
= 20,
20 /* For codes below here, tokeniser->b is printed before the error. */
23 e_declared_as_different_mode
= 32,
25 e_not_of_type_string_or_integer
= 34,
31 /* recursive usage: */
33 static void read_program_(struct analyser
* a
, int terminator
);
34 static struct node
* read_C(struct analyser
* a
);
35 static struct node
* C_style(struct analyser
* a
, const char * s
, int token
);
38 static void print_node_(struct node
* p
, int n
, const char * s
) {
41 for (i
= 0; i
< n
; i
++) fputs(i
== n
- 1 ? s
: " ", stdout
);
42 printf("%s ", name_of_token(p
->type
));
43 if (p
->name
) report_b(stdout
, p
->name
->b
);
44 if (p
->literalstring
) {
46 report_b(stdout
, p
->literalstring
);
50 if (p
->AE
) print_node_(p
->AE
, n
+1, "# ");
51 if (p
->left
) print_node_(p
->left
, n
+1, " ");
52 if (p
->right
) print_node_(p
->right
, n
, " ");
53 if (p
->aux
) print_node_(p
->aux
, n
+1, "@ ");
56 extern void print_program(struct analyser
* a
) {
57 print_node_(a
->program
, 0, " ");
60 static struct node
* new_node(struct analyser
* a
, int type
) {
62 p
->next
= a
->nodes
; a
->nodes
= p
;
70 p
->line_number
= a
->tokeniser
->line_number
;
75 static const char * name_of_mode(int n
) {
77 case m_backward
: return "string backward";
78 case m_forward
: return "string forward";
79 /* case m_integer: return "integer"; */
81 fprintf(stderr
, "Invalid mode %d in name_of_mode()\n", n
);
85 static const char * name_of_type(int n
) {
87 case 's': return "string";
88 case 'i': return "integer";
89 case 'r': return "routine";
90 case 'R': return "routine or grouping";
91 case 'g': return "grouping";
93 fprintf(stderr
, "Invalid type %d in name_of_type()\n", n
);
97 static const char * name_of_name_type(int code
) {
99 case t_string
: return "string";
100 case t_boolean
: return "boolean";
101 case t_integer
: return "integer";
102 case t_routine
: return "routine";
103 case t_external
: return "external";
104 case t_grouping
: return "grouping";
106 fprintf(stderr
, "Invalid type code %d in name_of_name_type()\n", code
);
110 static void count_error(struct analyser
* a
) {
111 struct tokeniser
* t
= a
->tokeniser
;
112 if (t
->error_count
>= 20) { fprintf(stderr
, "... etc\n"); exit(1); }
116 static void error2(struct analyser
* a
, error_code n
, int x
) {
117 struct tokeniser
* t
= a
->tokeniser
;
119 fprintf(stderr
, "%s:%d: ", t
->file
, t
->line_number
);
120 if ((int)n
>= (int)e_redeclared
) report_b(stderr
, t
->b
);
122 case e_token_omitted
:
123 fprintf(stderr
, "%s omitted", name_of_token(t
->omission
)); break;
124 case e_unexpected_token_in_among
:
125 fprintf(stderr
, "in among(...), ");
127 case e_unexpected_token
:
128 fprintf(stderr
, "unexpected %s", name_of_token(t
->token
));
129 if (t
->token
== c_number
) fprintf(stderr
, " %d", t
->number
);
130 if (t
->token
== c_name
) {
131 fprintf(stderr
, " ");
132 report_b(stderr
, t
->b
);
134 case e_string_omitted
:
135 fprintf(stderr
, "string omitted"); break;
137 case e_unresolved_substring
:
138 fprintf(stderr
, "unresolved substring on line %d", x
); break;
139 case e_not_allowed_inside_reverse
:
140 fprintf(stderr
, "%s not allowed inside reverse(...)", name_of_token(t
->token
)); break;
141 case e_empty_grouping
:
142 fprintf(stderr
, "empty grouping"); break;
143 case e_already_backwards
:
144 fprintf(stderr
, "backwards used when already in this mode"); break;
146 fprintf(stderr
, "empty among(...)"); break;
147 case e_adjacent_bracketed_in_among
:
148 fprintf(stderr
, "two adjacent bracketed expressions in among(...)"); break;
149 case e_substring_preceded_by_substring
:
150 fprintf(stderr
, "substring preceded by another substring on line %d", x
); break;
153 fprintf(stderr
, " re-declared"); break;
155 fprintf(stderr
, " undeclared"); break;
156 case e_declared_as_different_mode
:
157 fprintf(stderr
, " declared as %s mode; used as %s mode",
158 name_of_mode(a
->mode
), name_of_mode(x
)); break;
159 case e_not_of_type_x
:
160 fprintf(stderr
, " not of type %s", name_of_type(x
)); break;
161 case e_not_of_type_string_or_integer
:
162 fprintf(stderr
, " not of type string or integer"); break;
164 fprintf(stderr
, " misplaced"); break;
166 fprintf(stderr
, " redefined"); break;
168 fprintf(stderr
, " mis-used as %s mode",
169 name_of_mode(x
)); break;
171 if ((int)n
< (int)e_unresolved_substring
&& t
->previous_token
> 0)
172 fprintf(stderr
, " after %s", name_of_token(t
->previous_token
));
173 fprintf(stderr
, "\n");
176 static void error(struct analyser
* a
, error_code n
) { error2(a
, n
, 0); }
178 static void error3(struct analyser
* a
, struct node
* p
, symbol
* b
) {
180 fprintf(stderr
, "%s:%d: among(...) has repeated string '", a
->tokeniser
->file
, p
->line_number
);
182 fprintf(stderr
, "'\n");
185 static void error3a(struct analyser
* a
, struct node
* p
) {
187 fprintf(stderr
, "%s:%d: previously seen here\n", a
->tokeniser
->file
, p
->line_number
);
190 static void error4(struct analyser
* a
, struct name
* q
) {
192 fprintf(stderr
, "%s:%d: ", a
->tokeniser
->file
, q
->used
->line_number
);
193 report_b(stderr
, q
->b
);
194 fprintf(stderr
, " undefined\n");
197 static void omission_error(struct analyser
* a
, int n
) {
198 a
->tokeniser
->omission
= n
;
199 error(a
, e_token_omitted
);
202 static int check_token(struct analyser
* a
, int code
) {
203 struct tokeniser
* t
= a
->tokeniser
;
204 if (t
->token
!= code
) { omission_error(a
, code
); return false; }
208 static int get_token(struct analyser
* a
, int code
) {
209 struct tokeniser
* t
= a
->tokeniser
;
212 int x
= check_token(a
, code
);
213 if (!x
) t
->token_held
= true;
218 static struct name
* look_for_name(struct analyser
* a
) {
219 symbol
* q
= a
->tokeniser
->b
;
221 for (p
= a
->names
; p
; p
= p
->next
) {
224 if (n
== SIZE(q
) && memcmp(q
, b
, n
* sizeof(symbol
)) == 0) {
225 p
->referenced
= true;
232 static struct name
* find_name(struct analyser
* a
) {
233 struct name
* p
= look_for_name(a
);
234 if (p
== 0) error(a
, e_undeclared
);
238 static void check_routine_mode(struct analyser
* a
, struct name
* p
, int mode
) {
239 if (p
->mode
< 0) p
->mode
= mode
; else
240 if (p
->mode
!= mode
) error2(a
, e_misused
, mode
);
243 static void check_name_type(struct analyser
* a
, struct name
* p
, int type
) {
246 if (p
->type
== t_string
) return;
249 if (p
->type
== t_integer
) return;
252 if (p
->type
== t_boolean
) return;
255 if (p
->type
== t_grouping
) return;
258 if (p
->type
== t_routine
|| p
->type
== t_external
) return;
261 if (p
->type
== t_grouping
) return;
264 error2(a
, e_not_of_type_x
, type
);
267 static void read_names(struct analyser
* a
, int type
) {
268 struct tokeniser
* t
= a
->tokeniser
;
269 if (!get_token(a
, c_bra
)) return;
271 int token
= read_token(t
);
274 /* Context-sensitive token - once declared as a name, it loses
275 * its special meaning, for compatibility with older versions
278 static const symbol c_len_lit
[] = {
281 MOVE_TO_B(t
->b
, c_len_lit
);
285 /* Context-sensitive token - once declared as a name, it loses
286 * its special meaning, for compatibility with older versions
289 static const symbol c_lenof_lit
[] = {
290 'l', 'e', 'n', 'o', 'f'
292 MOVE_TO_B(t
->b
, c_lenof_lit
);
297 if (look_for_name(a
) != 0) error(a
, e_redeclared
); else {
301 p
->mode
= -1; /* routines, externals */
302 p
->count
= a
->name_count
[type
];
303 p
->referenced
= false;
304 p
->used_in_among
= false;
306 p
->value_used
= false;
307 p
->initialised
= false;
311 p
->declaration_line_number
= t
->line_number
;
312 a
->name_count
[type
]++;
315 if (token
!= c_name
) {
316 disable_token(t
, token
);
321 if (!check_token(a
, c_ket
)) t
->token_held
= true;
327 static symbol
* new_literalstring(struct analyser
* a
) {
328 NEW(literalstring
, p
);
329 p
->b
= copy_b(a
->tokeniser
->b
);
330 p
->next
= a
->literalstrings
;
331 a
->literalstrings
= p
;
335 static int read_AE_test(struct analyser
* a
) {
337 struct tokeniser
* t
= a
->tokeniser
;
338 switch (read_token(t
)) {
339 case c_assign
: return c_mathassign
;
342 case c_multiplyassign
:
349 case c_le
: return t
->token
;
350 default: error(a
, e_unexpected_token
); t
->token_held
= true; return c_eq
;
354 static int binding(int t
) {
356 case c_plus
: case c_minus
: return 1;
357 case c_multiply
: case c_divide
: return 2;
362 static void mark_used_in(struct analyser
* a
, struct name
* q
, struct node
* p
) {
365 q
->local_to
= a
->program_end
->name
;
366 } else if (q
->local_to
) {
367 if (q
->local_to
!= a
->program_end
->name
) {
368 /* Used in more than one routine/external. */
374 static void name_to_node(struct analyser
* a
, struct node
* p
, int type
) {
375 struct name
* q
= find_name(a
);
377 check_name_type(a
, q
, type
);
378 mark_used_in(a
, q
, p
);
383 static struct node
* read_AE(struct analyser
* a
, int B
) {
384 struct tokeniser
* t
= a
->tokeniser
;
387 switch (read_token(t
)) {
388 case c_minus
: /* monadic */
390 if (q
->type
== c_neg
) {
391 /* Optimise away double negation, which avoids generators
392 * having to worry about generating "--" (decrement operator
393 * in many languages).
396 /* Don't free q, it's in the linked list a->nodes. */
399 p
= new_node(a
, c_neg
);
407 p
= new_node(a
, c_name
);
408 name_to_node(a
, p
, 'i');
409 if (p
->name
) p
->name
->value_used
= true;
413 a
->int_limits_used
= true;
419 p
= new_node(a
, t
->token
);
422 p
= new_node(a
, c_number
);
423 p
->number
= t
->number
;
427 p
= C_style(a
, "s", t
->token
);
430 error(a
, e_unexpected_token
);
431 t
->token_held
= true;
435 int token
= read_token(t
);
436 int b
= binding(token
);
437 if (binding(token
) <= B
) {
438 t
->token_held
= true;
441 q
= new_node(a
, token
);
443 q
->right
= read_AE(a
, b
);
448 static struct node
* read_C_connection(struct analyser
* a
, struct node
* q
, int op
) {
449 struct tokeniser
* t
= a
->tokeniser
;
450 struct node
* p
= new_node(a
, op
);
451 struct node
* p_end
= q
;
455 p_end
->right
= q
; p_end
= q
;
456 } while (read_token(t
) == op
);
457 t
->token_held
= true;
461 static struct node
* read_C_list(struct analyser
* a
) {
462 struct tokeniser
* t
= a
->tokeniser
;
463 struct node
* p
= new_node(a
, c_bra
);
464 struct node
* p_end
= 0;
466 int token
= read_token(t
);
467 if (token
== c_ket
) return p
;
468 if (token
< 0) { omission_error(a
, c_ket
); return p
; }
469 t
->token_held
= true;
471 struct node
* q
= read_C(a
);
473 token
= read_token(t
);
474 if (token
!= c_and
&& token
!= c_or
) {
475 t
->token_held
= true;
478 q
= read_C_connection(a
, q
, token
);
480 if (p_end
== 0) p
->left
= q
; else p_end
->right
= q
;
486 static struct node
* C_style(struct analyser
* a
, const char * s
, int token
) {
488 struct node
* p
= new_node(a
, token
);
489 for (i
= 0; s
[i
] != 0; i
++) switch (s
[i
]) {
491 p
->left
= read_C(a
); continue;
493 p
->aux
= read_C(a
); continue;
495 p
->AE
= read_AE(a
, 0); continue;
497 get_token(a
, c_for
); continue;
500 int str_token
= read_token(a
->tokeniser
);
501 if (str_token
== c_name
) name_to_node(a
, p
, 's'); else
502 if (str_token
== c_literalstring
) p
->literalstring
= new_literalstring(a
);
503 else error(a
, e_string_omitted
);
509 if (get_token(a
, c_name
)) name_to_node(a
, p
, s
[i
]);
515 static struct node
* read_literalstring(struct analyser
* a
) {
516 struct node
* p
= new_node(a
, c_literalstring
);
517 p
->literalstring
= new_literalstring(a
);
521 static void reverse_b(symbol
* b
) {
522 int i
= 0; int j
= SIZE(b
) - 1;
524 int ch1
= b
[i
]; int ch2
= b
[j
];
525 b
[i
++] = ch2
; b
[j
--] = ch1
;
529 static int compare_amongvec(const void *pv
, const void *qv
) {
530 const struct amongvec
* p
= (const struct amongvec
*)pv
;
531 const struct amongvec
* q
= (const struct amongvec
*)qv
;
532 symbol
* b_p
= p
->b
; int p_size
= p
->size
;
533 symbol
* b_q
= q
->b
; int q_size
= q
->size
;
534 int smaller_size
= p_size
< q_size
? p_size
: q_size
;
536 for (i
= 0; i
< smaller_size
; i
++)
537 if (b_p
[i
] != b_q
[i
]) return b_p
[i
] - b_q
[i
];
539 return p_size
- q_size
;
540 return p
->p
->line_number
- q
->p
->line_number
;
543 static void make_among(struct analyser
* a
, struct node
* p
, struct node
* substring
) {
546 NEWVEC(amongvec
, v
, p
->number
);
547 struct node
* q
= p
->left
;
548 struct amongvec
* w0
= v
;
549 struct amongvec
* w1
= v
;
552 int direction
= substring
!= 0 ? substring
->mode
: p
->mode
;
553 int backward
= direction
== m_backward
;
555 if (a
->amongs
== 0) a
->amongs
= x
; else a
->amongs_end
->next
= x
;
559 x
->number
= a
->among_count
++;
560 x
->function_count
= 0;
563 if (q
->type
== c_bra
) { x
->starter
= q
; q
= q
->right
; }
566 if (q
->type
== c_literalstring
) {
567 symbol
* b
= q
->literalstring
;
568 w1
->b
= b
; /* pointer to case string */
569 w1
->p
= q
; /* pointer to corresponding node */
570 w1
->size
= SIZE(b
); /* number of characters in string */
571 w1
->i
= -1; /* index of longest substring */
572 w1
->result
= -1; /* number of corresponding case expression */
574 struct name
* function
= q
->left
->name
;
575 w1
->function
= function
;
576 function
->used_in_among
= true;
577 check_routine_mode(a
, function
, direction
);
585 if (q
->left
== 0) /* empty command: () */
597 if (w1
-v
!= p
->number
) { fprintf(stderr
, "oh! %d %d\n", (int)(w1
-v
), p
->number
); exit(1); }
598 if (backward
) for (w0
= v
; w0
< w1
; w0
++) reverse_b(w0
->b
);
599 qsort(v
, w1
- v
, sizeof(struct amongvec
), compare_amongvec
);
601 /* the following loop is O(n squared) */
602 for (w0
= w1
- 1; w0
>= v
; w0
--) {
607 for (w
= w0
- 1; w
>= v
; w
--) {
608 if (w
->size
< size
&& memcmp(w
->b
, b
, w
->size
* sizeof(symbol
)) == 0) {
609 w0
->i
= w
- v
; /* fill in index of longest substring */
614 if (backward
) for (w0
= v
; w0
< w1
; w0
++) reverse_b(w0
->b
);
616 for (w0
= v
; w0
< w1
- 1; w0
++)
617 if (w0
->size
== (w0
+ 1)->size
&&
618 memcmp(w0
->b
, (w0
+ 1)->b
, w0
->size
* sizeof(symbol
)) == 0) {
619 error3(a
, (w0
+ 1)->p
, (w0
+ 1)->b
);
623 x
->literalstring_count
= p
->number
;
624 x
->command_count
= result
- 1;
627 x
->substring
= substring
;
628 if (substring
!= 0) substring
->among
= x
;
629 if (x
->command_count
!= 0 || x
->starter
!= 0) a
->amongvar_needed
= true;
632 static struct node
* read_among(struct analyser
* a
) {
633 struct tokeniser
* t
= a
->tokeniser
;
634 struct node
* p
= new_node(a
, c_among
);
635 struct node
* p_end
= 0;
636 int previous_token
= -1;
637 struct node
* substring
= a
->substring
;
640 p
->number
= 0; /* counts the number of literals */
641 if (!get_token(a
, c_bra
)) return p
;
644 int token
= read_token(t
);
646 case c_literalstring
:
647 q
= read_literalstring(a
);
648 if (read_token(t
) == c_name
) {
649 struct node
* r
= new_node(a
, c_name
);
650 name_to_node(a
, r
, 'r');
653 else t
->token_held
= true;
656 if (previous_token
== c_bra
) error(a
, e_adjacent_bracketed_in_among
);
657 q
= read_C_list(a
); break;
659 error(a
, e_unexpected_token_in_among
);
660 previous_token
= token
;
663 if (p
->number
== 0) error(a
, e_empty_among
);
664 if (t
->error_count
== 0) make_among(a
, p
, substring
);
667 previous_token
= token
;
668 if (p_end
== 0) p
->left
= q
; else p_end
->right
= q
;
673 static struct node
* read_substring(struct analyser
* a
) {
675 struct node
* p
= new_node(a
, c_substring
);
676 if (a
->substring
!= 0) error2(a
, e_substring_preceded_by_substring
, a
->substring
->line_number
);
681 static void check_modifyable(struct analyser
* a
) {
682 if (!a
->modifyable
) error(a
, e_not_allowed_inside_reverse
);
685 static struct node
* read_C(struct analyser
* a
) {
686 struct tokeniser
* t
= a
->tokeniser
;
687 int token
= read_token(t
);
690 return read_C_list(a
);
694 if (a
->mode
== m_backward
) error(a
, e_already_backwards
); else a
->mode
= m_backward
;
695 { struct node
* p
= C_style(a
, "C", token
);
703 int modifyable
= a
->modifyable
;
704 a
->modifyable
= false;
705 a
->mode
= mode
== m_forward
? m_backward
: m_forward
;
707 struct node
* p
= C_style(a
, "C", token
);
709 a
->modifyable
= modifyable
;
721 return C_style(a
, "C", token
);
724 return C_style(a
, "AC", token
);
726 struct node
* n
= C_style(a
, "i", token
);
727 if (n
->name
) n
->name
->initialised
= true;
733 return C_style(a
, "A", token
);
745 return C_style(a
, "", token
);
750 n
= C_style(a
, "s", token
);
751 if (n
->name
) n
->name
->initialised
= true;
760 n
= C_style(a
, "S", token
);
761 if (n
->name
) n
->name
->value_used
= true;
765 return C_style(a
, "CfD", token
);
768 struct node
* n
= C_style(a
, "b", token
);
769 if (n
->name
) n
->name
->initialised
= true;
773 get_token(a
, c_name
);
776 struct name
* q
= find_name(a
);
778 int modifyable
= a
->modifyable
;
779 switch (q
? q
->type
: t_string
)
780 /* above line was: switch (q->type) - bug #1 fix 7/2/2003 */
783 error(a
, e_not_of_type_string_or_integer
);
784 /* Handle $foo for unknown 'foo' as string since
785 * that's more common and so less likely to cause
786 * an error avalanche. */
789 /* Assume for now that $ on string both initialises and
790 * uses the string variable. FIXME: Can we do better?
792 q
->initialised
= true;
793 q
->value_used
= true;
795 a
->modifyable
= true;
796 p
= new_node(a
, c_dollar
);
797 p
->left
= read_C(a
); break;
799 /* a->mode = m_integer; */
800 p
= new_node(a
, read_AE_test(a
));
801 p
->AE
= read_AE(a
, 0);
803 /* +=, etc don't "initialise" as they only amend an
804 * existing value. Similarly, they don't count as
809 q
->initialised
= true;
817 q
->value_used
= true;
823 if (q
) mark_used_in(a
, q
, p
);
826 a
->modifyable
= modifyable
;
831 struct name
* q
= find_name(a
);
832 struct node
* p
= new_node(a
, c_name
);
834 mark_used_in(a
, q
, p
);
837 p
->type
= c_booltest
;
838 q
->value_used
= true;
841 error(a
, e_misplaced
); /* integer name misplaced */
844 q
->value_used
= true;
849 check_routine_mode(a
, q
, a
->mode
);
852 p
->type
= c_grouping
; break;
860 struct node
* p
= new_node(a
, token
);
862 if (t
->token
== c_minus
) read_token(t
);
863 if (!check_token(a
, c_name
)) { omission_error(a
, c_name
); return p
; }
864 name_to_node(a
, p
, 'g');
867 case c_literalstring
:
868 return read_literalstring(a
);
869 case c_among
: return read_among(a
);
870 case c_substring
: return read_substring(a
);
871 default: error(a
, e_unexpected_token
); return 0;
875 static int next_symbol(symbol
* p
, symbol
* W
, int utf8
) {
878 int j
= get_utf8(p
, & ch
);
881 W
[0] = p
[0]; return 1;
885 static symbol
* alter_grouping(symbol
* p
, symbol
* q
, int style
, int utf8
) {
889 if (style
== c_plus
) {
890 while (j
< SIZE(q
)) {
891 width
= next_symbol(q
+ j
, W
, utf8
);
892 p
= add_to_b(p
, 1, W
);
896 while (j
< SIZE(q
)) {
898 width
= next_symbol(q
+ j
, W
, utf8
);
899 for (i
= 0; i
< SIZE(p
); i
++) {
901 memmove(p
+ i
, p
+ i
+ 1, (SIZE(p
) - i
- 1) * sizeof(symbol
));
911 static void read_define_grouping(struct analyser
* a
, struct name
* q
) {
912 struct tokeniser
* t
= a
->tokeniser
;
916 if (a
->groupings
== 0) a
->groupings
= p
; else a
->groupings_end
->next
= p
;
917 a
->groupings_end
= p
;
918 if (q
) q
->grouping
= p
;
921 p
->number
= q
? q
->count
: 0;
922 p
->line_number
= a
->tokeniser
->line_number
;
925 switch (read_token(t
)) {
928 struct name
* r
= find_name(a
);
930 check_name_type(a
, r
, 'g');
931 p
->b
= alter_grouping(p
->b
, r
->grouping
->b
, style
, false);
935 case c_literalstring
:
936 p
->b
= alter_grouping(p
->b
, t
->b
, style
, (a
->encoding
== ENC_UTF8
));
938 default: error(a
, e_unexpected_token
); return;
940 switch (read_token(t
)) {
942 case c_minus
: style
= t
->token
; break;
943 default: goto label0
;
951 for (i
= 0; i
< SIZE(p
->b
); i
++) {
952 if (p
->b
[i
] > max
) max
= p
->b
[i
];
953 if (p
->b
[i
] < min
) min
= p
->b
[i
];
956 p
->smallest_ch
= min
;
957 if (min
== 1<<16) error(a
, e_empty_grouping
);
959 t
->token_held
= true; return;
963 static void read_define_routine(struct analyser
* a
, struct name
* q
) {
964 struct node
* p
= new_node(a
, c_define
);
965 a
->amongvar_needed
= false;
967 check_name_type(a
, q
, 'R');
968 if (q
->definition
!= 0) error(a
, e_redefined
);
969 if (q
->mode
< 0) q
->mode
= a
->mode
; else
970 if (q
->mode
!= a
->mode
) error2(a
, e_declared_as_different_mode
, q
->mode
);
973 if (a
->program
== 0) a
->program
= p
; else a
->program_end
->right
= p
;
977 if (q
) q
->definition
= p
->left
;
979 if (a
->substring
!= 0) {
980 error2(a
, e_unresolved_substring
, a
->substring
->line_number
);
983 p
->amongvar_needed
= a
->amongvar_needed
;
986 static void read_define(struct analyser
* a
) {
987 if (get_token(a
, c_name
)) {
988 struct name
* q
= find_name(a
);
993 /* No declaration, so sniff next token - if it is 'as' then parse
994 * as a routine, otherwise as a grouping.
996 if (read_token(a
->tokeniser
) == c_as
) {
1001 a
->tokeniser
->token_held
= true;
1004 if (type
== t_grouping
) {
1005 read_define_grouping(a
, q
);
1007 read_define_routine(a
, q
);
1012 static void read_backwardmode(struct analyser
* a
) {
1014 a
->mode
= m_backward
;
1015 if (get_token(a
, c_bra
)) {
1016 read_program_(a
, c_ket
);
1017 check_token(a
, c_ket
);
1022 static void read_program_(struct analyser
* a
, int terminator
) {
1023 struct tokeniser
* t
= a
->tokeniser
;
1025 switch (read_token(t
)) {
1026 case c_strings
: read_names(a
, t_string
); break;
1027 case c_booleans
: read_names(a
, t_boolean
); break;
1028 case c_integers
: read_names(a
, t_integer
); break;
1029 case c_routines
: read_names(a
, t_routine
); break;
1030 case c_externals
: read_names(a
, t_external
); break;
1031 case c_groupings
: read_names(a
, t_grouping
); break;
1032 case c_define
: read_define(a
); break;
1033 case c_backwardmode
:read_backwardmode(a
); break;
1035 if (terminator
== c_ket
) return;
1038 error(a
, e_unexpected_token
); break;
1040 if (terminator
>= 0) omission_error(a
, c_ket
);
1046 extern void read_program(struct analyser
* a
) {
1047 read_program_(a
, -1);
1049 struct name
* q
= a
->names
;
1052 case t_external
: case t_routine
:
1053 if (q
->used
&& q
->definition
== 0) error4(a
, q
);
1056 if (q
->used
&& q
->grouping
== 0) error4(a
, q
);
1063 if (a
->tokeniser
->error_count
== 0) {
1064 struct name
* q
= a
->names
;
1066 if (!q
->referenced
) {
1067 fprintf(stderr
, "%s:%d: warning: %s '",
1069 q
->declaration_line_number
,
1070 name_of_name_type(q
->type
));
1071 report_b(stderr
, q
->b
);
1072 if (q
->type
== t_routine
||
1073 q
->type
== t_external
||
1074 q
->type
== t_grouping
) {
1075 fprintf(stderr
, "' declared but not defined\n");
1077 fprintf(stderr
, "' defined but not used\n");
1079 } else if (q
->type
== t_routine
|| q
->type
== t_grouping
) {
1082 if (q
->type
== t_routine
) {
1083 line_num
= q
->definition
->line_number
;
1085 line_num
= q
->grouping
->line_number
;
1087 fprintf(stderr
, "%s:%d: warning: %s '",
1090 name_of_name_type(q
->type
));
1091 report_b(stderr
, q
->b
);
1092 fprintf(stderr
, "' defined but not used\n");
1094 } else if (q
->type
== t_external
) {
1096 } else if (!q
->initialised
) {
1098 fprintf(stderr
, "%s:%d: warning: %s '",
1100 q
->declaration_line_number
,
1101 name_of_name_type(q
->type
));
1102 report_b(stderr
, q
->b
);
1103 fprintf(stderr
, "' is never initialised\n");
1104 } else if (!q
->value_used
) {
1106 fprintf(stderr
, "%s:%d: warning: %s '",
1108 q
->declaration_line_number
,
1109 name_of_name_type(q
->type
));
1110 report_b(stderr
, q
->b
);
1111 fprintf(stderr
, "' is set but never used\n");
1118 extern struct analyser
* create_analyser(struct tokeniser
* t
) {
1123 a
->literalstrings
= 0;
1128 a
->mode
= m_forward
;
1129 a
->modifyable
= true;
1130 { int i
; for (i
= 0; i
< t_size
; i
++) a
->name_count
[i
] = 0; }
1132 a
->int_limits_used
= false;
1136 extern void close_analyser(struct analyser
* a
) {
1138 struct node
* q
= a
->nodes
;
1140 struct node
* q_next
= q
->next
;
1146 struct name
* q
= a
->names
;
1148 struct name
* q_next
= q
->next
;
1149 lose_b(q
->b
); FREE(q
);
1154 struct literalstring
* q
= a
->literalstrings
;
1156 struct literalstring
* q_next
= q
->next
;
1157 lose_b(q
->b
); FREE(q
);
1162 struct among
* q
= a
->amongs
;
1164 struct among
* q_next
= q
->next
;
1165 FREE(q
->b
); FREE(q
);
1170 struct grouping
* q
= a
->groupings
;
1172 struct grouping
* q_next
= q
->next
;
1173 lose_b(q
->b
); FREE(q
);