Skip to content

Commit 2db5e17

Browse files
majochamajocha
committed
quick "occurs" check
1 parent 9fc0931 commit 2db5e17

File tree

1 file changed

+95
-16
lines changed

1 file changed

+95
-16
lines changed

‎src/Compiler/Optimize/Optimizer.fs‎

Lines changed: 95 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -9,24 +9,18 @@ open Internal.Utilities.Collections
99
open Internal.Utilities.Library
1010
open Internal.Utilities.Library.Extras
1111
open FSharp.Compiler
12-
open FSharp.Compiler.AbstractIL.Diagnostics
1312
open FSharp.Compiler.AbstractIL.IL
1413
open FSharp.Compiler.AttributeChecking
1514
open FSharp.Compiler.CompilerGlobalState
1615
open FSharp.Compiler.DiagnosticsLogger
1716
open FSharp.Compiler.Text.Range
1817
open FSharp.Compiler.Syntax.PrettyNaming
1918
open FSharp.Compiler.Syntax
20-
open FSharp.Compiler.SyntaxTreeOps
2119
open FSharp.Compiler.TcGlobals
2220
open FSharp.Compiler.Text
23-
open FSharp.Compiler.Text.Layout
24-
open FSharp.Compiler.Text.LayoutRender
25-
open FSharp.Compiler.Text.TaggedText
2621
open FSharp.Compiler.TypedTree
2722
open FSharp.Compiler.TypedTreeBasics
2823
open FSharp.Compiler.TypedTreeOps
29-
open FSharp.Compiler.TypedTreeOps.DebugPrint
3024
open FSharp.Compiler.TypedTreePickle
3125
open FSharp.Compiler.TypeHierarchy
3226
open FSharp.Compiler.TypeRelations
@@ -36,6 +30,61 @@ open System.Collections.ObjectModel
3630

3731
let OptimizerStackGuardDepth = GetEnvInteger "FSHARP_Optimizer" 50
3832

33+
//-------------------------------------------------------------------------
34+
// Cheap "occurs" checks (avoid full free-variable set construction)
35+
//-------------------------------------------------------------------------
36+
37+
let rec private ExprUsesLocal (v: Val) (expr: Expr) =
38+
// Be robust against reclinks and wrappers
39+
let expr = stripExpr expr
40+
match expr with
41+
| Expr.Val (VRefLocal v2, _, _) -> valEq v v2
42+
| Expr.App (f, _, _, args, _) ->
43+
ExprUsesLocal v f || List.exists (ExprUsesLocal v) args
44+
| Expr.Lambda (_, _, _, _, body, _, _)
45+
| Expr.TyLambda (_, _, body, _, _) ->
46+
ExprUsesLocal v body
47+
| Expr.StaticOptimization (_, e2, e3, _) ->
48+
ExprUsesLocal v e2 || ExprUsesLocal v e3
49+
| Expr.TyChoose _ ->
50+
// Conservative: free-choice typars inside; assume potential use
51+
true
52+
| Expr.Quote _ ->
53+
// Conservative: quotations can capture locals
54+
true
55+
| Expr.Let (TBind (_, e1, _), e2, _, _) ->
56+
ExprUsesLocal v e1 || ExprUsesLocal v e2
57+
| Expr.LetRec (binds, body, _, _) ->
58+
List.exists (fun (TBind (_, e, _)) -> ExprUsesLocal v e) binds || ExprUsesLocal v body
59+
| Expr.Sequential (e1, e2, _, _) ->
60+
ExprUsesLocal v e1 || ExprUsesLocal v e2
61+
| Expr.Match (_, _, dtree, targets, _, _) ->
62+
DecisionTreeUsesLocal v dtree ||
63+
Array.exists (fun (TTarget (_, e, _)) -> ExprUsesLocal v e) targets
64+
// IMPORTANT: account for address-of locals (e.g., passing out-byref) which carry the ValRef in the op payload
65+
| Expr.Op (TOp.LValueOp (LAddrOf _, lv), _, _, _) ->
66+
valEq v lv.Deref
67+
| Expr.Op (_, _, args, _) ->
68+
List.exists (ExprUsesLocal v) args
69+
| Expr.Obj (_, _, _, ctorCall, overrides, iimpls, _) ->
70+
ExprUsesLocal v ctorCall ||
71+
List.exists (fun (TObjExprMethod (_, _, _, _, e, _)) -> ExprUsesLocal v e) overrides ||
72+
List.exists (fun (_, ms) -> List.exists (fun (TObjExprMethod (_, _, _, _, e, _)) -> ExprUsesLocal v e) ms) iimpls
73+
| Expr.DebugPoint (_, e) ->
74+
ExprUsesLocal v e
75+
| _ -> false
76+
77+
and private DecisionTreeUsesLocal (v: Val) (dt: DecisionTree) =
78+
match dt with
79+
| TDSuccess (es, _) ->
80+
List.exists (ExprUsesLocal v) es
81+
| TDBind (TBind (_, e1, _), rest) ->
82+
ExprUsesLocal v e1 || DecisionTreeUsesLocal v rest
83+
| TDSwitch (e, cases, dflt, _) ->
84+
ExprUsesLocal v e ||
85+
List.exists (fun (TCase (_, t)) -> DecisionTreeUsesLocal v t) cases ||
86+
Option.exists (DecisionTreeUsesLocal v) dflt
87+
3988
let i_ldlen = [ I_ldlen; (AI_conv DT_I4) ]
4089

