1 #include <stdlib.h> /* for exit */
2 #include <string.h> /* for strlen */
3 #include <stdio.h> /* for fprintf etc */
4 #include <ctype.h>
5 #include <limits.h>
6 #include "header.h"
7
8 /* prototypes */
9
10 static void generate(struct generator * g, struct node * p);
11 static void generate_next(struct generator * g, struct node * p);
12 static void w(struct generator * g, const char * s);
13 static void writef(struct generator * g, const char * s, struct node * p);
14
new_label(struct generator * g)15 static int new_label(struct generator * g) {
16 return g->next_label++;
17 }
18
vars_newname(struct generator * g)19 static struct str * vars_newname(struct generator * g) {
20
21 struct str * output;
22 g->var_number++;
23 output = str_new();
24 str_append_string(output, "v_");
25 str_append_int(output, g->var_number);
26 return output;
27 }
28
29 /* Write routines for items from the syntax tree */
30
write_varname(struct generator * g,struct name * p)31 static void write_varname(struct generator * g, struct name * p) {
32
33 int ch = p->b[0];
34 if (p->type != t_external) {
35 write_char(g, "SBIRXG"[p->type]);
36 write_char(g, '_');
37 }
38 write_char(g, toupper(ch));
39 str_append_b_tail(g->outbuf, p->b, 1);
40
41 ch = p->b[SIZE(p->b) - 1];
42 if (ch == '_') {
43 write_char(g, 'E');
44 }
45 }
46
write_varref(struct generator * g,struct name * p)47 static void write_varref(struct generator * g, struct name * p) { /* reference to variable */
48 if (p->type < t_routine) write_string(g, "Z.");
49 write_varname(g, p);
50 }
51
write_literal_string(struct generator * g,symbol * p)52 static void write_literal_string(struct generator * g, symbol * p) {
53 int i;
54 // Ada supports UTF-8 literal strings, we only need to escape the quote and
55 // special characters.
56 write_char(g, '"');
57 for (i = 0; i < SIZE(p); i++) {
58 int ch = p[i];
59 if (ch == '"') {
60 write_string(g, "\"\"");
61 } else if (ch < 32 || ch == 127) {
62 printf("In write_literal_string, can't handle non-graphic character 0x%02x currently\n", (int)p[i]);
63 exit(1);
64 } else if (ch <= 255) {
65 write_char(g, ch);
66 } else {
67 printf("In write_literal_string, can't convert p[%d] to char because it's 0x%02x\n", i, (int)p[i]);
68 exit(1);
69 }
70 }
71 write_char(g, '"');
72 }
73
write_margin(struct generator * g)74 static void write_margin(struct generator * g) {
75 int i;
76 for (i = 0; i < g->margin; i++) write_string(g, " ");
77 }
78
79 /* Write a variable declaration. */
write_declare(struct generator * g,char * declaration,struct node * p)80 static void write_declare(struct generator * g,
81 char * declaration,
82 struct node * p) {
83 struct str * temp = g->outbuf;
84 g->outbuf = g->declarations;
85 write_string(g, " ");
86 writef(g, declaration, p);
87 write_string(g, ";");
88 write_newline(g);
89 g->outbuf = temp;
90 }
91
write_comment(struct generator * g,struct node * p)92 static void write_comment(struct generator * g, struct node * p) {
93 if (g->options->comments) {
94 write_margin(g);
95 write_string(g, "-- ");
96 write_comment_content(g, p);
97 write_newline(g);
98 }
99 }
100
write_block_start(struct generator * g)101 static void write_block_start(struct generator * g) {
102 w(g, "~Mbegin~+~N");
103 }
104
write_block_end(struct generator * g)105 static void write_block_end(struct generator * g) { /* block end */
106 w(g, "~-~Mend;~N");
107 }
108
restore_string(struct node * p,struct str * out,struct str * savevar)109 static void restore_string(struct node * p, struct str * out, struct str * savevar) {
110
111 str_clear(out);
112 str_append_string(out, "Z.C := ");
113 if (p->mode != m_forward) str_append_string(out, "Z.L - ");
114 str_append(out, savevar);
115 str_append_string(out, ";");
116 }
117
write_savecursor(struct generator * g,struct node * p,struct str * savevar)118 static void write_savecursor(struct generator * g, struct node * p,
119 struct str * savevar) {
120 g->B[0] = str_data(savevar);
121 g->S[1] = "";
122 if (p->mode != m_forward) g->S[1] = "Z.L - ";
123 write_declare(g, " ~B0 : Char_Index", p);
124 writef(g, "~M~B0 := ~S1Z.C;~N" , p);
125 }
126
write_restorecursor(struct generator * g,struct node * p,struct str * savevar)127 static void write_restorecursor(struct generator * g, struct node * p, struct str * savevar) {
128 write_margin(g);
129 if (p->mode == m_forward) {
130 write_string(g, "Z.C := ");
131 } else {
132 write_string(g, "Z.C := Z.L - ");
133 }
134 write_str(g, savevar);
135 write_string(g, ";");
136 write_newline(g);
137 }
138
wsetl(struct generator * g,int n)139 static void wsetl(struct generator * g, int n) {
140
141 write_newline(g);
142 write_margin(g);
143 write_string(g, "<<lab");
144 write_int(g, n);
145 write_string(g, ">>");
146 write_newline(g);
147 g->line_labelled = g->line_count;
148 }
149
wgotol(struct generator * g,int n)150 static void wgotol(struct generator * g, int n) {
151 write_margin(g);
152 write_string(g, "goto lab");
153 write_int(g, n);
154 write_string(g, ";");
155 write_newline(g);
156 }
157
write_failure(struct generator * g)158 static void write_failure(struct generator * g) {
159
160 if (str_len(g->failure_str) != 0) {
161 write_margin(g);
162 write_str(g, g->failure_str);
163 write_newline(g);
164 }
165 write_margin(g);
166 switch (g->failure_label) {
167 case x_return:
168 write_string(g, "Result := False;");
169 write_newline(g);
170 write_margin(g);
171 write_string(g, "return;");
172 break;
173 default:
174 write_string(g, "goto lab");
175 write_int(g, g->failure_label);
176 write_string(g, ";");
177 g->label_used = 1;
178 }
179 write_newline(g);
180 g->unreachable = true;
181 }
182
write_failure_if(struct generator * g,char * s,struct node * p)183 static void write_failure_if(struct generator * g, char * s, struct node * p) {
184
185 writef(g, "~Mif ", p);
186 writef(g, s, p);
187 writef(g, " then~N~+", p);
188 write_failure(g);
189 writef(g, "~-~Mend if;~N", p);
190 g->unreachable = false;
191 }
192
193 /* if at limit fail */
write_check_limit(struct generator * g,struct node * p)194 static void write_check_limit(struct generator * g, struct node * p) {
195 if (p->mode == m_forward) {
196 write_failure_if(g, "Z.C >= Z.L", p);
197 } else {
198 write_failure_if(g, "Z.C <= Z.Lb", p);
199 }
200 }
201
202 /* Formatted write. */
writef(struct generator * g,const char * input,struct node * p)203 static void writef(struct generator * g, const char * input, struct node * p) {
204 int i = 0;
205 int l = strlen(input);
206
207 while (i < l) {
208 int ch = input[i++];
209 if (ch != '~') {
210 write_char(g, ch);
211 continue;
212 }
213 switch (input[i++]) {
214 default: write_char(g, input[i - 1]); continue;
215 case 'C': write_comment(g, p); continue;
216 case 'f':
217 write_failure(g);
218 g->unreachable = false;
219 continue;
220 case 'M': write_margin(g); continue;
221 case 'N': write_newline(g); continue;
222 case '{': write_block_start(g); continue;
223 case '}': write_block_end(g); continue;
224 case 'S': write_string(g, g->S[input[i++] - '0']); continue;
225 case 'B': write_b(g, g->B[input[i++] - '0']); continue;
226 case 'I': write_int(g, g->I[input[i++] - '0']); continue;
227 case 'V': write_varref(g, g->V[input[i++] - '0']); continue;
228 case 'W': write_varname(g, g->V[input[i++] - '0']); continue;
229 case 'L': write_literal_string(g, g->L[input[i++] - '0']); continue;
230 case '+': g->margin++; continue;
231 case '-': g->margin--; continue;
232 case 'n': write_string(g, g->options->name); continue;
233 }
234 }
235 }
236
w(struct generator * g,const char * s)237 static void w(struct generator * g, const char * s) {
238 writef(g, s, 0);
239 }
240
need_among_var(struct node * p)241 static int need_among_var(struct node *p) {
242
243 while (p) {
244 if (p->type == c_substring || p->type == c_among) {
245 return 1;
246 }
247 if (p->right && need_among_var(p->right)) {
248 return 1;
249 }
250 p = p->left;
251 }
252 return 0;
253 }
254
need_among_handler(struct among * a)255 static int need_among_handler(struct among *a) {
256 int i;
257 struct amongvec * v = a->b;
258
259 for (i = 0; i < a->literalstring_count; i++, v++) {
260 if (v->function != 0) {
261 return 1;
262 }
263 }
264
265 return 0;
266 }
267
generate_AE(struct generator * g,struct node * p)268 static void generate_AE(struct generator * g, struct node * p) {
269 const char * s;
270 switch (p->type) {
271 case c_name:
272 write_varref(g, p->name); break;
273 case c_number:
274 // Avoid `parentheses required for unary minus` error from gnat.
275 if (p->number < 0)
276 write_char(g, '(');
277 write_int(g, p->number);
278 if (p->number < 0)
279 write_char(g, ')');
280 break;
281 case c_maxint:
282 write_string(g, "Integer'Last"); break;
283 case c_minint:
284 write_string(g, "Integer'First"); break;
285 case c_neg:
286 write_string(g, "(-"); generate_AE(g, p->right); write_char(g, ')'); break;
287 case c_multiply:
288 s = " * "; goto label0;
289 case c_plus:
290 s = " + "; goto label0;
291 case c_minus:
292 s = " - "; goto label0;
293 case c_divide:
294 s = " / ";
295 label0:
296 write_char(g, '('); generate_AE(g, p->left);
297 write_string(g, s); generate_AE(g, p->right); write_char(g, ')'); break;
298 case c_cursor:
299 w(g, "Z.C"); break;
300 case c_limit:
301 w(g, p->mode == m_forward ? "Z.L" : "Z.Lb"); break;
302 case c_len:
303 w(g, "Length_Utf8 (Z)");
304 break;
305 case c_size:
306 w(g, "Length (Z)");
307 break;
308 case c_lenof:
309 case c_sizeof:
310 g->V[0] = p->name;
311 w(g, "Length_Utf8 (~V0)");
312 break;
313 default:
314 break;
315 }
316 }
317
generate_bra(struct generator * g,struct node * p)318 static void generate_bra(struct generator * g, struct node * p) {
319 write_comment(g, p);
320 p = p->left;
321 while (p) {
322 generate(g, p);
323 p = p->right;
324 }
325 }
326
generate_and(struct generator * g,struct node * p)327 static void generate_and(struct generator * g, struct node * p) {
328 struct str * savevar = vars_newname(g);
329 int keep_c = K_needed(g, p->left);
330
331 write_comment(g, p);
332
333 if (keep_c) write_savecursor(g, p, savevar);
334
335 p = p->left;
336 while (p) {
337 generate(g, p);
338 if (g->unreachable) break;
339 if (keep_c && p->right != 0) write_restorecursor(g, p, savevar);
340 p = p->right;
341 }
342 str_delete(savevar);
343 }
344
generate_or(struct generator * g,struct node * p)345 static void generate_or(struct generator * g, struct node * p) {
346 struct str * savevar = vars_newname(g);
347 int used = g->label_used;
348 int keep_c = K_needed(g, p->left);
349
350 int a0 = g->failure_label;
351 struct str * a1 = str_copy(g->failure_str);
352
353 int out_lab = new_label(g);
354 int end_unreachable = true;
355
356 write_comment(g, p);
357
358 if (keep_c) write_savecursor(g, p, savevar);
359
360 p = p->left;
361 str_clear(g->failure_str);
362
363 if (p == 0) {
364 /* p should never be 0 after an or: there should be at least two
365 * sub nodes. */
366 fprintf(stderr, "Error: \"or\" node without children nodes.");
367 exit(1);
368 }
369 while (p->right) {
370 g->failure_label = new_label(g);
371 g->label_used = 0;
372 generate(g, p);
373 if (!g->unreachable) {
374 wgotol(g, out_lab);
375 end_unreachable = false;
376 }
377
378 if (g->label_used)
379 wsetl(g, g->failure_label);
380 g->unreachable = false;
381 if (keep_c) {
382 write_restorecursor(g, p, savevar);
383 }
384 p = p->right;
385 }
386 g->label_used = used;
387 g->failure_label = a0;
388 str_delete(g->failure_str);
389 g->failure_str = a1;
390
391 generate(g, p);
392 wsetl(g, out_lab);
393 if (!end_unreachable) {
394 g->unreachable = false;
395 }
396 str_delete(savevar);
397 }
398
generate_backwards(struct generator * g,struct node * p)399 static void generate_backwards(struct generator * g, struct node * p) {
400 writef(g, "~MZ.Lb := Z.C; Z.C := Z.L;~C~N", p);
401 generate(g, p->left);
402 w(g, "~MZ.C := Z.Lb;~N");
403 }
404
405
generate_not(struct generator * g,struct node * p)406 static void generate_not(struct generator * g, struct node * p) {
407 struct str * savevar = vars_newname(g);
408 int keep_c = K_needed(g, p->left);
409
410 int a0 = g->failure_label, l;
411 struct str * a1 = str_copy(g->failure_str);
412
413 write_comment(g, p);
414 if (keep_c) {
415 write_savecursor(g, p, savevar);
416 }
417
418 g->failure_label = new_label(g);
419 str_clear(g->failure_str);
420
421 l = g->failure_label;
422
423 generate(g, p->left);
424
425 g->failure_label = a0;
426 str_delete(g->failure_str);
427 g->failure_str = a1;
428
429 if (!g->unreachable) write_failure(g);
430
431 if (g->label_used)
432 wsetl(g, l);
433
434 g->unreachable = false;
435
436 if (keep_c) write_restorecursor(g, p, savevar);
437 str_delete(savevar);
438 }
439
440
generate_try(struct generator * g,struct node * p)441 static void generate_try(struct generator * g, struct node * p) {
442 struct str * savevar;
443 int keep_c = K_needed(g, p->left);
444
445 g->failure_label = new_label(g);
446 g->label_used = 0;
447 str_clear(g->failure_str);
448
449 write_comment(g, p);
450 if (keep_c) {
451 savevar = vars_newname(g);
452 write_savecursor(g, p, savevar);
453 restore_string(p, g->failure_str, savevar);
454 }
455
456 generate(g, p->left);
457 if (g->label_used)
458 wsetl(g, g->failure_label);
459 g->unreachable = false;
460
461 if (keep_c) {
462 str_delete(savevar);
463 }
464 }
465
generate_set(struct generator * g,struct node * p)466 static void generate_set(struct generator * g, struct node * p) {
467 write_comment(g, p);
468 g->V[0] = p->name;
469 writef(g, "~M~V0 := True;~N", p);
470 }
471
generate_unset(struct generator * g,struct node * p)472 static void generate_unset(struct generator * g, struct node * p) {
473 write_comment(g, p);
474 g->V[0] = p->name;
475 writef(g, "~M~V0 := False;~N", p);
476 }
477
generate_fail(struct generator * g,struct node * p)478 static void generate_fail(struct generator * g, struct node * p) {
479 write_comment(g, p);
480 generate(g, p->left);
481 if (!g->unreachable) write_failure(g);
482 }
483
484 /* generate_test() also implements 'reverse' */
485
generate_test(struct generator * g,struct node * p)486 static void generate_test(struct generator * g, struct node * p) {
487 struct str * savevar = vars_newname(g);
488 int keep_c = K_needed(g, p->left);
489
490 write_comment(g, p);
491
492 if (keep_c) {
493 write_savecursor(g, p, savevar);
494 }
495
496 generate(g, p->left);
497
498 if (!g->unreachable) {
499 if (keep_c) {
500 write_restorecursor(g, p, savevar);
501 }
502 }
503 str_delete(savevar);
504 }
505
generate_do(struct generator * g,struct node * p)506 static void generate_do(struct generator * g, struct node * p) {
507 struct str * savevar = vars_newname(g);
508 int keep_c = K_needed(g, p->left);
509 write_comment(g, p);
510 if (keep_c) write_savecursor(g, p, savevar);
511
512 if (p->left->type == c_call) {
513 /* Optimise do <call> */
514 write_comment(g, p->left);
515 g->V[0] = p->left->name;
516 w(g, "~M~V0 (Z, Result);~N");
517 } else {
518 g->failure_label = new_label(g);
519 str_clear(g->failure_str);
520
521 generate(g, p->left);
522 if (g->label_used)
523 wsetl(g, g->failure_label);
524 g->unreachable = false;
525 }
526
527 if (keep_c) write_restorecursor(g, p, savevar);
528 str_delete(savevar);
529 }
530
generate_GO_grouping(struct generator * g,struct node * p,int is_goto,int complement)531 static void generate_GO_grouping(struct generator * g, struct node * p, int is_goto, int complement) {
532
533 struct grouping * q = p->name->grouping;
534 g->S[0] = p->mode == m_forward ? "" : "_Backward";
535 g->S[1] = complement ? "In" : "Out";
536 g->S[2] = g->options->encoding == ENC_UTF8 ? "" : "";
537 g->V[0] = p->name;
538 g->I[0] = q->smallest_ch;
539 g->I[1] = q->largest_ch;
540 if (is_goto) {
541 writef(g, "~M~S1_Grouping~S0~S2 (Z, ~V0, ~I0, ~I1, True, C);", p);
542 write_failure_if(g, "C < 0", p);
543 } else {
544 writef(g, "~C"
545 "~M~S1_Grouping~S0~S2 (Z, ~V0, ~I0, ~I1, True, C);~N", p);
546 write_failure_if(g, "C < 0", p);
547
548 if (p->mode == m_forward)
549 w(g, "~MZ.C := Z.C + C;~N");
550 else
551 w(g, "~MZ.C := Z.C - C;~N");
552 }
553 }
554
generate_GO(struct generator * g,struct node * p,int style)555 static void generate_GO(struct generator * g, struct node * p, int style) {
556 int end_unreachable = false;
557 int used = g->label_used;
558 /* Initialise to NULL to suppress bogus "may be used uninitialised" warning. */
559 struct str * savevar = NULL;
560 int keep_c = style == 1 || repeat_restore(g, p->left);
561 int a0 = g->failure_label;
562
563 int golab = new_label(g);
564
565 if (p->left->type == c_grouping || p->left->type == c_non) {
566 /* Special case for "goto" or "gopast" when used on a grouping or an
567 * inverted grouping - the movement of c by the matching action is
568 * exactly what we want! */
569 #ifdef OPTIMISATION_WARNINGS
570 printf("Optimising %s %s\n", style ? "goto" : "gopast", p->left->type == c_non ? "non" : "grouping");
571 #endif
572 if (g->options->comments) {
573 writef(g, "~M~C", p);
574 }
575 generate_GO_grouping(g, p->left, style, p->left->type == c_non);
576 return;
577 }
578
579 write_comment(g, p);
580 w(g, "~Mloop~N~+");
581
582 if (keep_c) {
583 savevar = vars_newname(g);
584 write_savecursor(g, p, savevar);
585 }
586
587 g->failure_label = new_label(g);
588 g->label_used = 0;
589 str_clear(g->failure_str);
590 generate(g, p->left);
591
592 if (g->unreachable) {
593 /* Cannot break out of this loop: therefore the code after the
594 * end of the loop is unreachable.*/
595 end_unreachable = true;
596 } else {
597 /* include for goto; omit for gopast */
598 if (style == 1) write_restorecursor(g, p, savevar);
599 g->I[0] = golab;
600 w(g, "~Mexit;~N");
601 }
602 g->unreachable = false;
603 if (g->label_used)
604 wsetl(g, g->failure_label);
605 if (keep_c) {
606 write_restorecursor(g, p, savevar);
607 str_delete(savevar);
608 }
609 g->label_used = used;
610 g->failure_label = a0;
611
612 write_check_limit(g, p);
613 generate_next(g, p);
614
615 g->I[0] = golab;
616 w(g, "~-~Mend loop;~N");
617 g->unreachable = end_unreachable;
618 }
619
generate_loop(struct generator * g,struct node * p)620 static void generate_loop(struct generator * g, struct node * p) {
621 struct str * loopvar = vars_newname(g);
622 write_comment(g, p);
623 g->B[0] = str_data(loopvar);
624 write_declare(g, " ~B0 : Integer", p);
625 w(g, "~MFor ~B0 := ");
626 generate_AE(g, p->AE);
627 writef(g, " DownTo 1 Do~N", p);
628 writef(g, "~{", p);
629
630 generate(g, p->left);
631
632 w(g, "~}");
633 str_delete(loopvar);
634 g->unreachable = false;
635 }
636
generate_repeat_or_atleast(struct generator * g,struct node * p,struct str * loopvar)637 static void generate_repeat_or_atleast(struct generator * g, struct node * p, struct str * loopvar) {
638 struct str * savevar = vars_newname(g);
639 int keep_c = repeat_restore(g, p->left);
640 int replab = new_label(g);
641 g->I[0] = replab;
642 wsetl(g, replab);
643 writef(g, "~N~Mloop~N~+", p);
644
645 if (keep_c) write_savecursor(g, p, savevar);
646
647 g->failure_label = new_label(g);
648 g->label_used = 0;
649 generate(g, p->left);
650
651 if (!g->unreachable) {
652 if (loopvar != 0) {
653 g->B[0] = str_data(loopvar);
654 w(g, "~M~B0 := ~B0 - 1;~N");
655 }
656
657 g->I[0] = replab;
658 w(g, "~Mgoto lab~I0;~N");
659 }
660 if (g->label_used)
661 wsetl(g, g->failure_label);
662 g->unreachable = false;
663
664 if (keep_c) write_restorecursor(g, p, savevar);
665
666 w(g, "~N~Mexit;~N~-~Mend loop;~N");
667 str_delete(savevar);
668 }
669
generate_repeat(struct generator * g,struct node * p)670 static void generate_repeat(struct generator * g, struct node * p) {
671 write_comment(g, p);
672 generate_repeat_or_atleast(g, p, NULL);
673 }
674
generate_atleast(struct generator * g,struct node * p)675 static void generate_atleast(struct generator * g, struct node * p) {
676 struct str * loopvar = vars_newname(g);
677
678 write_comment(g, p);
679 w(g, "~{");
680 g->B[0] = str_data(loopvar);
681
682 write_declare(g, " ~B0 : Integer", p);
683 w(g, "~M~B0 := ");
684 generate_AE(g, p->AE);
685 w(g, ";~N");
686 {
687 int a0 = g->failure_label;
688
689 generate_repeat_or_atleast(g, p, loopvar);
690
691 g->failure_label = a0;
692 }
693 g->B[0] = str_data(loopvar);
694 write_failure_if(g, "~B0 > 0", p);
695 w(g, "~}");
696 str_delete(loopvar);
697 }
698
generate_setmark(struct generator * g,struct node * p)699 static void generate_setmark(struct generator * g, struct node * p) {
700 write_comment(g, p);
701 g->V[0] = p->name;
702 writef(g, "~M~V0 := Z.C;~N", p);
703 }
704
generate_tomark(struct generator * g,struct node * p)705 static void generate_tomark(struct generator * g, struct node * p) {
706 write_comment(g, p);
707 g->S[0] = p->mode == m_forward ? ">" : "<";
708
709 w(g, "~Mif Z.C ~S0 "); generate_AE(g, p->AE); w(g, " then~N");
710 write_failure(g);
711 w(g, "~Mend if;~N");
712 g->unreachable = false;
713 w(g, "~MZ.C := "); generate_AE(g, p->AE); writef(g, ";~N", p);
714 }
715
generate_atmark(struct generator * g,struct node * p)716 static void generate_atmark(struct generator * g, struct node * p) {
717 write_comment(g, p);
718 w(g, "~Mif Z.C /= "); generate_AE(g, p->AE); writef(g, " then~N~+", p);
719 write_failure(g);
720 w(g, "~-~Mend if;~N");
721 g->unreachable = false;
722 }
723
generate_hop(struct generator * g,struct node * p)724 static void generate_hop(struct generator * g, struct node * p) {
725 g->S[0] = p->mode == m_forward ? "" : "_Backward";
726 if (g->options->encoding == ENC_UTF8) {
727 w(g, "~MC := Skip_Utf8~S0 (Z, ");
728 generate_AE(g, p->AE); writef(g, ");~C~N", p);
729 write_failure_if(g, "C < 0", p);
730 } else {
731 w(g, "~MC := Z.C ~S0 ");
732 generate_AE(g, p->AE);
733 writef(g, ";~C~N", p);
734 if (p->mode == m_forward) {
735 write_failure_if(g, "C > Z.L or C < Z.C", p);
736 } else {
737 write_failure_if(g, "C < Z.Lb or C > Z.C", p);
738 }
739 }
740 writef(g, "~MZ.C := C;~N", p);
741 }
742
generate_delete(struct generator * g,struct node * p)743 static void generate_delete(struct generator * g, struct node * p) {
744 write_comment(g, p);
745 writef(g, "~MSlice_Del (Z);~N", p);
746 }
747
generate_next(struct generator * g,struct node * p)748 static void generate_next(struct generator * g, struct node * p) {
749 write_comment(g, p);
750 if (p->mode == m_forward)
751 w(g, "~MC := Skip_Utf8 (Z);~N");
752 else
753 w(g, "~MC := Skip_Utf8_Backward (Z);~N");
754 write_failure_if(g, "C < 0", p);
755 w(g, "~MZ.C := C;~N");
756 }
757
generate_tolimit(struct generator * g,struct node * p)758 static void generate_tolimit(struct generator * g, struct node * p) {
759 g->S[0] = p->mode == m_forward ? "" : "b";
760 writef(g, "~MZ.C := Z.L~S0;~C~N", p);
761 }
762
generate_atlimit(struct generator * g,struct node * p)763 static void generate_atlimit(struct generator * g, struct node * p) {
764 write_comment(g, p);
765 g->S[0] = p->mode == m_forward ? "" : "b";
766 g->S[1] = p->mode == m_forward ? "<" : ">";
767 write_failure_if(g, "Z.C ~S1 Z.L~S0", p);
768 }
769
generate_leftslice(struct generator * g,struct node * p)770 static void generate_leftslice(struct generator * g, struct node * p) {
771 g->S[0] = p->mode == m_forward ? "Bra" : "Ket";
772 writef(g, "~MZ.~S0 := Z.C;~C~N", p);
773 }
774
generate_rightslice(struct generator * g,struct node * p)775 static void generate_rightslice(struct generator * g, struct node * p) {
776 g->S[0] = p->mode == m_forward ? "Ket" : "Bra";
777 writef(g, "~MZ.~S0 := Z.C;~C~N", p);
778 }
779
generate_assignto(struct generator * g,struct node * p)780 static void generate_assignto(struct generator * g, struct node * p) {
781 g->V[0] = p->name;
782 writef(g, "~M~V0 := Assign_To (Z, ~V0);~C~N", p);
783 write_failure_if(g, "~V0 == 0", p);
784 }
785
generate_sliceto(struct generator * g,struct node * p)786 static void generate_sliceto(struct generator * g, struct node * p) {
787 write_comment(g, p);
788 g->V[0] = p->name;
789 writef(g, "~M~V0 := Ada.Strings.Unbounded.To_Unbounded_String (Slice_To (Z));~N", p);
790 }
791
generate_address(struct generator * g,struct node * p)792 static void generate_address(struct generator * g, struct node * p) {
793 symbol * b = p->literalstring;
794 if (b != 0) {
795 write_literal_string(g, b);
796 } else {
797 write_varname(g, p->name);
798 }
799 }
800
generate_insert(struct generator * g,struct node * p,int style)801 static void generate_insert(struct generator * g, struct node * p, int style) {
802
803 int keep_c = style == c_attach;
804 write_comment(g, p);
805 if (p->mode == m_backward) keep_c = !keep_c;
806 if (keep_c) w(g, "~MC := Z.C;~N");
807 writef(g, "~MInsert (Z, Z.C, Z.C, ", p);
808 generate_address(g, p);
809 writef(g, ");~N", p);
810 if (keep_c) w(g, "~MZ.C := C;~N");
811 }
812
generate_assignfrom(struct generator * g,struct node * p)813 static void generate_assignfrom(struct generator * g, struct node * p) {
814 int keep_c = p->mode == m_forward; /* like 'attach' */
815
816 write_comment(g, p);
817 if (keep_c) writef(g, "~MC := Z.C;~N", p);
818 if (p->mode == m_forward) {
819 writef(g, "~MInsert (Z, Z.C, Z.L, ", p);
820 } else {
821 writef(g, "~MInsert (Z, Z.Lb, Z.C, ", p);
822 }
823 generate_address(g, p);
824 writef(g, ");~N", p);
825 if (keep_c) w(g, "~MZ.C := C;~N");
826 }
827
generate_slicefrom(struct generator * g,struct node * p)828 static void generate_slicefrom(struct generator * g, struct node * p) {
829 write_comment(g, p);
830 w(g, "~MSlice_From (Z, ");
831 generate_address(g, p);
832 writef(g, ");~N", p);
833 }
834
generate_setlimit(struct generator * g,struct node * p)835 static void generate_setlimit(struct generator * g, struct node * p) {
836 struct str * savevar = vars_newname(g);
837 struct str * varname = vars_newname(g);
838
839 g->B[0] = str_data(varname);
840 write_declare(g, " ~B0 : Integer", p);
841 if (p->left && p->left->type == c_tomark) {
842 /* Special case for:
843 *
844 * setlimit tomark AE for C
845 *
846 * All uses of setlimit in the current stemmers we ship follow this
847 * pattern, and by special-casing we can avoid having to save and
848 * restore c.
849 */
850 struct node * q = p->left;
851
852 ++g->keep_count;
853
854 g->S[0] = q->mode == m_forward ? ">" : "<";
855
856 w(g, "~Mif Z.C ~S0 "); generate_AE(g, q->AE); writef(g, " then~N~+", q);
857 w(g, "~MResult := False;~N");
858 w(g, "~Mreturn;~-~N");
859 w(g, "~Mend if;~N");
860 w(g, "~M~B0");
861 g->unreachable = false;
862
863 if (p->mode == m_forward) {
864 w(g, " := Z.L - Z.C; Z.L := ");
865 } else {
866 w(g, " := Z.Lb; Z.Lb := ");
867 }
868 generate_AE(g, q->AE);
869 w(g, ";~N");
870
871 if (p->mode == m_forward) {
872 str_assign(g->failure_str, "Z.L := Z.L + ");
873 str_append(g->failure_str, varname);
874 str_append_ch(g->failure_str, ';');
875 } else {
876 str_assign(g->failure_str, "Z.Lb := ");
877 str_append(g->failure_str, varname);
878 str_append_ch(g->failure_str, ';');
879 }
880
881 } else {
882 write_savecursor(g, p, savevar);
883
884 generate(g, p->left);
885
886 if (!g->unreachable) {
887 g->B[0] = str_data(varname);
888 if (p->mode == m_forward) {
889 w(g, "~M~B0 := Z.L - Z.C;~N");
890 w(g, "~MZ.L := Z.C;~N");
891 } else {
892 w(g, "~M~B0 := Z.Lb;~N");
893 w(g, "~MZ.Lb := Z.C;~N");
894 }
895 write_restorecursor(g, p, savevar);
896
897 if (p->mode == m_forward) {
898 str_assign(g->failure_str, "Z.L := Z.L + ");
899 str_append(g->failure_str, varname);
900 str_append_ch(g->failure_str, ';');
901 } else {
902 str_assign(g->failure_str, "Z.Lb := ");
903 str_append(g->failure_str, varname);
904 str_append_ch(g->failure_str, ';');
905 }
906 }
907 }
908
909 if (!g->unreachable) {
910 generate(g, p->aux);
911
912 if (!g->unreachable) {
913 write_margin(g);
914 write_str(g, g->failure_str);
915 write_newline(g);
916 }
917 }
918 str_delete(varname);
919 str_delete(savevar);
920 }
921
922 /* dollar sets snowball up to operate on a string variable as if it were the
923 * current string */
generate_dollar(struct generator * g,struct node * p)924 static void generate_dollar(struct generator * g, struct node * p) {
925 struct str * savevar = vars_newname(g);
926 g->B[0] = str_data(savevar);
927 write_comment(g, p);
928 g->V[0] = p->name;
929
930 {
931 struct str * saved_output = g->outbuf;
932 str_clear(g->failure_str);
933 g->outbuf = g->failure_str;
934 writef(g, "~V0 := FCurrent; "
935 "FCurrent := ~B0_Current; "
936 "FCursor := ~B0_Cursor; "
937 "FLimit := ~B0_Limit; "
938 "FBkLimit := ~B0_BkLimit; "
939 "FBra := ~B0_Bra; "
940 "FKet := ~B0_Ket;", p);
941 g->failure_str = g->outbuf;
942 g->outbuf = saved_output;
943 }
944
945 write_declare(g, "~B0_Current : AnsiString", p);
946 write_declare(g, "~B0_Cursor : Integer", p);
947 write_declare(g, "~B0_Limit : Integer", p);
948 write_declare(g, "~B0_BkLimit : Integer", p);
949 write_declare(g, "~B0_Bra : Integer", p);
950 write_declare(g, "~B0_Ket : Integer", p);
951 writef(g, "~{"
952 "~M~B0_Current := FCurrent;~N"
953 "{ ~M~B0_Current := Copy(FCurrent, 1, FLimit); }~N"
954 "~M~B0_Cursor := FCursor;~N"
955 "~M~B0_Limit := FLimit;~N"
956 "~M~B0_BkLimit := FBkLimit;~N"
957 "~M~B0_Bra := FBra;~N"
958 "~M~B0_Ket := FKet;~N"
959 "~MFCurrent := ~V0;~N"
960 "~MFCursor := 0;~N"
961 "~MFLimit := Length(current);~N", p);
962 generate(g, p->left);
963 if (!g->unreachable) {
964 write_margin(g);
965 write_str(g, g->failure_str);
966 write_newline(g);
967 }
968 w(g, "~}");
969 str_delete(savevar);
970 }
971
generate_integer_assign(struct generator * g,struct node * p,char * s)972 static void generate_integer_assign(struct generator * g, struct node * p, char * s) {
973
974 g->V[0] = p->name;
975 w(g, "~M~V0 := ");
976
977 if (s != 0) {
978 g->S[0] = s;
979 w(g, "~V0 ~S0 ");
980 }
981
982 generate_AE(g, p->AE);
983 w(g, ";~N");
984 }
985
generate_integer_test(struct generator * g,struct node * p,char * s)986 static void generate_integer_test(struct generator * g, struct node * p, char * s) {
987
988 w(g, "~Mif not (");
989 generate_AE(g, p->left);
990 write_char(g, ' ');
991 write_string(g, s);
992 write_char(g, ' ');
993 generate_AE(g, p->AE);
994 w(g, ") then~+~N");
995 write_failure(g);
996 w(g, "~-~Mend if;~N");
997 g->unreachable = false;
998 }
999
generate_integer_function(struct generator * g,struct node * p,char * s)1000 static void generate_integer_function(struct generator * g, struct node * p, char * s) {
1001
1002 w(g, "~MResult := (");
1003 generate_AE(g, p->left);
1004 write_char(g, ' ');
1005 write_string(g, s);
1006 write_char(g, ' ');
1007 generate_AE(g, p->AE);
1008 w(g, ");~N");
1009 g->unreachable = false;
1010 }
1011
generate_call(struct generator * g,struct node * p)1012 static void generate_call(struct generator * g, struct node * p) {
1013
1014 write_comment(g, p);
1015 g->V[0] = p->name;
1016 writef(g, "~M~V0 (Z, Result);~N", p);
1017 write_failure_if(g, "not Result", p);
1018 }
1019
generate_grouping(struct generator * g,struct node * p,int complement)1020 static void generate_grouping(struct generator * g, struct node * p, int complement) {
1021
1022 struct grouping * q = p->name->grouping;
1023 g->S[0] = p->mode == m_forward ? "" : "_Backward";
1024 g->S[1] = complement ? "Out_" : "In_";
1025 g->S[2] = g->options->encoding == ENC_UTF8 ? "" : "";
1026 g->V[0] = p->name;
1027 g->I[0] = q->smallest_ch;
1028 g->I[1] = q->largest_ch;
1029 writef(g, "~M~S1Grouping~S0~S2 (Z, ~V0, ~I0, ~I1, False, C);~N", p);
1030 write_failure_if(g, "C /= 0", p);
1031 }
1032
generate_namedstring(struct generator * g,struct node * p)1033 static void generate_namedstring(struct generator * g, struct node * p) {
1034
1035 write_comment(g, p);
1036 g->S[0] = p->mode == m_forward ? "" : "_Backward";
1037 g->V[0] = p->name;
1038 writef(g, "~MC := Eq_S~S0 (Z, Ada.Strings.Unbounded.To_String (~V0));", p);
1039 write_failure_if(g, "C = 0", p);
1040 }
1041
generate_literalstring(struct generator * g,struct node * p)1042 static void generate_literalstring(struct generator * g, struct node * p) {
1043 symbol * b = p->literalstring;
1044 write_comment(g, p);
1045 g->S[0] = p->mode == m_forward ? "" : "_Backward";
1046 g->L[0] = b;
1047 writef(g, "~MC := Eq_S~S0 (Z, ~L0);~N", p);
1048 write_failure_if(g, "C = 0", p);
1049 if (p->mode == m_forward) {
1050 writef(g, "~MZ.C := Z.C + C;~N", p);
1051 } else {
1052 writef(g, "~MZ.C := Z.C - C;~N", p);
1053 }
1054 }
1055
generate_define(struct generator * g,struct node * p)1056 static void generate_define(struct generator * g, struct node * p) {
1057 struct str *saved_output;
1058 struct str *saved_declarations;
1059
1060 /* Generate function header. */
1061 g->V[0] = p->name;
1062 w(g, "~N~Mprocedure ~W0 (Z : in out Context_Type; Result : out Boolean) is~N");
1063
1064 /* Save output*/
1065 saved_output = g->outbuf;
1066 saved_declarations = g->declarations;
1067
1068 g->outbuf = str_new();
1069 g->declarations = str_new();
1070
1071 g->next_label = 0;
1072 g->var_number = 0;
1073
1074 g->failure_label = x_return;
1075 g->unreachable = false;
1076
1077 /* Generate function body. */
1078 w(g, "~{");
1079 switch (p->left->type) {
1080 case c_eq: generate_integer_function(g, p->left, "="); break;
1081 case c_ne: generate_integer_function(g, p->left, "/="); break;
1082 case c_gr: generate_integer_function(g, p->left, ">"); break;
1083 case c_ge: generate_integer_function(g, p->left, ">="); break;
1084 case c_ls: generate_integer_function(g, p->left, "<"); break;
1085 case c_le: generate_integer_function(g, p->left, "<="); break;
1086 default:
1087 generate(g, p->left);
1088 if (!g->unreachable) w(g, "~N~MResult := True;~N");
1089 str_append_string(saved_output, " C : Result_Index;\n");
1090 if (need_among_var(p->left) || 1) {
1091 str_append_string(saved_output, " A : Integer;\n");
1092 }
1093 break;
1094 }
1095 g->V[0] = p->name;
1096 w(g, "~-~Mend ~W0;~N");
1097
1098 if (g->var_number) {
1099 str_append(saved_output, g->declarations);
1100 }
1101
1102 str_append(saved_output, g->outbuf);
1103 str_delete(g->declarations);
1104 str_delete(g->outbuf);
1105 g->declarations = saved_declarations;
1106 g->outbuf = saved_output;
1107 }
1108
generate_substring(struct generator * g,struct node * p)1109 static void generate_substring(struct generator * g, struct node * p) {
1110 struct among * x = p->among;
1111 int block = -1;
1112 unsigned int bitmap = 0;
1113 struct amongvec * among_cases = x->b;
1114 int c;
1115 int empty_case = -1;
1116 int n_cases = 0;
1117 symbol cases[2];
1118 int shortest_size = INT_MAX;
1119 int call_done = 0;
1120 int need_handler = need_among_handler(x);
1121
1122 write_comment(g, p);
1123
1124 g->S[0] = p->mode == m_forward ? "" : "_Backward";
1125 g->I[0] = x->number;
1126
1127 /* In forward mode with non-ASCII UTF-8 characters, the first character
1128 * of the string will often be the same, so instead look at the last
1129 * common character position.
1130 *
1131 * In backward mode, we can't match if there are fewer characters before
1132 * the current position than the minimum length.
1133 */
1134 for (c = 0; c < x->literalstring_count; ++c) {
1135 int size = among_cases[c].size;
1136 if (size != 0 && size < shortest_size) {
1137 shortest_size = size;
1138 }
1139 }
1140
1141 for (c = 0; c < x->literalstring_count; ++c) {
1142 symbol ch;
1143 if (among_cases[c].size == 0) {
1144 empty_case = c;
1145 continue;
1146 }
1147 if (p->mode == m_forward) {
1148 ch = among_cases[c].b[shortest_size - 1];
1149 } else {
1150 ch = among_cases[c].b[among_cases[c].size - 1];
1151 }
1152 if (n_cases == 0) {
1153 block = ch >> 5;
1154 } else if (ch >> 5 != block) {
1155 block = -1;
1156 if (n_cases > 2) break;
1157 }
1158 if (block == -1) {
1159 if (n_cases > 0 && ch == cases[0]) continue;
1160 if (n_cases < 2) {
1161 cases[n_cases++] = ch;
1162 } else if (ch != cases[1]) {
1163 ++n_cases;
1164 break;
1165 }
1166 } else {
1167 if ((bitmap & (1u << (ch & 0x1f))) == 0) {
1168 bitmap |= 1u << (ch & 0x1f);
1169 if (n_cases < 2)
1170 cases[n_cases] = ch;
1171 ++n_cases;
1172 }
1173 }
1174 }
1175
1176 if (block != -1 || n_cases <= 2) {
1177 char buf[64];
1178 char buf2[128];
1179 char buf3[64];
1180 g->I[2] = block;
1181 g->I[3] = bitmap;
1182 g->I[4] = shortest_size - 1;
1183 g->S[3] = buf3;
1184 snprintf(buf3, sizeof(buf3), "16#%x#", bitmap);
1185 if (p->mode == m_forward) {
1186 if (shortest_size == 1)
1187 sprintf(buf, "Z.C");
1188 else
1189 sprintf(buf, "Z.C + %d", shortest_size - 1);
1190 snprintf(buf2, sizeof(buf2), "Character'Pos (Z.P (%s + 1))", buf);
1191 g->S[1] = buf;
1192 g->S[2] = buf2;
1193 if (shortest_size == 1) {
1194 writef(g, "~Mif Z.C >= Z.L", p);
1195 } else {
1196 writef(g, "~Mif Z.C + ~I4 >= Z.L", p);
1197 }
1198 } else {
1199 g->S[1] = "Z.C - 1";
1200 g->S[2] = "Character'Pos (Z.P (Z.C))";
1201 if (shortest_size == 1) {
1202 writef(g, "~Mif Z.C <= Z.Lb", p);
1203 } else {
1204 writef(g, "~Mif Z.C - ~I4 <= Z.Lb", p);
1205 }
1206 }
1207 if (n_cases == 0) {
1208 /* We get this for the degenerate case: among ( '' )
1209 * This doesn't seem to be a useful construct, but it is
1210 * syntactically valid.
1211 */
1212 } else if (n_cases == 1) {
1213 g->I[4] = cases[0];
1214 writef(g, " or else ~S2 /= ~I4", p);
1215 } else if (n_cases == 2) {
1216 g->I[4] = cases[0];
1217 g->I[5] = cases[1];
1218 writef(g, " or else (~S2 /= ~I4 and then ~S2 /= ~I5)", p);
1219 } else {
1220 writef(g, " or else Check_Among (Z, ~S1, ~I2, ~S3)", p);
1221 }
1222 writef(g, " then~+~N", p);
1223 if (empty_case != -1) {
1224 /* If the among includes the empty string, it can never fail
1225 * so not matching the bitmap means we match the empty string.
1226 */
1227 g->I[4] = among_cases[empty_case].result;
1228 writef(g, "~MA := ~I4;~-~N~Melse~+~C", p);
1229 if (need_handler) {
1230 writef(g, "~MFind_Among~S0 (Z, A_~I0, Among_String, Among_Handler'Access, A);~N", p);
1231 } else {
1232 writef(g, "~MFind_Among~S0 (Z, A_~I0, Among_String, null, A);~N", p);
1233 }
1234 write_failure_if(g, "A = 0", p);
1235 call_done = 1;
1236 } else {
1237 writef(g, "~f~C", p);
1238 }
1239 writef(g, "~-~Mend if;~N", p);
1240 } else {
1241 #ifdef OPTIMISATION_WARNINGS
1242 printf("Couldn't shortcut among %d\n", x->number);
1243 #endif
1244 }
1245
1246 if (!call_done) {
1247 if (need_handler) {
1248 writef(g, "~MFind_Among~S0 (Z, A_~I0, Among_String, Among_Handler'Access, A);~N", p);
1249 } else {
1250 writef(g, "~MFind_Among~S0 (Z, A_~I0, Among_String, null, A);~N", p);
1251 }
1252 write_failure_if(g, "A = 0", p);
1253 }
1254 }
1255
generate_among(struct generator * g,struct node * p)1256 static void generate_among(struct generator * g, struct node * p) {
1257
1258 struct among * x = p->among;
1259
1260 if (x->substring == 0) generate_substring(g, p);
1261
1262 if (x->starter != 0) generate(g, x->starter);
1263
1264 if (x->command_count == 1 && x->nocommand_count == 0) {
1265 /* Only one outcome ("no match" already handled). */
1266 generate(g, x->commands[0]);
1267 } else if (x->command_count > 0) {
1268 int i;
1269 write_comment(g, p);
1270 w(g, "~Mcase A is~N~+");
1271 for (i = 1; i <= x->command_count; i++) {
1272 g->I[0] = i;
1273 w(g, "~Mwhen ~I0 =>~N");
1274 g->margin++;
1275 generate(g, x->commands[i - 1]);
1276 g->margin--;
1277 g->unreachable = false;
1278 }
1279 w(g, "~Mwhen others =>~N");
1280 w(g, "~M null;~N");
1281 w(g, "~-~Mend case;~N");
1282 }
1283 }
1284
generate_booltest(struct generator * g,struct node * p)1285 static void generate_booltest(struct generator * g, struct node * p) {
1286
1287 write_comment(g, p);
1288 g->V[0] = p->name;
1289 write_failure_if(g, "not ~V0", p);
1290 }
1291
generate_false(struct generator * g,struct node * p)1292 static void generate_false(struct generator * g, struct node * p) {
1293
1294 write_comment(g, p);
1295 write_failure(g);
1296 }
1297
generate_debug(struct generator * g,struct node * p)1298 static void generate_debug(struct generator * g, struct node * p) {
1299
1300 write_comment(g, p);
1301 g->I[0] = g->debug_count++;
1302 g->I[1] = p->line_number;
1303 writef(g, "~Mdebug(~I0, ~I1);~N", p);
1304 }
1305
generate(struct generator * g,struct node * p)1306 static void generate(struct generator * g, struct node * p) {
1307
1308 int a0;
1309 struct str * a1;
1310
1311 if (g->unreachable) return;
1312
1313 a0 = g->failure_label;
1314 a1 = str_copy(g->failure_str);
1315
1316 switch (p->type) {
1317 case c_define: generate_define(g, p); break;
1318 case c_bra: generate_bra(g, p); break;
1319 case c_and: generate_and(g, p); break;
1320 case c_or: generate_or(g, p); break;
1321 case c_backwards: generate_backwards(g, p); break;
1322 case c_not: generate_not(g, p); break;
1323 case c_set: generate_set(g, p); break;
1324 case c_unset: generate_unset(g, p); break;
1325 case c_try: generate_try(g, p); break;
1326 case c_fail: generate_fail(g, p); break;
1327 case c_reverse:
1328 case c_test: generate_test(g, p); break;
1329 case c_do: generate_do(g, p); break;
1330 case c_goto: generate_GO(g, p, 1); break;
1331 case c_gopast: generate_GO(g, p, 0); break;
1332 case c_repeat: generate_repeat(g, p); break;
1333 case c_loop: generate_loop(g, p); break;
1334 case c_atleast: generate_atleast(g, p); break;
1335 case c_setmark: generate_setmark(g, p); break;
1336 case c_tomark: generate_tomark(g, p); break;
1337 case c_atmark: generate_atmark(g, p); break;
1338 case c_hop: generate_hop(g, p); break;
1339 case c_delete: generate_delete(g, p); break;
1340 case c_next: generate_next(g, p); break;
1341 case c_tolimit: generate_tolimit(g, p); break;
1342 case c_atlimit: generate_atlimit(g, p); break;
1343 case c_leftslice: generate_leftslice(g, p); break;
1344 case c_rightslice: generate_rightslice(g, p); break;
1345 case c_assignto: generate_assignto(g, p); break;
1346 case c_sliceto: generate_sliceto(g, p); break;
1347 case c_assign: generate_assignfrom(g, p); break;
1348 case c_insert:
1349 case c_attach: generate_insert(g, p, p->type); break;
1350 case c_slicefrom: generate_slicefrom(g, p); break;
1351 case c_setlimit: generate_setlimit(g, p); break;
1352 case c_dollar: generate_dollar(g, p); break;
1353 case c_mathassign: generate_integer_assign(g, p, NULL); break;
1354 case c_plusassign: generate_integer_assign(g, p, "+"); break;
1355 case c_minusassign: generate_integer_assign(g, p, "-"); break;
1356 case c_multiplyassign:generate_integer_assign(g, p, "*"); break;
1357 case c_divideassign: generate_integer_assign(g, p, "/"); break;
1358 case c_eq: generate_integer_test(g, p, "="); break;
1359 case c_ne: generate_integer_test(g, p, "/="); break;
1360 case c_gr: generate_integer_test(g, p, ">"); break;
1361 case c_ge: generate_integer_test(g, p, ">="); break;
1362 case c_ls: generate_integer_test(g, p, "<"); break;
1363 case c_le: generate_integer_test(g, p, "<="); break;
1364 case c_call: generate_call(g, p); break;
1365 case c_grouping: generate_grouping(g, p, false); break;
1366 case c_non: generate_grouping(g, p, true); break;
1367 case c_name: generate_namedstring(g, p); break;
1368 case c_literalstring: generate_literalstring(g, p); break;
1369 case c_among: generate_among(g, p); break;
1370 case c_substring: generate_substring(g, p); break;
1371 case c_booltest: generate_booltest(g, p); break;
1372 case c_false: generate_false(g, p); break;
1373 case c_true: break;
1374 case c_debug: generate_debug(g, p); break;
1375 default: fprintf(stderr, "%d encountered\n", p->type);
1376 exit(1);
1377 }
1378
1379 g->failure_label = a0;
1380 str_delete(g->failure_str);
1381 g->failure_str = a1;
1382 }
1383
1384 /* Class declaration generation. */
generate_unit_start(struct generator * g)1385 static void generate_unit_start(struct generator * g) {
1386 g->margin = 0;
1387 write_start_comment(g, "-- ", NULL);
1388 }
1389
generate_method_decl(struct generator * g,struct name * q)1390 static void generate_method_decl(struct generator * g, struct name * q) {
1391 g->V[0] = q;
1392 w(g, "~Mprocedure ~W0 (Z : in out Context_Type; Result : out Boolean);~N");
1393 }
1394
generate_method_decls(struct generator * g,enum name_types type)1395 static void generate_method_decls(struct generator * g, enum name_types type) {
1396 struct name * q;
1397 struct among * a = g->analyser->amongs;
1398 int need_handler = 0;
1399
1400 for (q = g->analyser->names; q; q = q->next) {
1401 if ((enum name_types)q->type == type) {
1402 generate_method_decl(g, q);
1403 }
1404 }
1405
1406 while (a != 0 && need_handler == 0) {
1407 need_handler = need_among_handler(a);
1408 a = a->next;
1409 }
1410 if (need_handler) {
1411 w(g, "~N~Mprocedure Among_Handler (Context : in out Stemmer.Context_Type'Class; Operation : in Operation_Index; Result : out Boolean);~N");
1412 }
1413 }
1414
has_string_variable(struct generator * g)1415 static int has_string_variable(struct generator * g) {
1416 struct name * q;
1417 for (q = g->analyser->names; q; q = q->next) {
1418 g->V[0] = q;
1419 if (q->type == t_string) {
1420 return 1;
1421 }
1422 }
1423
1424 return 0;
1425 }
1426
generate_member_decls(struct generator * g)1427 static void generate_member_decls(struct generator * g) {
1428 struct name * q;
1429 int count = 0;
1430
1431
1432 for (q = g->analyser->names; q; q = q->next) {
1433 if (q->type == t_string || q->type == t_integer || q->type == t_boolean)
1434 count++;
1435 }
1436
1437 w(g, " type Context_Type is new Stemmer.Context_Type with");
1438 if (count > 0) {
1439 w(g, " record~N~+");
1440 for (q = g->analyser->names; q; q = q->next) {
1441 g->V[0] = q;
1442 switch (q->type) {
1443 case t_string:
1444 w(g, "~M~W0 : Ada.Strings.Unbounded.Unbounded_String;~N");
1445 break;
1446 case t_integer:
1447 w(g, "~M~W0 : Integer;~N");
1448 break;
1449 case t_boolean:
1450 w(g, "~M~W0 : Boolean;~N");
1451 break;
1452 }
1453 }
1454
1455 w(g, "~-");
1456 w(g, "~- end record;~N");
1457 } else {
1458 w(g, " null record;~N");
1459 }
1460 }
1461
generate_among_string(struct generator * g,struct among * x,int count)1462 static int generate_among_string(struct generator * g, struct among * x, int count) {
1463 int i;
1464 struct amongvec * v = x->b;
1465 int limit = count == 0 ? 38 : 80;
1466
1467 g->I[0] = x->number;
1468
1469 for (i = 0; i < x->literalstring_count; i++, v++) {
1470 /* Write among's string. */
1471 g->L[0] = v->b;
1472 g->I[1] = i;
1473 if (count + SIZE(v->b) > limit) {
1474 w(g, "~N~M& ");
1475 count = 3;
1476 limit = 80;
1477 } else if (count > 0) {
1478 w(g, " & ");
1479 }
1480 w(g, "~L0");
1481 count += SIZE(v->b) + 5;
1482 }
1483 return count;
1484 }
1485
generate_among_table(struct generator * g,struct among * x,int start_pos,int * operation)1486 static int generate_among_table(struct generator * g, struct among * x, int start_pos, int *operation) {
1487 int i;
1488 struct amongvec * v = x->b;
1489
1490 g->I[0] = x->number;
1491
1492 g->I[1] = x->literalstring_count - 1;
1493 w(g, "~MA_~I0 : constant Among_Array_Type (0 .. ~I1) := ~+(~N");
1494
1495 v = x->b;
1496 for (i = 0; i < x->literalstring_count; i++, v++) {
1497 g->I[1] = start_pos;
1498
1499 /* Write among's string position. */
1500 if (x->literalstring_count == 1) {
1501 w(g, "~Mothers => (~I1, ");
1502 } else {
1503 w(g, "~M(~I1, ");
1504 }
1505 start_pos = start_pos + SIZE(v->b);
1506 g->I[1] = start_pos - 1;
1507 w(g, "~I1, ");
1508
1509 /* Write among's index & result. */
1510 g->I[2] = v->i;
1511 w(g, "~I2, ");
1512 g->I[2] = v->result;
1513 w(g, "~I2, ");
1514
1515 /* Write among's handler. */
1516 if (v->function == 0) {
1517 w(g, "0)");
1518 } else {
1519 *operation = *operation + 1;
1520 g->I[1] = *operation;
1521 w(g, "~I1)");
1522 }
1523 if (i + 1 < x->literalstring_count) {
1524 w(g, ",~N");
1525 }
1526 }
1527 w(g, ");~-~N~N");
1528 return start_pos;
1529 }
1530
generate_amongs(struct generator * g)1531 static int generate_amongs(struct generator * g) {
1532 struct among * a = g->analyser->amongs;
1533 int count;
1534 int start_pos;
1535
1536 w(g, "~MAmong_String : constant String := ~+");
1537 count = 0;
1538 while (a != 0) {
1539 count = generate_among_string(g, a, count);
1540 a = a->next;
1541 }
1542 w(g, ";~N~-~N");
1543
1544 int operation = 0;
1545 start_pos = 1;
1546 a = g->analyser->amongs;
1547 while (a != 0) {
1548 start_pos = generate_among_table(g, a, start_pos, &operation);
1549 a = a->next;
1550 }
1551 return operation;
1552 }
1553
generate_constructor(struct generator * g)1554 static int generate_constructor(struct generator * g) {
1555 return generate_amongs(g);
1556 }
1557
generate_methods(struct generator * g)1558 static void generate_methods(struct generator * g) {
1559 struct node * p = g->analyser->program;
1560 while (p != 0) {
1561 generate(g, p);
1562 p = p->right;
1563 }
1564 }
1565
generate_operations_dispatcher(struct generator * g)1566 static int generate_operations_dispatcher(struct generator * g) {
1567 struct among * a = g->analyser->amongs;
1568 int i;
1569 int operation = 0;
1570
1571 w(g, "~N~Mprocedure Among_Handler (Context : in out Stemmer.Context_Type'Class; Operation : in Operation_Index; Result : out Boolean) is~N");
1572 w(g, "~Mbegin~+~N~M");
1573 w(g, "case Operation is~+~N~M");
1574 a = g->analyser->amongs;
1575 while (a != 0) {
1576 struct amongvec * v = a->b;
1577 for (i = 0; i < a->literalstring_count; i++, v++) {
1578 if (v->function != 0) {
1579 operation++;
1580 g->I[2] = operation;
1581 w(g, "when ~I2 =>~N~M");
1582 g->V[0] = v->function;
1583 w(g, " ~W0 (Context_Type (Context), Result);~N~M");
1584 }
1585 }
1586 a = a->next;
1587 }
1588 w(g, "when others =>~N~M");
1589 w(g, " Result := False;~-~N~Mend case;~-~N~M");
1590 w(g, "end Among_Handler;~N~-");
1591 return operation;
1592 }
1593
set_bit(symbol * b,int i)1594 static void set_bit(symbol * b, int i) { b[i/8] |= 1 << i%8; }
1595
generate_grouping_table(struct generator * g,struct grouping * q)1596 static void generate_grouping_table(struct generator * g, struct grouping * q) {
1597
1598 int range = q->largest_ch - q->smallest_ch + 1;
1599 int size = (range + 7)/ 8; /* assume 8 bits per symbol */
1600 symbol * b = q->b;
1601 symbol * map = create_b(size);
1602 int i;
1603 int count = 0;
1604 int need_comma = 0;
1605
1606 for (i = 0; i < size; i++) map[i] = 0;
1607
1608 /* Using unicode would require revision here */
1609
1610 for (i = 0; i < SIZE(b); i++) set_bit(map, b[i] - q->smallest_ch);
1611
1612 g->V[0] = q->name;
1613 g->I[0] = 8 * size - 1;
1614 w(g, "~N~M~W0 : constant Grouping_Array (0 .. ~I0) := (~N~+~M");
1615 for (i = 0; i < size; i++) {
1616 unsigned char m = map[i];
1617 int j;
1618 count++;
1619 if (i != 0) {
1620 w(g, ",~N~M");
1621 need_comma = 0;
1622 }
1623 for (j = 0; j < 8; j++) {
1624 if (need_comma)
1625 w(g, ", ");
1626
1627 if (m & (1 << j)) {
1628 w(g, "True");
1629 } else {
1630 w(g, "False");
1631 }
1632 need_comma = 1;
1633 }
1634 }
1635 w(g, "~N~-~M);~N");
1636
1637 lose_b(map);
1638 }
1639
generate_groupings(struct generator * g)1640 static void generate_groupings(struct generator * g) {
1641 struct grouping * q;
1642 for (q = g->analyser->groupings; q; q = q->next) {
1643 if (q->name->used)
1644 generate_grouping_table(g, q);
1645 }
1646 }
1647
generate_program_ada(struct generator * g)1648 extern void generate_program_ada(struct generator * g) {
1649
1650 g->outbuf = str_new();
1651 g->failure_str = str_new();
1652
1653 generate_unit_start(g);
1654
1655 /* generate implementation. */
1656 w(g, "package body Stemmer.");
1657 w(g, g->options->package);
1658 w(g, " is~N~+~N");
1659 w(g, "~Mpragma Style_Checks (\"-mr\");~N");
1660 w(g, "~Mpragma Warnings (Off, \"*variable*is never read and never assigned*\");~N");
1661 w(g, "~Mpragma Warnings (Off, \"*mode could be*instead of*\");~N");
1662 w(g, "~Mpragma Warnings (Off, \"*formal parameter.*is not modified*\");~N");
1663 w(g, "~Mpragma Warnings (Off, \"*this line is too long*\");~N");
1664 w(g, "~Mpragma Warnings (Off, \"*is not referenced*\");~N");
1665 w(g, "~N");
1666
1667 generate_method_decls(g, t_routine);
1668 generate_groupings(g);
1669
1670 int operations = generate_constructor(g);
1671 generate_methods(g);
1672 if (operations > 0) {
1673 generate_operations_dispatcher(g);
1674 }
1675
1676 w(g, "end Stemmer.");
1677 w(g, g->options->package);
1678 w(g, ";~N");
1679
1680 output_str(g->options->output_src, g->outbuf);
1681
1682 str_clear(g->outbuf);
1683
1684 g->margin = 0;
1685 write_start_comment(g, "-- ", NULL);
1686 if (has_string_variable(g)) {
1687 w(g, "private with Ada.Strings.Unbounded;~N");
1688 }
1689 w(g, "package Stemmer.");
1690 w(g, g->options->package);
1691 w(g, " with SPARK_Mode is~N~+");
1692 w(g, " type Context_Type is new Stemmer.Context_Type with private;~N");
1693 w(g, " procedure Stem (Z : in out Context_Type; Result : out Boolean);~N");
1694 w(g, "private~N");
1695 generate_member_decls(g);
1696 w(g, "end Stemmer.");
1697 w(g, g->options->package);
1698 w(g, ";~N");
1699 output_str(g->options->output_h, g->outbuf);
1700 str_delete(g->failure_str);
1701 str_delete(g->outbuf);
1702 }
1703