Browse Source

fix type parameter pretty dumping

Simon Krajewski 1 năm trước cách đây
mục cha
commit
22158007b0
2 tập tin đã thay đổi với 21 bổ sung4 xóa
  1. 9 4
      src/codegen/codegen.ml
  2. 12 0
      src/core/tPrinting.ml

+ 9 - 4
src/codegen/codegen.ml

@@ -240,11 +240,16 @@ module Dump = struct
 		let buf,close = create_dumpfile [] ((dump_path com) :: (platform_name_macro com) :: fst path @ [snd path]) in
 		let buf,close = create_dumpfile [] ((dump_path com) :: (platform_name_macro com) :: fst path @ [snd path]) in
 		buf,close
 		buf,close
 
 
-	let dump_types com s_expr =
+	let dump_types com pretty =
 		let s_type = s_type (Type.print_context()) in
 		let s_type = s_type (Type.print_context()) in
+		let s_expr,s_type_param = if pretty then
+			(Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t"),(s_type_param s_type)
+		else
+			(Type.s_expr_pretty false "\t" true),(Printer.s_type_param "")
+		in
 		let params tl = match tl with
 		let params tl = match tl with
 			| [] -> ""
 			| [] -> ""
-			| l -> Printf.sprintf "<%s>" (String.concat ", " (List.map (Printer.s_type_param "") l))
+			| l -> Printf.sprintf "<%s>" (String.concat ", " (List.map s_type_param l))
 		in
 		in
 		List.iter (fun mt ->
 		List.iter (fun mt ->
 			let path = Type.t_path mt in
 			let path = Type.t_path mt in
@@ -376,10 +381,10 @@ module Dump = struct
 
 
 	let dump_types com =
 	let dump_types com =
 		match Common.defined_value_safe com Define.Dump with
 		match Common.defined_value_safe com Define.Dump with
-			| "pretty" -> dump_types com (Type.s_expr_pretty false "\t" true)
+			| "pretty" -> dump_types com true
 			| "record" -> dump_record com
 			| "record" -> dump_record com
 			| "position" -> dump_position com
 			| "position" -> dump_position com
-			| _ -> dump_types com (Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t")
+			| _ -> dump_types com false 
 
 
 	let dump_dependencies ?(target_override=None) com =
 	let dump_dependencies ?(target_override=None) com =
 		let target_name = match target_override with
 		let target_name = match target_override with

+ 12 - 0
src/core/tPrinting.ml

@@ -128,6 +128,18 @@ and s_constraint = function
 	| MOpenStructure -> "MOpenStructure"
 	| MOpenStructure -> "MOpenStructure"
 	| MEmptyStructure -> "MEmptyStructure"
 	| MEmptyStructure -> "MEmptyStructure"
 
 
+let s_type_param s_type ttp =
+	let s = match (get_constraints ttp) with
+		| [] -> ttp.ttp_name
+		| tl1 -> Printf.sprintf "%s:%s" ttp.ttp_name (String.concat " & " (List.map s_type tl1))
+	in
+	begin match ttp.ttp_default with
+	| None ->
+		s
+	| Some t ->
+		Printf.sprintf "%s = %s" s (s_type t)
+	end
+		
 let s_access is_read = function
 let s_access is_read = function
 	| AccNormal -> "default"
 	| AccNormal -> "default"
 	| AccNo -> "null"
 	| AccNo -> "null"