Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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()); |