+fun printActionDiffs {have, need} =
+ case (ununif have, ununif need) of
+ ((TAction (p1, in1, out1), loc), (TAction (p2, in2, out2), _)) =>
+ let
+ fun checkPreds () =
+ if predImplies (p1, p2) then
+ ()
+ else
+ (ErrorMsg.error (SOME loc) "Files provides the wrong kind of configuration.";
+ preface ("Have:", p_pred p1);
+ preface ("Need:", p_pred p2))
+
+ fun checkIn () =
+ SM.appi (fn (name, t) =>
+ case SM.find (in2, name) of
+ NONE => (ErrorMsg.error (SOME loc) "An unavailable environment variable is used.";
+ print ("Name: " ^ name ^ "\n");
+ preface ("Type:", p_typ t))
+ | SOME t' =>
+ subTyp (t', t)
+ handle Unify _ =>
+ (ErrorMsg.error (SOME loc) "Wrong type for environment variable.";
+ print (" Name: " ^ name ^ "\n");
+ preface (" Has type:", p_typ t');
+ preface ("Used with type:", p_typ t)))
+ in1
+
+ fun checkOut () =
+ SM.appi (fn (name, t) =>
+ case SM.find (out1, name) of
+ NONE => (ErrorMsg.error (SOME loc) "Missing an output environment variable.";
+ print ("Name: " ^ name ^ "\n");
+ preface ("Type:", p_typ t))
+ | SOME t' =>
+ subTyp (t', t)
+ handle Unify _ =>
+ (ErrorMsg.error (SOME loc) "Wrong type for output environment variable.";
+ print (" Name: " ^ name ^ "\n");
+ preface (" Has type:", p_typ t');
+ preface ("Need type:", p_typ t)))
+ out2
+ in
+ checkPreds ();
+ checkIn ();
+ checkOut ();
+ true
+ end
+
+ | _ => false
+