(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi

   yacc.lex: Lexer specification

  2012-1-13 ohori
  %footer added for defuncteringing ml.grm.sml
 *)

structure Tokens = LrVals.Tokens
type pos = int
type token = Tokens.token
type lexresult = token

type lexarg = Header.inputSource
type arg = lexarg

open Tokens
val error = Header.error
val lineno = Header.lineno
val text = Header.text

val pcount = ref 0
val commentLevel = ref 0
val actionstart = ref 0

val eof = fn i => (if (!pcount)>0 then
			error i (!actionstart)
			      " eof encountered in action beginning here !"
		   else (); EOF(!lineno,!lineno))

val Add = fn s => (text := s::(!text))

local val dict = 
  [("%prec",PREC_TAG),
   ("%term",TERM),
   ("%nonterm",NONTERM), 
   ("%eop",PERCENT_EOP),
   ("%start",START),
   ("%prefer",PREFER),
   ("%subst",SUBST),
   ("%change",CHANGE),
   ("%keyword",KEYWORD),
   ("%name",NAME),
   ("%verbose",VERBOSE), 
   ("%nodefault",NODEFAULT),
   ("%value",VALUE), 
   ("%noshift",NOSHIFT),
   ("%header",PERCENT_HEADER),
   ("%footer",PERCENT_FOOTER), 
   ("%decompose",PERCENT_DECOMPOSE),
   ("%blocksize",PERCENT_BLOCKSIZE),
   ("%pure",PERCENT_PURE),
   ("%token_sig_info",PERCENT_TOKEN_SIG_INFO),
   ("%arg",PERCENT_ARG),
   ("%pos",PERCENT_POS)]
in
fun lookup (s,left,right) = let
       fun f ((a,d)::b) = if a=s then d(left,right) else f b
	 | f nil = UNKNOWN(s,left,right)
       in
	  f dict
       end
end

fun inc (ri as ref i) = (ri := i+1)
fun dec (ri as ref i) = (ri := i-1)

%%
%header (
structure LexMLYACC
);
%arg (inputSource);
%s A CODE F COMMENT STRING EMPTYCOMMENT;
ws = [\t\ ]+;
eol=("\n"|"\013\n"|"\013");
idchars = [A-Za-z_'0-9];
id=[A-Za-z]{idchars}*;
tyvar="'"{idchars}*;
qualid ={id}".";
%%
<INITIAL>"(*"	=> (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
		    continue(); YYBEGIN INITIAL; continue());
<A>"(*"		=> (YYBEGIN EMPTYCOMMENT; commentLevel := 1; continue());
<CODE>"(*"	=> (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
		    continue(); YYBEGIN CODE; continue());
<INITIAL>[^(%\013\n]+ => (Add yytext; continue());
<INITIAL>"%%"	 => (YYBEGIN A; HEADER (concat (rev (!text)),!lineno,!lineno));
<INITIAL,CODE,COMMENT,F,EMPTYCOMMENT>{eol}  => (Add yytext; inc lineno; continue());
<INITIAL>.	 => (Add yytext; continue());

<A>{eol}	=> (inc lineno; continue ());
<A>{ws}+	=> (continue());
<A>of		=> (OF(!lineno,!lineno));
<A>for		=> (FOR(!lineno,!lineno));
<A>"{"		=> (LBRACE(!lineno,!lineno));
<A>"}"		=> (RBRACE(!lineno,!lineno));
<A>","		=> (COMMA(!lineno,!lineno));
<A>"*"		=> (ASTERISK(!lineno,!lineno));
<A>"->"		=> (ARROW(!lineno,!lineno));
<A>"%left"	=> (PREC(Header.LEFT,!lineno,!lineno));
<A>"%right"	=> (PREC(Header.RIGHT,!lineno,!lineno));
<A>"%nonassoc" 	=> (PREC(Header.NONASSOC,!lineno,!lineno));
<A>"%"[a-z_]+	=> (lookup(yytext,!lineno,!lineno));
<A>{tyvar}	=> (TYVAR(yytext,!lineno,!lineno));
<A>{qualid}	=> (IDDOT(yytext,!lineno,!lineno));
<A>[0-9]+	=> (INT (yytext,!lineno,!lineno));
<A>"%%"		=> (DELIMITER(!lineno,!lineno));
<A>":"		=> (COLON(!lineno,!lineno));
<A>"|"		=> (BAR(!lineno,!lineno));
<A>{id}		=> (ID ((yytext,!lineno),!lineno,!lineno));
<A>"("		=> (pcount := 1; actionstart := (!lineno);
		    text := nil; YYBEGIN CODE; continue() before YYBEGIN A);
<A>.		=> (UNKNOWN(yytext,!lineno,!lineno));
<CODE>"("	=> (inc pcount; Add yytext; continue());
<CODE>")"	=> (dec pcount;
		    if !pcount = 0 then
			 PROG (concat (rev (!text)),!lineno,!lineno)
		    else (Add yytext; continue()));
<CODE>"\""	=> (Add yytext; YYBEGIN STRING; continue());
<CODE>[^()"\n\013]+ => (Add yytext; continue());

<COMMENT>[(*)]	=> (Add yytext; continue());
<COMMENT>"*)"	=> (Add yytext; dec commentLevel;
		    if !commentLevel=0
			 then BOGUS_VALUE(!lineno,!lineno)
			 else continue()
		   );
<COMMENT>"(*"	=> (Add yytext; inc commentLevel; continue());
<COMMENT>[^*()\n\013]+ => (Add yytext; continue());

<EMPTYCOMMENT>[(*)]  => (continue());
<EMPTYCOMMENT>"*)"   => (dec commentLevel;
		          if !commentLevel=0 then YYBEGIN A else ();
			  continue ());
<EMPTYCOMMENT>"(*"   => (inc commentLevel; continue());
<EMPTYCOMMENT>[^*()\n\013]+ => (continue());

<STRING>"\""	=> (Add yytext; YYBEGIN CODE; continue());
<STRING>\\	=> (Add yytext; continue());
<STRING>{eol}	=> (Add yytext; error inputSource (!lineno) "unclosed string";
 	            inc lineno; YYBEGIN CODE; continue());
<STRING>[^"\\\n\013]+ => (Add yytext; continue());
<STRING>\\\"	=> (Add yytext; continue());
<STRING>\\{eol} => (Add yytext; inc lineno; YYBEGIN F; continue());
<STRING>\\[\ \t] => (Add yytext; YYBEGIN F; continue());

<F>{ws}		=> (Add yytext; continue());
<F>\\		=> (Add yytext; YYBEGIN STRING; continue());
<F>.		=> (Add yytext; error inputSource (!lineno) "unclosed string";
		    YYBEGIN CODE; continue());

