浏览代码

factor out dotGraph

Simon Krajewski 4 月之前
父节点
当前提交
b4336ed0d1
共有 2 个文件被更改,包括 21 次插入10 次删除
  1. 17 0
      src/context/dotGraph.ml
  2. 4 10
      src/optimization/analyzer.ml

+ 17 - 0
src/context/dotGraph.ml

@@ -0,0 +1,17 @@
+open SafeCom
+
+let platform_name_macro com =
+	if Define.defined com.defines Define.Macro then "macro"
+	else Globals.platform_name com.platform
+
+let get_dump_path com path name =
+	com.dump_config.dump_path :: [platform_name_macro com] @ (fst path) @ [Printf.sprintf "%s.%s" (snd path) name]
+
+let start_graph ?(graph_config=[]) base_path suffix =
+	let ch = Path.create_file false suffix [] base_path in
+	Printf.fprintf ch "digraph graphname {\n";
+	List.iter (fun s -> Printf.fprintf ch "%s;\n" s) graph_config;
+	ch,(fun () ->
+		Printf.fprintf ch "}\n";
+		close_out ch
+	)

+ 4 - 10
src/optimization/analyzer.ml

@@ -880,13 +880,7 @@ module Debug = struct
 	let dot_debug ctx c cf =
 		let g = ctx.graph in
 		let start_graph ?(graph_config=[]) suffix =
-			let ch = Path.create_file false suffix [] (get_dump_path ctx c cf) in
-			Printf.fprintf ch "digraph graphname {\n";
-			List.iter (fun s -> Printf.fprintf ch "%s;\n" s) graph_config;
-			ch,(fun () ->
-				Printf.fprintf ch "}\n";
-				close_out ch
-			)
+			DotGraph.start_graph ~graph_config (DotGraph.get_dump_path ctx.com c cf) suffix
 		in
 		let ch,f = start_graph "-cfg.dot" in
 		List.iter (fun bb -> dot_debug_node g ch [NILoopGroups;NIScopes;NIPhi;NIExpr] bb) g.g_nodes;
@@ -1118,12 +1112,12 @@ module Run = struct
 					print_endline (Type.s_expr_pretty true "" false (s_type (print_context())) e);
 					print_endline (Printf.sprintf "</%s>" s);
 				) (List.rev actx.debug_exprs);
-				Debug.dot_debug actx c cf;
-				print_endline (Printf.sprintf "dot graph written to %s" (String.concat "/" (Debug.get_dump_path actx c cf)));
+				Debug.dot_debug actx c.cl_path cf.cf_name;
+				print_endline (Printf.sprintf "dot graph written to %s" (String.concat "/" (DotGraph.get_dump_path actx.com c.cl_path cf.cf_name)));
 			in
 			let maybe_debug () = match config.debug_kind with
 				| DebugNone -> ()
-				| DebugDot -> Debug.dot_debug actx c cf;
+				| DebugDot -> Debug.dot_debug actx c.cl_path cf.cf_name;
 				| DebugFull -> debug()
 			in
 			begin try