(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) 2012 Johannes 'josch' Schauer <j.schauer@email.de>      *)
(*  Copyright (C) 2012 Pietro Abate <pietro.abate@pps.jussieu.fr>         *)
(*                                                                        *)
(*  This library is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Lesser General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version.  A special linking    *)
(*  exception to the GNU Lesser General Public License applies to this    *)
(*  library, see the COPYING file for more information.                   *)
(**************************************************************************)

open! ExtLib
open Dose_common
open Dose_debian
open Dose_algo

#define __label __FILE__
let label =  __label ;;
include Util.Logging(struct let label = label end) ;;

let progressbar_build_graph = Util.Progress.create "build_graph"
let progressbar_build_graph_bfs = Util.Progress.create "build_graph_bfs"
let timer_build_graph = Util.Timer.create "build_graph"
let timer_build_graph_bfs = Util.Timer.create "build_graph_bfs"

module IntSet = BootstrapCommon.IntSet

type vertex =
  |InstSet of (int * IntSet.t)
  |SrcPkg  of int

module Unique = Unique.Make(struct
  type t = vertex
  let compare v1 v2 =
    match v1,v2 with 
    |SrcPkg p1, SrcPkg p2 -> Pervasives.compare p1 p2
    |InstSet (p1,s1), InstSet (p2,s2) -> begin
        match Pervasives.compare p1 p2 with
          | 0 -> IntSet.compare s1 s2
          | i -> i
     end
    |SrcPkg _, InstSet _ -> -1
    |InstSet _, SrcPkg _ -> 1
end)

type kind =
  |BuildDep
  |BuildsFrom of IntSet.t ref

type 'a edge = { 
  depend : kind;
  annotation : 'a list
}

let default_edge = { depend = BuildsFrom (ref IntSet.empty); annotation = [] }

