mlyacc/src/yacc.lex

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