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