소스 검색

[eval] support some more debugging expressions

Simon Krajewski 7 년 전
부모
커밋
58e8c45df0
3개의 변경된 파일57개의 추가작업 그리고 57개의 파일을 삭제
  1. 4 13
      src/macro/eval/evalDebugCLI.ml
  2. 48 23
      src/macro/eval/evalDebugMisc.ml
  3. 5 21
      src/macro/eval/evalDebugSocket.ml

+ 4 - 13
src/macro/eval/evalDebugCLI.ml

@@ -344,8 +344,8 @@ let rec wait ctx run env =
 			begin try
 				let e = parse_expr ctx e env.env_debug.expr.epos in
 				begin try
-					let name,v = expr_to_value ctx env e in
-					output_value name v
+					let v = expr_to_value ctx env e in
+					output_value (Ast.s_expr e) v
 				with Exit ->
 					output_error ("Don't know how to handle this expression: " ^ (Ast.s_expr e))
 				end
@@ -358,17 +358,8 @@ let rec wait ctx run env =
 			begin try
 				let expr,value = parse expr_s,parse value in
 				begin try
-					let _,value = expr_to_value ctx env value in
-					begin match fst expr with
-						(* TODO: support setting array elements and enum values *)
-						| EField(e1,s) ->
-							let _,v1 = expr_to_value ctx env e1 in
-							set_field v1 (hash_s s) value;
-						| EConst (Ident s) ->
-							set_variable ctx env.env_debug.scopes s value env;
-						| _ ->
-							raise Exit
-					end
+					let value = expr_to_value ctx env value in
+					write_expr ctx env expr value;
 				with Exit ->
 					output_error ("Don't know how to handle this expression")
 				end

+ 48 - 23
src/macro/eval/evalDebugMisc.ml

@@ -5,6 +5,7 @@ open EvalContext
 open EvalHash
 open EvalValue
 open EvalEncode
+open EvalMisc
 
 type debug_connection = {
 	wait : context -> (env -> value) -> env -> value;
@@ -146,40 +147,64 @@ let expr_to_value ctx env e =
 	let rec loop e = match fst e with
 		| EConst cst ->
 			begin match cst with
-				| String s -> "",encode_string s
-				| Int s -> "",VInt32 (Int32.of_string s)
-				| Float s -> "",VFloat (float_of_string s)
-				| Ident "true" -> "",VTrue
-				| Ident "false" -> "",VFalse
-				| Ident "null" -> "",VNull
+				| String s -> encode_string s
+				| Int s -> VInt32 (Int32.of_string s)
+				| Float s -> VFloat (float_of_string s)
+				| Ident "true" -> VTrue
+				| Ident "false" -> VFalse
+				| Ident "null" -> VNull
 				| Ident s ->
 					let value = resolve_ident ctx env s in
-					s,value
+					value
 				| _ -> raise Exit
 			end
 		| EArray(e1,eidx) ->
-			let n1,v1 = loop e1 in
-			let nidx,vidx = loop eidx in
+			let v1 = loop e1 in
+			let vidx = loop eidx in
 			let idx = match vidx with VInt32 i -> Int32.to_int i | _ -> raise Exit in
-			let n = Printf.sprintf "%s[%d]" n1 idx in
 			begin match v1 with
-				| VArray va ->
-					let v = EvalArray.get va idx in
-					(n,v)
-				| VVector vv ->
-					let v = Array.get vv idx in
-					(n,v)
-				| VEnumValue ev ->
-					let v = Array.get ev.eargs idx in
-					(n,v)
-				| _ ->
-					raise Exit
+				| VArray va -> EvalArray.get va idx
+				| VVector vv -> Array.get vv idx
+				| VEnumValue ev -> Array.get ev.eargs idx
+				| _ -> raise Exit
 			end
 		| EField(e1,s) ->
-			let n1,v1 = loop e1 in
+			let v1 = loop e1 in
 			let v = EvalField.field v1 (hash_s s) in
-			(Printf.sprintf "%s.%s" n1 s),v
+			v
+		| EArrayDecl el ->
+			let vl = List.map loop el in
+			encode_array vl
+		| EObjectDecl fl ->
+			let fl = List.map (fun ((s,_,_),e) -> s,loop e) fl in
+			encode_obj_s None fl
 		| _ ->
 			raise Exit
 	in
 	loop e
+
+let write_expr ctx env expr value =
+	begin match fst expr with
+		| EField(e1,s) ->
+			let v1 = expr_to_value ctx env e1 in
+			set_field v1 (hash_s s) value;
+		| EConst (Ident s) ->
+			begin try
+				let slot = get_var_slot_by_name env.env_debug.scopes s in
+				env.env_locals.(slot) <- value;
+			with Not_found ->
+				raise Exit
+			end
+		| EArray(e1,e2) ->
+			let v1 = expr_to_value ctx env e1 in
+			let vidx = expr_to_value ctx env e2 in
+			let idx = match vidx with VInt32 i -> Int32.to_int i | _ -> raise Exit in
+			begin match v1 with
+				| VArray va -> EvalArray.set va idx value
+				| VVector vv -> Array.set vv idx value
+				| VEnumValue ev -> Array.set ev.eargs idx value
+				| _ -> raise Exit
+			end
+		| _ ->
+			raise Exit
+	end

+ 5 - 21
src/macro/eval/evalDebugSocket.ml

@@ -320,7 +320,6 @@ type command_outcome =
 	| Run of Json.t * EvalContext.env
 	| Wait of Json.t * EvalContext.env
 
-
 let make_connection socket =
 	(* Reads input and reacts accordingly. *)
 	let rec wait ctx run env =
@@ -485,8 +484,8 @@ let make_connection socket =
 					begin try
 						let e = parse_expr ctx e env.env_debug.expr.epos in
 						begin try
-							let access,v = expr_to_value ctx env e in
-							Loop (output_inner_vars v access)
+							let v = expr_to_value ctx env e in
+							Loop (output_inner_vars v (Ast.s_expr e))
 						with Exit ->
 							error ("Don't know how to handle this expression: " ^ (Ast.s_expr e))
 						end
@@ -509,24 +508,9 @@ let make_connection socket =
 					begin try
 						let expr,value = parse expr_s,parse value in
 						begin try
-							let _,value = expr_to_value ctx env value in
-							begin match fst expr with
-								(* TODO: support setting array elements and enum values *)
-								| EField(e1,s) ->
-									let _,v1 = expr_to_value ctx env e1 in
-									set_field v1 (hash_s s) value;
-									Loop (var_to_json s value expr_s)
-								| EConst (Ident s) ->
-									begin try
-										let slot = get_var_slot_by_name env.env_debug.scopes s in
-										env.env_locals.(slot) <- value;
-										Loop (var_to_json name value s)
-									with Not_found ->
-										error ("No variable found: " ^ s);
-									end
-								| _ ->
-									raise Exit
-							end
+							let value = expr_to_value ctx env value in
+							write_expr ctx env expr value;
+							Loop (var_to_json name value expr_s)
 						with Exit ->
 							error "Don't know how to handle this expression"
 						end