Skip to content

Commit

Permalink
merge
Browse files Browse the repository at this point in the history
  • Loading branch information
KevinRansom committed May 17, 2024
1 parent dd74905 commit 3caa1d6
Show file tree
Hide file tree
Showing 2 changed files with 86 additions and 14 deletions.
17 changes: 3 additions & 14 deletions src/Compiler/Optimize/Optimizer.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2356,15 +2356,7 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr =
OptimizeConst cenv env expr (c, m, ty)

| Expr.Val (v, _vFlags, m) ->
if not (v.Accessibility.IsPrivate) then
OptimizeVal cenv env expr (v, m)
else
expr,
{ TotalSize = 10
FunctionSize = 1
HasEffect = false
MightMakeCriticalTailcall=false
Info=UnknownValue }
OptimizeVal cenv env expr (v, m)


| Expr.Quote (ast, splices, isFromQueryExpression, m, ty) ->
Expand Down Expand Up @@ -3082,9 +3074,6 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, shouldInline, inlineIfLambda,
let fvs = freeInExpr CollectLocals expr
if fvs.UsesMethodLocalConstructs then
// Discarding lambda for binding because uses protected members --- TBD: Should we warn or error here
None
elif fvs.FreeLocals |> Seq.exists(fun v -> v.Accessibility.IsPrivate ) then
// Discarding lambda for binding because uses private members --- TBD: Should we warn or error here
None
else
let exprCopy = CopyExprForInlining cenv inlineIfLambda expr m
Expand Down Expand Up @@ -4123,10 +4112,10 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) =
let fvs = freeInExpr CollectLocals body
if fvs.UsesMethodLocalConstructs then
// Discarding lambda for binding because uses protected members
UnknownValue
UnknownValue
elif fvs.FreeLocals.ToArray() |> Seq.fold(fun acc v -> if not acc then v.Accessibility.IsPrivate else acc) false then
// Discarding lambda for binding because uses private members
UnknownValue
UnknownValue
else
ivalue

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,10 @@ module Inlining =
|> ignoreWarnings
|> verifyILBaseline

let withRealInternalSignature realSig compilation =
compilation
|> withOptions [if realSig then "--realsig+" else "--realsig-" ]

// SOURCE=Match01.fs SCFLAGS="-a --optimize+" COMPILE_ONLY=1 POSTCMD="..\\CompareIL.cmd Match01.dll" # Match01.fs
[<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"Match01_RealInternalSignatureOn.fs"|])>]
let ``Match01_RealInternalSignatureOn_fs`` compilation =
Expand Down Expand Up @@ -139,3 +143,82 @@ let found = data |> List.contains nan
}"""]
#endif

[<InlineData(true)>] // RealSig
[<InlineData(false)>] // Regular
[<Theory>]
let ``Inlining field with private module`` (realSig) =
Fsx """
module private PrivateModule =
let moduleValue = 1
let inline getModuleValue () =
moduleValue
[<EntryPoint>]
let main argv =
// [FS1118] Failed to inline the value 'getModuleValue' marked 'inline', perhaps because a recursive value was marked 'inline'
// (fixed by making PrivateModule internal instead of private)
PrivateModule.getModuleValue () |> ignore
0
"""
|> withOptimize
|> withRealInternalSignature realSig
|> asExe
|> compileAndRun
|> shouldSucceed

[<InlineData(true)>] // RealSig
[<InlineData(false)>] // Regular
[<Theory>]
let ``Inlining field with private class`` (realSig) =
Fsx """
type private FirstType () =
member this.FirstMethod () = ()
type private SecondType () =
member this.SecondMethod () =
let inline callFirstMethod (first: FirstType) =
first.FirstMethod ()
callFirstMethod (FirstType())
printfn $"{(SecondType ()).SecondMethod()}"
"""
|> withOptimize
|> withRealInternalSignature realSig
|> asExe
|> compileAndRun
|> shouldSucceed

[<InlineData(true)>] // RealSig
[<InlineData(false)>] // Regular
[<Theory>]
let ``Inlining deep local functions field with private class`` (realSig) =
Fsx """
type private FirstType () =
member this.FirstMethod () = ()
type private SecondType () =
member this.SecondMethod () =
let inline callFirstMethod (first: FirstType) =
first.FirstMethod ()
let inline callFirstMethodDeeper (first: FirstType) =
callFirstMethod (first)
let inline callFirstMethodMoreDeeper (first: FirstType) =
callFirstMethodDeeper (first)
let inline callFirstMethodMostDeeply (first: FirstType) =
callFirstMethodMoreDeeper (first)
callFirstMethodMostDeeply (FirstType())
printfn $"{(SecondType ()).SecondMethod()}"
"""
|> withOptimize
|> withRealInternalSignature realSig
|> asExe
|> compileAndRun
|> shouldSucceed

0 comments on commit 3caa1d6

Please sign in to comment.