(* Copyright F.Marchant 2007 GPL *)

module Integer =
  struct
    type t = int
    let compare = compare
  end  

module SetPlus(Set : Set.S) = struct
  include Set
  
  let of_list = List.fold_left (fun s x -> add x s) empty
  
  let split_element s = let e = choose s in (e, remove e s)
                            
  let print print_element s =
    Printf.printf "{";
    (try let (elt, sr) = split_element s in
       print_element elt;
       iter (fun e -> Printf.printf ", "; print_element e)
            sr
     with Not_found -> ());
    Printf.printf "}\n"
end

module IntSet = SetPlus( Set.Make( Integer ) )

let required = function
    Some x -> x
  | None -> assert false

module StepPermuter = struct

type ssp = SSP of
  (IntSet.t           (* Initial set *)
   * int list option  (* Current permutation, if remains. *)
   * (int * IntSet.t) (* Iterator of initial set *)
   * ssp option)      (* Permuter of remaining elements, if any. *)

let get (SSP (_, permut_option, _, _)) = permut_option

let rec normal_ret e s remains si =
    if IntSet.is_empty remains then
      SSP ( s, Some [e], si, None )
    else                                    
      let pi = start remains in
        SSP ( s, Some (e::required (get pi)), si, Some pi )

and start s =
  let (e, rem) as si = IntSet.split_element s in
    normal_ret e s rem si

let rec next (SSP ( s, _, si, pio)) =
  let end_ret () = SSP ( s, None, si, None ) in
    match pio with
    	  None -> end_ret ()
    	| Some pi -> let npi = next pi in
                   let (elem, rem) = si in
    match get npi with
      	None ->
         if IntSet.is_empty rem then
           end_ret ()
         else
        	 let (e, _) as nsi = IntSet.split_element rem in
              normal_ret e s (IntSet.remove e s) nsi
	    | Some npi2 ->
	  SSP( s,
	       Some (elem::npi2),
                     si,
                     Some npi )
end

let (<<) f g x = f (g x)

let print_int_list =
  Printf.printf "[%s]\n" << String.concat "; " << List.map string_of_int

let while_some get f next =
  let rec _while_some thing =
    match get thing with
        None -> ()
      | Some x -> f x; _while_some (next thing) in
    _while_some
  
let _ = while_some
          StepPermuter.get 
          print_int_list
          StepPermuter.next
          (StepPermuter.start (IntSet.of_list [11; 13; 47]))
(*
[11; 13; 47]
[11; 47; 13]
[13; 11; 47]
[13; 47; 11]
[47; 11; 13]
[47; 13; 11]
*)