(* Title:  "BaseDefinitions/check-unique.sml"

   Author: Walther Neuper

   (c) due to copyright terms

*)

"-----------------------------------------------------------------------------------------------";

"table of contents -----------------------------------------------------------------------------";

"-----------------------------------------------------------------------------------------------";

"----------- re-build check_pblguh_unique with high order funs ---------------------------------";

"-----------------------------------------------------------------------------------------------";

"-----------------------------------------------------------------------------------------------";

"-----------------------------------------------------------------------------------------------";

"----------- re-build check_pblguh_unique with high order funs ---------------------------------";

"----------- re-build check_pblguh_unique with high order funs ---------------------------------";

"----------- re-build check_pblguh_unique with high order funs ---------------------------------";

(*------- auxiliary format for fn*)

fun pbl_select_guh pbt =

  let                                          

    val {guh, ...} = (**)(pbt: pbt)(** )(pbt: met)( **)

  in guh end;

pbl_select_guh: pbt -> guh;(**)

fun met_select_guh pbt =

  let                                          

    val {guh, ...} = (pbt: met)

  in guh end;

met_select_guh: met -> guh;(**)

(*------- hint: build higher order functions be replacing the selector by a variable argument *)

(*  collect*)

fun collect select_guh pbls =

  let

    fun node coll (Store.Ptyp (_, [n], ns)) = [select_guh n] @ (nodes coll ns)

      | node _ _ = raise ERROR "collect_guhs: too general Store.Ptyp"

	  and nodes coll [] = coll

      | nodes coll (n :: ns) = (node coll n) @ (nodes coll ns);

  in nodes [] pbls end;

collect: ('a -> 'b) -> 'a   Store.ptyp list -> 'b list;

collect pbl_select_guh: pbt Store.ptyp list -> guh list;

collect met_select_guh: met Store.ptyp list -> guh list;

fun message select store guh =

  if member op = (select store) guh

  then error ("Check_Unique failed with \"" ^ guh ^ "\";\n" ^

	      "use \"sort_guhs()\" for a list of guhs;\n" ^

	      "consider setting \"Check_Unique.on := false\"")

  else ();

 message: ('a -> guh list       ) -> 'a           -> guh -> unit;

(message (collect pbl_select_guh)): pbt Store.ptyp list -> guh -> unit;

(message (collect met_select_guh)): met Store.ptyp list -> guh -> unit;

(Check_Unique.collect (#guh : Probl_Def.T -> Check_Unique.guh)): pbt Store.ptyp list -> guh list;

(Check_Unique.collect (#guh : Meth_Def.T -> Check_Unique.guh)): met Store.ptyp list -> guh list;

val check_pblguh_unique = message (Check_Unique.collect (#guh : Probl_Def.T -> Check_Unique.guh));

check_pblguh_unique: pbt Store.ptyp list -> guh -> unit

;

val check_metguh_unique = message (Check_Unique.collect (#guh : Meth_Def.T -> Check_Unique.guh));

check_metguh_unique: met Store.ptyp list -> guh -> unit

;