Browse Source

added -D dump_dependencies

Simon Krajewski 13 years ago
parent
commit
1c21c78971
2 changed files with 41 additions and 17 deletions
  1. 40 17
      codegen.ml
  2. 1 0
      main.ml

+ 40 - 17
codegen.ml

@@ -58,10 +58,8 @@ let type_constant com c p =
 	match c with
 	| Int s ->
 		if String.length s > 10 && String.sub s 0 2 = "0x" then error "Invalid hexadecimal integer" p;
-		(try
-			mk (TConst (TInt (Int32.of_string s))) t.tint p
-		with
-			_ -> mk (TConst (TFloat s)) t.tfloat p)
+		(try mk (TConst (TInt (Int32.of_string s))) t.tint p
+		with _ -> mk (TConst (TFloat s)) t.tfloat p)
 	| Float f -> mk (TConst (TFloat f)) t.tfloat p
 	| String s -> mk (TConst (TString s)) t.tstring p
 	| Ident "true" -> mk (TConst (TBool true)) t.tbool p
@@ -1476,22 +1474,25 @@ let rec constructor_side_effects e =
 (*
 	Make a dump of the full typed AST of all types
 *)
+let rec create_dumpfile acc = function
+	| [] -> assert false
+	| d :: [] ->
+		let ch = open_out (String.concat "/" (List.rev (d :: acc)) ^ ".dump") in
+		let buf = Buffer.create 0 in		
+		buf, (fun () ->
+			output_string ch (Buffer.contents buf);
+			close_out ch)		
+	| d :: l ->
+		let dir = String.concat "/" (List.rev (d :: acc)) in
+		if not (Sys.file_exists dir) then Unix.mkdir dir 0o755;
+		create_dumpfile (d :: acc) l
+
 let dump_types com =
 	let s_type = s_type (Type.print_context()) in
 	let params = function [] -> "" | l -> Printf.sprintf "<%s>" (String.concat "," (List.map (fun (n,t) -> n ^ " : " ^ s_type t) l)) in
-	let rec create acc = function
-		| [] -> ()
-		| d :: l ->
-			let dir = String.concat "/" (List.rev (d :: acc)) in
-			if not (Sys.file_exists dir) then Unix.mkdir dir 0o755;
-			create (d :: acc) l
-	in
 	List.iter (fun mt ->
 		let path = Type.t_path mt in
-		let dir = "dump" :: fst path in
-		create [] dir;
-		let ch = open_out (String.concat "/" dir ^ "/" ^ snd path ^ ".dump") in
-		let buf = Buffer.create 0 in
+		let buf,close = create_dumpfile [] ("dump" :: fst path @ [snd path]) in
 		let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 		(match mt with
 		| Type.TClassDecl c ->
@@ -1525,10 +1526,32 @@ let dump_types com =
 		| Type.TTypeDecl t ->
 			print "%stype %s%s = %s" (if t.t_private then "private " else "") (s_type_path path) (params t.t_types) (s_type t.t_type);
 		);
-		output_string ch (Buffer.contents buf);
-		close_out ch
+		close();
 	) com.types
 
+let dump_dependencies com =
+	let buf,close = create_dumpfile [] ["dump";".dependencies"] in
+	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
+	let dep = Hashtbl.create 0 in
+	List.iter (fun m ->
+		print "%s:\n" m.m_extra.m_file;
+		PMap.iter (fun _ m2 ->
+			print "\t%s\n" (m2.m_extra.m_file);
+			let l = try Hashtbl.find dep m2.m_extra.m_file with Not_found -> [] in
+			Hashtbl.replace dep m2.m_extra.m_file (m :: l)
+		) m.m_extra.m_deps;
+	) com.Common.modules;
+	close();
+	let buf,close = create_dumpfile [] ["dump";".dependants"] in
+	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
+	Hashtbl.iter (fun n ml ->
+		print "%s:\n" n;
+		List.iter (fun m ->
+			print "\t%s\n" (m.m_extra.m_file);
+		) ml;
+	) dep;
+	close()
+
 (*
 	Build a default safe-cast expression :
 	{ var $t = <e>; if( Std.is($t,<t>) ) $t else throw "Class cast error"; }

+ 1 - 0
main.ml

@@ -1051,6 +1051,7 @@ try
 			Genxml.generate com file);
 		if com.platform = Flash || com.platform = Cpp || com.platform = Cs then List.iter (Codegen.fix_overrides com) com.types;
 		if Common.defined com "dump" then Codegen.dump_types com;
+		if Common.defined com "dump_dependencies" then Codegen.dump_dependencies com;
 		t();
 		(match com.platform with
 		| _ when !no_output ->