[eval] add -D eval-pretty-print (#10963)

src-json/define.json

@@ -166,6 +166,12 @@
 		"platforms": ["eval"],
 		"params": ["depth"]
 	},
+	{
+		"name": "EvalPrettyPrint",
+		"define": "eval-pretty-print",
+		"doc": "Enable indented output for eval printing.",
+		"platforms": ["eval"]
+	},
 	{
 		"name": "EvalStack",
 		"define": "eval-stack",

src/macro/eval/evalContext.ml

@@ -288,6 +288,7 @@ and context = {
 	mutable exception_stack : (pos * env_kind) list;
 	max_stack_depth : int;
 	max_print_depth : int;
+	print_indentation : string option;
 }
 
 module GlobalState = struct

src/macro/eval/evalMain.ml

@@ -130,6 +130,8 @@ let create com api is_macro =
 		exception_stack = [];
 		max_stack_depth = int_of_string (Common.defined_value_safe ~default:"1000" com Define.EvalCallStackDepth);
 		max_print_depth = int_of_string (Common.defined_value_safe ~default:"5" com Define.EvalPrintDepth);
+		print_indentation = match Common.defined_value_safe com Define.EvalPrettyPrint
+			with | "" -> None | "1" -> Some "  " | indent -> Some indent;
 	} in
 	if debug.support_debugger && not !GlobalState.debugger_initialized then begin
 		(* Let's wait till the debugger says we're good to continue. This allows it to finish configuration.

src/macro/eval/evalPrinting.ml

@@ -49,31 +49,64 @@ let s_date d =
 
 let s_hash key = create_ascii (EvalHash.rev_hash key)
 
-let rec s_object depth o =
+let rec indent buf s n =
+	match n with
+	| 0 -> ()
+	| _ -> begin
+		Buffer.add_string buf s;
+		indent buf s (n - 1)
+	end
+
+let rec s_object depth indent_level o =
 	let fields = object_fields o in
 	let buf = Buffer.create 0 in
+	let inner_indent_level = indent_level + 1 in
+
 	Buffer.add_string buf "{";
+	(match (get_ctx()).print_indentation with
+		| None -> ()
+		| Some s -> begin
+			Buffer.add_string buf "\n";
+			indent buf s inner_indent_level
+		end);
+
 	List.iteri (fun i (k,v) ->
-		if i > 0 then Buffer.add_string buf ", ";
+		if i > 0 then begin
+			match (get_ctx()).print_indentation with
+				| None -> Buffer.add_string buf ", "
+				| Some s -> begin
+					Buffer.add_string buf ",\n";
+					indent buf s inner_indent_level
+				end;
+		end;
+
 		Buffer.add_string buf (rev_hash k);
 		Buffer.add_string buf ": ";
-		Buffer.add_string buf (s_value depth v).sstring;
+		Buffer.add_string buf (s_value ~indent_level:inner_indent_level depth v).sstring;
 	) fields;
+
+	(match (get_ctx()).print_indentation with
+		| None -> ()
+		| Some s -> begin
+			Buffer.add_string buf "\n";
+			indent buf s indent_level
+		end);
+
 	Buffer.add_string buf "}";
 	let s = Buffer.contents buf in
 	create_with_length s (try UTF8.length s with _ -> String.length s)
 
-and s_array depth va =
+and s_array depth indent_level va =
 	join empty_string [
 		rbkopen;
-		EvalArray.join va (s_value depth) rcomma;
+		EvalArray.join va (s_value ~indent_level depth) rcomma;
 		rbkclose;
 	]
 
-and s_vector depth vv =
+and s_vector depth indent_level vv =
 	join empty_string [
 		rbkopen;
-		EvalArray.join (EvalArray.create vv) (s_value depth) rcomma;
+		EvalArray.join (EvalArray.create vv) (s_value ~indent_level depth) rcomma;
 		rbkclose;
 	]
 
@@ -85,7 +118,7 @@ and s_enum_ctor_name ve =
 		end
 	with Not_found -> "#unknown"
 
-and s_enum_value depth ve =
+and s_enum_value depth indent_level ve =
 	let name = s_enum_ctor_name ve in
 	match ve.eargs with
 	| [||] -> create_ascii name
@@ -93,7 +126,7 @@ and s_enum_value depth ve =
 		join empty_string [
 			create_ascii name;
 			rpopen;
-			join rcomma (Array.to_list (Array.map (s_value (depth + 1)) vl));
+			join rcomma (Array.to_list (Array.map (s_value ~indent_level (depth + 1)) vl));
 			rpclose;
 		]
 
@@ -102,10 +135,10 @@ and s_proto_kind proto = match proto.pkind with
 	| PEnum _ -> join empty_string [create_ascii "Enum<"; s_hash proto.ppath; rgt]
 	| PInstance | PObject -> die "" __LOC__
 
-and s_value depth v =
+and s_value ?(indent_level=0) depth v =
 	let call_to_string () =
 		let vf = field_raise v EvalHash.key_toString in
-		s_value (depth + 1) (call_value_on v vf [])
+		s_value ~indent_level (depth + 1) (call_value_on v vf [])
 	in
 	if depth > (get_ctx()).max_print_depth then rstop
 	else match v with
@@ -122,17 +155,17 @@ and s_value depth v =
 	| VFunction (f,_) -> rfun
 	| VFieldClosure _ -> rclosure
 	| VHandle _ -> rhandle
-	| VEnumValue ve -> s_enum_value depth ve
+	| VEnumValue ve -> s_enum_value depth indent_level ve
 	| VString s -> s
 	| VNativeString s -> create_unknown_vstring s
-	| VArray va -> s_array (depth + 1) va
-	| VVector vv -> s_vector (depth + 1) vv
+	| VArray va -> s_array (depth + 1) indent_level va
+	| VVector vv -> s_vector (depth + 1) indent_level vv
 	| VInstance {ikind=IDate d} -> s_date d
 	| VInstance {ikind=IPos p} -> create_ascii ("#pos(" ^ Lexer.get_error_pos (Printf.sprintf "%s:%d:") p ^ ")") (* STODO: not ascii? *)
 	| VInstance {ikind=IRegex r} -> r.r_rex_string
 	| VInstance i -> (try call_to_string () with Not_found -> s_hash i.iproto.ppath)
-	| VObject o -> (try call_to_string () with Not_found -> s_object (depth + 1) o)
-	| VLazy f -> s_value depth (!f())
+	| VObject o -> (try call_to_string () with Not_found -> s_object (depth + 1) indent_level o)
+	| VLazy f -> s_value ~indent_level depth (!f())
 	| VPrototype proto ->
 		try
 			call_to_string()

src/macro/eval/evalStdLib.ml

@@ -239,7 +239,7 @@ module StdArray = struct
 	)
 
 	let toString = vifun0 (fun vthis ->
-		vstring (s_array 0 (this vthis))
+		vstring (s_array 0 0 (this vthis))
 	)
 
 	let unshift = vifun1 (fun vthis v ->