print " in:\n";
output (p_typ t))
-fun describe_type_error loc te =
+fun will_be_action (t, _) =
+ case t of
+ TArrow (_, t') => will_be_action t'
+ | TAction _ => true
+ | TNested _ => true
+ | TUnif (_, ref (SOME t')) => will_be_action t'
+ | _ => false
+
+fun get_first_arg (t, _) =
+ case t of
+ TArrow (t', _) => SOME t'
+ | TUnif (_, ref (SOME t')) => get_first_arg t'
+ | _ => NONE
+
+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 ("Needed type:", p_typ t2);
Option.app (describe_unification_error t1) ueo)
| WrongForm (place, form, e, t, ueo) =>
- (ErrorMsg.error (SOME loc) (place ^ " has a non-" ^ form ^ " type.");
- preface ("Expression:", p_exp e);
- preface (" Type:", p_typ t);
- Option.app (describe_unification_error t) ueo)
+ if form = "action" andalso will_be_action t then
+ (case get_first_arg t of
+ NONE => ErrorMsg.error (SOME loc) "You probably forgot a 'with' clause here."
+ | SOME t' =>
+ (ErrorMsg.error (SOME loc) ("Not enough arguments passed to configuration function. (" ^ place ^ ")");
+ preface (" Expression so far:", p_exp e);
+ preface ("Next argument type:", p_typ t')))
+ else
+ (ErrorMsg.error (SOME loc) (place ^ " has a non-" ^ form ^ " type.");
+ preface ("Expression:", p_exp e);
+ preface (" Type:", p_typ t);
+ Option.app (describe_unification_error t) ueo)
| UnboundVariable name =>
ErrorMsg.error (SOME loc) ("Unbound variable " ^ name ^ ".\n")
| WrongPred (place, p1, p2) =>
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