2
0
Эх сурвалжийг харах

[macro] don't exception-wrap every API function (#11374)

Simon Krajewski 1 жил өмнө
parent
commit
16d4f1fe3a

+ 2 - 13
src/macro/eval/evalMain.ml

@@ -376,19 +376,8 @@ let init ctx = ()
 
 let setup get_api =
 	let api = get_api (fun() -> (get_ctx()).curapi.get_com()) (fun() -> (get_ctx()).curapi) in
-	List.iter (fun (n,v) -> match v with
-		| VFunction(f,b) ->
-			let f vl = try
-				f vl
-			with
-			| Sys_error msg | Failure msg | Invalid_argument msg ->
-				exc_string msg
-			| MacroApi.Invalid_expr ->
-				exc_string "Invalid expression"
-			in
-			let v = VFunction (f,b) in
-			Hashtbl.replace GlobalState.macro_lib n v
-		| _ -> die "" __LOC__
+	List.iter (fun (n,v) ->
+		Hashtbl.replace GlobalState.macro_lib n v
 	) api;
 	Globals.macro_platform := Globals.Eval
 

+ 22 - 8
src/macro/macroApi.ml

@@ -70,6 +70,7 @@ type 'value compiler_api = {
 	display_error : ?depth:int -> (string -> pos -> unit);
 	with_imports : 'a . import list -> placed_name list list -> (unit -> 'a) -> 'a;
 	with_options : 'a . compiler_options -> (unit -> 'a) -> 'a;
+	exc_string : 'a . string -> 'a;
 }
 
 
@@ -1013,12 +1014,9 @@ let encode_meta m set =
 			encode_meta_content (!meta)
 		);
 		"add", vfun3 (fun k vl p ->
-			(try
-				let el = List.map decode_expr (decode_array vl) in
-				meta := (Meta.from_string (decode_string k), el, decode_pos p) :: !meta;
-				set (!meta)
-			with Invalid_expr ->
-				failwith "Invalid expression");
+			let el = List.map decode_expr (decode_array vl) in
+			meta := (Meta.from_string (decode_string k), el, decode_pos p) :: !meta;
+			set (!meta);
 			vnull
 		);
 		"extract", vfun1 (fun k ->
@@ -1799,6 +1797,19 @@ let rec make_const e =
 **)
 
 let macro_api ccom get_api =
+	let decode_type v =
+		try decode_type v
+		with Invalid_expr -> (get_api()).exc_string "Invalid expression"
+	in
+	let decode_expr v =
+		try decode_expr v
+		with Invalid_expr -> (get_api()).exc_string "Invalid expression"
+	in
+	let decode_texpr v =
+		try decode_texpr v
+		with Invalid_expr -> (get_api()).exc_string "Invalid expression"
+	in
+	let failwith s = (get_api()).exc_string s in
 	[
 		"contains_display_position", vfun1 (fun p ->
 			let p = decode_pos p in
@@ -1929,14 +1940,17 @@ let macro_api ccom get_api =
 		);
 		"do_parse", vfun3 (fun s p b ->
 			let s = decode_string s in
-			if s = "" then raise Invalid_expr;
+			if s = "" then (get_api()).exc_string "Invalid expression";
 			encode_expr ((get_api()).parse_string s (decode_pos p) (decode_bool b))
 		);
 		"make_expr", vfun2 (fun v p ->
 			encode_expr (value_to_expr v (decode_pos p))
 		);
 		"signature", vfun1 (fun v ->
-			encode_string (Digest.to_hex (value_signature v))
+			try
+				encode_string (Digest.to_hex (value_signature v))
+			with Invalid_argument msg ->
+				(get_api()).exc_string msg
 		);
 		"to_complex_type", vfun1 (fun v ->
 			try	encode_ctype (TExprToExpr.convert_type' (decode_type v))

+ 7 - 1
src/typing/macroContext.ml

@@ -197,7 +197,8 @@ let make_macro_com_api com mcom p =
 				let r = match ParserEntry.parse_expr_string com.defines s p raise_typing_error inl with
 					| ParseSuccess(data,true,_) when inl -> data (* ignore errors when inline-parsing in display file *)
 					| ParseSuccess(data,_,_) -> data
-					| ParseError _ -> raise MacroApi.Invalid_expr in
+					| ParseError _ -> Interp.exc_string "Invalid expression"
+				in
 				exit();
 				r
 			with Error err ->
@@ -315,6 +316,7 @@ let make_macro_com_api com mcom p =
 		warning = (fun ?(depth=0) w msg p ->
 			com.warning ~depth w [] msg p
 		);
+		exc_string = Interp.exc_string;
 	}
 
 let make_macro_api ctx mctx p =
@@ -327,6 +329,10 @@ let make_macro_api ctx mctx p =
 			raise_typing_error "Malformed metadata string" p
 	in
 	let com_api = make_macro_com_api ctx.com mctx.com p in
+	let mk_type_path ?sub path =
+		try mk_type_path ?sub path
+		with Invalid_argument s -> com_api.exc_string s
+	in
 	{
 		com_api with
 		MacroApi.get_type = (fun s ->