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