|
@@ -333,10 +333,8 @@ let reduce_control_flow com e = match e.eexpr with
|
|
|
| _ ->
|
|
|
e
|
|
|
|
|
|
-let inline_stack = new_rec_stack()
|
|
|
-
|
|
|
-let rec reduce_loop ctx e =
|
|
|
- let e = Type.map_expr (reduce_loop ctx) e in
|
|
|
+let rec reduce_loop ctx stack e =
|
|
|
+ let e = Type.map_expr (reduce_loop ctx stack) e in
|
|
|
sanitize_expr ctx.com (match e.eexpr with
|
|
|
| TCall(e1,el) ->
|
|
|
begin match Texpr.skip e1 with
|
|
@@ -346,18 +344,18 @@ let rec reduce_loop ctx e =
|
|
|
let rt = (match follow ef.etype with TFun (_,rt) -> rt | _ -> die "" __LOC__) in
|
|
|
begin try
|
|
|
let e = type_inline ctx cf func ethis el rt None e.epos ~self_calling_closure:true false in
|
|
|
- reduce_loop ctx e
|
|
|
+ reduce_loop ctx stack e
|
|
|
with Error { err_message = Custom _ } ->
|
|
|
reduce_expr ctx e
|
|
|
end;
|
|
|
- | {eexpr = TField(ef,(FStatic(cl,cf) | FInstance(cl,_,cf)))} when needs_inline ctx (Some cl) cf && not (rec_stack_memq cf inline_stack) ->
|
|
|
+ | {eexpr = TField(ef,(FStatic(cl,cf) | FInstance(cl,_,cf)))} when needs_inline ctx (Some cl) cf && not (rec_stack_memq cf stack) ->
|
|
|
begin match cf.cf_expr with
|
|
|
| Some {eexpr = TFunction tf} ->
|
|
|
let config = inline_config (Some cl) cf el e.etype in
|
|
|
let rt = (match Abstract.follow_with_abstracts e1.etype with TFun (_,rt) -> rt | _ -> die "" __LOC__) in
|
|
|
begin try
|
|
|
let e = type_inline ctx cf tf ef el rt config e.epos false in
|
|
|
- rec_stack_default inline_stack cf (fun cf' -> cf' == cf) (fun () -> reduce_loop ctx e) e
|
|
|
+ rec_stack_default stack cf (fun cf' -> cf' == cf) (fun () -> reduce_loop ctx stack e) e
|
|
|
with Error { err_message = Custom _ } ->
|
|
|
reduce_expr ctx e
|
|
|
end
|
|
@@ -367,7 +365,7 @@ let rec reduce_loop ctx e =
|
|
|
| { eexpr = TField ({ eexpr = TTypeExpr (TClassDecl c) },field) } ->
|
|
|
(match api_inline ctx c (field_name field) el e.epos with
|
|
|
| None -> reduce_expr ctx e
|
|
|
- | Some e -> reduce_loop ctx e)
|
|
|
+ | Some e -> reduce_loop ctx stack e)
|
|
|
| _ ->
|
|
|
reduce_expr ctx e
|
|
|
end
|
|
@@ -375,37 +373,38 @@ let rec reduce_loop ctx e =
|
|
|
reduce_expr ctx (reduce_control_flow ctx.com e))
|
|
|
|
|
|
let reduce_expression ctx e =
|
|
|
- if ctx.com.foptimize then
|
|
|
+ if ctx.com.foptimize then begin
|
|
|
(* We go through rec_stack_default here so that the current field is on inline_stack. This prevents self-recursive
|
|
|
inlining (#7569). *)
|
|
|
- rec_stack_default inline_stack ctx.f.curfield (fun cf' -> cf' == ctx.f.curfield) (fun () -> reduce_loop ctx e) e
|
|
|
- else
|
|
|
+ let stack = new_rec_stack() in
|
|
|
+ rec_stack_default stack ctx.f.curfield (fun cf' -> cf' == ctx.f.curfield) (fun () -> reduce_loop ctx stack e) e
|
|
|
+ end else
|
|
|
e
|
|
|
|
|
|
-let rec make_constant_expression ctx ?(concat_strings=false) e =
|
|
|
- let e = reduce_loop ctx e in
|
|
|
+let rec make_constant_expression ctx stack ?(concat_strings=false) e =
|
|
|
+ let e = reduce_loop ctx stack e in
|
|
|
match e.eexpr with
|
|
|
| TConst _ -> Some e
|
|
|
| TField({eexpr = TTypeExpr _},FEnum _) -> Some e
|
|
|
- | TBinop ((OpAdd|OpSub|OpMult|OpDiv|OpMod|OpShl|OpShr|OpUShr|OpOr|OpAnd|OpXor) as op,e1,e2) -> (match make_constant_expression ctx e1,make_constant_expression ctx e2 with
|
|
|
+ | TBinop ((OpAdd|OpSub|OpMult|OpDiv|OpMod|OpShl|OpShr|OpUShr|OpOr|OpAnd|OpXor) as op,e1,e2) -> (match make_constant_expression ctx stack e1,make_constant_expression ctx stack e2 with
|
|
|
| Some ({eexpr = TConst (TString s1)}), Some ({eexpr = TConst (TString s2)}) when concat_strings ->
|
|
|
Some (mk (TConst (TString (s1 ^ s2))) ctx.com.basic.tstring (punion e1.epos e2.epos))
|
|
|
| Some e1, Some e2 -> Some (mk (TBinop(op, e1, e2)) e.etype e.epos)
|
|
|
| _ -> None)
|
|
|
- | TUnop((Neg | NegBits) as op,Prefix,e1) -> (match make_constant_expression ctx e1 with
|
|
|
+ | TUnop((Neg | NegBits) as op,Prefix,e1) -> (match make_constant_expression ctx stack e1 with
|
|
|
| Some e1 -> Some (mk (TUnop(op,Prefix,e1)) e.etype e.epos)
|
|
|
| None -> None)
|
|
|
| TCast (e1, None) ->
|
|
|
- (match make_constant_expression ctx e1 with
|
|
|
+ (match make_constant_expression ctx stack e1 with
|
|
|
| None -> None
|
|
|
| Some e1 -> Some {e with eexpr = TCast(e1,None)})
|
|
|
| TParenthesis e1 ->
|
|
|
- begin match make_constant_expression ctx ~concat_strings e1 with
|
|
|
+ begin match make_constant_expression ctx stack ~concat_strings e1 with
|
|
|
| None -> None
|
|
|
| Some e1 -> Some {e with eexpr = TParenthesis e1}
|
|
|
end
|
|
|
| TMeta(m,e1) ->
|
|
|
- begin match make_constant_expression ctx ~concat_strings e1 with
|
|
|
+ begin match make_constant_expression ctx stack ~concat_strings e1 with
|
|
|
| None -> None
|
|
|
| Some e1 -> Some {e with eexpr = TMeta(m,e1)}
|
|
|
end
|
|
@@ -422,3 +421,6 @@ let rec make_constant_expression ctx ?(concat_strings=false) e =
|
|
|
| Some e -> make_constant_expression ctx e)
|
|
|
with Not_found -> None) *)
|
|
|
| _ -> None
|
|
|
+
|
|
|
+let make_constant_expression ctx ?(concat_strings=false) e =
|
|
|
+ make_constant_expression ctx (new_rec_stack()) ~concat_strings e
|