Permutations for an arbitrary container type

permutations.ml

module type PERMUT_CONTAINER = sig
  type 'a t
  val append: 'a t -> 'a t -> 'a t
  val empty: 'a t
  val cons: 'a -> 'a t -> 'a t
  val rev: 'a t -> 'a t
  val hd: 'a t -> 'a
  val tl: 'a t -> 'a t
  val fold_left: ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
end

module Permutations(C: PERMUT_CONTAINER): sig
  val permutations: 'a C.t -> 'a C.t C.t
end = struct
  let singleton x = C.cons x C.empty

  let insert_in_all_positions x c =
    let rec aux prev acc l = if l=C.empty
      then C.cons
          (C.append prev (singleton x))
          (C.rev acc)
      else
        let hd = C.hd l in
        let tl = C.tl l in
        aux (C.append prev (singleton hd))
          (C.cons (C.append prev (C.cons x l)) acc)
          tl in
    aux C.empty C.empty c

  let rec permutations l = if l = C.empty
    then C.empty
    else if C.tl l=C.empty
    then C.hd l |> singleton |> singleton
    else
      let x = C.hd l in
      let xs = C.tl l in
      C.fold_left (fun acc p -> C.append acc (insert_in_all_positions x p)) C.empty
        (permutations xs)
end

module ListPermutations = Permutations(struct
    include List
    type 'a t = 'a list
    let append = (@)
    let empty = []
    let cons x l = x :: l
  end)

module ArrayPermutations = Permutations(struct
    type 'a t = 'a array
    include Array
    let empty = [||]
    let cons x l = append [|x|] l
    let rev a = fold_left (fun l x -> cons x l) [||] a
    let hd l = get l 0
    let tl l = sub l 1 ((length l)-1)
  end)