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