toposort.ml

(** See documentation in the .mli *)


exception DependencyCycle of string * string list

(** Do the actual topological sort.

    This function takes several parameters :
    @param acc this is the accumulator, which contains already sorted values
    @param in_process contains values which are currently being processed (to detect cyclic dependencies)
    @param to_sort this is the list to sort
    @param dep_fun gives dependencies for a specific value from to_sort list *)
let rec topological_sort_acc: 
    ('a -> string) -> 'a list -> 'a list -> 'a list -> ('a -> 'a list) -> 'a list = 
  fun a2str acc in_process to_sort dep_fun -> match to_sort with
    | [] -> acc
    | x::tl ->
        if List.mem x in_process then
          (* If this element is already marked as being processed, it must be
             a cyclic dependency *)
          raise (DependencyCycle(a2str x, List.map a2str in_process))

        else if List.mem x acc then
          (* If the element is already in the accumulator, it means
             we've already sorted it. *)
          topological_sort_acc a2str acc in_process tl dep_fun

        else
          (* Else, we compute the dependencies for this value *)
          let dependencies = dep_fun x in
          let dependencies_sorted =
            topological_sort_acc a2str acc (x :: in_process) dependencies dep_fun
          in
          let acc = dependencies_sorted @ [x] in
            topological_sort_acc a2str acc in_process tl dep_fun
                          

let f: ('a -> string) -> 'a list -> ('a -> 'a list) -> 'a list =
  fun a2str to_sort dep_fun -> topological_sort_acc a2str [] [] to_sort dep_fun