X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/75d4c2d6fb7996625d062f5949ceb2e66c0a70ab..06bd821502f57dcb4ef89295b221fc2b9a4f1ae3:/src/tycheck.sml diff --git a/src/tycheck.sml b/src/tycheck.sml index f68100f..12efce3 100644 --- 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, @@ -574,8 +571,6 @@ fun checkExp G (eAll as (e, loc)) = | EIf (e1, e2, e3) => let - val t = (newUnif (), loc) - val t1 = checkExp G e1 val t2 = checkExp G e2 val t3 = checkExp G e3 @@ -583,20 +578,21 @@ fun checkExp G (eAll as (e, loc)) = in (subTyp (t1, bool)) handle Unify ue => - dte (WrongType ("\"If\" test", + dte (WrongType ("\"if\" test", e1, t1, bool, SOME ue)); - subTyp (t2, t); - (subTyp (t3, t)) - handle Unify ue => - dte (WrongType ("\"Else\" case", - eAll, - t3, - t2, - SOME ue)); - t + (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