From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 26 May 2007 17:24:58 +0000 (+0000)
Subject: Special error message for withholding arguments to configuration functions
X-Git-Tag: release_2010-11-19~200
X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/07d66c3691fac5239dfa1f5a8858623ef542c71f?ds=sidebyside

Special error message for withholding arguments to configuration functions
---

diff --git a/src/describe.sml b/src/describe.sml
index 1384d3b..a753ddb 100644
--- a/src/describe.sml
+++ b/src/describe.sml
@@ -102,6 +102,20 @@ fun describe_unification_error t ue =
 	     print " in:\n";
 	     output (p_typ t))
 
+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', _) => t'
+      | TUnif (_, ref (SOME t')) => get_first_arg t'
+      | _ => raise Fail "get_first_arg failed!"
+
 fun describe_type_error loc te =
     case te of
 	WrongType (place, e, t1, t2, ueo) =>
@@ -111,10 +125,15 @@ fun describe_type_error loc te =
 	 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
+	    (ErrorMsg.error (SOME loc) "Not enough arguments passed to configuration function.";
+	     preface (" Expression so far:", p_exp e);
+	     preface ("Next argument type:", p_typ (get_first_arg 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) =>