4190
/// size of a function call
@@ -1706,9 +1755,7 @@ let TryEliminateBinding cenv _env bind e2 _m =
17061755
// But note the cases below cover some instances of side-effecting expressions as well....
17071756
let IsUniqueUse vspec2 args =
17081757
valEq vspec1 vspec2
1709-
// REVIEW: this looks slow. Look only for one variable instead
1710-
&& (let fvs = accFreeInExprs (CollectLocalsWithStackGuard()) args emptyFreeVars
1711-
not (Zset.contains vspec1 fvs.FreeLocals))
1758+
&& not (List.exists (ExprUsesLocal vspec1) args)
17121759

17131760
// Immediate consumption of value as 2nd or subsequent argument to a construction or projection operation
17141761
let rec GetImmediateUseContext rargsl argsr =
@@ -1742,8 +1789,12 @@ let TryEliminateBinding cenv _env bind e2 _m =
17421789
// Immediate consumption of value by a pattern match 'let x = e in match x with ...'
17431790
| Expr.Match (spMatch, _exprm, TDSwitch(DebugPoints(Expr.Val (VRefLocal vspec2, _, _), recreate1), cases, dflt, _), targets, m, ty2)
17441791
when (valEq vspec1 vspec2 &&
1745-
let fvs = accFreeInTargets CollectLocals targets (accFreeInSwitchCases CollectLocals cases dflt emptyFreeVars)
1746-
not (Zset.contains vspec1 fvs.FreeLocals)) ->
1792+
let fvsContains =
1793+
let fvTargets = accFreeInTargets CollectLocals targets emptyFreeVars
1794+
let fvCases = accFreeInSwitchCases CollectLocals cases dflt emptyFreeVars
1795+
let fvs = unionFreeVars fvTargets fvCases
1796+
Zset.contains vspec1 fvs.FreeLocals
1797+
not fvsContains) ->
17471798

17481799
let spMatch = spBind.Combine spMatch
17491800
Some (Expr.Match (spMatch, e1.Range, TDSwitch(recreate1 e1, cases, dflt, m), targets, m, ty2) |> recreate0)
@@ -2896,12 +2947,25 @@ and OptimizeLinearExpr cenv env expr contf =
28962947

28972948
| Expr.Let (bind, body, m, _) ->
28982949

2899-
let (bindR, bindingInfo), env = OptimizeBinding cenv false env bind
2950+
let (bindR: Binding, bindingInfo), env = OptimizeBinding cenv false env bind
29002951

29012952
OptimizeLinearExpr cenv env body (contf << (fun (bodyR, bodyInfo) ->
2902-
// PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time.
2903-
// Is it quadratic or quasi-quadratic?
2904-
if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr (CollectLocalsWithStackGuard()) bodyR).FreeLocals) (bindR, bindingInfo) then
2953+
// Cheap occurrence check + precise fallback before eliminating
2954+
let v = bindR.Var
2955+
let usedQuick = ExprUsesLocal v bodyR
2956+
let usedFull =
2957+
if usedQuick then true
2958+
else
2959+
let fvs = freeInExpr CollectLocals bodyR
2960+
Zset.contains v fvs.FreeLocals
2961+
let keepBinding =
2962+
(not cenv.settings.EliminateUnusedBindings && not v.InlineIfLambda) ||
2963+
Option.isSome v.MemberInfo ||
2964+
(bindingInfo.HasEffect && not (IsDiscardableEffectExpr bindR.Expr)) ||
2965+
v.IsFixed ||
2966+
usedFull
2967+
2968+
if keepBinding then
29052969
// Eliminate let bindings on the way back up
29062970
let exprR, adjust = TryEliminateLet cenv env bindR bodyR m
29072971
exprR,
@@ -4040,8 +4104,23 @@ and OptimizeDecisionTree cenv env m x =
40404104
let (bind, binfo), envinner = OptimizeBinding cenv false env bind
40414105
let rest, rinfo = OptimizeDecisionTree cenv envinner m rest
40424106

4043-
if ValueIsUsedOrHasEffect cenv (fun () -> (accFreeInDecisionTree CollectLocals rest emptyFreeVars).FreeLocals) (bind, binfo) then
4107+
// Quick occurrence check with precise fallback
4108+
let v = bind.Var
4109+
let usedQuick = DecisionTreeUsesLocal v rest
4110+
let usedFull =
4111+
if usedQuick then true
4112+
else
4113+
let fvs = accFreeInDecisionTree CollectLocals rest emptyFreeVars
4114+
Zset.contains v fvs.FreeLocals
4115+
4116+
let keepBinding =
4117+
(not cenv.settings.EliminateUnusedBindings && not v.InlineIfLambda) ||
4118+
Option.isSome v.MemberInfo ||
4119+
(binfo.HasEffect && not (IsDiscardableEffectExpr bind.Expr)) ||
4120+
v.IsFixed ||
4121+
usedFull
40444122

4123+
if keepBinding then
40454124
let info = CombineValueInfosUnknown [rinfo;binfo]
40464125
// try to fold the let-binding into a single result expression
40474126
match rest with

0 commit comments

Comments
 (0)