diff options
| -rw-r--r-- | src/urweb.lex | 30 | ||||
| -rw-r--r-- | tests/xcomments.ur | 8 | ||||
| -rw-r--r-- | tests/xcomments.urp | 1 | ||||
| -rw-r--r-- | tests/xcomments.urs | 1 |
4 files changed, 31 insertions, 9 deletions
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()); diff --git a/tests/xcomments.ur b/tests/xcomments.ur new file mode 100644 index 00000000..61a0b34b --- /dev/null +++ b/tests/xcomments.ur @@ -0,0 +1,8 @@ +fun foo () = <xml>Hi!</xml> + +(* fun bar () = return (* No *)<xml>Yes!</xml> *) + +fun main () = return <xml><body> + A (* B *) C (* D (* E *) F *) D<br/> + <b>A</b> <i>(* B *) C <b>D (* E *) F {foo ()}</b></i> +</body></xml> diff --git a/tests/xcomments.urp b/tests/xcomments.urp new file mode 100644 index 00000000..1a0c34f8 --- /dev/null +++ b/tests/xcomments.urp @@ -0,0 +1 @@ +xcomments diff --git a/tests/xcomments.urs b/tests/xcomments.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/xcomments.urs @@ -0,0 +1 @@ +val main : unit -> transaction page |