Skip to content

Commit

Permalink
[macro] don't exception-wrap every API function (HaxeFoundation#11374)
Browse files Browse the repository at this point in the history
  • Loading branch information
Simn authored and 0b1kn00b committed Jan 25, 2024
1 parent 3fe9a43 commit 71ccbcf
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 22 deletions.
15 changes: 2 additions & 13 deletions src/macro/eval/evalMain.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
30 changes: 22 additions & 8 deletions src/macro/macroApi.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}


Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand Down
8 changes: 7 additions & 1 deletion src/typing/macroContext.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down Expand Up @@ -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 =
Expand All @@ -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 ->
Expand Down

0 comments on commit 71ccbcf

Please sign in to comment.