ocaml/yacc/reader.c

1860 lines
42 KiB
C

/**************************************************************************/
/* */
/* OCaml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* en Automatique. */
/* */
/* All rights reserved. This file is distributed under the terms of */
/* the GNU Lesser General Public License version 2.1, with the */
/* special exception on linking described in the file LICENSE. */
/* */
/**************************************************************************/
/* Based on public-domain code from Berkeley Yacc */
#include <string.h>
#include "defs.h"
/* The line size must be a positive integer. One hundred was chosen */
/* because few lines in Yacc input grammars exceed 100 characters. */
/* Note that if a line exceeds LINESIZE characters, the line buffer */
/* will be expanded to accommodate it. */
#define LINESIZE 100
char *cache;
int cinc, cache_size;
int ntags, tagmax;
char **tag_table;
char saw_eof;
char *cptr, *line;
int linesize;
bucket *goal;
int prec;
int gensym;
char last_was_action;
int maxitems;
bucket **pitem;
int maxrules;
bucket **plhs;
int name_pool_size;
char *name_pool;
static unsigned char caml_ident_start[32] =
"\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";
static unsigned char caml_ident_body[32] =
"\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";
#define In_bitmap(bm,c) (bm[(unsigned char)(c) >> 3] & (1 << ((c) & 7)))
void start_rule (register bucket *bp, int s_lineno);
static char *buffer;
static size_t length;
static size_t capacity;
static void push_stack(char x) {
if (length - 1 >= capacity) {
buffer = realloc(buffer, capacity = 3*length/2 + 100);
if (!buffer) no_space();
}
buffer[++length] = x;
buffer[0] = '\1';
}
static void pop_stack(char x) {
if (!buffer || buffer[length--] != x) {
switch (x) {
case '{': x = '}'; break;
case '(': x = ')'; break;
default: break;
}
fprintf(stderr, "Mismatched parentheses or braces: '%c'\n", x);
syntax_error(lineno, line, cptr - 1);
}
}
void cachec(int c)
{
assert(cinc >= 0);
if (cinc >= cache_size)
{
cache_size += 256;
cache = REALLOC(cache, cache_size);
if (cache == 0) no_space();
}
cache[cinc] = c;
++cinc;
}
void get_line(void)
{
register FILE *f = input_file;
register int c;
register int i;
if (saw_eof || (c = getc(f)) == EOF)
{
if (line) { FREE(line); line = 0; }
cptr = 0;
saw_eof = 1;
return;
}
if (line == 0 || linesize != (LINESIZE + 1))
{
if (line) FREE(line);
linesize = LINESIZE + 1;
line = MALLOC(linesize);
if (line == 0) no_space();
}
i = 0;
++lineno;
for (;;)
{
line[i] = c;
if (++i >= linesize)
{
linesize += LINESIZE;
line = REALLOC(line, linesize);
if (line == 0) no_space();
}
if (c == '\n') {
if (i >= 2 && line[i-2] == '\r') {
line[i-2] = '\n'; i--;
}
line[i] = '\0'; cptr = line; return;
}
c = getc(f);
if (c == EOF) { saw_eof = 1; c = '\n'; }
}
}
char *
dup_line(void)
{
register char *p, *s, *t;
if (line == 0) return (0);
s = line;
while (*s != '\n') ++s;
p = MALLOC(s - line + 1);
if (p == 0) no_space();
s = line;
t = p;
while ((*t++ = *s++) != '\n') continue;
return (p);
}
void skip_comment(void)
{
register char *s;
int st_lineno = lineno;
char *st_line = dup_line();
char *st_cptr = st_line + (cptr - line);
s = cptr + 2;
for (;;)
{
if (*s == '*' && s[1] == '/')
{
cptr = s + 2;
FREE(st_line);
return;
}
if (*s == '\n')
{
get_line();
if (line == 0)
unterminated_comment(st_lineno, st_line, st_cptr);
s = cptr;
}
else
++s;
}
}
static void process_quoted_string(char c, FILE *const f)
{
int s_lineno = lineno;
char *s_line = dup_line();
char *s_cptr = s_line + (cptr - line - 1);
char quote = c;
for (;;)
{
c = *cptr++;
putc(c, f);
if (c == quote)
{
FREE(s_line);
return;
}
if (c == '\n')
unterminated_string(s_lineno, s_line, s_cptr);
if (c == '\\')
{
c = *cptr++;
putc(c, f);
if (c == '\n')
{
get_line();
if (line == 0)
unterminated_string(s_lineno, s_line, s_cptr);
}
}
}
}
int process_apostrophe(FILE *const f)
{
if (cptr[0] != 0 && cptr[0] != '\\' && cptr[1] == '\'') {
fwrite(cptr, 1, 2, f);
cptr += 2;
} else if (cptr[0] == '\\'
&& (isdigit((unsigned char) cptr[1]) || cptr[1] == 'x')
&& isdigit((unsigned char) cptr[2])
&& isdigit((unsigned char) cptr[3])
&& cptr[4] == '\'') {
fwrite(cptr, 1, 5, f);
cptr += 5;
} else if (cptr[0] == '\\'
&& cptr[1] == 'o'
&& cptr[2] >= '0' && cptr[2] <= '3'
&& cptr[3] >= '0' && cptr[3] <= '7'
&& cptr[4] >= '0' && cptr[4] <= '7'
&& cptr[5] == '\'') {
fwrite(cptr, 1, 6, f);
cptr += 6;
} else if (cptr[0] == '\\' && cptr[2] == '\'') {
fwrite(cptr, 1, 3, f);
cptr += 3;
} else {
return 0;
}
return 1;
}
void process_apostrophe_body(FILE *f)
{
if (!process_apostrophe(f)) {
while (In_bitmap(caml_ident_body, *cptr)) {
putc(*cptr, f);
cptr++;
}
}
}
static void process_open_curly_bracket(FILE *f) {
char *idcptr = cptr;
if (*idcptr == '%') {
if (*++idcptr == '%') idcptr++;
if (In_bitmap(caml_ident_start, *idcptr)) {
idcptr++;
while (In_bitmap(caml_ident_body, *idcptr)) idcptr++;
while (*idcptr == '.') {
idcptr++;
if (In_bitmap(caml_ident_start, *idcptr)) {
idcptr++;
while (In_bitmap(caml_ident_body, *idcptr)) idcptr++;
}
}
while (*idcptr == ' ' || *idcptr == 9 || *idcptr == 12) idcptr++;
} else {
return;
}
}
if (In_bitmap(caml_ident_start, *idcptr) || *idcptr == '|')
{
char *newcptr = idcptr;
size_t size = 0;
char *buf;
while(In_bitmap(caml_ident_body, *newcptr)) { newcptr++; }
if (*newcptr == '|')
{ /* Raw string */
int s_lineno;
char *s_line;
char *s_cptr;
size = newcptr - idcptr;
buf = MALLOC(size + 2);
if (!buf) no_space();
memcpy(buf, idcptr, size);
buf[size] = '}';
buf[size + 1] = '\0';
fwrite(cptr, 1, newcptr - cptr + 1, f);
cptr = newcptr + 1;
s_lineno = lineno;
s_line = dup_line();
s_cptr = s_line + (cptr - line - 1);
for (;;)
{
char c = *cptr++;
putc(c, f);
if (c == '|')
{
int match = 1;
size_t i;
for (i = 0; i <= size; ++i) {
if (cptr[i] != buf[i]) {
newcptr--;
match = 0;
break;
}
}
if (match) {
FREE(s_line);
FREE(buf);
fwrite(cptr, 1, size, f);
cptr += size;
return;
}
}
if (c == '\n')
{
get_line();
if (line == 0)
unterminated_string(s_lineno, s_line, s_cptr);
}
}
FREE(buf);
return;
}
}
return;
}
static void process_comment(FILE *const f) {
char c = *cptr;
unsigned depth = 1;
if (c == '*')
{
int c_lineno = lineno;
char *c_line = dup_line();
char *c_cptr = c_line + (cptr - line - 1);
putc('*', f);
++cptr;
for (;;)
{
c = *cptr++;
putc(c, f);
switch (c)
{
case '*':
if (*cptr == ')')
{
depth--;
if (depth == 0) {
FREE(c_line);
return;
}
}
continue;
case '\n':
get_line();
if (line == 0)
unterminated_comment(c_lineno, c_line, c_cptr);
continue;
case '(':
if (*cptr == '*') ++depth;
continue;
case '\'':
process_apostrophe(f);
continue;
case '"':
process_quoted_string(c, f);
continue;
case '{':
process_open_curly_bracket(f);
continue;
default:
if (In_bitmap(caml_ident_start, c)) {
while (In_bitmap(caml_ident_body, *cptr)) putc(*cptr++, f);
}
continue;
}
}
}
}
char *substring (char *str, int start, int len)
{
int i;
char *buf = MALLOC (len+1);
if (buf == NULL) return NULL;
for (i = 0; i < len; i++){
buf[i] = str[start+i];
}
buf[i] = '\0'; /* PR#4796 */
return buf;
}
void parse_line_directive (void)
{
int i = 0, j = 0;
int line_number = 0;
char *file_name = NULL;
again:
if (line == 0) return;
if (line[i] != '#') return;
++ i;
while (line[i] == ' ' || line[i] == '\t') ++ i;
if (line[i] < '0' || line[i] > '9') return;
while (line[i] >= '0' && line[i] <= '9'){
line_number = line_number * 10 + line[i] - '0';
++ i;
}
while (line[i] == ' ' || line[i] == '\t') ++ i;
if (line[i] == '"'){
++ i;
j = i;
while (line[j] != '"' && line[j] != '\0') ++j;
if (line[j] == '"'){
file_name = substring (line, i, j - i);
if (file_name == NULL) no_space ();
}
}
lineno = line_number - 1;
if (file_name != NULL){
if (virtual_input_file_name != NULL) FREE (virtual_input_file_name);
virtual_input_file_name = file_name;
}
get_line ();
goto again;
}
int
nextc(void)
{
register char *s;
if (line == 0)
{
get_line();
parse_line_directive ();
if (line == 0)
return (EOF);
}
s = cptr;
for (;;)
{
switch (*s)
{
case '\n':
get_line();
parse_line_directive ();
if (line == 0) return (EOF);
s = cptr;
break;
case ' ':
case '\t':
case '\f':
case '\r':
case '\v':
case ',':
case ';':
++s;
break;
case '\\':
cptr = s;
return ('%');
case '/':
if (s[1] == '*')
{
cptr = s;
skip_comment();
s = cptr;
break;
}
else if (s[1] == '/')
{
get_line();
parse_line_directive ();
if (line == 0) return (EOF);
s = cptr;
break;
}
/* fall through */
default:
cptr = s;
return (*s);
}
}
}
int
keyword(void)
{
register int c;
char *t_cptr = cptr;
c = *++cptr;
if (isalpha(c))
{
cinc = 0;
for (;;)
{
if (isalpha(c))
{
if (isupper(c)) c = tolower(c);
cachec(c);
}
else if (isdigit(c) || c == '_' || c == '.' || c == '$')
cachec(c);
else
break;
c = *++cptr;
}
cachec(NUL);
if (strcmp(cache, "token") == 0 || strcmp(cache, "term") == 0)
return (TOKEN);
if (strcmp(cache, "type") == 0)
return (TYPE);
if (strcmp(cache, "left") == 0)
return (LEFT);
if (strcmp(cache, "right") == 0)
return (RIGHT);
if (strcmp(cache, "nonassoc") == 0 || strcmp(cache, "binary") == 0)
return (NONASSOC);
if (strcmp(cache, "start") == 0)
return (START);
}
else
{
++cptr;
if (c == '{')
return (TEXT);
if (c == '%' || c == '\\')
return (MARK);
if (c == '<')
return (LEFT);
if (c == '>')
return (RIGHT);
if (c == '0')
return (TOKEN);
if (c == '2')
return (NONASSOC);
}
syntax_error(lineno, line, t_cptr);
/*NOTREACHED*/
return 0;
}
void copy_text(void)
{
register int c;
register FILE *f = text_file;
int need_newline = 0;
int t_lineno = lineno;
char *t_line = dup_line();
char *t_cptr = t_line + (cptr - line - 2);
if (*cptr == '\n')
{
get_line();
if (line == 0)
unterminated_text(t_lineno, t_line, t_cptr);
}
fprintf(f, line_format, lineno, input_file_name_disp);
loop:
c = *cptr++;
switch (c)
{
case '\n':
putc('\n', f);
need_newline = 0;
get_line();
if (line) goto loop;
unterminated_text(t_lineno, t_line, t_cptr);
case '"':
putc(c, f);
process_quoted_string(c, f);
goto loop;
case '\'':
putc(c, f);
process_apostrophe_body(f);
goto loop;
case '(':
putc(c, f);
need_newline = 1;
process_comment(f);
goto loop;
case '%':
case '\\':
if (*cptr == '}')
{
if (need_newline) putc('\n', f);
++cptr;
FREE(t_line);
return;
}
/* fall through */
case '{':
putc(c, f);
process_open_curly_bracket(f);
goto loop;
default:
putc(c, f);
if (In_bitmap(caml_ident_start, c)) {
while (In_bitmap(caml_ident_body, *cptr)) {
putc(*cptr, f);
cptr++;
}
}
need_newline = 1;
goto loop;
}
}
int
hexval(int c)
{
if (c >= '0' && c <= '9')
return (c - '0');
if (c >= 'A' && c <= 'F')
return (c - 'A' + 10);
if (c >= 'a' && c <= 'f')
return (c - 'a' + 10);
return (-1);
}
bucket *
get_literal(void)
{
register int c, quote;
register int i;
register int n;
register char *s;
register bucket *bp;
int s_lineno = lineno;
char *s_line = dup_line();
char *s_cptr = s_line + (cptr - line);
quote = *cptr++;
cinc = 0;
for (;;)
{
c = *cptr++;
if (c == quote) break;
if (c == '\n') unterminated_string(s_lineno, s_line, s_cptr);
if (c == '\\')
{
char *c_cptr = cptr - 1;
c = *cptr++;
switch (c)
{
case '\n':
get_line();
if (line == 0) unterminated_string(s_lineno, s_line, s_cptr);
continue;
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
n = c - '0';
c = *cptr;
if (IS_OCTAL(c))
{
n = (n << 3) + (c - '0');
c = *++cptr;
if (IS_OCTAL(c))
{
n = (n << 3) + (c - '0');
++cptr;
}
}
if (n > MAXCHAR) illegal_character(c_cptr);
c = n;
break;
case 'x':
c = *cptr++;
n = hexval(c);
if (n < 0 || n >= 16)
illegal_character(c_cptr);
for (;;)
{
c = *cptr;
i = hexval(c);
if (i < 0 || i >= 16) break;
++cptr;
n = (n << 4) + i;
if (n > MAXCHAR) illegal_character(c_cptr);
}
c = n;
break;
case 'a': c = 7; break;
case 'b': c = '\b'; break;
case 'f': c = '\f'; break;
case 'n': c = '\n'; break;
case 'r': c = '\r'; break;
case 't': c = '\t'; break;
case 'v': c = '\v'; break;
}
}
cachec(c);
}
FREE(s_line);
n = cinc;
s = MALLOC(n);
if (s == 0) no_space();
for (i = 0; i < n; ++i)
s[i] = cache[i];
cinc = 0;
if (n == 1)
cachec('\'');
else
cachec('"');
for (i = 0; i < n; ++i)
{
c = ((unsigned char *)s)[i];
if (c == '\\' || c == cache[0])
{
cachec('\\');
cachec(c);
}
else if (isprint(c))
cachec(c);
else
{
cachec('\\');
switch (c)
{
case 7: cachec('a'); break;
case '\b': cachec('b'); break;
case '\f': cachec('f'); break;
case '\n': cachec('n'); break;
case '\r': cachec('r'); break;
case '\t': cachec('t'); break;
case '\v': cachec('v'); break;
default:
cachec(((c >> 6) & 7) + '0');
cachec(((c >> 3) & 7) + '0');
cachec((c & 7) + '0');
break;
}
}
}
if (n == 1)
cachec('\'');
else
cachec('"');
cachec(NUL);
bp = lookup(cache);
bp->class = TERM;
if (n == 1 && bp->value == UNDEFINED)
bp->value = *(unsigned char *)s;
FREE(s);
return (bp);
}
int
is_reserved(char *name)
{
char *s;
if (strcmp(name, ".") == 0 ||
strcmp(name, "$accept") == 0 ||
strcmp(name, "$end") == 0)
return (1);
if (name[0] == '$' && name[1] == '$' && isdigit((unsigned char) name[2]))
{
s = name + 3;
while (isdigit((unsigned char) *s)) ++s;
if (*s == NUL) return (1);
}
return (0);
}
bucket *
get_name(void)
{
register int c;
cinc = 0;
for (c = *cptr; IS_IDENT(c); c = *++cptr)
cachec(c);
cachec(NUL);
if (is_reserved(cache)) used_reserved(cache);
return (lookup(cache));
}
int
get_number(void)
{
register int c;
register int n;
n = 0;
for (c = *cptr; isdigit(c); c = *++cptr)
n = 10*n + (c - '0');
return (n);
}
char *
get_tag(void)
{
register int c;
register int i;
register char *s;
char *t_line = dup_line();
long bracket_depth;
cinc = 0;
bracket_depth = 0;
while (1) {
c = *++cptr;
if (c == EOF) unexpected_EOF();
if (c == '\n') syntax_error(lineno, line, cptr);
if (c == '>' && 0 == bracket_depth && cptr[-1] != '-') break;
if (c == '[') ++ bracket_depth;
if (c == ']') -- bracket_depth;
cachec(c);
}
++cptr;
cachec(NUL);
for (i = 0; i < ntags; ++i)
{
if (strcmp(cache, tag_table[i]) == 0)
return (tag_table[i]);
}
if (ntags >= tagmax)
{
tagmax += 16;
tag_table = (char **)
(tag_table ? REALLOC(tag_table, tagmax*sizeof(char *))
: MALLOC(tagmax*sizeof(char *)));
if (tag_table == 0) no_space();
}
s = MALLOC(cinc);
if (s == 0) no_space();
strcpy(s, cache);
tag_table[ntags] = s;
++ntags;
FREE(t_line);
return (s);
}
void declare_tokens(int assoc)
{
register int c;
register bucket *bp;
char *tag = 0;
if (assoc != TOKEN) ++prec;
c = nextc();
if (c == EOF) unexpected_EOF();
if (c == '<')
{
tag = get_tag();
c = nextc();
if (c == EOF) unexpected_EOF();
}
for (;;)
{
if (isalpha(c) || c == '_' || c == '.' || c == '$')
bp = get_name();
else if (c == '\'' || c == '"')
bp = get_literal();
else
return;
if (bp == goal) tokenized_start(bp->name);
bp->class = TERM;
if (tag)
{
if (bp->tag && tag != bp->tag)
retyped_warning(bp->name);
bp->tag = tag;
}
if (assoc == TOKEN)
{
bp->true_token = 1;
}
else
{
if (bp->prec && prec != bp->prec)
reprec_warning(bp->name);
bp->assoc = assoc;
bp->prec = prec;
}
if (strcmp(bp->name, "EOF") == 0)
bp->value = 0;
c = nextc();
if (c == EOF) unexpected_EOF();
if (isdigit(c))
{
int value = get_number();
if (bp->value != UNDEFINED && value != bp->value)
revalued_warning(bp->name);
bp->value = value;
c = nextc();
if (c == EOF) unexpected_EOF();
}
}
}
void declare_types(void)
{
register int c;
register bucket *bp;
char *tag;
c = nextc();
if (c == EOF) unexpected_EOF();
if (c != '<') syntax_error(lineno, line, cptr);
tag = get_tag();
for (;;)
{
c = nextc();
if (isalpha(c) || c == '_' || c == '.' || c == '$')
bp = get_name();
else if (c == '\'' || c == '"')
bp = get_literal();
else
return;
if (bp->tag && tag != bp->tag)
retyped_warning(bp->name);
bp->tag = tag;
}
}
void declare_start(void)
{
register int c;
register bucket *bp;
static int entry_counter = 0;
for (;;) {
c = nextc();
if (!isalpha(c) && c != '_' && c != '.' && c != '$') return;
bp = get_name();
if (bp->class == TERM)
terminal_start(bp->name);
if (entry_counter >= MAX_ENTRY_POINT)
too_many_entries();
bp->entry = ++entry_counter;
}
}
void read_declarations(void)
{
register int c, k;
cache_size = 256;
cache = MALLOC(cache_size);
if (cache == 0) no_space();
for (;;)
{
c = nextc();
if (c == EOF) unexpected_EOF();
if (c != '%') syntax_error(lineno, line, cptr);
switch (k = keyword())
{
case MARK:
return;
case TEXT:
copy_text();
break;
case TOKEN:
case LEFT:
case RIGHT:
case NONASSOC:
declare_tokens(k);
break;
case TYPE:
declare_types();
break;
case START:
declare_start();
break;
}
}
}
void output_token_type(void)
{
bucket * bp;
int n;
fprintf(interface_file, "type token =\n");
if (!rflag) ++outline;
fprintf(output_file, "type token =\n");
n = 0;
for (bp = first_symbol; bp; bp = bp->next) {
if (bp->class == TERM && bp->true_token) {
fprintf(interface_file, " | %s", bp->name);
fprintf(output_file, " | %s", bp->name);
if (bp->tag) {
/* Print the type expression in parentheses to make sure
that the constructor is unary */
fprintf(interface_file, " of (%s)", bp->tag);
fprintf(output_file, " of (%s)", bp->tag);
}
fprintf(interface_file, "\n");
if (!rflag) ++outline;
fprintf(output_file, "\n");
n++;
}
}
fprintf(interface_file, "\n");
if (!rflag) ++outline;
fprintf(output_file, "\n");
}
void initialize_grammar(void)
{
nitems = 4;
maxitems = 300;
pitem = (bucket **) MALLOC(maxitems*sizeof(bucket *));
if (pitem == 0) no_space();
pitem[0] = 0;
pitem[1] = 0;
pitem[2] = 0;
pitem[3] = 0;
nrules = 3;
maxrules = 100;
plhs = (bucket **) MALLOC(maxrules*sizeof(bucket *));
if (plhs == 0) no_space();
plhs[0] = 0;
plhs[1] = 0;
plhs[2] = 0;
rprec = (short *) MALLOC(maxrules*sizeof(short));
if (rprec == 0) no_space();
rprec[0] = 0;
rprec[1] = 0;
rprec[2] = 0;
rassoc = (char *) MALLOC(maxrules*sizeof(char));
if (rassoc == 0) no_space();
rassoc[0] = TOKEN;
rassoc[1] = TOKEN;
rassoc[2] = TOKEN;
}
void expand_items(void)
{
maxitems += 300;
pitem = (bucket **) REALLOC(pitem, maxitems*sizeof(bucket *));
if (pitem == 0) no_space();
}
void expand_rules(void)
{
maxrules += 100;
plhs = (bucket **) REALLOC(plhs, maxrules*sizeof(bucket *));
if (plhs == 0) no_space();
rprec = (short *) REALLOC(rprec, maxrules*sizeof(short));
if (rprec == 0) no_space();
rassoc = (char *) REALLOC(rassoc, maxrules*sizeof(char));
if (rassoc == 0) no_space();
}
void advance_to_start(void)
{
register int c;
register bucket *bp;
char *s_cptr;
int s_lineno;
for (;;)
{
c = nextc();
if (c != '%') break;
s_cptr = cptr;
switch (keyword())
{
case MARK:
no_grammar();
case TEXT:
copy_text();
break;
case START:
declare_start();
break;
default:
syntax_error(lineno, line, s_cptr);
}
}
c = nextc();
if (!isalpha(c) && c != '_' && c != '.' && c != '_')
syntax_error(lineno, line, cptr);
bp = get_name();
if (goal == 0)
{
if (bp->class == TERM)
terminal_start(bp->name);
goal = bp;
}
s_lineno = lineno;
c = nextc();
if (c == EOF) unexpected_EOF();
if (c != ':') syntax_error(lineno, line, cptr);
start_rule(bp, s_lineno);
++cptr;
}
int at_first;
void start_rule(register bucket *bp, int s_lineno)
{
if (bp->class == TERM)
terminal_lhs(s_lineno);
bp->class = NONTERM;
if (nrules >= maxrules)
expand_rules();
plhs[nrules] = bp;
rprec[nrules] = UNDEFINED;
rassoc[nrules] = TOKEN;
at_first = 1;
}
void end_rule(void)
{
if (!last_was_action) default_action_error();
last_was_action = 0;
if (nitems >= maxitems) expand_items();
pitem[nitems] = 0;
++nitems;
++nrules;
}
void insert_empty_rule(void)
{
register bucket *bp, **bpp;
assert(cache);
sprintf(cache, "$$%d", ++gensym);
bp = make_bucket(cache);
last_symbol->next = bp;
last_symbol = bp;
bp->tag = plhs[nrules]->tag;
bp->class = NONTERM;
if ((nitems += 2) > maxitems)
expand_items();
bpp = pitem + nitems - 1;
*bpp-- = bp;
while ((bpp[0] = bpp[-1])) --bpp;
if (++nrules >= maxrules)
expand_rules();
plhs[nrules] = plhs[nrules-1];
plhs[nrules-1] = bp;
rprec[nrules] = rprec[nrules-1];
rprec[nrules-1] = 0;
rassoc[nrules] = rassoc[nrules-1];
rassoc[nrules-1] = TOKEN;
}
void add_symbol(void)
{
register int c;
register bucket *bp;
int s_lineno = lineno;
char *ecptr = cptr;
c = *cptr;
if (c == '\'' || c == '"')
bp = get_literal();
else
bp = get_name();
c = nextc();
if (c == ':')
{
end_rule();
start_rule(bp, s_lineno);
++cptr;
return;
}
if (last_was_action) syntax_error (lineno, line, ecptr);
last_was_action = 0;
if (++nitems > maxitems)
expand_items();
pitem[nitems-1] = bp;
}
void copy_action(void)
{
register int c;
register int i, n;
int depth;
bucket *item;
char *tagres;
register FILE *f = action_file;
int a_lineno = lineno;
char *a_line = dup_line();
char *a_cptr = a_line + (cptr - line);
push_stack('{');
if (last_was_action) syntax_error (lineno, line, cptr);
last_was_action = 1;
/*
fprintf(f, "(* Rule %d, file %s, line %d *)\n",
nrules-2, input_file_name, lineno);
*/
if (sflag)
fprintf(f, "yyact.(%d) <- (fun __caml_parser_env ->\n", nrules-2);
else
fprintf(f, "; (fun __caml_parser_env ->\n");
n = 0;
for (i = nitems - 1; pitem[i]; --i) ++n;
for (i = 1; i <= n; i++) {
item = pitem[nitems + i - n - 1];
if (item->class == TERM && !item->tag) continue;
fprintf(f, " let _%d = ", i);
if (item->tag)
fprintf(f, "(Parsing.peek_val __caml_parser_env %d : %s) in\n", n - i,
item->tag);
else if (sflag)
fprintf(f, "Parsing.peek_val __caml_parser_env %d in\n", n - i);
else
fprintf(f, "(Parsing.peek_val __caml_parser_env %d : '%s) in\n", n - i,
item->name);
}
fprintf(f, " Obj.repr(\n");
fprintf(f, line_format, lineno, input_file_name_disp);
for (i = 0; i < cptr - line; i++) fputc(' ', f);
fputc ('(', f);
depth = 1;
cptr++;
loop:
c = *cptr;
if (c == '$')
{
if (isdigit((unsigned char) cptr[1]))
{
++cptr;
i = get_number();
if (i <= 0 || i > n)
unknown_rhs(i);
item = pitem[nitems + i - n - 1];
if (item->class == TERM && !item->tag)
illegal_token_ref(i, item->name);
fprintf(f, "_%d", i);
goto loop;
}
}
if (c == '_' || c == '$' || In_bitmap(caml_ident_start, c))
{
do
{
putc(c, f);
c = *++cptr;
} while (c == '_' || c == '$' || In_bitmap(caml_ident_body, c));
goto loop;
}
if (c == '}' && depth == 1) {
fprintf(f, ")\n# 0\n ");
cptr++;
pop_stack('{');
tagres = plhs[nrules]->tag;
if (tagres)
fprintf(f, " : %s))\n", tagres);
else if (sflag)
fprintf(f, "))\n");
else
fprintf(f, " : '%s))\n", plhs[nrules]->name);
if (sflag)
fprintf(f, "\n");
FREE(a_line);
return;
}
putc(c, f);
++cptr;
switch (c)
{
case '\n':
get_line();
if (line) goto loop;
unterminated_action(a_lineno, a_line, a_cptr);
case '{':
process_open_curly_bracket(f);
/* Even if there is a raw string, we deliberately keep the
* closing '}' in the buffer */
push_stack('{');
++depth;
goto loop;
case '}':
--depth;
pop_stack('{');
goto loop;
case '"':
process_quoted_string('"', f);
goto loop;
case '\'':
process_apostrophe_body(f);
goto loop;
case '(':
push_stack('(');
process_comment(f);
goto loop;
case ')':
pop_stack('(');
goto loop;
default:
goto loop;
}
}
int
mark_symbol(void)
{
register int c;
register bucket *bp;
c = cptr[1];
if (c == '%' || c == '\\')
{
cptr += 2;
return (1);
}
if (c == '=')
cptr += 2;
else if ((c == 'p' || c == 'P') &&
((c = cptr[2]) == 'r' || c == 'R') &&
((c = cptr[3]) == 'e' || c == 'E') &&
((c = cptr[4]) == 'c' || c == 'C') &&
((c = cptr[5], !IS_IDENT(c))))
cptr += 5;
else
syntax_error(lineno, line, cptr);
c = nextc();
if (isalpha(c) || c == '_' || c == '.' || c == '$')
bp = get_name();
else if (c == '\'' || c == '"')
bp = get_literal();
else
{
syntax_error(lineno, line, cptr);
/*NOTREACHED*/
}
if (rprec[nrules] != UNDEFINED && bp->prec != rprec[nrules])
prec_redeclared();
rprec[nrules] = bp->prec;
rassoc[nrules] = bp->assoc;
return (0);
}
void read_grammar(void)
{
register int c;
initialize_grammar();
advance_to_start();
for (;;)
{
c = nextc();
if (c == '|' && at_first){
++cptr;
c = nextc();
}
at_first = 0;
if (c == EOF) break;
if (isalpha(c) || c == '_' || c == '.' || c == '$' || c == '\'' ||
c == '"')
add_symbol();
else if (c == '{' || c == '=')
copy_action();
else if (c == '|')
{
end_rule();
start_rule(plhs[nrules-1], 0);
++cptr;
}
else if (c == '%')
{
if (mark_symbol()) break;
}
else
syntax_error(lineno, line, cptr);
}
end_rule();
}
void free_tags(void)
{
register int i;
if (tag_table == 0) return;
for (i = 0; i < ntags; ++i)
{
assert(tag_table[i]);
FREE(tag_table[i]);
}
FREE(tag_table);
}
void pack_names(void)
{
register bucket *bp;
register char *p, *s, *t;
name_pool_size = 13; /* 13 == sizeof("$end") + sizeof("$accept") */
for (bp = first_symbol; bp; bp = bp->next)
name_pool_size += strlen(bp->name) + 1;
name_pool = MALLOC(name_pool_size);
if (name_pool == 0) no_space();
strcpy(name_pool, "$accept");
strcpy(name_pool+8, "$end");
t = name_pool + 13;
for (bp = first_symbol; bp; bp = bp->next)
{
p = t;
s = bp->name;
while ((*t++ = *s++)) continue;
FREE(bp->name);
bp->name = p;
}
}
void check_symbols(void)
{
register bucket *bp;
if (goal->class == UNKNOWN)
undefined_goal(goal->name);
for (bp = first_symbol; bp; bp = bp->next)
{
if (bp->class == UNKNOWN)
{
undefined_symbol(bp->name);
bp->class = TERM;
}
}
}
void pack_symbols(void)
{
register bucket *bp;
register bucket **v;
register int i, j, k, n;
nsyms = 2;
ntokens = 1;
for (bp = first_symbol; bp; bp = bp->next)
{
++nsyms;
if (bp->class == TERM) ++ntokens;
}
start_symbol = ntokens;
nvars = nsyms - ntokens;
symbol_name = (char **) MALLOC(nsyms*sizeof(char *));
if (symbol_name == 0) no_space();
symbol_value = (short *) MALLOC(nsyms*sizeof(short));
if (symbol_value == 0) no_space();
symbol_prec = (short *) MALLOC(nsyms*sizeof(short));
if (symbol_prec == 0) no_space();
symbol_assoc = MALLOC(nsyms);
if (symbol_assoc == 0) no_space();
symbol_tag = (char **) MALLOC(nsyms*sizeof(char *));
if (symbol_tag == 0) no_space();
symbol_true_token = (char *) MALLOC(nsyms*sizeof(char));
if (symbol_true_token == 0) no_space();
v = (bucket **) MALLOC(nsyms*sizeof(bucket *));
if (v == 0) no_space();
v[0] = 0;
v[start_symbol] = 0;
i = 1;
j = start_symbol + 1;
for (bp = first_symbol; bp; bp = bp->next)
{
if (bp->class == TERM)
v[i++] = bp;
else
v[j++] = bp;
}
assert(i == ntokens && j == nsyms);
for (i = 1; i < ntokens; ++i)
v[i]->index = i;
goal->index = start_symbol + 1;
k = start_symbol + 2;
while (++i < nsyms)
if (v[i] != goal)
{
v[i]->index = k;
++k;
}
goal->value = 0;
k = 1;
for (i = start_symbol + 1; i < nsyms; ++i)
{
if (v[i] != goal)
{
v[i]->value = k;
++k;
}
}
k = 0;
for (i = 1; i < ntokens; ++i)
{
n = v[i]->value;
if (n > 256)
{
for (j = k++; j > 0 && symbol_value[j-1] > n; --j)
symbol_value[j] = symbol_value[j-1];
symbol_value[j] = n;
}
}
if (v[1]->value == UNDEFINED)
v[1]->value = 256;
j = 0;
n = 257;
for (i = 2; i < ntokens; ++i)
{
if (v[i]->value == UNDEFINED)
{
while (j < k && n == symbol_value[j])
{
while (++j < k && n == symbol_value[j]) continue;
++n;
}
v[i]->value = n;
++n;
}
}
symbol_name[0] = name_pool + 8;
symbol_value[0] = 0;
symbol_prec[0] = 0;
symbol_assoc[0] = TOKEN;
symbol_tag[0] = "";
symbol_true_token[0] = 0;
for (i = 1; i < ntokens; ++i)
{
symbol_name[i] = v[i]->name;
symbol_value[i] = v[i]->value;
symbol_prec[i] = v[i]->prec;
symbol_assoc[i] = v[i]->assoc;
symbol_tag[i] = v[i]->tag;
symbol_true_token[i] = v[i]->true_token;
}
symbol_name[start_symbol] = name_pool;
symbol_value[start_symbol] = -1;
symbol_prec[start_symbol] = 0;
symbol_assoc[start_symbol] = TOKEN;
symbol_tag[start_symbol] = "";
symbol_true_token[start_symbol] = 0;
for (++i; i < nsyms; ++i)
{
k = v[i]->index;
symbol_name[k] = v[i]->name;
symbol_value[k] = v[i]->value;
symbol_prec[k] = v[i]->prec;
symbol_assoc[k] = v[i]->assoc;
symbol_tag[i] = v[i]->tag;
symbol_true_token[i] = v[i]->true_token;
}
FREE(v);
}
static int is_polymorphic(char * s)
{
while (*s != 0) {
char c = *s++;
if (c == '\'' || c == '#') return 1;
if (c == '[') {
c = *s;
while (c == ' ' || c == '\t' || c == '\r' || c == '\n') c = *++s;
if (c == '<' || c == '>') return 1;
}
if (In_bitmap(caml_ident_start, c)) {
while (In_bitmap(caml_ident_body, *s)) s++;
}
}
return 0;
}
void make_goal(void)
{
static char name[7] = "'\\xxx'";
bucket * bp;
bucket * bc;
goal = lookup("%entry%");
ntotalrules = nrules - 2;
for(bp = first_symbol; bp != 0; bp = bp->next) {
if (bp->entry) {
start_rule(goal, 0);
if (nitems + 2> maxitems)
expand_items();
name[2] = '0' + ((bp->entry >> 6) & 7);
name[3] = '0' + ((bp->entry >> 3) & 7);
name[4] = '0' + (bp->entry & 7);
bc = lookup(name);
bc->class = TERM;
bc->value = (unsigned char) bp->entry;
pitem[nitems++] = bc;
pitem[nitems++] = bp;
if (bp->tag == NULL)
entry_without_type(bp->name);
if (is_polymorphic(bp->tag))
polymorphic_entry_point(bp->name);
fprintf(entry_file,
"let %s (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) =\n (Parsing.yyparse yytables %u lexfun lexbuf : %s)\n",
bp->name, bp->entry, bp->tag);
fprintf(interface_file,
"val %s :\n (Lexing.lexbuf -> token) -> Lexing.lexbuf -> %s\n",
bp->name,
bp->tag);
fprintf(action_file,
"(* Entry %s *)\n", bp->name);
if (sflag)
fprintf(action_file,
"yyact.(%d) <- (fun __caml_parser_env -> raise "
"(Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))\n",
ntotalrules);
else
fprintf(action_file,
"; (fun __caml_parser_env -> raise "
"(Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))\n");
ntotalrules++;
last_was_action = 1;
end_rule();
}
}
}
void pack_grammar(void)
{
register int i, j;
int assoc, prec;
ritem = (short *) MALLOC(nitems*sizeof(short));
if (ritem == 0) no_space();
rlhs = (short *) MALLOC(nrules*sizeof(short));
if (rlhs == 0) no_space();
rrhs = (short *) MALLOC((nrules+1)*sizeof(short));
if (rrhs == 0) no_space();
rprec = (short *) REALLOC(rprec, nrules*sizeof(short));
if (rprec == 0) no_space();
rassoc = REALLOC(rassoc, nrules);
if (rassoc == 0) no_space();
ritem[0] = -1;
ritem[1] = goal->index;
ritem[2] = 0;
ritem[3] = -2;
rlhs[0] = 0;
rlhs[1] = 0;
rlhs[2] = start_symbol;
rrhs[0] = 0;
rrhs[1] = 0;
rrhs[2] = 1;
j = 4;
for (i = 3; i < nrules; ++i)
{
rlhs[i] = plhs[i]->index;
rrhs[i] = j;
assoc = TOKEN;
prec = 0;
while (pitem[j])
{
ritem[j] = pitem[j]->index;
if (pitem[j]->class == TERM)
{
prec = pitem[j]->prec;
assoc = pitem[j]->assoc;
}
++j;
}
ritem[j] = -i;
++j;
if (rprec[i] == UNDEFINED)
{
rprec[i] = prec;
rassoc[i] = assoc;
}
}
rrhs[i] = j;
FREE(plhs);
FREE(pitem);
}
void print_grammar(void)
{
register int i, j, k;
int spacing = 0;
register FILE *f = verbose_file;
if (!vflag) return;
k = 1;
for (i = 2; i < nrules; ++i)
{
if (rlhs[i] != rlhs[i-1])
{
if (i != 2) fprintf(f, "\n");
fprintf(f, "%4d %s :", i - 2, symbol_name[rlhs[i]]);
spacing = strlen(symbol_name[rlhs[i]]) + 1;
}
else
{
fprintf(f, "%4d ", i - 2);
j = spacing;
while (--j >= 0) putc(' ', f);
putc('|', f);
}
while (ritem[k] >= 0)
{
fprintf(f, " %s", symbol_name[ritem[k]]);
++k;
}
++k;
putc('\n', f);
}
}
void reader(void)
{
virtual_input_file_name = caml_stat_strdup_of_os(input_file_name);
if (!virtual_input_file_name) no_space();
create_symbol_table();
read_declarations();
output_token_type();
read_grammar();
make_goal();
free_symbol_table();
free_tags();
pack_names();
check_symbols();
pack_symbols();
pack_grammar();
free_symbols();
print_grammar();
}