Mercurial > urweb

comparison src/urweb.lex @ 1283:b04354e24d1b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
ML-style comments inside XML
author Adam Chlipala <adam@chlipala.net>
date Tue, 10 Aug 2010 14:44:26 -0400
parents c316ca3c9ec6
children 43ca083678f8
comparison
equal deleted inserted replaced
1282:a9a500d22ebc 1283:b04354e24d1b
32 type pos = int 32 type pos = int
33 type svalue = Tokens.svalue 33 type svalue = Tokens.svalue
34 type ('a,'b) token = ('a,'b) Tokens.token 34 type ('a,'b) token = ('a,'b) Tokens.token
35 type lexresult = (svalue,pos) Tokens.token 35 type lexresult = (svalue,pos) Tokens.token
36 36
37 val commentOut = ref (fn () => ())
38
37 local 39 local
38 val commentLevel = ref 0 40 val commentLevel = ref 0
39 val commentPos = ref 0 41 val commentPos = ref 0
40 in 42 in
41 fun enterComment pos = 43 fun enterComment pos =
45 (); 47 ();
46 commentLevel := !commentLevel + 1) 48 commentLevel := !commentLevel + 1)
47 49
48 fun exitComment () = 50 fun exitComment () =
49 (ignore (commentLevel := !commentLevel - 1); 51 (ignore (commentLevel := !commentLevel - 1);
50 !commentLevel = 0) 52 if !commentLevel = 0 then
53 !commentOut ()
54 else
55 ())
51 56
52 fun eof () = 57 fun eof () =
53 let 58 let
54 val pos = ErrorMsg.lastLineStart () 59 val pos = ErrorMsg.lastLineStart ()
55 in 60 in
165 id = [a-z_][A-Za-z0-9_']*; 170 id = [a-z_][A-Za-z0-9_']*;
166 cid = [A-Z][A-Za-z0-9_]*; 171 cid = [A-Z][A-Za-z0-9_]*;
167 ws = [\ \t\012]; 172 ws = [\ \t\012];
168 intconst = [0-9]+; 173 intconst = [0-9]+;
169 realconst = [0-9]+\.[0-9]*; 174 realconst = [0-9]+\.[0-9]*;
170 notags = [^<{\n]+; 175 notags = [^<{\n(]+;
171 oint = [0-9][0-9][0-9]; 176 oint = [0-9][0-9][0-9];
172 xint = x[0-9a-fA-F][0-9a-fA-F]; 177 xint = x[0-9a-fA-F][0-9a-fA-F];
173 178
174 %% 179 %%
175 180
176 <INITIAL> \n => (newline yypos; 181 <INITIAL,COMMENT,XMLTAG>
177 continue ()); 182 \n => (newline yypos;
178 <COMMENT> \n => (newline yypos;
179 continue ());
180 <XMLTAG> \n => (newline yypos;
181 continue ()); 183 continue ());
182 <XML> \n => (newline yypos; 184 <XML> \n => (newline yypos;
183 Tokens.NOTAGS (yytext, yypos, yypos + size yytext)); 185 Tokens.NOTAGS (yytext, yypos, yypos + size yytext));
184 186
185 <INITIAL> {ws}+ => (lex ()); 187 <INITIAL> {ws}+ => (lex ());
186 188
187 <INITIAL> "(*" => (YYBEGIN COMMENT; 189 <INITIAL> "(*" => (YYBEGIN COMMENT;
190 commentOut := (fn () => YYBEGIN INITIAL);
188 enterComment (pos yypos); 191 enterComment (pos yypos);
189 continue ()); 192 continue ());
190 <INITIAL> "*)" => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments"; 193 <XML> "(*" => (YYBEGIN COMMENT;
194 commentOut := (fn () => YYBEGIN XML);
195 enterComment (pos yypos);
196 continue ());
197 <XMLTAG> "(*" => (YYBEGIN COMMENT;
198 commentOut := (fn () => YYBEGIN XMLTAG);
199 enterComment (pos yypos);
200 continue ());
201 <INITIAL,XML,XMLTAG>
202 "*)" => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments";
191 continue ()); 203 continue ());
192 204
193 <COMMENT> "(*" => (enterComment (pos yypos); 205 <COMMENT> "(*" => (enterComment (pos yypos);
194 continue ()); 206 continue ());
195 <COMMENT> "*)" => (if exitComment () then YYBEGIN INITIAL else (); 207 <COMMENT> "*)" => (exitComment ();
196 continue ()); 208 continue ());
197 209
198 <STRING,CHAR> "\\\"" => (str := #"\"" :: !str; continue()); 210 <STRING,CHAR> "\\\"" => (str := #"\"" :: !str; continue());
199 <STRING,CHAR> "\\'" => (str := #"'" :: !str; continue()); 211 <STRING,CHAR> "\\'" => (str := #"'" :: !str; continue());
200 <STRING,CHAR> "\\n" => (str := #"\n" :: !str; continue()); 212 <STRING,CHAR> "\\n" => (str := #"\n" :: !str; continue());