Skip to content

Commit

Permalink
[macro] clean up some internal data structures
Browse files Browse the repository at this point in the history
and remove the crude TFor change
  • Loading branch information
Simn committed Nov 22, 2023
1 parent 3aeb26b commit e60332d
Show file tree
Hide file tree
Showing 8 changed files with 36 additions and 37 deletions.
4 changes: 2 additions & 2 deletions src/context/abstractCast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,8 @@ let rec make_static_call ctx c cf a pl args t p =
let e,f = push_this ctx e in
ctx.with_type_stack <- (WithType.with_type t) :: ctx.with_type_stack;
let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name [e] p with
| Some e -> type_expr ctx e (WithType.with_type t)
| None -> type_expr ctx (EConst (Ident "null"),p) WithType.value
| MSuccess e -> type_expr ctx e (WithType.with_type t)
| _ -> type_expr ctx (EConst (Ident "null"),p) WithType.value
in
ctx.with_type_stack <- List.tl ctx.with_type_stack;
let e = try cast_or_unify_raise ctx t e p with Error { err_message = Unify _ } -> raise Not_found in
Expand Down
7 changes: 6 additions & 1 deletion src/context/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,11 @@ type build_info = {
build_apply : Type.t list -> Type.t;
}

type macro_result =
| MSuccess of expr
| MError
| MMacroInMacro

type typer_globals = {
mutable delayed : delay list;
mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
Expand All @@ -103,7 +108,7 @@ type typer_globals = {
mutable load_only_cached_modules : bool;
functional_interface_lut : (path,tclass_field) lookup;
(* api *)
do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> expr option;
do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> macro_result;
do_load_macro : typer -> bool -> path -> string -> pos -> ((string * bool * t) list * t * tclass * Type.tclass_field);
do_load_module : typer -> path -> pos -> module_def;
do_load_type_def : typer -> pos -> type_path -> module_type;
Expand Down
21 changes: 15 additions & 6 deletions src/typing/callUnification.ml
Original file line number Diff line number Diff line change
Expand Up @@ -453,13 +453,21 @@ object(self)
ctx.macro_depth <- ctx.macro_depth + 1;
ctx.with_type_stack <- with_type :: ctx.with_type_stack;
let ethis_f = ref (fun () -> ()) in
let macro_in_macro () =
(fun () ->
let e = (EThrow((EConst(String("macro-in-macro",SDoubleQuotes))),p),p) in
type_expr ~mode ctx e with_type
)
in
let f = (match ethis.eexpr with
| TTypeExpr (TClassDecl c) ->
DeprecationCheck.check_cf (create_deprecation_context ctx) cf p;
(match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with
| None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
| Some (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos)
| Some e -> (fun() -> type_expr ~mode ctx e with_type))
begin match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with
| MError -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
| MSuccess (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos)
| MSuccess e -> (fun() -> type_expr ~mode ctx e with_type)
| MMacroInMacro -> macro_in_macro ()
end
| _ ->
(* member-macro call : since we will make a static call, let's find the actual class and not its subclass *)
(match follow ethis.etype with
Expand All @@ -469,8 +477,9 @@ object(self)
let eparam,f = push_this ctx ethis in
ethis_f := f;
let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name (eparam :: el) p with
| None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
| Some e -> (fun() -> type_expr ~mode ctx e WithType.value)
| MError -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value)
| MSuccess e -> (fun() -> type_expr ~mode ctx e with_type)
| MMacroInMacro -> macro_in_macro ()
in
e
else
Expand Down
5 changes: 1 addition & 4 deletions src/typing/forLoop.ml
Original file line number Diff line number Diff line change
Expand Up @@ -536,7 +536,4 @@ let type_for_loop ctx handle_display it e2 p =
in
let ik,e1 = loop None it in
let e1 = type_expr ctx e1 WithType.value in
if DeadEnd.has_dead_end e1 then
e1
else
type_for_loop ctx handle_display ik e1 e2 p
type_for_loop ctx handle_display ik e1 e2 p
8 changes: 4 additions & 4 deletions src/typing/instanceBuilder.ml
Original file line number Diff line number Diff line change
Expand Up @@ -39,8 +39,8 @@ let build_macro_type ctx pl p =
) in
let old = ctx.ret in
let t = (match ctx.g.do_macro ctx MMacroType path field args p with
| None -> spawn_monomorph ctx p
| Some _ -> ctx.ret
| MError | MMacroInMacro -> spawn_monomorph ctx p
| MSuccess _ -> ctx.ret
) in
ctx.ret <- old;
t
Expand All @@ -58,8 +58,8 @@ let build_macro_build ctx c pl cfl p =
let old = ctx.ret,ctx.get_build_infos in
ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));
let t = (match ctx.g.do_macro ctx MMacroType path field args p with
| None -> spawn_monomorph ctx p
| Some _ -> ctx.ret
| MError | MMacroInMacro -> spawn_monomorph ctx p
| MSuccess _ -> ctx.ret
) in
ctx.ret <- fst old;
ctx.get_build_infos <- snd old;
Expand Down
11 changes: 6 additions & 5 deletions src/typing/macroContext.ml
Original file line number Diff line number Diff line change
Expand Up @@ -966,11 +966,12 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
in
let call() =
match call_macro args with
| None -> None
| None ->
MError
| Some v ->
let expected,process = match mode with
| MExpr | MDisplay ->
"Expr",(fun () -> Some (Interp.decode_expr v))
"Expr",(fun () -> MSuccess (Interp.decode_expr v))
| MBuild ->
"Array<Field>",(fun () ->
let fields = if v = Interp.vnull then
Expand All @@ -980,7 +981,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
else
List.map Interp.decode_field (Interp.decode_array v)
in
Some (EVars [mk_evar ~t:(CTAnonymous fields,p) ("fields",null_pos)],p)
MSuccess (EVars [mk_evar ~t:(CTAnonymous fields,p) ("fields",null_pos)],p)
)
| MMacroType ->
"ComplexType",(fun () ->
Expand All @@ -993,13 +994,13 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
Interp.decode_type v
in
ctx.ret <- t;
Some (EBlock [],p)
MSuccess (EBlock [],p)
)
in
safe_decode ctx.com v expected mret p process
in
let e = if ctx.com.is_macro_context then
Some (EThrow((EConst(String("macro-in-macro",SDoubleQuotes))),p),p)
MMacroInMacro
else
call()
in
Expand Down
4 changes: 2 additions & 2 deletions src/typing/typeloadFields.ml
Original file line number Diff line number Diff line change
Expand Up @@ -481,8 +481,8 @@ let build_module_def ctx mt meta fvars fbuild =
let r = try ctx.g.do_macro ctx MBuild cpath meth el p with e -> ctx.get_build_infos <- old; raise e in
ctx.get_build_infos <- old;
(match r with
| None -> raise_typing_error "Build failure" p
| Some e -> fbuild e)
| MError | MMacroInMacro -> raise_typing_error "Build failure" p
| MSuccess e -> fbuild e)
) :: f_build
| Meta.Using,el,p -> (fun () ->
List.iter (fun e ->
Expand Down
13 changes: 0 additions & 13 deletions tests/unit/src/unit/issues/Issue11403.hx

This file was deleted.

0 comments on commit e60332d

Please sign in to comment.