type et = [`Loop | `NoLoop | `StrongDep ]

(* we cannot just use the polymorphic compare here because that one checks
 * for structural equality and the Set data structure is structurally
 * different depending on the order in which elements were added to the set.
 * Thus instead, use Set.compare *)
let compare_edge e1 e2 =
  match e1, e2 with
  | { depend = BuildDep }, { depend = BuildDep } -> 0
  | { depend = BuildsFrom s1 }, {depend = BuildsFrom s2} -> IntSet.compare !s1 !s2
  | { depend = BuildDep }, { depend = BuildsFrom _ } -> 1
  | { depend = BuildsFrom _ }, { depend = BuildDep } -> -1

module PkgV = struct
  type t = Unique.t
  let compare v1 v2 = Pervasives.compare (Unique.uid v1) (Unique.uid v2)
  let hash = Unique.uid
  let equal v1 v2 = (Unique.uid v1) = (Unique.uid v2)
end
 
module PkgE = struct
  type t = et edge
  let compare x y = compare_edge x y
  let equal x y = ( compare_edge x y ) = 0
  let default = default_edge
end

module G = Graph.Imperative.Digraph.ConcreteBidirectionalLabeled(PkgV)(PkgE)

module VertexSet = Set.Make(G.V)
module EdgeSet = Set.Make(G.E)

(* given a list of tuples where the first element is a source package and the
 * second element is a partitioning of its installation set between its direct
 * dependencies, connect binary packages to source packages according to
 * "bin2src" and omit connections of binary packages to source packages for
 * binary packages that qualify as "available" *)
let graph_helper ?(num_cores=1) available bin2src univ partitionofsrc sl =
  let g = G.create () in
  let seen = Hashtbl.create (List.length sl) in
  let rec aux = function
    | [] -> g
    | todo -> begin
        (* generate dependency sets outside of graph generation because the
         * graph is imperative and we must not executed code with side-effects
         * inside a parallel block *)
        let worker srcpkg =
            Util.Progress.progress progressbar_build_graph;
            let _, partitions = partitionofsrc srcpkg in
            let srcpkgid = CudfAdd.pkgtoint univ srcpkg in
            (srcpkgid, partitions)
        in
        let instsets = if num_cores > 1 then
            (* On 32 bit architectures it can happen that the result returned
             * by parmap is too big to fit into the OCaml constraints for
             * maximum allocatable memory. Should this problem occur, we
             * repeat the computation with smaller chunk sizes.
             * Unfortunately, should the result be too big and the child
             * process throws an Out_of_memory error, then all the parent
             * process sees is the Failure exception that the marshalling
             * module throws. Thus, the Failure we do catch might also be
             * caused by other problems than an Out_of_memory exception.
             * https://github.com/rdicosmo/parmap/issues/46
             *)
            let rec splitjob maxsplits todo =
                    let parmap ~ncores ?(csize = 1) f l =
                      if ncores <= 1 then List.map f l
                      else
                        (*
                        let input = ref l in
                        let demux () = match !input with
                          | [] -> raise Parany.End_of_input
                          | x :: xs -> (input := xs; x) in
                        let output = ref [] in
                        let mux x =
                          output := x :: !output in
                           *)
                        let inarray = Array.of_list l in
                        let outarray = Array.make (List.length l) (0,[]) in
                        let counter = ref 0 in
                        let demux () =
                          if !counter = List.length l then
                            raise Parany.End_of_input
                          else
                            let res = (!counter, inarray.(!counter)) in
                            incr counter;
                            res
                        in
                        let mux (i,x) = outarray.(i) <- x in
                        let fwrapper (i,x) = (i,f x) in
                        (* for safety *)
                        Parany.set_copy_on_work ();
                        Parany.set_copy_on_mux ();
                        (* parallel work *)
                        Parany.run ~verbose:false ~csize ~nprocs:ncores ~demux ~work:fwrapper ~mux;
                        (*!output*)
                        Array.to_list outarray
                    in parmap ~ncores:num_cores worker todo
(*
              try
                Parmap.parmap ~ncores:num_cores worker (Parmap.L todo)
              with
              | Failure "input_value_from_block: bad object" |Out_of_memory -> begin
                  if maxsplits <= 0 then fatal "exceeded maximum split depth";
                  warning "parmap raised out of memory exception with list length %d, splitting job..." (List.length todo);
                  let l1, l2 = List.split_nth ((List.length todo)/2) todo in
                  let res1 = splitjob (maxsplits-1) l1 in
                  let res2 = splitjob (maxsplits-1) l2 in
                  List.append res1 res2
                end
    *)
            in
            let maxsplits = 4 in
            splitjob maxsplits todo
          else
            List.map worker todo
        in
        (* we must not do this iteration in the block above because side
         * effects from parallel blocks are discarded *)
        List.iter (fun (srcpkgid,_) -> Hashtbl.add seen srcpkgid ()) instsets;
        (* go over all source packages and their partitions installation sets
         * and create a new list of source packages to work on if the new
         * source package has not been seen yet *)
        let todo = List.fold_left (fun acc (srcpkgid, partitions) ->
            begin if not (Hashtbl.mem seen srcpkgid) then fatal "something went wrong" end;
            let src = Unique.create (SrcPkg srcpkgid) in
            (* we already add the source vertex here explicitly even though
             * this vertex is normally added together with the edges to its
             * InstSet vertices. This is so that when creating a graph starting
             * from a single source package and that source package has
             * unsatisfiable dependencies that source package will still be
             * part of the output (with no outgoing edges) *)
            G.add_vertex g src;
            List.fold_left (fun acc (pid,is) ->
                let instset = Unique.create (InstSet (pid,is)) in
                let label = { depend = BuildDep; annotation = [] } in
                let edge = (src,label,instset) in
                G.add_edge_e g edge;
                (* Only connect the InstSet vertex to the source packages
                 * building the binary packages in "is" and not "pid".
                 * "pid" has to be explicitly part of "is" if a connection
                 * from this InstSet vertex to a SrcPkg should be made.
                 * This is important to not include non-strong direct
                 * dependencies in a strong dependency graph. *)
                IntSet.fold (fun pid acc ->
                    let binpkg = try
                        CudfAdd.inttopkg univ pid
                      with Not_found -> fatal "cannot find pkg for pid %d" pid
                    in
                    if not (available binpkg) then begin
                      let srcpkgdep = bin2src binpkg in
                      let srcpkgdepid = CudfAdd.pkgtoint univ srcpkgdep in
                      let dst = Unique.create (SrcPkg srcpkgdepid) in
                      begin try begin match G.E.label (G.find_edge g instset dst) with
                        |{ depend = BuildsFrom s } -> s := IntSet.add pid !s
                        |_ -> assert false
                      end with Not_found ->  begin
                          let label = { depend = BuildsFrom (ref (IntSet.singleton pid)); annotation = [] } in
                          let edge = (instset,label,dst) in
                          G.add_edge_e g edge
                        end;
                      end;
                      if Hashtbl.mem seen srcpkgdepid then
                        acc
                      else begin
                        Hashtbl.add seen srcpkgdepid ();
                        srcpkgdep::acc
                      end
                    end else acc
                  ) is acc
              ) acc partitions
          ) [] instsets
        in
        aux todo
      end
  in
  aux sl
;;

let get_src_package ?(allowmismatch=false) univ pkg = try
    BootstrapCommon.get_src_package ~allowmismatch univ pkg
  with Sources.NotfoundSrc ->
    failwith (Printf.sprintf "can't find source package for binary package %s"
                (BootstrapCommon.string_of_package pkg))
;;

(* create and time a normal buildgraph by calculating installation sets *)
let dist_graph ?(global_constraints=[]) ?(available=(fun _ -> true)) ?(allowmismatch=false) ?(opt=false) ?(num_cores=1) custom_is_ht univ sl =
  Util.Timer.start timer_build_graph;
  Util.Progress.set_total progressbar_build_graph (List.length sl);

  let global_constraints =
    List.map (fun (vpkg,pkglist) ->
	(vpkg,List.map (CudfAdd.pkgtoint univ) pkglist)
    ) global_constraints
  in

  let bin2src = get_src_package ~allowmismatch univ in
  let pool = Depsolver_int.init_pool_univ ~global_constraints univ in

  let opt_partition_cache = Hashtbl.create 10000 in
  let partitionofsrc = if opt then
      BootstrapCommon.compute_dependency_sets_opt ~global_constraints ~partition:true ~available opt_partition_cache pool univ
    else
      BootstrapCommon.compute_dependency_sets ~global_constraints ~partition:true custom_is_ht pool univ
  in

  Util.Timer.stop timer_build_graph (graph_helper ~num_cores available bin2src univ partitionofsrc sl)
;;

(* create and time a buildgraph by calculating installation closures *)
let closure_graph ?(global_constraints=[]) ?(available=(fun _ -> true)) ?(allowmismatch=false) ?(num_cores=1) univ sl =
  Util.Timer.start timer_build_graph;
  Util.Progress.set_total progressbar_build_graph (List.length sl);
  let global_constraints =
    List.map (fun (vpkg,pkglist) ->
	(vpkg,List.map (CudfAdd.pkgtoint univ) pkglist)
    ) global_constraints
  in

  let bin2src = get_src_package ~allowmismatch univ in
  let pool = Depsolver_int.init_pool_univ ~global_constraints univ in

  let globalid = Cudf.universe_size univ in
  let to_set l = List.fold_right IntSet.add l IntSet.empty in

  (* rule: connect everything to everything else *)
  let partitionofsrc src =
    let l = List.fold_left (fun acc vpkglist ->
      let disj = CudfAdd.resolve_vpkgs_int univ vpkglist in
      List.fold_left (fun acc2 pid ->
          let dcs = Depsolver_int.dependency_closure_cache pool [pid] in
          (pid, IntSet.remove globalid (to_set dcs))::acc2
      ) acc disj
    ) [] src.Cudf.depends in
    IntSet.empty, l
  in

  Util.Timer.stop timer_build_graph (graph_helper ~num_cores available bin2src univ partitionofsrc sl)
;;

(* create and time a normal buildgraph by calculating strong dependencies *)
let strong_graph ?(global_constraints=[]) ?(available=(fun _ -> true)) ?(allowmismatch=false) ?(num_cores=1) univ sl =
  Util.Timer.start timer_build_graph;
  Util.Progress.set_total progressbar_build_graph (List.length sl);
  let global_constraints =
    List.map (fun (vpkg,pkglist) ->
	(vpkg,List.map (CudfAdd.pkgtoint univ) pkglist)
    ) global_constraints
  in

  let bin2src = get_src_package ~allowmismatch univ in
  let pool = Depsolver_int.init_pool_univ ~global_constraints univ in

  let sdg = Strongdeps.strongdeps_univ univ in
  (* connect all binary packages to the Essential:yes packages *)
  if List.length global_constraints > 0 then begin
    (* get all binary packages that are Essential:yes *)
    let essential = Cudf.get_packages
        ~filter:(fun pkg ->
            BootstrapCommon.debtype_of_cudfpkg pkg = `BinPkg
            && BootstrapCommon.debessential_of_cudfpkg pkg)
        univ
    in
    (* calculate the strong dependency graph of all Essential:yes packages and
     * add all its edges to the original graph. This is done because some
     * Essential:yes packages are never explicitly depended upon so their
     * vertices will otherwise not show up in the graph *)
    Defaultgraphs.PackageGraph.G.iter_edges
      (Defaultgraphs.PackageGraph.G.add_edge sdg)
      (Strongdeps.strongdeps univ essential);
    (* connect all vertices in the original graph to all Essential:yes packages *)
    Defaultgraphs.PackageGraph.G.iter_vertex
      (fun v -> List.iter
          (Defaultgraphs.PackageGraph.add_edge ~transitive:true sdg v)
          essential) sdg
  end;

  let tointset l = List.fold_left (fun acc e -> IntSet.add (CudfAdd.pkgtoint univ e) acc) IntSet.empty l in
  let to_set l = List.fold_right IntSet.add l IntSet.empty in
  (* rule: connect each source package to those source packages which build the
   * binary packages that make their strong dependencies *)
  (* if the dependency closure of any direct dependency has a non-empty
   * intersection with the set of strong dependencies, add a connection. *)
  let partitionofsrc src =
    (* the package in question might not be part of the strong dependency
     * graph if it had unsatisfiable dependencies *)
    if Defaultgraphs.PackageGraph.G.mem_vertex sdg src then
      let strongdeps = Defaultgraphs.PackageGraph.succ_list sdg src in
      let strongdepss = tointset strongdeps in
      let l = List.fold_left (fun acc vpkglist ->
          let disj = CudfAdd.resolve_vpkgs_int univ vpkglist in
          List.fold_left (fun acc2 pid ->
              let dc = Depsolver_int.dependency_closure_cache pool [pid] in
              let dcs = to_set dc in
              let inters = IntSet.inter strongdepss dcs in
              if not(IntSet.is_empty inters) then (pid, inters)::acc2 else acc2
            ) acc disj
        ) [] src.Cudf.depends in
      IntSet.empty, l
    else begin
      warning "package %s cannot be installed" (BootstrapCommon.string_of_package src);
      IntSet.empty, []
    end
  in

  Util.Timer.stop timer_build_graph (graph_helper ~num_cores available bin2src univ partitionofsrc sl)
