Improve some error messages

[hcoop/domtool2.git] / src / tycheck.sml

diff --git a/src/tycheck.sml b/src/tycheck.sml
index def1463..12efce3 100644 (file)
--- a/src/tycheck.sml
+++ b/src/tycheck.sml
@@ -258,10 +258,7 @@ fun envVarSetFrom v (e, _) =
 
       | _ => NONE
 
-fun ununify (tAll as (t, _)) =
-    case t of
-       TUnif (_, ref (SOME t)) => ununify t
-      | _ => tAll
+val ununify = Describe.ununify
 
 fun checkExp G (eAll as (e, loc)) =
     let
@@ -446,14 +443,14 @@ fun checkExp G (eAll as (e, loc)) =
                             (TAction (p', d', r'), loc)
                         end
                       | (TError, _) => t2
-                      | _ => (dte (WrongForm ("Action to be sequenced",
+                      | _ => (dte (WrongForm ("First action to be sequenced",
                                               "action",
                                               e2,
                                               t2,
                                               NONE));
                               (TError, loc)))
                  | (TError, _) => t1
-                 | _ => (dte (WrongForm ("Action to be sequenced",
+                 | _ => (dte (WrongForm ("Second action to be sequenced",
                                          "action",
                                          e1,
                                          t1,
@@ -505,14 +502,14 @@ fun checkExp G (eAll as (e, loc)) =
                             (TAction (p', d', r2), loc)
                         end
                       | (TError, _) => t2
-                      | _ => (dte (WrongForm ("Action to be sequenced",
+                      | _ => (dte (WrongForm ("Body of local settings",
                                               "action",
                                               e2,
                                               t2,
                                               NONE));
                               (TError, loc)))
                  | (TError, _) => t1
-                 | _ => (dte (WrongForm ("Action to be sequenced",
+                 | _ => (dte (WrongForm ("Local settings",
                                          "action",
                                          e1,
                                          t1,
@@ -571,6 +568,32 @@ fun checkExp G (eAll as (e, loc)) =
 
          | ESkip => (TAction ((CPrefix (CRoot, loc), loc),
                               SM.empty, SM.empty), loc)
+
+         | EIf (e1, e2, e3) =>
+           let
+               val t1 = checkExp G e1
+               val t2 = checkExp G e2
+               val t3 = checkExp G e3
+               val bool = (TBase "bool", loc)
+           in
+               (subTyp (t1, bool))
+               handle Unify ue =>
+                      dte (WrongType ("\"if\" test",
+                                      e1,
+                                      t1,
+                                      bool,
+                                      SOME ue));
+               (subTyp (t2, t3); t3)
+                      handle Unify _ =>
+                             ((subTyp (t3, t2); t2)
+                              handle Unify ue =>
+                                     (dte (WrongType ("\"else\" case",
+                                                      eAll,
+                                                      t3,
+                                                      t2,
+                                                      SOME ue));
+                                      (TError, loc)))
+           end
     end
 
 exception Ununif