l4/pkg/ocaml/ocaml/contrib/yacc/reader.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the Q Public License version 1.0.               */
  10 /*                                                                     */
  11 /***********************************************************************/
  12
  13 /* Based on public-domain code from Berkeley Yacc */
  14
  15 /* $Id: reader.c 9271 2009-05-20 11:58:43Z doligez $ */
  16
  17 #include <string.h>
  18 #include "defs.h"
  19
  20 /*  The line size must be a positive integer.  One hundred was chosen      */
  21 /*  because few lines in Yacc input grammars exceed 100 characters.        */
  22 /*  Note that if a line exceeds LINESIZE characters, the line buffer       */
  23 /*  will be expanded to accomodate it.                                     */
  24
  25 #define LINESIZE 100
  26
  27 char *cache;
  28 int cinc, cache_size;
  29
  30 int ntags, tagmax;
  31 char **tag_table;
  32
  33 char saw_eof, unionized;
  34 char *cptr, *line;
  35 int linesize;
  36
  37 bucket *goal;
  38 int prec;
  39 int gensym;
  40 char last_was_action;
  41
  42 int maxitems;
  43 bucket **pitem;
  44
  45 int maxrules;
  46 bucket **plhs;
  47
  48 int name_pool_size;
  49 char *name_pool;
  50
  51 char line_format[] = "# %d \"%s\"\n";
  52
  53
  54
  55 void start_rule (register bucket *bp, int s_lineno);
  56
  57 void cachec(int c)
  58 {
  59     assert(cinc >= 0);
  60     if (cinc >= cache_size)
  61     {
  62         cache_size += 256;
  63         cache = REALLOC(cache, cache_size);
  64         if (cache == 0) no_space();
  65     }
  66     cache[cinc] = c;
  67     ++cinc;
  68 }
  69
  70
  71 void get_line(void)
  72 {
  73     register FILE *f = input_file;
  74     register int c;
  75     register int i;
  76
  77     if (saw_eof || (c = getc(f)) == EOF)
  78     {
  79         if (line) { FREE(line); line = 0; }
  80         cptr = 0;
  81         saw_eof = 1;
  82         return;
  83     }
  84
  85     if (line == 0 || linesize != (LINESIZE + 1))
  86     {
  87         if (line) FREE(line);
  88         linesize = LINESIZE + 1;
  89         line = MALLOC(linesize);
  90         if (line == 0) no_space();
  91     }
  92
  93     i = 0;
  94     ++lineno;
  95     for (;;)
  96     {
  97         line[i]  =  c;
  98         if (++i >= linesize)
  99         {
 100             linesize += LINESIZE;
 101             line = REALLOC(line, linesize);
 102             if (line ==  0) no_space();
 103         }
 104         if (c == '\n') { line[i] = '\0'; cptr = line; return; }
 105         c = getc(f);
 106         if (c ==  EOF) { saw_eof = 1; c = '\n'; }
 107     }
 108 }
 109
 110
 111 char *
 112 dup_line(void)
 113 {
 114     register char *p, *s, *t;
 115
 116     if (line == 0) return (0);
 117     s = line;
 118     while (*s != '\n') ++s;
 119     p = MALLOC(s - line + 1);
 120     if (p == 0) no_space();
 121
 122     s = line;
 123     t = p;
 124     while ((*t++ = *s++) != '\n') continue;
 125     return (p);
 126 }
 127
 128
 129 void skip_comment(void)
 130 {
 131     register char *s;
 132
 133     int st_lineno = lineno;
 134     char *st_line = dup_line();
 135     char *st_cptr = st_line + (cptr - line);
 136
 137     s = cptr + 2;
 138     for (;;)
 139     {
 140         if (*s == '*' && s[1] == '/')
 141         {
 142             cptr = s + 2;
 143             FREE(st_line);
 144             return;
 145         }
 146         if (*s == '\n')
 147         {
 148             get_line();
 149             if (line == 0)
 150                 unterminated_comment(st_lineno, st_line, st_cptr);
 151             s = cptr;
 152         }
 153         else
 154             ++s;
 155     }
 156 }
 157
 158 char *substring (char *str, int start, int len)
 159 {
 160   int i;
 161   char *buf = MALLOC (len+1);
 162   if (buf == NULL) return NULL;
 163   for (i = 0; i < len; i++){
 164     buf[i] = str[start+i];
 165   }
 166   buf[i] = '\0';      /* PR#4796 */
 167   return buf;
 168 }
 169
 170 void parse_line_directive (void)
 171 {
 172   int i = 0, j = 0;
 173   int line_number = 0;
 174   char *file_name = NULL;
 175
 176  again:
 177   if (line == 0) return;
 178   if (line[i] != '#') return;
 179   ++ i;
 180   while (line[i] == ' ' || line[i] == '\t') ++ i;
 181   if (line[i] < '0' || line[i] > '9') return;
 182   while (line[i] >= '0' && line[i] <= '9'){
 183     line_number = line_number * 10 + line[i] - '0';
 184     ++ i;
 185   }
 186   while (line[i] == ' ' || line[i] == '\t') ++ i;
 187   if (line[i] == '"'){
 188     ++ i;
 189     j = i;
 190     while (line[j] != '"' && line[j] != '\0') ++j;
 191     if (line[j] == '"'){
 192       file_name = substring (line, i, j - i);
 193       if (file_name == NULL) no_space ();
 194     }
 195   }
 196   lineno = line_number - 1;
 197   if (file_name != NULL){
 198     if (virtual_input_file_name != NULL) FREE (virtual_input_file_name);
 199     virtual_input_file_name = file_name;
 200   }
 201   get_line ();
 202   goto again;
 203 }
 204
 205 int
 206 nextc(void)
 207 {
 208     register char *s;
 209
 210     if (line == 0)
 211     {
 212         get_line();
 213         parse_line_directive ();
 214         if (line == 0)
 215             return (EOF);
 216     }
 217
 218     s = cptr;
 219     for (;;)
 220     {
 221         switch (*s)
 222         {
 223         case '\n':
 224             get_line();
 225             parse_line_directive ();
 226             if (line == 0) return (EOF);
 227             s = cptr;
 228             break;
 229
 230         case ' ':
 231         case '\t':
 232         case '\f':
 233         case '\r':
 234         case '\v':
 235         case ',':
 236         case ';':
 237             ++s;
 238             break;
 239
 240         case '\\':
 241             cptr = s;
 242             return ('%');
 243
 244         case '/':
 245             if (s[1] == '*')
 246             {
 247                 cptr = s;
 248                 skip_comment();
 249                 s = cptr;
 250                 break;
 251             }
 252             else if (s[1] == '/')
 253             {
 254                 get_line();
 255                 parse_line_directive ();
 256                 if (line == 0) return (EOF);
 257                 s = cptr;
 258                 break;
 259             }
 260             /* fall through */
 261
 262         default:
 263             cptr = s;
 264             return (*s);
 265         }
 266     }
 267 }
 268
 269
 270 int
 271 keyword(void)
 272 {
 273     register int c;
 274     char *t_cptr = cptr;
 275
 276     c = *++cptr;
 277     if (isalpha(c))
 278     {
 279         cinc = 0;
 280         for (;;)
 281         {
 282             if (isalpha(c))
 283             {
 284                 if (isupper(c)) c = tolower(c);
 285                 cachec(c);
 286             }
 287             else if (isdigit(c) || c == '_' || c == '.' || c == '$')
 288                 cachec(c);
 289             else
 290                 break;
 291             c = *++cptr;
 292         }
 293         cachec(NUL);
 294
 295         if (strcmp(cache, "token") == 0 || strcmp(cache, "term") == 0)
 296             return (TOKEN);
 297         if (strcmp(cache, "type") == 0)
 298             return (TYPE);
 299         if (strcmp(cache, "left") == 0)
 300             return (LEFT);
 301         if (strcmp(cache, "right") == 0)
 302             return (RIGHT);
 303         if (strcmp(cache, "nonassoc") == 0 || strcmp(cache, "binary") == 0)
 304             return (NONASSOC);
 305         if (strcmp(cache, "start") == 0)
 306             return (START);
 307         if (strcmp(cache, "union") == 0)
 308             return (UNION);
 309         if (strcmp(cache, "ident") == 0)
 310             return (IDENT);
 311     }
 312     else
 313     {
 314         ++cptr;
 315         if (c == '{')
 316             return (TEXT);
 317         if (c == '%' || c == '\\')
 318             return (MARK);
 319         if (c == '<')
 320             return (LEFT);
 321         if (c == '>')
 322             return (RIGHT);
 323         if (c == '0')
 324             return (TOKEN);
 325         if (c == '2')
 326             return (NONASSOC);
 327     }
 328     syntax_error(lineno, line, t_cptr);
 329     /*NOTREACHED*/
 330     return 0;
 331 }
 332
 333
 334 void copy_ident(void)
 335 {
 336     register int c;
 337     register FILE *f = output_file;
 338
 339     c = nextc();
 340     if (c == EOF) unexpected_EOF();
 341     if (c != '"') syntax_error(lineno, line, cptr);
 342     ++outline;
 343     fprintf(f, "#ident \"");
 344     for (;;)
 345     {
 346         c = *++cptr;
 347         if (c == '\n')
 348         {
 349             fprintf(f, "\"\n");
 350             return;
 351         }
 352         putc(c, f);
 353         if (c == '"')
 354         {
 355             putc('\n', f);
 356             ++cptr;
 357             return;
 358         }
 359     }
 360 }
 361
 362
 363 void copy_text(void)
 364 {
 365     register int c;
 366     int quote;
 367     register FILE *f = text_file;
 368     int need_newline = 0;
 369     int t_lineno = lineno;
 370     char *t_line = dup_line();
 371     char *t_cptr = t_line + (cptr - line - 2);
 372
 373     if (*cptr == '\n')
 374     {
 375         get_line();
 376         if (line == 0)
 377             unterminated_text(t_lineno, t_line, t_cptr);
 378     }
 379     fprintf(f, line_format, lineno, input_file_name);
 380
 381 loop:
 382     c = *cptr++;
 383     switch (c)
 384     {
 385     case '\n':
 386         putc('\n', f);
 387         need_newline = 0;
 388         get_line();
 389         if (line) goto loop;
 390         unterminated_text(t_lineno, t_line, t_cptr);
 391
 392     case '"':
 393         {
 394             int s_lineno = lineno;
 395             char *s_line = dup_line();
 396             char *s_cptr = s_line + (cptr - line - 1);
 397
 398             quote = c;
 399             putc(c, f);
 400             for (;;)
 401             {
 402                 c = *cptr++;
 403                 putc(c, f);
 404                 if (c == quote)
 405                 {
 406                     need_newline = 1;
 407                     FREE(s_line);
 408                     goto loop;
 409                 }
 410                 if (c == '\n')
 411                     unterminated_string(s_lineno, s_line, s_cptr);
 412                 if (c == '\\')
 413                 {
 414                     c = *cptr++;
 415                     putc(c, f);
 416                     if (c == '\n')
 417                     {
 418                         get_line();
 419                         if (line == 0)
 420                             unterminated_string(s_lineno, s_line, s_cptr);
 421                     }
 422                 }
 423             }
 424         }
 425
 426     case '\'':
 427         putc(c, f);
 428         if (cptr[0] != 0 && cptr[0] != '\\' && cptr[1] == '\'') {
 429           fwrite(cptr, 1, 2, f);
 430           cptr += 2;
 431         } else
 432         if (cptr[0] == '\\'
 433             && isdigit((unsigned char) cptr[1])
 434             && isdigit((unsigned char) cptr[2])
 435             && isdigit((unsigned char) cptr[3])
 436             && cptr[4] == '\'') {
 437           fwrite(cptr, 1, 5, f);
 438           cptr += 5;
 439         } else
 440         if (cptr[0] == '\\' && cptr[2] == '\'') {
 441           fwrite(cptr, 1, 3, f);
 442           cptr += 3;
 443         }
 444         goto loop;
 445
 446     case '(':
 447         putc(c, f);
 448         need_newline = 1;
 449         c = *cptr;
 450         if (c == '*')
 451         {
 452             int c_lineno = lineno;
 453             char *c_line = dup_line();
 454             char *c_cptr = c_line + (cptr - line - 1);
 455
 456             putc('*', f);
 457             ++cptr;
 458             for (;;)
 459             {
 460                 c = *cptr++;
 461                 putc(c, f);
 462                 if (c == '*' && *cptr == ')')
 463                 {
 464                     putc(')', f);
 465                     ++cptr;
 466                     FREE(c_line);
 467                     goto loop;
 468                 }
 469                 if (c == '\n')
 470                 {
 471                     get_line();
 472                     if (line == 0)
 473                         unterminated_comment(c_lineno, c_line, c_cptr);
 474                 }
 475             }
 476         }
 477         need_newline = 1;
 478         goto loop;
 479
 480     case '%':
 481     case '\\':
 482         if (*cptr == '}')
 483         {
 484             if (need_newline) putc('\n', f);
 485             ++cptr;
 486             FREE(t_line);
 487             return;
 488         }
 489         /* fall through */
 490
 491     default:
 492         putc(c, f);
 493         need_newline = 1;
 494         goto loop;
 495     }
 496 }
 497
 498
 499 void copy_union(void)
 500 {
 501     register int c;
 502     int quote;
 503     int depth;
 504     int u_lineno = lineno;
 505     char *u_line = dup_line();
 506     char *u_cptr = u_line + (cptr - line - 6);
 507
 508     if (unionized) over_unionized(cptr - 6);
 509     unionized = 1;
 510
 511     if (!lflag)
 512         fprintf(text_file, line_format, lineno, input_file_name);
 513
 514     fprintf(text_file, "typedef union");
 515     if (dflag) fprintf(union_file, "typedef union");
 516
 517     depth = 1;
 518     cptr++;
 519
 520 loop:
 521     c = *cptr++;
 522     putc(c, text_file);
 523     if (dflag) putc(c, union_file);
 524     switch (c)
 525     {
 526     case '\n':
 527         get_line();
 528         if (line == 0) unterminated_union(u_lineno, u_line, u_cptr);
 529         goto loop;
 530
 531     case '{':
 532         ++depth;
 533         goto loop;
 534
 535     case '}':
 536         --depth;
 537         if (c == '}' && depth == 0) {
 538           fprintf(text_file, " YYSTYPE;\n");
 539           FREE(u_line);
 540           return;
 541         }
 542         goto loop;
 543
 544     case '\'':
 545     case '"':
 546         {
 547             int s_lineno = lineno;
 548             char *s_line = dup_line();
 549             char *s_cptr = s_line + (cptr - line - 1);
 550
 551             quote = c;
 552             for (;;)
 553             {
 554                 c = *cptr++;
 555                 putc(c, text_file);
 556                 if (dflag) putc(c, union_file);
 557                 if (c == quote)
 558                 {
 559                     FREE(s_line);
 560                     goto loop;
 561                 }
 562                 if (c == '\n')
 563                     unterminated_string(s_lineno, s_line, s_cptr);
 564                 if (c == '\\')
 565                 {
 566                     c = *cptr++;
 567                     putc(c, text_file);
 568                     if (dflag) putc(c, union_file);
 569                     if (c == '\n')
 570                     {
 571                         get_line();
 572                         if (line == 0)
 573                             unterminated_string(s_lineno, s_line, s_cptr);
 574                     }
 575                 }
 576             }
 577         }
 578
 579     case '(':
 580         c = *cptr;
 581         if (c == '*')
 582         {
 583             int c_lineno = lineno;
 584             char *c_line = dup_line();
 585             char *c_cptr = c_line + (cptr - line - 1);
 586
 587             putc('*', text_file);
 588             if (dflag) putc('*', union_file);
 589             ++cptr;
 590             for (;;)
 591             {
 592                 c = *cptr++;
 593                 putc(c, text_file);
 594                 if (dflag) putc(c, union_file);
 595                 if (c == '*' && *cptr == ')')
 596                 {
 597                     putc(')', text_file);
 598                     if (dflag) putc(')', union_file);
 599                     ++cptr;
 600                     FREE(c_line);
 601                     goto loop;
 602                 }
 603                 if (c == '\n')
 604                 {
 605                     get_line();
 606                     if (line == 0)
 607                         unterminated_comment(c_lineno, c_line, c_cptr);
 608                 }
 609             }
 610         }
 611         goto loop;
 612
 613     default:
 614         goto loop;
 615     }
 616 }
 617
 618
 619 int
 620 hexval(int c)
 621 {
 622     if (c >= '0' && c <= '9')
 623         return (c - '0');
 624     if (c >= 'A' && c <= 'F')
 625         return (c - 'A' + 10);
 626     if (c >= 'a' && c <= 'f')
 627         return (c - 'a' + 10);
 628     return (-1);
 629 }
 630
 631
 632 bucket *
 633 get_literal(void)
 634 {
 635     register int c, quote;
 636     register int i;
 637     register int n;
 638     register char *s;
 639     register bucket *bp;
 640     int s_lineno = lineno;
 641     char *s_line = dup_line();
 642     char *s_cptr = s_line + (cptr - line);
 643
 644     quote = *cptr++;
 645     cinc = 0;
 646     for (;;)
 647     {
 648         c = *cptr++;
 649         if (c == quote) break;
 650         if (c == '\n') unterminated_string(s_lineno, s_line, s_cptr);
 651         if (c == '\\')
 652         {
 653             char *c_cptr = cptr - 1;
 654
 655             c = *cptr++;
 656             switch (c)
 657             {
 658             case '\n':
 659                 get_line();
 660                 if (line == 0) unterminated_string(s_lineno, s_line, s_cptr);
 661                 continue;
 662
 663             case '0': case '1': case '2': case '3':
 664             case '4': case '5': case '6': case '7':
 665                 n = c - '0';
 666                 c = *cptr;
 667                 if (IS_OCTAL(c))
 668                 {
 669                     n = (n << 3) + (c - '0');
 670                     c = *++cptr;
 671                     if (IS_OCTAL(c))
 672                     {
 673                         n = (n << 3) + (c - '0');
 674                         ++cptr;
 675                     }
 676                 }
 677                 if (n > MAXCHAR) illegal_character(c_cptr);
 678                 c = n;
 679                     break;
 680
 681             case 'x':
 682                 c = *cptr++;
 683                 n = hexval(c);
 684                 if (n < 0 || n >= 16)
 685                     illegal_character(c_cptr);
 686                 for (;;)
 687                 {
 688                     c = *cptr;
 689                     i = hexval(c);
 690                     if (i < 0 || i >= 16) break;
 691                     ++cptr;
 692                     n = (n << 4) + i;
 693                     if (n > MAXCHAR) illegal_character(c_cptr);
 694                 }
 695                 c = n;
 696                 break;
 697
 698             case 'a': c = 7; break;
 699             case 'b': c = '\b'; break;
 700             case 'f': c = '\f'; break;
 701             case 'n': c = '\n'; break;
 702             case 'r': c = '\r'; break;
 703             case 't': c = '\t'; break;
 704             case 'v': c = '\v'; break;
 705             }
 706         }
 707         cachec(c);
 708     }
 709     FREE(s_line);
 710
 711     n = cinc;
 712     s = MALLOC(n);
 713     if (s == 0) no_space();
 714
 715     for (i = 0; i < n; ++i)
 716         s[i] = cache[i];
 717
 718     cinc = 0;
 719     if (n == 1)
 720         cachec('\'');
 721     else
 722         cachec('"');
 723
 724     for (i = 0; i < n; ++i)
 725     {
 726         c = ((unsigned char *)s)[i];
 727         if (c == '\\' || c == cache[0])
 728         {
 729             cachec('\\');
 730             cachec(c);
 731         }
 732         else if (isprint(c))
 733             cachec(c);
 734         else
 735         {
 736             cachec('\\');
 737             switch (c)
 738             {
 739             case 7: cachec('a'); break;
 740             case '\b': cachec('b'); break;
 741             case '\f': cachec('f'); break;
 742             case '\n': cachec('n'); break;
 743             case '\r': cachec('r'); break;
 744             case '\t': cachec('t'); break;
 745             case '\v': cachec('v'); break;
 746             default:
 747                 cachec(((c >> 6) & 7) + '0');
 748                 cachec(((c >> 3) & 7) + '0');
 749                 cachec((c & 7) + '0');
 750                 break;
 751             }
 752         }
 753     }
 754
 755     if (n == 1)
 756         cachec('\'');
 757     else
 758         cachec('"');
 759
 760     cachec(NUL);
 761     bp = lookup(cache);
 762     bp->class = TERM;
 763     if (n == 1 && bp->value == UNDEFINED)
 764         bp->value = *(unsigned char *)s;
 765     FREE(s);
 766
 767     return (bp);
 768 }
 769
 770
 771 int
 772 is_reserved(char *name)
 773 {
 774     char *s;
 775
 776     if (strcmp(name, ".") == 0 ||
 777             strcmp(name, "$accept") == 0 ||
 778             strcmp(name, "$end") == 0)
 779         return (1);
 780
 781     if (name[0] == '$' && name[1] == '$' && isdigit((unsigned char) name[2]))
 782     {
 783         s = name + 3;
 784         while (isdigit((unsigned char) *s)) ++s;
 785         if (*s == NUL) return (1);
 786     }
 787
 788     return (0);
 789 }
 790
 791
 792 bucket *
 793 get_name(void)
 794 {
 795     register int c;
 796
 797     cinc = 0;
 798     for (c = *cptr; IS_IDENT(c); c = *++cptr)
 799         cachec(c);
 800     cachec(NUL);
 801
 802     if (is_reserved(cache)) used_reserved(cache);
 803
 804     return (lookup(cache));
 805 }
 806
 807
 808 int
 809 get_number(void)
 810 {
 811     register int c;
 812     register int n;
 813
 814     n = 0;
 815     for (c = *cptr; isdigit(c); c = *++cptr)
 816         n = 10*n + (c - '0');
 817
 818     return (n);
 819 }
 820
 821
 822 char *
 823 get_tag(void)
 824 {
 825     register int c;
 826     register int i;
 827     register char *s;
 828     char *t_line = dup_line();
 829     long bracket_depth;
 830
 831     cinc = 0;
 832     bracket_depth = 0;
 833     while (1) {
 834       c = *++cptr;
 835       if (c == EOF) unexpected_EOF();
 836       if (c == '\n') syntax_error(lineno, line, cptr);
 837       if (c == '>' && 0 == bracket_depth && cptr[-1] != '-') break;
 838       if (c == '[') ++ bracket_depth;
 839       if (c == ']') -- bracket_depth;
 840       cachec(c);
 841     }
 842     ++cptr;
 843     cachec(NUL);
 844
 845     for (i = 0; i < ntags; ++i)
 846     {
 847         if (strcmp(cache, tag_table[i]) == 0)
 848             return (tag_table[i]);
 849     }
 850
 851     if (ntags >= tagmax)
 852     {
 853         tagmax += 16;
 854         tag_table = (char **)
 855                         (tag_table ? REALLOC(tag_table, tagmax*sizeof(char *))
 856                                    : MALLOC(tagmax*sizeof(char *)));
 857         if (tag_table == 0) no_space();
 858     }
 859
 860     s = MALLOC(cinc);
 861     if  (s == 0) no_space();
 862     strcpy(s, cache);
 863     tag_table[ntags] = s;
 864     ++ntags;
 865     FREE(t_line);
 866     return (s);
 867 }
 868
 869
 870 void declare_tokens(int assoc)
 871 {
 872     register int c;
 873     register bucket *bp;
 874     int value;
 875     char *tag = 0;
 876
 877     if (assoc != TOKEN) ++prec;
 878
 879     c = nextc();
 880     if (c == EOF) unexpected_EOF();
 881     if (c == '<')
 882     {
 883         tag = get_tag();
 884         c = nextc();
 885         if (c == EOF) unexpected_EOF();
 886     }
 887
 888     for (;;)
 889     {
 890         if (isalpha(c) || c == '_' || c == '.' || c == '$')
 891             bp = get_name();
 892         else if (c == '\'' || c == '"')
 893             bp = get_literal();
 894         else
 895             return;
 896
 897         if (bp == goal) tokenized_start(bp->name);
 898         bp->class = TERM;
 899
 900         if (tag)
 901         {
 902             if (bp->tag && tag != bp->tag)
 903                 retyped_warning(bp->name);
 904             bp->tag = tag;
 905         }
 906
 907         if (assoc == TOKEN)
 908         {
 909             bp->true_token = 1;
 910         }
 911         else
 912         {
 913             if (bp->prec && prec != bp->prec)
 914                 reprec_warning(bp->name);
 915             bp->assoc = assoc;
 916             bp->prec = prec;
 917         }
 918
 919         if (strcmp(bp->name, "EOF") == 0)
 920             bp->value = 0;
 921
 922         c = nextc();
 923         if (c == EOF) unexpected_EOF();
 924         value = UNDEFINED;
 925         if (isdigit(c))
 926         {
 927             value = get_number();
 928             if (bp->value != UNDEFINED && value != bp->value)
 929                 revalued_warning(bp->name);
 930             bp->value = value;
 931             c = nextc();
 932             if (c == EOF) unexpected_EOF();
 933         }
 934     }
 935 }
 936
 937
 938 void declare_types(void)
 939 {
 940     register int c;
 941     register bucket *bp;
 942     char *tag;
 943
 944     c = nextc();
 945     if (c == EOF) unexpected_EOF();
 946     if (c != '<') syntax_error(lineno, line, cptr);
 947     tag = get_tag();
 948
 949     for (;;)
 950     {
 951         c = nextc();
 952         if (isalpha(c) || c == '_' || c == '.' || c == '$')
 953             bp = get_name();
 954         else if (c == '\'' || c == '"')
 955             bp = get_literal();
 956         else
 957             return;
 958
 959         if (bp->tag && tag != bp->tag)
 960             retyped_warning(bp->name);
 961         bp->tag = tag;
 962     }
 963 }
 964
 965
 966 void declare_start(void)
 967 {
 968     register int c;
 969     register bucket *bp;
 970     static int entry_counter = 0;
 971
 972     for (;;) {
 973       c = nextc();
 974       if (!isalpha(c) && c != '_' && c != '.' && c != '$') return;
 975       bp = get_name();
 976
 977       if (bp->class == TERM)
 978         terminal_start(bp->name);
 979       bp->entry = ++entry_counter;
 980       if (entry_counter == 256)
 981         too_many_entries();
 982     }
 983 }
 984
 985
 986 void read_declarations(void)
 987 {
 988     register int c, k;
 989
 990     cache_size = 256;
 991     cache = MALLOC(cache_size);
 992     if (cache == 0) no_space();
 993
 994     for (;;)
 995     {
 996         c = nextc();
 997         if (c == EOF) unexpected_EOF();
 998         if (c != '%') syntax_error(lineno, line, cptr);
 999         switch (k = keyword())
1000         {
1001         case MARK:
1002             return;
1003
1004         case IDENT:
1005             copy_ident();
1006             break;
1007
1008         case TEXT:
1009             copy_text();
1010             break;
1011
1012         case UNION:
1013             copy_union();
1014             break;
1015
1016         case TOKEN:
1017         case LEFT:
1018         case RIGHT:
1019         case NONASSOC:
1020             declare_tokens(k);
1021             break;
1022
1023         case TYPE:
1024             declare_types();
1025             break;
1026
1027         case START:
1028             declare_start();
1029             break;
1030         }
1031     }
1032 }
1033
1034 void output_token_type(void)
1035 {
1036   bucket * bp;
1037   int n;
1038
1039   fprintf(interface_file, "type token =\n");
1040   if (!rflag) ++outline;
1041   fprintf(output_file, "type token =\n");
1042   n = 0;
1043   for (bp = first_symbol; bp; bp = bp->next) {
1044     if (bp->class == TERM && bp->true_token) {
1045       fprintf(interface_file, "  | %s", bp->name);
1046       fprintf(output_file, "  | %s", bp->name);
1047       if (bp->tag) {
1048         /* Print the type expression in parentheses to make sure
1049            that the constructor is unary */
1050         fprintf(interface_file, " of (%s)", bp->tag);
1051         fprintf(output_file, " of (%s)", bp->tag);
1052       }
1053       fprintf(interface_file, "\n");
1054       if (!rflag) ++outline;
1055       fprintf(output_file, "\n");
1056       n++;
1057     }
1058   }
1059   fprintf(interface_file, "\n");
1060   if (!rflag) ++outline;
1061   fprintf(output_file, "\n");
1062 }
1063
1064 void initialize_grammar(void)
1065 {
1066     nitems = 4;
1067     maxitems = 300;
1068     pitem = (bucket **) MALLOC(maxitems*sizeof(bucket *));
1069     if (pitem == 0) no_space();
1070     pitem[0] = 0;
1071     pitem[1] = 0;
1072     pitem[2] = 0;
1073     pitem[3] = 0;
1074
1075     nrules = 3;
1076     maxrules = 100;
1077     plhs = (bucket **) MALLOC(maxrules*sizeof(bucket *));
1078     if (plhs == 0) no_space();
1079     plhs[0] = 0;
1080     plhs[1] = 0;
1081     plhs[2] = 0;
1082     rprec = (short *) MALLOC(maxrules*sizeof(short));
1083     if (rprec == 0) no_space();
1084     rprec[0] = 0;
1085     rprec[1] = 0;
1086     rprec[2] = 0;
1087     rassoc = (char *) MALLOC(maxrules*sizeof(char));
1088     if (rassoc == 0) no_space();
1089     rassoc[0] = TOKEN;
1090     rassoc[1] = TOKEN;
1091     rassoc[2] = TOKEN;
1092 }
1093
1094
1095 void expand_items(void)
1096 {
1097     maxitems += 300;
1098     pitem = (bucket **) REALLOC(pitem, maxitems*sizeof(bucket *));
1099     if (pitem == 0) no_space();
1100 }
1101
1102
1103 void expand_rules(void)
1104 {
1105     maxrules += 100;
1106     plhs = (bucket **) REALLOC(plhs, maxrules*sizeof(bucket *));
1107     if (plhs == 0) no_space();
1108     rprec = (short *) REALLOC(rprec, maxrules*sizeof(short));
1109     if (rprec == 0) no_space();
1110     rassoc = (char *) REALLOC(rassoc, maxrules*sizeof(char));
1111     if (rassoc == 0) no_space();
1112 }
1113
1114
1115 void advance_to_start(void)
1116 {
1117     register int c;
1118     register bucket *bp;
1119     char *s_cptr;
1120     int s_lineno;
1121
1122     for (;;)
1123     {
1124         c = nextc();
1125         if (c != '%') break;
1126         s_cptr = cptr;
1127         switch (keyword())
1128         {
1129         case MARK:
1130             no_grammar();
1131
1132         case TEXT:
1133             copy_text();
1134             break;
1135
1136         case START:
1137             declare_start();
1138             break;
1139
1140         default:
1141             syntax_error(lineno, line, s_cptr);
1142         }
1143     }
1144
1145     c = nextc();
1146     if (!isalpha(c) && c != '_' && c != '.' && c != '_')
1147         syntax_error(lineno, line, cptr);
1148     bp = get_name();
1149     if (goal == 0)
1150     {
1151         if (bp->class == TERM)
1152             terminal_start(bp->name);
1153         goal = bp;
1154     }
1155
1156     s_lineno = lineno;
1157     c = nextc();
1158     if (c == EOF) unexpected_EOF();
1159     if (c != ':') syntax_error(lineno, line, cptr);
1160     start_rule(bp, s_lineno);
1161     ++cptr;
1162 }
1163
1164
1165 int at_first;
1166
1167 void start_rule(register bucket *bp, int s_lineno)
1168 {
1169     if (bp->class == TERM)
1170         terminal_lhs(s_lineno);
1171     bp->class = NONTERM;
1172     if (nrules >= maxrules)
1173         expand_rules();
1174     plhs[nrules] = bp;
1175     rprec[nrules] = UNDEFINED;
1176     rassoc[nrules] = TOKEN;
1177     at_first = 1;
1178 }
1179
1180
1181 void end_rule(void)
1182 {
1183     if (!last_was_action) default_action_error();
1184
1185     last_was_action = 0;
1186     if (nitems >= maxitems) expand_items();
1187     pitem[nitems] = 0;
1188     ++nitems;
1189     ++nrules;
1190 }
1191
1192
1193 void insert_empty_rule(void)
1194 {
1195     register bucket *bp, **bpp;
1196
1197     assert(cache);
1198     sprintf(cache, "$$%d", ++gensym);
1199     bp = make_bucket(cache);
1200     last_symbol->next = bp;
1201     last_symbol = bp;
1202     bp->tag = plhs[nrules]->tag;
1203     bp->class = NONTERM;
1204
1205     if ((nitems += 2) > maxitems)
1206         expand_items();
1207     bpp = pitem + nitems - 1;
1208     *bpp-- = bp;
1209     while ((bpp[0] = bpp[-1])) --bpp;
1210
1211     if (++nrules >= maxrules)
1212         expand_rules();
1213     plhs[nrules] = plhs[nrules-1];
1214     plhs[nrules-1] = bp;
1215     rprec[nrules] = rprec[nrules-1];
1216     rprec[nrules-1] = 0;
1217     rassoc[nrules] = rassoc[nrules-1];
1218     rassoc[nrules-1] = TOKEN;
1219 }
1220
1221
1222 void add_symbol(void)
1223 {
1224     register int c;
1225     register bucket *bp;
1226     int s_lineno = lineno;
1227     char *ecptr = cptr;
1228
1229     c = *cptr;
1230     if (c == '\'' || c == '"')
1231         bp = get_literal();
1232     else
1233         bp = get_name();
1234
1235     c = nextc();
1236     if (c == ':')
1237     {
1238         end_rule();
1239         start_rule(bp, s_lineno);
1240         ++cptr;
1241         return;
1242     }
1243
1244     if (last_was_action) syntax_error (lineno, line, ecptr);
1245     last_was_action = 0;
1246
1247     if (++nitems > maxitems)
1248         expand_items();
1249     pitem[nitems-1] = bp;
1250 }
1251
1252
1253 void copy_action(void)
1254 {
1255     register int c;
1256     register int i, n;
1257     int depth;
1258     int quote;
1259     bucket *item;
1260     char *tagres;
1261     register FILE *f = action_file;
1262     int a_lineno = lineno;
1263     char *a_line = dup_line();
1264     char *a_cptr = a_line + (cptr - line);
1265
1266     if (last_was_action) syntax_error (lineno, line, cptr);
1267     last_was_action = 1;
1268
1269     /*
1270       fprintf(f, "(* Rule %d, file %s, line %d *)\n",
1271             nrules-2, input_file_name, lineno);
1272             */
1273     if (sflag)
1274       fprintf(f, "yyact.(%d) <- (fun __caml_parser_env ->\n", nrules-2);
1275     else
1276       fprintf(f, "; (fun __caml_parser_env ->\n");
1277
1278     n = 0;
1279     for (i = nitems - 1; pitem[i]; --i) ++n;
1280
1281     for (i = 1; i <= n; i++) {
1282       item = pitem[nitems + i - n - 1];
1283       if (item->class == TERM && !item->tag) continue;
1284       fprintf(f, "    let _%d = ", i);
1285       if (item->tag)
1286         fprintf(f, "(Parsing.peek_val __caml_parser_env %d : %s) in\n", n - i,
1287                 item->tag);
1288       else if (sflag)
1289         fprintf(f, "Parsing.peek_val __caml_parser_env %d in\n", n - i);
1290       else
1291         fprintf(f, "(Parsing.peek_val __caml_parser_env %d : '%s) in\n", n - i,
1292                 item->name);
1293     }
1294     fprintf(f, "    Obj.repr(\n");
1295     fprintf(f, line_format, lineno, input_file_name);
1296     for (i = 0; i < cptr - line; i++) fputc(' ', f);
1297     fputc ('(', f);
1298
1299     depth = 1;
1300     cptr++;
1301
1302 loop:
1303     c = *cptr;
1304     if (c == '$')
1305     {
1306         if (isdigit((unsigned char) cptr[1]))
1307         {
1308             ++cptr;
1309             i = get_number();
1310
1311             if (i <= 0 || i > n)
1312               unknown_rhs(i);
1313             item = pitem[nitems + i - n - 1];
1314             if (item->class == TERM && !item->tag)
1315               illegal_token_ref(i, item->name);
1316             fprintf(f, "_%d", i);
1317             goto loop;
1318         }
1319     }
1320     if (isalpha(c) || c == '_' || c == '$')
1321     {
1322         do
1323         {
1324             putc(c, f);
1325             c = *++cptr;
1326         } while (isalnum(c) || c == '_' || c == '$');
1327         goto loop;
1328     }
1329     if (c == '}' && depth == 1) {
1330       fprintf(f, ")\n# 0\n              ");
1331       cptr++;
1332       tagres = plhs[nrules]->tag;
1333       if (tagres)
1334         fprintf(f, " : %s))\n", tagres);
1335       else if (sflag)
1336         fprintf(f, "))\n");
1337       else
1338         fprintf(f, " : '%s))\n", plhs[nrules]->name);
1339       if (sflag)
1340         fprintf(f, "\n");
1341       return;
1342     }
1343     putc(c, f);
1344     ++cptr;
1345     switch (c)
1346     {
1347     case '\n':
1348         get_line();
1349         if (line) goto loop;
1350         unterminated_action(a_lineno, a_line, a_cptr);
1351
1352     case '{':
1353         ++depth;
1354         goto loop;
1355
1356     case '}':
1357         --depth;
1358         goto loop;
1359
1360     case '"':
1361         {
1362             int s_lineno = lineno;
1363             char *s_line = dup_line();
1364             char *s_cptr = s_line + (cptr - line - 1);
1365
1366             quote = c;
1367             for (;;)
1368             {
1369                 c = *cptr++;
1370                 putc(c, f);
1371                 if (c == quote)
1372                 {
1373                     FREE(s_line);
1374                     goto loop;
1375                 }
1376                 if (c == '\n')
1377                     unterminated_string(s_lineno, s_line, s_cptr);
1378                 if (c == '\\')
1379                 {
1380                     c = *cptr++;
1381                     putc(c, f);
1382                     if (c == '\n')
1383                     {
1384                         get_line();
1385                         if (line == 0)
1386                             unterminated_string(s_lineno, s_line, s_cptr);
1387                     }
1388                 }
1389             }
1390         }
1391
1392     case '\'':
1393         if (cptr[0] != 0 && cptr[0] != '\\' && cptr[1] == '\'') {
1394           fwrite(cptr, 1, 2, f);
1395           cptr += 2;
1396         } else
1397         if (cptr[0] == '\\'
1398             && isdigit((unsigned char) cptr[1])
1399             && isdigit((unsigned char) cptr[2])
1400             && isdigit((unsigned char) cptr[3])
1401             && cptr[4] == '\'') {
1402           fwrite(cptr, 1, 5, f);
1403           cptr += 5;
1404         } else
1405         if (cptr[0] == '\\' && cptr[2] == '\'') {
1406           fwrite(cptr, 1, 3, f);
1407           cptr += 3;
1408         }
1409         goto loop;
1410
1411     case '(':
1412         c = *cptr;
1413         if (c == '*')
1414         {
1415             int c_lineno = lineno;
1416             char *c_line = dup_line();
1417             char *c_cptr = c_line + (cptr - line - 1);
1418
1419             putc('*', f);
1420             ++cptr;
1421             for (;;)
1422             {
1423                 c = *cptr++;
1424                 putc(c, f);
1425                 if (c == '*' && *cptr == ')')
1426                 {
1427                     putc(')', f);
1428                     ++cptr;
1429                     FREE(c_line);
1430                     goto loop;
1431                 }
1432                 if (c == '\n')
1433                 {
1434                     get_line();
1435                     if (line == 0)
1436                         unterminated_comment(c_lineno, c_line, c_cptr);
1437                 }
1438             }
1439         }
1440         goto loop;
1441
1442     default:
1443         goto loop;
1444     }
1445 }
1446
1447
1448 int
1449 mark_symbol(void)
1450 {
1451     register int c;
1452     register bucket *bp;
1453
1454     c = cptr[1];
1455     if (c == '%' || c == '\\')
1456     {
1457         cptr += 2;
1458         return (1);
1459     }
1460
1461     if (c == '=')
1462         cptr += 2;
1463     else if ((c == 'p' || c == 'P') &&
1464              ((c = cptr[2]) == 'r' || c == 'R') &&
1465              ((c = cptr[3]) == 'e' || c == 'E') &&
1466              ((c = cptr[4]) == 'c' || c == 'C') &&
1467              ((c = cptr[5], !IS_IDENT(c))))
1468         cptr += 5;
1469     else
1470         syntax_error(lineno, line, cptr);
1471
1472     c = nextc();
1473     if (isalpha(c) || c == '_' || c == '.' || c == '$')
1474         bp = get_name();
1475     else if (c == '\'' || c == '"')
1476         bp = get_literal();
1477     else
1478     {
1479         syntax_error(lineno, line, cptr);
1480         /*NOTREACHED*/
1481     }
1482
1483     if (rprec[nrules] != UNDEFINED && bp->prec != rprec[nrules])
1484         prec_redeclared();
1485
1486     rprec[nrules] = bp->prec;
1487     rassoc[nrules] = bp->assoc;
1488     return (0);
1489 }
1490
1491
1492 void read_grammar(void)
1493 {
1494     register int c;
1495
1496     initialize_grammar();
1497     advance_to_start();
1498
1499     for (;;)
1500     {
1501         c = nextc();
1502         if (c == '|' && at_first){
1503           ++cptr;
1504           c = nextc();
1505         }
1506         at_first = 0;
1507         if (c == EOF) break;
1508         if (isalpha(c) || c == '_' || c == '.' || c == '$' || c == '\'' ||
1509                 c == '"')
1510             add_symbol();
1511         else if (c == '{' || c == '=')
1512             copy_action();
1513         else if (c == '|')
1514         {
1515             end_rule();
1516             start_rule(plhs[nrules-1], 0);
1517             ++cptr;
1518         }
1519         else if (c == '%')
1520         {
1521             if (mark_symbol()) break;
1522         }
1523         else
1524             syntax_error(lineno, line, cptr);
1525     }
1526     end_rule();
1527 }
1528
1529
1530 void free_tags(void)
1531 {
1532     register int i;
1533
1534     if (tag_table == 0) return;
1535
1536     for (i = 0; i < ntags; ++i)
1537     {
1538         assert(tag_table[i]);
1539         FREE(tag_table[i]);
1540     }
1541     FREE(tag_table);
1542 }
1543
1544
1545 void pack_names(void)
1546 {
1547     register bucket *bp;
1548     register char *p, *s, *t;
1549
1550     name_pool_size = 13;  /* 13 == sizeof("$end") + sizeof("$accept") */
1551     for (bp = first_symbol; bp; bp = bp->next)
1552         name_pool_size += strlen(bp->name) + 1;
1553     name_pool = MALLOC(name_pool_size);
1554     if (name_pool == 0) no_space();
1555
1556     strcpy(name_pool, "$accept");
1557     strcpy(name_pool+8, "$end");
1558     t = name_pool + 13;
1559     for (bp = first_symbol; bp; bp = bp->next)
1560     {
1561         p = t;
1562         s = bp->name;
1563         while ((*t++ = *s++)) continue;
1564         FREE(bp->name);
1565         bp->name = p;
1566     }
1567 }
1568
1569
1570 void check_symbols(void)
1571 {
1572     register bucket *bp;
1573
1574     if (goal->class == UNKNOWN)
1575         undefined_goal(goal->name);
1576
1577     for (bp = first_symbol; bp; bp = bp->next)
1578     {
1579         if (bp->class == UNKNOWN)
1580         {
1581             undefined_symbol(bp->name);
1582             bp->class = TERM;
1583         }
1584     }
1585 }
1586
1587
1588 void pack_symbols(void)
1589 {
1590     register bucket *bp;
1591     register bucket **v;
1592     register int i, j, k, n;
1593
1594     nsyms = 2;
1595     ntokens = 1;
1596     for (bp = first_symbol; bp; bp = bp->next)
1597     {
1598         ++nsyms;
1599         if (bp->class == TERM) ++ntokens;
1600     }
1601     start_symbol = ntokens;
1602     nvars = nsyms - ntokens;
1603
1604     symbol_name = (char **) MALLOC(nsyms*sizeof(char *));
1605     if (symbol_name == 0) no_space();
1606     symbol_value = (short *) MALLOC(nsyms*sizeof(short));
1607     if (symbol_value == 0) no_space();
1608     symbol_prec = (short *) MALLOC(nsyms*sizeof(short));
1609     if (symbol_prec == 0) no_space();
1610     symbol_assoc = MALLOC(nsyms);
1611     if (symbol_assoc == 0) no_space();
1612     symbol_tag = (char **) MALLOC(nsyms*sizeof(char *));
1613     if (symbol_tag == 0) no_space();
1614     symbol_true_token = (char *) MALLOC(nsyms*sizeof(char));
1615     if (symbol_true_token == 0) no_space();
1616
1617     v = (bucket **) MALLOC(nsyms*sizeof(bucket *));
1618     if (v == 0) no_space();
1619
1620     v[0] = 0;
1621     v[start_symbol] = 0;
1622
1623     i = 1;
1624     j = start_symbol + 1;
1625     for (bp = first_symbol; bp; bp = bp->next)
1626     {
1627         if (bp->class == TERM)
1628             v[i++] = bp;
1629         else
1630             v[j++] = bp;
1631     }
1632     assert(i == ntokens && j == nsyms);
1633
1634     for (i = 1; i < ntokens; ++i)
1635         v[i]->index = i;
1636
1637     goal->index = start_symbol + 1;
1638     k = start_symbol + 2;
1639     while (++i < nsyms)
1640         if (v[i] != goal)
1641         {
1642             v[i]->index = k;
1643             ++k;
1644         }
1645
1646     goal->value = 0;
1647     k = 1;
1648     for (i = start_symbol + 1; i < nsyms; ++i)
1649     {
1650         if (v[i] != goal)
1651         {
1652             v[i]->value = k;
1653             ++k;
1654         }
1655     }
1656
1657     k = 0;
1658     for (i = 1; i < ntokens; ++i)
1659     {
1660         n = v[i]->value;
1661         if (n > 256)
1662         {
1663             for (j = k++; j > 0 && symbol_value[j-1] > n; --j)
1664                 symbol_value[j] = symbol_value[j-1];
1665             symbol_value[j] = n;
1666         }
1667     }
1668
1669     if (v[1]->value == UNDEFINED)
1670         v[1]->value = 256;
1671
1672     j = 0;
1673     n = 257;
1674     for (i = 2; i < ntokens; ++i)
1675     {
1676         if (v[i]->value == UNDEFINED)
1677         {
1678             while (j < k && n == symbol_value[j])
1679             {
1680                 while (++j < k && n == symbol_value[j]) continue;
1681                 ++n;
1682             }
1683             v[i]->value = n;
1684             ++n;
1685         }
1686     }
1687
1688     symbol_name[0] = name_pool + 8;
1689     symbol_value[0] = 0;
1690     symbol_prec[0] = 0;
1691     symbol_assoc[0] = TOKEN;
1692     symbol_tag[0] = "";
1693     symbol_true_token[0] = 0;
1694     for (i = 1; i < ntokens; ++i)
1695     {
1696         symbol_name[i] = v[i]->name;
1697         symbol_value[i] = v[i]->value;
1698         symbol_prec[i] = v[i]->prec;
1699         symbol_assoc[i] = v[i]->assoc;
1700         symbol_tag[i] = v[i]->tag;
1701         symbol_true_token[i] = v[i]->true_token;
1702     }
1703     symbol_name[start_symbol] = name_pool;
1704     symbol_value[start_symbol] = -1;
1705     symbol_prec[start_symbol] = 0;
1706     symbol_assoc[start_symbol] = TOKEN;
1707     symbol_tag[start_symbol] = "";
1708     symbol_true_token[start_symbol] = 0;
1709     for (++i; i < nsyms; ++i)
1710     {
1711         k = v[i]->index;
1712         symbol_name[k] = v[i]->name;
1713         symbol_value[k] = v[i]->value;
1714         symbol_prec[k] = v[i]->prec;
1715         symbol_assoc[k] = v[i]->assoc;
1716         symbol_tag[i] = v[i]->tag;
1717         symbol_true_token[i] = v[i]->true_token;
1718     }
1719
1720     FREE(v);
1721 }
1722
1723 static unsigned char caml_ident_start[32] =
1724 "\000\000\000\000\000\000\000\000\376\377\377\207\376\377\377\007\000\000\000\000\000\000\000\000\377\377\177\377\377\377\177\377";
1725 static unsigned char caml_ident_body[32] =
1726 "\000\000\000\000\200\000\377\003\376\377\377\207\376\377\377\007\000\000\000\000\000\000\000\000\377\377\177\377\377\377\177\377";
1727
1728 #define In_bitmap(bm,c) (bm[(unsigned char)(c) >> 3] & (1 << ((c) & 7)))
1729
1730 static int is_polymorphic(char * s)
1731 {
1732   while (*s != 0) {
1733     char c = *s++;
1734     if (c == '\'' || c == '#') return 1;
1735     if (c == '[') {
1736       c = *s;
1737       while (c == ' ' || c == '\t' || c == '\r' || c == '\n') c = *++s;
1738       if (c == '<' || c == '>') return 1;
1739     }
1740     if (In_bitmap(caml_ident_start, c)) {
1741       while (In_bitmap(caml_ident_body, *s)) s++;
1742     }
1743   }
1744   return 0;
1745 }
1746
1747 void make_goal(void)
1748 {
1749   static char name[7] = "'\\xxx'";
1750   bucket * bp;
1751   bucket * bc;
1752
1753   goal = lookup("%entry%");
1754   ntotalrules = nrules - 2;
1755   for(bp = first_symbol; bp != 0; bp = bp->next) {
1756     if (bp->entry) {
1757       start_rule(goal, 0);
1758       if (nitems + 2> maxitems)
1759         expand_items();
1760       name[2] = '0' + ((bp->entry >> 6) & 7);
1761       name[3] = '0' + ((bp->entry >> 3) & 7);
1762       name[4] = '0' + (bp->entry & 7);
1763       bc = lookup(name);
1764       bc->class = TERM;
1765       bc->value = (unsigned char) bp->entry;
1766       pitem[nitems++] = bc;
1767       pitem[nitems++] = bp;
1768       if (bp->tag == NULL)
1769         entry_without_type(bp->name);
1770       if (is_polymorphic(bp->tag))
1771         polymorphic_entry_point(bp->name);
1772       fprintf(entry_file,
1773               "let %s (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) =\n   (Parsing.yyparse yytables %d lexfun lexbuf : %s)\n",
1774               bp->name, bp->entry, bp->tag);
1775       fprintf(interface_file,
1776               "val %s :\n  (Lexing.lexbuf  -> token) -> Lexing.lexbuf -> %s\n",
1777               bp->name,
1778               bp->tag);
1779       fprintf(action_file,
1780               "(* Entry %s *)\n", bp->name);
1781       if (sflag)
1782         fprintf(action_file,
1783                 "yyact.(%d) <- (fun __caml_parser_env -> raise "
1784                 "(Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))\n",
1785                 ntotalrules);
1786       else
1787         fprintf(action_file,
1788                 "; (fun __caml_parser_env -> raise "
1789                 "(Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))\n");
1790       ntotalrules++;
1791       last_was_action = 1;
1792       end_rule();
1793     }
1794   }
1795 }
1796
1797 void pack_grammar(void)
1798 {
1799     register int i, j;
1800     int assoc, prec;
1801
1802     ritem = (short *) MALLOC(nitems*sizeof(short));
1803     if (ritem == 0) no_space();
1804     rlhs = (short *) MALLOC(nrules*sizeof(short));
1805     if (rlhs == 0) no_space();
1806     rrhs = (short *) MALLOC((nrules+1)*sizeof(short));
1807     if (rrhs == 0) no_space();
1808     rprec = (short *) REALLOC(rprec, nrules*sizeof(short));
1809     if (rprec == 0) no_space();
1810     rassoc = REALLOC(rassoc, nrules);
1811     if (rassoc == 0) no_space();
1812
1813     ritem[0] = -1;
1814     ritem[1] = goal->index;
1815     ritem[2] = 0;
1816     ritem[3] = -2;
1817     rlhs[0] = 0;
1818     rlhs[1] = 0;
1819     rlhs[2] = start_symbol;
1820     rrhs[0] = 0;
1821     rrhs[1] = 0;
1822     rrhs[2] = 1;
1823
1824     j = 4;
1825     for (i = 3; i < nrules; ++i)
1826     {
1827         rlhs[i] = plhs[i]->index;
1828         rrhs[i] = j;
1829         assoc = TOKEN;
1830         prec = 0;
1831         while (pitem[j])
1832         {
1833             ritem[j] = pitem[j]->index;
1834             if (pitem[j]->class == TERM)
1835             {
1836                 prec = pitem[j]->prec;
1837                 assoc = pitem[j]->assoc;
1838             }
1839             ++j;
1840         }
1841         ritem[j] = -i;
1842         ++j;
1843         if (rprec[i] == UNDEFINED)
1844         {
1845             rprec[i] = prec;
1846             rassoc[i] = assoc;
1847         }
1848     }
1849     rrhs[i] = j;
1850
1851     FREE(plhs);
1852     FREE(pitem);
1853 }
1854
1855
1856 void print_grammar(void)
1857 {
1858     register int i, j, k;
1859     int spacing = 0;
1860     register FILE *f = verbose_file;
1861
1862     if (!vflag) return;
1863
1864     k = 1;
1865     for (i = 2; i < nrules; ++i)
1866     {
1867         if (rlhs[i] != rlhs[i-1])
1868         {
1869             if (i != 2) fprintf(f, "\n");
1870             fprintf(f, "%4d  %s :", i - 2, symbol_name[rlhs[i]]);
1871             spacing = strlen(symbol_name[rlhs[i]]) + 1;
1872         }
1873         else
1874         {
1875             fprintf(f, "%4d  ", i - 2);
1876             j = spacing;
1877             while (--j >= 0) putc(' ', f);
1878             putc('|', f);
1879         }
1880
1881         while (ritem[k] >= 0)
1882         {
1883             fprintf(f, " %s", symbol_name[ritem[k]]);
1884             ++k;
1885         }
1886         ++k;
1887         putc('\n', f);
1888     }
1889 }
1890
1891
1892 void reader(void)
1893 {
1894     virtual_input_file_name = substring (input_file_name, 0,
1895                                          strlen (input_file_name));
1896     create_symbol_table();
1897     read_declarations();
1898     output_token_type();
1899     read_grammar();
1900     make_goal();
1901     free_symbol_table();
1902     free_tags();
1903     pack_names();
1904     check_symbols();
1905     pack_symbols();
1906     pack_grammar();
1907     free_symbols();
1908     print_grammar();
1909 }