/* (C) Copyright International Business Machines Corporation 23 January */
/* 1990.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
/* SCCS Info: @(#)felex.lex	1.5 3/13/90 */

%e 1600
%p 4000
%n 500
%k 1300
%a 10000
%o 10000

%{
#include "li.h"

#undef TRUE
#undef FALSE
#undef CALLMESSAGE

#include "resdefs.h"
#include "lex-yacc.h"
#include "felex.h"
#include "tokens.h"

globinfo global;

int yyint;
double yydouble;
static char *yymembuf;

%}

letter		[a-zA-Z_]
digit		[0-9]
symbol		{letter}({letter}|{digit})*
sign            [-+]
integer		{sign}?{digit}+
exponent	[Ee]{sign}?{digit}+
real            {sign}?({digit})+"."({digit})*({exponent})?

Ada_comment	"--"
C_comment	"/*"

squote		"'"
dquote		\"
namescase	"->"
assign		":="
nequal		"<>"
lequal		"<="
gequal		">="
move		"<-"

whitespace      [ \t]+
newline		\n
error           .

%%

include(keywords.lex)

{symbol}	Treturn(T_SYMBOL);
{real}  	{ yydouble = atof(yytext); Treturn(T_REAL); }
{integer}	{ yyint = atoi(yytext); Treturn(T_INTEGER); }
{squote}        { yy_grab_str(yytext, YYLMAX, SQUOTE); Treturn(T_NAME); }
{dquote}        { yy_grab_str(yytext, YYLMAX, DQUOTE); Treturn(T_STRING); }

{Ada_comment}   { skip_comment("\n"); }
{C_comment}	{ skip_comment("*/"); }

{namescase}	Treturn(T_NAMESCASE);
{assign}	Treturn(T_ASSIGN);
{nequal}	Treturn(T_NEQUAL);
{lequal}	Treturn(T_LEQUAL);
{gequal}	Treturn(T_GEQUAL);
{move}		Treturn(T_MOVE);

"("		Treturn('(');
")"		Treturn(')');
"{"		Treturn('{');
"}"		Treturn('}');
"["		Treturn('[');
"]"		Treturn(']');
"<"		Treturn('<');
">"		Treturn('>');
","		Treturn(',');
";"		Treturn(';');
"!"		Treturn('!');
":"		Treturn(':');
"."		Treturn('.');
"#"		Treturn('#');
"="		Treturn('=');
"?"		Treturn('?');
"|"		Treturn('|');
"*"		Treturn('*');
"+"		Treturn('+');
"-"		Treturn('-');
"/"		Treturn('/');
"\\"		Treturn('\\');

{whitespace}    ;
{newline}	;
{error}         Treturn(T_ERROR);

%%

void
lexinit()
{
    extern char yysbuf[], *yysptr;

    yysptr = yysbuf;		/* we have to do this initially because */
				/*  lusing yacc does static global */
				/*  initializations.  might be others.... */

    global.lineno = 1;
    global.charno = 0;
    global.tokno = 0;
}

void
felex_setinput(infile, inbuf)
FILE *infile;
char *inbuf;
{
    if (infile) {
	yyin = infile; 
	yymembuf = nil; 
    }
    else {
	yymembuf = inbuf;
	yyin = nil;
    }
}


/* yy_grab_str - the regular expressions used by lex are maximal.  can't
   match a delimited string with "<beginning>.*<end>" because ".*" will eat
   all the input.  this routine parses a delimited string and stops at the
   first occurrence of the end delimiter. 
*/

void
yy_grab_str(strbuf, bufsiz, delim)
char *strbuf;			/* buffer to hold string or name we grab */
int bufsiz;			/* size of largest string or name we can build */
char delim;			/* end of string or name character */
{
  char c;
  int ic;
  int chars_in_buf = 0;		/* total number of chars in buffer */


  while ((ic = input()) != EOF &&
	 chars_in_buf < bufsiz )
    {
      c = (char) ic;
      if (Notprintable(c)) {
	  yyerror("Newlines may not be imbedded in string literals");
	  /* set error flag */
      }

      if (c == delim) 
	{
	  if ((ic = input()) == EOF) /* peek ahead one char */
	    break;
	  c = (char) ic;
	  if (c == delim)	/* doubled delim?  count it as one. */
	    {
	      strbuf[chars_in_buf++] = c;
	      continue;
	    }
	  else
	    {
	      unput(c);		/* real delim.  restore peek-aboo */
              break;
	    }
	}
      strbuf[chars_in_buf++] = c;
    }
  strbuf[chars_in_buf] = '\0';
}
    


/* skip_comment - again, because lex wants maximal regular expression matches
   this routine is used to skip over contents of comments.  almost like 
   yy_grab_str but doesn't worry about doubled end of string delimiters 
   representing a single occurrence of the delimiter, etc.
*/

void
skip_comment(end_of_comment)
char *end_of_comment;
{
  char c,*ceoc;
  int ic;

  ceoc = end_of_comment;	/* points to eoc char we want to match */
  do 
      {
	if ((ic = input()) == EOF)
	  return;
	c = (char) ic;
	if (c != *ceoc++)	/* match?  if yes, look at next eoc char */
	  ceoc = end_of_comment; /* if no, abort and start from beginning */
      }
  while (*ceoc);		/* stop if we match entire eoc string */
}

