Improve pretty-printing and add undirected graph

2 files changed, 23 insertions, 7 deletions

diff --git a/src/hls/PrintExpression.ml b/src/hls/PrintExpression.ml
index cfe6750..df5dc37 100644
--- a/src/hls/PrintExpression.ml
+++ b/src/hls/PrintExpression.ml
@@ -34,7 +34,7 @@ let rec print_expression pp = function
       (PrintOp.print_addressing print_expression) (addr, to_expr_list elist)
       print_expression e;
     print_expression pp e
-  | Esetpred (p, cond, elist, e) ->
-    fprintf pp "%a = %a; " pred p (PrintOp.print_condition print_expression) (cond, to_expr_list elist);
+  | Esetpred (cond, elist, e) ->
+    fprintf pp "%a; " (PrintOp.print_condition print_expression) (cond, to_expr_list elist);
     print_expression pp e
 *)
diff --git a/src/hls/Schedule.ml b/src/hls/Schedule.ml
index 1052cb3..2fede53 100644
--- a/src/hls/Schedule.ml
+++ b/src/hls/Schedule.ml
@@ -87,6 +87,17 @@ end)(struct
   let default = 0
 end)
 
+module DFGSimp = Graph.Persistent.Graph.Concrete(struct
+    type t = int * instr
+    let compare = compare
+    let equal = (=)
+    let hash = Hashtbl.hash
+  end)
+
+let convert dfg =
+  DFG.fold_vertex (fun v g -> DFGSimp.add_vertex g v) dfg DFGSimp.empty
+  |> DFG.fold_edges (fun v1 v2 g -> DFGSimp.add_edge g v1 v2) dfg
+
 let reg r = sprintf "r%d" (P.to_int r)
 let print_pred r = sprintf "p%d" (P.to_int r)
 
@@ -203,7 +214,7 @@ module DFGDot = Graph.Graphviz.Dot(struct
     include DFG
   end)
 
-module DFGDfs = Graph.Traverse.Dfs(DFG)
+module DFGDfs = Graph.Traverse.Dfs(DFGSimp)
 
 module IMap = Map.Make (struct
   type t = int
@@ -738,11 +749,16 @@ let combine_bb_schedule schedule s =
 (**let add_el dfg i l =
   List.*)
 
+let check_in el =
+  List.exists (List.exists ((=) el))
+
 let all_dfs dfg =
-  let roots = DFG.fold_vertex (fun v li ->
-      if DFG.in_degree dfg v = 0 then v :: li else li
+  let roots = DFGSimp.fold_vertex (fun v li ->
+      if DFGSimp.in_degree dfg v = 0 then v :: li else li
     ) dfg [] in
-  List.map (fun r -> DFGDfs.fold_component (fun v l -> v :: l) [] dfg r) roots
+  List.fold_left (fun a el ->
+      if check_in el a then a else
+        (DFGDfs.fold_component (fun v l -> v :: l) [] dfg el) :: a) [] roots
 
 (** Should generate the [RTLPar] code based on the input [RTLBlock] description. *)
 let transf_rtlpar c c' (schedule : (int * int) list IMap.t) =
@@ -761,7 +777,7 @@ let transf_rtlpar c c' (schedule : (int * int) list IMap.t) =
       (*let final_body = List.map (fun x -> subgraph dfg x |> order_instr) body in*)
       let final_body2 = List.map (fun x -> subgraph dfg x
                                            |> (fun x ->
-                                               all_dfs x
+                                               all_dfs (convert x)
                                                |> List.map (subgraph x)
                                                |> List.map (fun y ->
                                                    TopoDFG.fold (fun i l -> snd i :: l) y []