;;

(* Build the dependency source graph bfs from a root node *)
let dist_graph_bfs ?(global_constraints=[]) ?(maxdepth=max_int) ?(available=(fun _ -> true)) ?(allowmismatch=false) custom_is_ht univ rootlist =
  Util.Timer.start timer_build_graph_bfs;
  Util.Progress.set_total progressbar_build_graph_bfs (Cudf.universe_size univ);

  let g = G.create () in
  let pool = Depsolver_int.init_pool_univ ~global_constraints univ in

  let bin2src = get_src_package ~allowmismatch univ in

  let queue = Queue.create () in
  let visited = Hashtbl.create (Cudf.universe_size univ) in
  (* add the root source package *)
  List.iter (fun root -> Queue.add (root,0) queue ) rootlist;

  begin try while (Queue.length queue > 0) do
    let (srcpkg,level) = Queue.take queue in
    let src = Unique.create (SrcPkg (CudfAdd.pkgtoint univ srcpkg)) in
    G.add_vertex g src;
    if not(Hashtbl.mem visited src) && level < maxdepth then begin
      Util.Progress.progress progressbar_build_graph_bfs;
      Hashtbl.add visited src ();
      (* if the package cannot be compiled the List.iter will not happen *)
      let _, partitions = BootstrapCommon.compute_dependency_sets ~global_constraints ~partition:true custom_is_ht pool univ srcpkg in
      List.iter (fun (pid,is) ->
          (* let open Cudf in Cudf_printer.pp_package stdout (CudfAdd.inttopkg univ pid); *)
          let instset = Unique.create (InstSet (pid,is)) in
          let label = { depend = BuildDep; annotation = [] } in
          let edge = (src,label,instset) in
          (* src -> instset edge *)
          G.add_edge_e g edge;
          IntSet.iter (fun pid ->
            let binpkg = CudfAdd.inttopkg univ pid in
            if not (available binpkg) then begin
              let srcpkgdep = bin2src binpkg in
              let dst = Unique.create (SrcPkg (CudfAdd.pkgtoint univ srcpkgdep)) in
              (* we add a new src to the queue of sources to compile *)
              Queue.add (srcpkgdep,level+1) queue;
              (* the edge (instset -> src edge) aleady exists. In this case we
               * add the pid of the binary to the list BuildsFrom *)
              try match G.E.label (G.find_edge g instset dst) with
                |{ depend = BuildsFrom s } -> s := IntSet.add pid !s
                |_ -> assert false 
              with Not_found ->  begin
                let label = { depend = BuildsFrom (ref (IntSet.singleton pid)); annotation = [] } in
                let edge = (instset,label,dst) in
                (* instset -> src edge *)
                G.add_edge_e g edge
              end
            end
          ) is
      ) partitions;
    end;
    (* here we check if the graph contains cycles. if this is the case we stop *)
    if false then raise Exit
  done with Exit -> () end ;
  Util.Timer.stop timer_build_graph_bfs g
