%{
/* web2c.l -- lexical analysis for Tangle output.  Public domain.  */

#include "web2c.h"
#include "y_tab.h"

/* Hack to make it possible to compile the generated code with C++
   Required if you use flex. */
#ifdef __cplusplus
#define webinput yyinput
#else
#define webinput input
#endif

/* For some reason flex wants to do a system call, so we must lose our
   definition of the Pascal read.  */
#undef read

char conditional[20], negbuf[2], temp[20];
extern boolean doing_statements;


/* We only read one input file.  This is the default definition, but
   giving it ourselves avoids the need to find -lfl or -ll at link time.
   This is a good thing, since libfl.a is often installed somewhere that
   the linker doesn't search by default.  */
int
yywrap P1H(void)
{
  return 1;
}
#define YY_SKIP_YYWRAP /* not that it matters */
%}
DIGIT		[0-9]
ALPHA		[a-zA-Z]
ALPHANUM	({DIGIT}|{ALPHA})
IDENTIFIER	({ALPHA}{ALPHANUM}*)
NUMBER		({DIGIT}+)
SIGN		("+"|"-")
SIGNED		({SIGN}?{NUMBER})
WHITE		[ \n\t]+
REAL		({NUMBER}"."{NUMBER}("e"{SIGNED})?)|({NUMBER}"e"{SIGNED})
COMMENT		(("{"[^}]*"}")|("(*"([^*]|"*"[^)])*"*)"))
W		({WHITE}|"packed ")+
WW		({WHITE}|{COMMENT}|"packed ")*
HHB0		("hh"{WW}"."{WW}"b0")
HHB1		("hh"{WW}"."{WW}"b1")

%%
{W}				;
"{"		{ while (webinput() != '}'); }

"#"		{
		    register int c;
		    putc('#', out);
		    while ((c = webinput()) && c != ';')
			putc(c, out);
		    putc('\n', out);
		}

"ifdef("	{register int c;
		 register char *cp=conditional;
		 new_line();
		 while ((c = webinput()) != '\'')
		    ;
		 while ((c = webinput()) != '\'')
		    *cp++ = c;
		 *cp = '\0';
		 (void) webinput();
		 if (doing_statements) fputs("\t;\n", out);
		 fprintf(out, "#ifdef %s\n", conditional);
		}

"endif("	{register int c;
		 new_line();
		 fputs("#endif /* ", out);
		 while ((c = webinput()) != '\'')
		    ;
		 while ((c = webinput()) != '\'')
		    (void) putc(c, out);
		 (void) webinput();
		 conditional[0] = '\0';
		 fputs(" */\n", out);
		}

"ifndef("	{register int c;
		 register char *cp=conditional;
		 new_line();
		 while ((c = webinput()) != '\'')
		    ;
		 while ((c = webinput()) != '\'')
		    *cp++ = c;
		 *cp = '\0';
		 (void) webinput();
		 if (doing_statements) fputs("\t;\n", out);
		 fprintf(out, "#ifndef %s\n", conditional);
		}

"endifn("	{register int c;
		 new_line();
		 fputs("#endif /* not ", out);
		 while ((c = webinput()) != '\'')
		    ;
		 while ((c = webinput()) != '\'')
		    putc(c, out);
		 (void) webinput();
		 conditional[0] = '\0';
		 fputs(" */\n", out);
		}


"procedure "[a-z]+";"[ \n\t]*"forward;"	;

"function "[(),:a-z]+";"[ \n\t]*"forward;"	;

"@define"	return last_tok=define_tok;
"@field"	return last_tok=field_tok;
"and"		return last_tok=and_tok;
"array"		return last_tok=array_tok;
"begin"		return last_tok=begin_tok;
"case"		return last_tok=case_tok;
"const"		return last_tok=const_tok;
"div"		return last_tok=div_tok;
"break"		return last_tok=break_tok;
"do"		return last_tok=do_tok;
"downto"	return last_tok=downto_tok;
"else"		return last_tok=else_tok;
"end"		return last_tok=end_tok;
"file"		return last_tok=file_tok;
"for"		return last_tok=for_tok;
"function"	return last_tok=function_tok;
"goto"		return last_tok=goto_tok;
"if"		return last_tok=if_tok;
"label"		return last_tok=label_tok;
"mod"		return last_tok=mod_tok;
"not"		return last_tok=not_tok;
"of"		return last_tok=of_tok;
"or"		return last_tok=or_tok;
"procedure"	return last_tok=procedure_tok;
"program"	return last_tok=program_tok;
"record"	return last_tok=record_tok;
"repeat"	return last_tok=repeat_tok;
{HHB0}		return last_tok=hhb0_tok;
{HHB1}		return last_tok=hhb1_tok;
"then"		return last_tok=then_tok;
"to"		return last_tok=to_tok;
"type"		return last_tok=type_tok;
"until"		return last_tok=until_tok;
"var"		return last_tok=var_tok;
"while"		return last_tok=while_tok;
"others"	return last_tok=others_tok;

