(* Generic breadth-first searching algorithm *)
(* See the file water-jug.ml for a canonical example of how
   to use this search thingy. *)

let rec member elt lst tst =
	match lst with
	[] -> false
	| e :: _ when (tst e elt) -> true
	| _ :: t -> member elt t tst ;;

(* Return list of elts of a not in b *)
let rec setdifference a b tst
	= match a with
	[] -> []
	| head :: tail when member head b tst -> setdifference tail b tst
	| head :: tail -> head :: setdifference tail b tst ;;

let rec uniq lst tst =
	match lst with
	[] -> []
	| head :: tail when member head tail tst -> uniq tail tst
	| head :: tail -> head :: uniq tail tst ;;

let rec mapcan func = function
	[] -> []
	| head :: tail -> (func head) @ mapcan func tail ;;

(* Breadth first search *)

let bfsearch (init: 'a) (goal: 'a -> bool) (rule: 'a -> 'a list) (tst: 'a -> 'a -> bool)
	=
	let bfnext (bfstate: 'a) (bfknown: 'a list) = uniq (setdifference (rule bfstate) bfknown tst) tst
	in let rec bftree (bftodo: ('a * 'a) list) (bfdone: ('a * 'a) list)
		=
		match bftodo with
		[] -> bfdone
		| hd :: _ when goal (fst hd) -> hd :: bfdone
		| hd :: tl -> let cur = fst hd in
			bftree
				(tl @ (List.map (function x -> (x,cur))
					(bfnext cur (List.map fst (bftodo @ bfdone)))))
				((List.hd bftodo) :: bfdone)
	in let rec bfbacktrack where tree path =
		if where = init then init :: path
		else bfbacktrack (List.assoc where tree) tree (where :: path)
	in let bfdata = bftree [(init,init)] []
	in bfbacktrack (fst (List.hd bfdata)) bfdata [];;