diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-11-25 09:48:23 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-11-25 09:48:23 -0500 |
| commit | e711704484b43a543a3b5fadd160613d5e869367 (patch) | |
| tree | b30db3385f35000cd8cd74718be5c3ce815c0147 | |
| parent | 74dcd6dc2c73c289230206f4a648fe4a1f44d06d (diff) | |
Hint about disallowed attributes
| -rw-r--r-- | src/elaborate.sml | 32 | ||||
| -rw-r--r-- | tests/vlad2.ur | 3 | ||||
| -rw-r--r-- | tests/vlad2.urp | 2 | ||||
| -rw-r--r-- | tests/vlad2.urs | 1 |
4 files changed, 33 insertions, 5 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml index ec742ce7..eccc4840 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -4017,11 +4017,33 @@ fun elabFile basis topStr topSgn env file = | (_, true) => (oneSummaryRound (); solver gs) | _ => app (fn Disjoint (loc, env, denv, c1, c2) => - ((ErrorMsg.errorAt loc "Couldn't prove field name disjointness"; - eprefaces' [("Con 1", p_con env c1), - ("Con 2", p_con env c2), - ("Hnormed 1", p_con env (ElabOps.hnormCon env c1)), - ("Hnormed 2", p_con env (ElabOps.hnormCon env c2))])) + let + val c1' = ElabOps.hnormCon env c1 + val c2' = ElabOps.hnormCon env c2 + + fun isUnif (c, _) = + case c of + L'.CUnif _ => true + | _ => false + + fun maybeAttr (c, _) = + case c of + L'.CRecord ((L'.KType, _), xts) => true + | _ => false + in + ErrorMsg.errorAt loc "Couldn't prove field name disjointness"; + eprefaces' [("Con 1", p_con env c1), + ("Con 2", p_con env c2), + ("Hnormed 1", p_con env c1'), + ("Hnormed 2", p_con env c2')]; + + if (isUnif c1' andalso maybeAttr c2') + orelse (isUnif c2' andalso maybeAttr c1') then + TextIO.output (TextIO.stdErr, + "You may be using a disallowed attribute with an HTML tag.\n") + else + () + end | TypeClass (env, c, r, loc) => expError env (Unresolvable (loc, c))) gs diff --git a/tests/vlad2.ur b/tests/vlad2.ur new file mode 100644 index 00000000..b4f573d2 --- /dev/null +++ b/tests/vlad2.ur @@ -0,0 +1,3 @@ +fun main () = return <xml><body><table> + <tr> <td align="right">#</td> <td>123</td> </tr> +</table></body></xml> diff --git a/tests/vlad2.urp b/tests/vlad2.urp new file mode 100644 index 00000000..c18469d1 --- /dev/null +++ b/tests/vlad2.urp @@ -0,0 +1,2 @@ + +vlad2 diff --git a/tests/vlad2.urs b/tests/vlad2.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/vlad2.urs @@ -0,0 +1 @@ +val main : unit -> transaction page |