{REAL}		{		
		  sprintf (temp, "%s%s", negbuf, yytext);
		  negbuf[0] = '\0';
		  return last_tok=r_num_tok;
		}

{NUMBER}	{
		  sprintf (temp, "%s%s", negbuf, yytext);
		  negbuf[0] = '\0';
		  return last_tok=i_num_tok;
		}

("'"([^']|"''")"'")		return last_tok=single_char_tok;

("'"([^']|"''")*"'")		return last_tok=string_literal_tok;

"+"		{ if ((last_tok>=undef_id_tok &&
		      last_tok<=field_id_tok) ||
		      last_tok==i_num_tok ||
		      last_tok==r_num_tok ||
		      last_tok==')' ||
		      last_tok==']')
		   return last_tok='+';
		else return last_tok=unary_plus_tok; }

"-"		{ if ((last_tok>=undef_id_tok &&
		      last_tok<=field_id_tok) ||
		      last_tok==i_num_tok ||
		      last_tok==r_num_tok ||
		      last_tok==')' ||
		      last_tok==']')
		   return last_tok='-';
		else {
		  int c;
		  while ((c = webinput()) == ' ' || c == '\t')
                    ;
  		  unput(c);
		  if (c < '0' || c > '9') {
			return last_tok = unary_minus_tok;
		  }
		  negbuf[0] = '-';
		}}

"*"		return last_tok='*';
"/"		return last_tok='/';
"="		return last_tok='=';
"<>"		return last_tok=not_eq_tok;
"<"		return last_tok='<';
">"		return last_tok='>';
"<="		return last_tok=less_eq_tok;
">="		return last_tok=great_eq_tok;
"("		return last_tok='(';
")"		return last_tok=')';
"["		return last_tok='[';
"]"		return last_tok=']';
":="		return last_tok=assign_tok;
".."		return last_tok=two_dots_tok;
"."		return last_tok='.';
","		return last_tok=',';
";"		return last_tok=';';
":"		return last_tok=':';
"^"		return last_tok='^';

{IDENTIFIER}	{ strcpy (last_id, yytext);
		  l_s = search_table (last_id);
		  return
                    last_tok = (l_s == -1 ? undef_id_tok : sym_table[l_s].typ);
		}


.		{ /* Any bizarre token will do.  */
		  return last_tok = two_dots_tok; }
%%
/* Some helper routines.  Defining these here means we don't have references
   to yytext outside of this file.  Which means we can omit one of the more
   troublesome autoconf tests. */
void
get_string_literal P1C(char *, s)
{
    int i, j;
    j = 1;
    s[0] = '"';
    for (i=1; yytext[i-1] != 0; i++) {
        if (yytext[i] == '\\' || yytext[i] == '"')
            s[j++] = '\\';
        else if (yytext[i] == '\'')
            i++;
        s[j++] = yytext[i];
    }
    s[j-1] = '"';
    s[j] = 0;
}

void
get_single_char P1C(char *, s)
{
    s[0]='\'';
    if (yytext[1] == '\\' || yytext[1] == '\'') {
        s[1] = '\\';
        s[2] = yytext[1];
        s[3] = '\'';
        s[4] = 0;
    } else {
        s[1] = yytext[1];
        s[2] = '\'';
        s[3] = 0;
    }
}

void
get_result_type P1C(char *, s)
{
    strcpy(s, yytext);
}


/* Since a syntax error can never be recovered from, we exit here with
   bad status.  */

int
yyerror P1C(string, s)
{
  /* This is so the convert script can delete the output file on error.  */
  puts ("@error@");
  fflush (stdout);
  fputs (s, stderr);
  fprintf (stderr, ": Last token = %d (%c), ", last_tok, last_tok);
  fprintf (stderr, "error buffer = `%s',\n\t", yytext);
  fprintf (stderr, "last id = `%s' (", last_id);
  ii = search_table (last_id);
  if (ii == -1)
    fputs ("not in symbol table", stderr);
  else
    switch (sym_table[ii].typ)
      {
      case undef_id_tok:
	fputs ("undefined", stderr);
	break;
      case var_id_tok:
	fputs ("variable", stderr);
	break;
      case const_id_tok:
	fputs ("constant", stderr);
	break;
      case type_id_tok:
	fputs ("type", stderr);
	break;
      case proc_id_tok:
	fputs ("parameterless procedure", stderr);
	break;
      case proc_param_tok:
	fputs ("procedure with parameters", stderr);
	break;
      case fun_id_tok:
	fputs ("parameterless function", stderr);
	break;
      case fun_param_tok:
	fputs ("function with parameters", stderr);
	break;
      default:
	fputs ("unknown!", stderr);
	break;
      }
  fputs (").\n", stderr);
  exit (1);

  /* Avoid silly warnings.  */
  return 0;
}