;;

let from_ic universe native_arch ic =
  let getstr n l =
   try match List.assoc n l with
     | GraphmlReader.String s -> s
     | _ -> failwith "expected string"
   with Not_found -> failwith (Printf.sprintf "cannot find key %s in list" n)
  in
  let getint n l =
   try match List.assoc n l with
     | GraphmlReader.Int i -> i
     | _ -> failwith "expected integer"
   with Not_found -> failwith (Printf.sprintf "cannot find key %s in list" n)
  in

  let node l =
    match getstr "kind" l with
     | "SrcPkg" -> begin
       let cudfname = CudfAdd.encode (getstr "cudfname" l) in
       let cudfversion = getint "cudfversion" l in
       let srcpkg = try
           Cudf.lookup_package universe (cudfname,cudfversion)
         with Not_found ->
           failwith (Printf.sprintf "cannot find cudf package %s (= %d)"
                       cudfname cudfversion)
       in
       Unique.create (SrcPkg (CudfAdd.pkgtoint universe srcpkg))
     end
     | "InstSet" -> begin
       let cudfname = CudfAdd.encode (getstr "cudfname" l) in
       let cudfversion = getint "cudfversion" l in
       let pkg = try
           Cudf.lookup_package universe (cudfname,cudfversion)
         with Not_found ->
           failwith (Printf.sprintf "cannot find cudf package %s (= %d)"
                       cudfname cudfversion)
       in
       let pid = CudfAdd.pkgtoint universe pkg in
       let binaries = try getstr "binaries" l
         with Not_found -> failwith "cannot find mandatory InstSet vertex attribute \"binaries\""
       in
       let is = BootstrapCommon.parse_debian_pkgstring universe native_arch binaries in
       Unique.create (InstSet (pid,is))
     end
     | _ -> failwith "invalid node kind"
  in
  let edge l =
    match getstr "kind" l with
     | "builddep" ->
       {depend = BuildDep; annotation = []}
     | "buildsfrom" ->
       let binaries = try getstr "binaries" l
         with Not_found -> failwith "cannot find mandatory buildsfrom edge attribute \"binaries\""
       in
       let is = BootstrapCommon.parse_debian_pkgstring universe native_arch binaries in
       {depend = BuildsFrom (ref is); annotation = []}
     | _ -> failwith "invalid edge kind"
  in

  let module GB = Graph.Builder.I(G) in
  let module GR = GraphmlReader.Parse(GB)(struct let node = node let edge = edge end) in
  (* we want the graph builder to traverse the nodes and edges of the input XML
   * in a deterministic order. This is so that given the same input graph
   * (where "same" means that all node and edge attributes are the same but
   * their order in the XML document may be different) the resulting SrcPkg
   * and InstSet nodes get assigned the same Unique.uid. This in turn is so
   * that it is possible to quickly get a stable order of all vertices
   * between individual runs because many algorithms will sort input
   * vertex lists and sorting by their Unique.uid is many times faster than
   * sorting by package name and version comparison.
   *
   * So instead of letting all algorithms using this graph sort by package name
   * and version, we want to be able to allow quick integer based sorts. But
   * for that the integer assigned to each package name/version must be
   * the same between different runs even if the order in which nodes and
   * edges in the input graph should be different.
   *
   * We rely on the mandatory "id" attribute of nodes and edges to be the same
   * between different runs for the same content. We expect only the order
   * to be different as the order should not matter (both nodes and edges are
   * sets)
   * *)
  let sort l1 l2 =
    let id1 = List.assoc "id" l1 in
    let id2 = List.assoc "id" l2 in
    Pervasives.compare id1 id2
  in
  GR.parse ~nodesort:(Some sort) ~edgesort:(Some sort) ic
