From 4bc2b6c4388096c65e2b45b186722e32267948d8 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Tue, 10 Aug 2010 14:44:26 -0400
Subject: ML-style comments inside XML

---
 src/urweb.lex | 30 +++++++++++++++++++++---------
 1 file changed, 21 insertions(+), 9 deletions(-)

(limited to 'src/urweb.lex')

diff --git a/src/urweb.lex b/src/urweb.lex
index 8930c463..8a989884 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -34,6 +34,8 @@ type svalue = Tokens.svalue
 type ('a,'b) token = ('a,'b) Tokens.token
 type lexresult = (svalue,pos) Tokens.token
 
+val commentOut = ref (fn () => ())
+
 local
   val commentLevel = ref 0
   val commentPos = ref 0
@@ -47,7 +49,10 @@ in
     
   fun exitComment () =
       (ignore (commentLevel := !commentLevel - 1);
-       !commentLevel = 0)
+       if !commentLevel = 0 then
+           !commentOut ()
+       else
+           ())
 
   fun eof () = 
     let 
@@ -167,17 +172,14 @@ cid = [A-Z][A-Za-z0-9_]*;
 ws = [\ \t\012];
 intconst = [0-9]+;
 realconst = [0-9]+\.[0-9]*;
-notags = [^<{\n]+;
+notags = [^<{\n(]+;
 oint = [0-9][0-9][0-9];
 xint = x[0-9a-fA-F][0-9a-fA-F];
 
 %%
 
-<INITIAL> \n          => (newline yypos;
-                          continue ());
-<COMMENT> \n          => (newline yypos;
-                          continue ());
-<XMLTAG> \n           => (newline yypos;
+<INITIAL,COMMENT,XMLTAG>
+      \n              => (newline yypos;
                           continue ());
 <XML> \n              => (newline yypos;
                           Tokens.NOTAGS (yytext, yypos, yypos + size yytext));
@@ -185,14 +187,24 @@ xint = x[0-9a-fA-F][0-9a-fA-F];
 <INITIAL> {ws}+       => (lex ());
 
 <INITIAL> "(*"        => (YYBEGIN COMMENT;
+                          commentOut := (fn () => YYBEGIN INITIAL);
+                          enterComment (pos yypos);
+                          continue ());
+<XML> "(*"            => (YYBEGIN COMMENT;
+                          commentOut := (fn () => YYBEGIN XML);
+                          enterComment (pos yypos);
+                          continue ());
+<XMLTAG> "(*"         => (YYBEGIN COMMENT;
+                          commentOut := (fn () => YYBEGIN XMLTAG);
                           enterComment (pos yypos);
                           continue ());
-<INITIAL> "*)"        => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments";
+<INITIAL,XML,XMLTAG>
+             "*)"     => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments";
 			  continue ());
 
 <COMMENT> "(*"        => (enterComment (pos yypos);
                           continue ());
-<COMMENT> "*)"        => (if exitComment () then YYBEGIN INITIAL else ();
+<COMMENT> "*)"        => (exitComment ();
 			  continue ());
 
 <STRING,CHAR> "\\\""  => (str := #"\"" :: !str; continue());
-- 
cgit v1.2.3