changeset 1048:38411c2cd363

Hint about disallowed attributes
author Adam Chlipala <adamc@hcoop.net>
date Wed, 25 Nov 2009 09:48:23 -0500
parents 609ab3947a08
children c2317cfb99ec 4eb1c4a1b057
files src/elaborate.sml tests/vlad2.ur tests/vlad2.urp tests/vlad2.urs
diffstat 4 files changed, 33 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/src/elaborate.sml	Wed Nov 25 09:30:44 2009 -0500
+++ b/src/elaborate.sml	Wed Nov 25 09:48:23 2009 -0500
@@ -4017,11 +4017,33 @@
                           | (_, 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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/vlad2.ur	Wed Nov 25 09:48:23 2009 -0500
@@ -0,0 +1,3 @@
+fun main () = return <xml><body><table>
+ <tr> <td align="right">#</td> <td>123</td> </tr>
+</table></body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/vlad2.urp	Wed Nov 25 09:48:23 2009 -0500
@@ -0,0 +1,2 @@
+
+vlad2
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/vlad2.urs	Wed Nov 25 09:48:23 2009 -0500
@@ -0,0 +1,1 @@
+val main : unit -> transaction page