;;

module Graphml (U : sig val univ : Cudf.universe end)  = struct
  include G

  let vertex_properties =
      ["name","string",None;
       "version","string",None;
       "binaries","string",None;
       "cudfversion","int",None;
       "cudfname","string",None;
       "architecture","string",None;
       "type","string",None;
       "kind","string",None;
      ]

  let edge_properties = [
    "kind","string",Some "builddep";
    "vpkglist","string",None;
    "binaries","string",None;
    "annotation","string",None
    ]

  let string_of_vertex_kind = function
    |InstSet _ -> "InstSet"
    |SrcPkg _ -> "SrcPkg"

  let map_vertex vertex =
    let vertex = Unique.value vertex in
    match vertex with
    |SrcPkg id->
      let pkg = CudfAdd.inttopkg U.univ id in
      let kind = ("kind",string_of_vertex_kind vertex) in
      let cudfname = ("cudfname", CudfAdd.decode pkg.Cudf.package) in
      let prop =
        (* store cudf property "version" in vertex property "cudfversion"
         * store cudf property "number" in vertex property "version"
         * for all other vertex properties, take the cudf property directly *)
        List.filter_map (fun (key,_,_) ->
            let k =
              if key = "cudfversion" then "version"
              else if key = "version" then "number"
              else key
            in
            try
              let value = Cudf.lookup_package_property pkg k in
              Some(key,value)
            with Not_found -> None
        ) vertex_properties
      in
      let prop = kind :: cudfname :: prop in
      (* only set those attributes which are not empty *)
      List.filter_map (fun (k,v) ->
        if v = "" then None else Some(k,v)
      ) prop
    |InstSet (pid,is) ->
      let binaries =
        let bl =
          List.map (fun pid ->
            let pkg = CudfAdd.inttopkg U.univ pid in
            BootstrapCommon.string_of_package pkg
          ) (IntSet.elements is)
        in
        ("binaries",String.concat "," bl)
      in
      let pkg = CudfAdd.inttopkg U.univ pid in
      let kind = ("kind",string_of_vertex_kind vertex) in
      let cudfname = ("cudfname", CudfAdd.decode pkg.Cudf.package) in
      let prop =
        (* store cudf property "version" in vertex property "cudfversion"
         * store cudf property "number" in vertex property "version"
         * for all other vertex properties, take the cudf property directly *)
        List.filter_map (fun (key,_,_) ->
            let k =
              if key = "cudfversion" then "version"
              else if key = "version" then "number"
              else key
            in
            try let value = Cudf.lookup_package_property pkg k in
              Some(key,value)
            with Not_found -> None
        ) vertex_properties
      in
      let prop = kind :: binaries :: cudfname :: prop in
      (* only set those attributes which are not empty *)
      List.filter_map (fun (k,v) ->
        if v = "" then None else Some(k,v)
      ) prop

  let map_edge (_,label,_) =
    let annot =
      match label with
        | {annotation} ->
          let annot = List.filter_map (fun a ->
            match a with
              | `StrongDep -> Some("strong")
              | _ -> None
          ) annotation in
          ("annotation", String.concat "," annot)
    in
    match label with
    |{ depend = BuildsFrom { contents = s } } ->
        let witness =
          let sl =
            List.map (fun pid ->
              let pkg = CudfAdd.inttopkg U.univ pid in
              BootstrapCommon.string_of_package pkg
            ) (IntSet.elements s)
          in
          ("binaries", String.concat "," sl)
        in
        let prop = [("kind","buildsfrom");witness;annot] in
        (* only set those attributes which are not empty *)
        List.filter_map (fun (k,v) ->
          if v = "" then None else Some(k,v)
        ) prop
    |{ depend = BuildDep } ->
        let kind = ("kind","builddep") in
        let prop = [kind;annot] in
        (* only set those attributes which are not empty *)
        List.filter_map (fun (k,v) ->
          if v = "" then None else Some(k,v)
        ) prop

  let vertex_uid = G.V.hash
  let edge_uid e = Hashtbl.hash (vertex_uid (G.E.src e),G.E.label e,vertex_uid (G.E.dst e))
end

module Oper = Defaultgraphs.GraphOper(G)
module Comp = Graph.Components.Make(G)
module Cycles = GraphUtils.FindCycles(G)
module Utils = GraphUtils.GraphUtils(G)
module Dfs = Graph.Traverse.Dfs(G)
module T = Graph.Topological.Make(G)
module Printer (U : sig val univ : Cudf.universe end) = Graph.Graphml.Print(G)(Graphml(struct let univ = U.univ end))
