| TUnif (_, ref (SOME t')) => get_first_arg t'
| _ => raise Fail "get_first_arg failed!"
-fun describe_type_error loc te =
+fun hint te =
+ case te of
+ WrongType (_, _, (TBase "string", _), (TBase "your_domain", _), _) =>
+ SOME "Did you forget to request permission to configure this domain? See:\n\thttps://members.hcoop.net/portal/domain"
+ | WrongType (_, (EString dom, _), (TBase "string", _), (TBase "domain", _), _) =>
+ if CharVector.exists Char.isUpper dom then
+ SOME "Uppercase letters aren't allowed in domain strings."
+ else
+ NONE
+ | _ => NONE
+
+fun describe_type_error' loc te =
case te of
WrongType (place, e, t1, t2, ueo) =>
(ErrorMsg.error (SOME loc) (place ^ " has wrong type.");
preface ("Have:", p_pred p1);
preface ("Need:", p_pred p2))
+fun ununify (tAll as (t, _)) =
+ case t of
+ TUnif (_, ref (SOME t)) => ununify t
+ | _ => tAll
+
+fun normalize_error err =
+ case err of
+ WrongType (s, e, t1, t2, ueo) =>
+ WrongType (s, e, ununify t1, ununify t2, ueo)
+ | WrongForm (s1, s2, e, t, ueo) =>
+ WrongForm (s1, s2, e, ununify t, ueo)
+ | UnboundVariable _ => err
+ | WrongPred _ => err
+
+fun describe_type_error loc te =
+ let
+ val te = normalize_error te
+ in
+ describe_type_error' loc te;
+ Option.app (fn s => (print "Hint Monster says:\n";
+ print s;
+ print "\n"))
+ (hint te)
+ end
+
end