1(* Modified by sweeks@acm.org on 2000-8-24.
2 * Ported to MLton.
3 *)
4
5(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
6
7   yacc.lex: Lexer specification
8 *)
9
10structure Tokens = Tokens
11type svalue = Tokens.svalue
12type pos = int
13type ('a,'b) token = ('a,'b) Tokens.token
14type lexresult = (svalue,pos) token
15
16type lexarg = Hdr.inputSource
17type arg = lexarg
18
19open Tokens
20val error = Hdr.error
21val lineno = Hdr.lineno
22val text = Hdr.text
23
24val pcount: int ref = ref 0
25val commentLevel: int ref = ref 0
26val actionstart: int ref = ref 0
27
28val eof = fn i => (if (!pcount)>0 then
29			error i (!actionstart)
30			      " eof encountered in action beginning here !"
31		   else (); EOF(!lineno,!lineno))
32
33val Add = fn s => (text := s::(!text))
34
35
36local val dict = [("%prec",PREC_TAG),("%term",TERM),
37	       ("%nonterm",NONTERM), ("%eop",PERCENT_EOP),("%start",START),
38	       ("%prefer",PREFER),("%subst",SUBST),("%change",CHANGE),
39	       ("%keyword",KEYWORD),("%name",NAME),
40	       ("%verbose",VERBOSE), ("%nodefault",NODEFAULT),
41	       ("%value",VALUE), ("%noshift",NOSHIFT),
42	       ("%header",PERCENT_HEADER),("%pure",PERCENT_PURE),
43	       ("%token_sig_info",PERCENT_TOKEN_SIG_INFO),
44	       ("%arg",PERCENT_ARG),
45	       ("%pos",PERCENT_POS)]
46in val lookup =
47     fn (s,left,right) =>
48	 let fun f ((a,d)::b) = if a=s then d(left,right) else f b
49	       | f nil = UNKNOWN(s,left,right)
50	 in f dict
51	 end
52end
53
54fun inc (ri as ref i : int ref) = (ri := i+1)
55fun dec (ri as ref i : int ref) = (ri := i-1)
56
57%%
58%header (
59functor LexMLYACC(structure Tokens : Mlyacc_TOKENS
60		  structure Hdr : HEADER (* = Header *)
61		    where type prec = Header.prec
62		      and type inputSource = Header.inputSource) : ARG_LEXER
63);
64%arg (inputSource);
65%s A CODE F COMMENT STRING EMPTYCOMMENT;
66ws = [\t\ ]+;
67idchars = [A-Za-z_'0-9];
68id=[A-Za-z]{idchars}*;
69tyvar="'"{idchars}*;
70qualid ={id}".";
71%%
72<INITIAL>"(*"	=> (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
73		    continue(); YYBEGIN INITIAL; continue());
74<A>"(*"		=> (YYBEGIN EMPTYCOMMENT; commentLevel := 1; continue());
75<CODE>"(*"	=> (Add yytext; YYBEGIN COMMENT; commentLevel := 1;
76		    continue(); YYBEGIN CODE; continue());
77<INITIAL>[^(%\n]+ => (Add yytext; continue());
78<INITIAL>"%%"	 => (YYBEGIN A; HEADER (concat (rev (!text)),!lineno,!lineno));
79<INITIAL,CODE,COMMENT,F,EMPTYCOMMENT>\n  => (Add yytext; inc lineno; continue());
80<INITIAL>.	 => (Add yytext; continue());
81
82<A>\n		=> (inc lineno; continue ());
83<A>{ws}+	=> (continue());
84<A>of		=> (OF(!lineno,!lineno));
85<A>for		=> (FOR(!lineno,!lineno));
86<A>"{"		=> (LBRACE(!lineno,!lineno));
87<A>"}"		=> (RBRACE(!lineno,!lineno));
88<A>","		=> (COMMA(!lineno,!lineno));
89<A>"*"		=> (ASTERISK(!lineno,!lineno));
90<A>"->"		=> (ARROW(!lineno,!lineno));
91<A>"%left"	=> (PREC(Hdr.LEFT,!lineno,!lineno));
92<A>"%right"	=> (PREC(Hdr.RIGHT,!lineno,!lineno));
93<A>"%nonassoc" 	=> (PREC(Hdr.NONASSOC,!lineno,!lineno));
94<A>"%"[a-z_]+	=> (lookup(yytext,!lineno,!lineno));
95<A>{tyvar}	=> (TYVAR(yytext,!lineno,!lineno));
96<A>{qualid}	=> (IDDOT(yytext,!lineno,!lineno));
97<A>[0-9]+	=> (INT (yytext,!lineno,!lineno));
98<A>"%%"		=> (DELIMITER(!lineno,!lineno));
99<A>":"		=> (COLON(!lineno,!lineno));
100<A>"|"		=> (BAR(!lineno,!lineno));
101<A>{id}		=> (ID ((yytext,!lineno),!lineno,!lineno));
102<A>"("		=> (pcount := 1; actionstart := (!lineno);
103		    text := nil; YYBEGIN CODE; continue() before YYBEGIN A);
104<A>.		=> (UNKNOWN(yytext,!lineno,!lineno));
105<CODE>"("	=> (inc pcount; Add yytext; continue());
106<CODE>")"	=> (dec pcount;
107		    if !pcount = 0 then
108			 PROG (concat (rev (!text)),!lineno,!lineno)
109		    else (Add yytext; continue()));
110<CODE>"\""	=> (Add yytext; YYBEGIN STRING; continue());
111<CODE>[^()"\n]+	=> (Add yytext; continue());
112
113<COMMENT>[(*)]	=> (Add yytext; continue());
114<COMMENT>"*)"	=> (Add yytext; dec commentLevel;
115		    if !commentLevel=0
116			 then BOGUS_VALUE(!lineno,!lineno)
117			 else continue()
118		   );
119<COMMENT>"(*"	=> (Add yytext; inc commentLevel; continue());
120<COMMENT>[^*()\n]+ => (Add yytext; continue());
121
122<EMPTYCOMMENT>[(*)]  => (continue());
123<EMPTYCOMMENT>"*)"   => (dec commentLevel;
124		          if !commentLevel=0 then YYBEGIN A else ();
125			  continue ());
126<EMPTYCOMMENT>"(*"   => (inc commentLevel; continue());
127<EMPTYCOMMENT>[^*()\n]+ => (continue());
128
129<STRING>"\""	=> (Add yytext; YYBEGIN CODE; continue());
130<STRING>\\	=> (Add yytext; continue());
131<STRING>\n	=> (Add yytext; error inputSource (!lineno) "unclosed string";
132 	            inc lineno; YYBEGIN CODE; continue());
133<STRING>[^"\\\n]+ => (Add yytext; continue());
134<STRING>\\\"	=> (Add yytext; continue());
135<STRING>\\[\ \t\n]   => (Add yytext;
136			if substring(yytext,1,1)="\n" then inc lineno else ();
137		     	YYBEGIN F; continue());
138
139<F>{ws}		=> (Add yytext; continue());
140<F>\\		=> (Add yytext; YYBEGIN STRING; continue());
141<F>.		=> (Add yytext; error inputSource (!lineno) "unclosed string";
142		    YYBEGIN CODE; continue());
143
144