module type Format = sig

        type source_object
        type target_object

        val target_of : source_object -> target_object
        val string_of_source_object : source_object -> string
        val string_of_target_object : target_object -> string

        val build : source_object -> unit

        val mtime_of_source_object : source_object -> float option
        val mtime_of_target_object : target_object -> float option
end

module Make = functor (F:Format) -> struct

  let prerr_endline _ = ();;

  let younger_s_t a b = 
    match F.mtime_of_source_object a, F.mtime_of_target_object b with
    | Some a, Some b -> a < b
    | _ -> false (* XXX check if correct *)
  ;;
  let younger_t_t a b = 
    match F.mtime_of_target_object a, F.mtime_of_target_object b with
    | Some a, Some b -> a < b
    | _ -> false (* XXX check if correct *)
  ;;

  let is_built t = younger_s_t t (F.target_of t);;

  let rec needs_build deps compiled (t,dependencies) =
    prerr_endline ("Checking if "^F.string_of_source_object t^" needs to be built");
    if List.mem t compiled then
      (prerr_endline "already compiled";
      false)
    else
    if not (is_built t) then
      (prerr_endline (F.string_of_source_object t^
       " is not built, thus needs to be built");
      true)
    else
    try
      let unsat =
        List.find
          (needs_build deps compiled) 
          (List.map (fun x -> x, List.assoc x deps) dependencies)
      in
        prerr_endline 
         (F.string_of_source_object t^" depends on "^F.string_of_source_object (fst unsat)^
         " that needs to be built, thus needs to be built");
        true
    with Not_found ->
      try 
        let unsat = 
          List.find (younger_t_t (F.target_of t)) (List.map F.target_of dependencies)
        in
          prerr_endline 
           (F.string_of_source_object t^" depends on "^F.string_of_target_object
           unsat^" and "^F.string_of_source_object t^".o is younger than "^
           F.string_of_target_object unsat^", thus needs to be built");
          true
      with Not_found -> false
  ;;

  let is_buildable compiled deps (t,dependencies) =
    prerr_endline ("Checking if "^F.string_of_source_object t^" is buildable");
    let b = needs_build deps compiled (t,dependencies) in
    if not b then
      (prerr_endline (F.string_of_source_object t^
       " does not need to be built, thus it not buildable");
      false)
    else
    try  
      let unsat =
        List.find (needs_build deps compiled) 
          (List.map (fun x -> x, List.assoc x deps) dependencies)
      in
        prerr_endline 
          (F.string_of_source_object t^" depends on "^
          F.string_of_source_object (fst unsat)^
          " that needs build, thus is not buildable");
        false
    with Not_found -> 
      prerr_endline 
        ("None of "^F.string_of_source_object t^
        " dependencies needs to be built, thus it is buildable");
      true
  ;;

  let rec make compiled deps = 
    let todo = List.filter (is_buildable compiled deps) deps in
    if todo <> [] then 
      (List.iter F.build (List.map fst todo);
       make (compiled@List.map fst todo) deps)
  ;;

  let rec purge_unwanted_roots wanted deps =
    let roots, rest = 
       List.partition 
         (fun (t,d) ->
           not (List.exists (fun (_,d1) -> List.mem t d1) deps))
         deps
    in
    let newroots = List.filter (fun (t,_) -> List.mem t wanted) roots in
    if newroots = roots then
      deps
    else
      purge_unwanted_roots wanted (newroots @ rest)
  ;;

  let make deps targets = 
    if targets = [] then 
      make [] deps
    else
      make [] (purge_unwanted_roots targets deps)
  ;;

end