diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index e209c5e9efc..b0a2cae2430 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -120,6 +120,9 @@ * Fix signature conformance: overloaded member with unit parameter `M(())` now matches sig `member M: unit -> unit`. ([Issue #19596](https://github.com/dotnet/fsharp/issues/19596), [PR #19615](https://github.com/dotnet/fsharp/pull/19615)) * Fix `--quiet` not suppressing NuGet restore output on stdout in F# Interactive ([Issue #18086](https://github.com/dotnet/fsharp/issues/18086)) * Reference assembly MVIDs are now deterministic across compiler invocations. Previously, `--refout` / `true` produced a different MVID every build because the implied signature hash used .NET's randomized `String.GetHashCode()`. ([Issue #19751](https://github.com/dotnet/fsharp/issues/19751), [PR #19801](https://github.com/dotnet/fsharp/pull/19801)) +* Parser: recover on unfinished if and binary expressions +([PR #19724](https://github.com/dotnet/fsharp/pull/19724)) +* Fix recursive inline-member optimization dependencies so inline consumers in recursive groups are resolved reliably without changing static initialization order. ([Issue #20085](https://github.com/dotnet/fsharp/issues/20085), [PR #20111](https://github.com/dotnet/fsharp/pull/20111)) * Parser: recover on unfinished if and binary expressions ([PR #19724](https://github.com/dotnet/fsharp/pull/19724)) * Parser: recover on missing 'when' conditions ([PR ##20071](https://github.com/dotnet/fsharp/pull/#20071)) * Fix `SynExpr.shouldBeParenthesizedInContext` to report parentheses as required around `SynExpr.Sequential` expressions used as record or anonymous-record field values, so the IDE "remove unnecessary parentheses" analyzer no longer breaks code like `{| A = ((); B = 3) |}`. ([Issue #17826](https://github.com/dotnet/fsharp/issues/17826), [PR #19850](https://github.com/dotnet/fsharp/pull/19850)) @@ -145,6 +148,7 @@ * Import: Don't walk non-F# assemblies when labelling trait constraint sources (PR [#20090](https://github.com/dotnet/fsharp/pull/20090)) * Avoid per-instance lock object in InterruptibleLazy and DelayInitArrayMap (PR [#20088](https://github.com/dotnet/fsharp/pull/20088)) * IL: fix leaking binary view ([PR #20250](https://github.com/dotnet/fsharp/pull/20250)) +* Fix dependency ordering and stack safety for recursive inline bindings. ([PR #20111](https://github.com/dotnet/fsharp/pull/20111)) ### Added diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 3ecedc13c63..b70e77c91f3 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -663,7 +663,10 @@ let GetInfoForLocalValue cenv env (v: Val) m = match TryGetInfoForLocalValue cenv env v with | Some vval -> vval | None -> - if not v.IsDispatchSlot && v.ShouldInline then + // Inside an inline body being prepared for export (not optimizing), a referenced inline val may + // legitimately be absent from the optimization environment here: it is exported as-is and + // resolved when the body gets inlined at the caller site. Only diagnose when optimizing for real. + if cenv.optimizing && not v.IsDispatchSlot && v.ShouldInline then errorR(Error(FSComp.SR.optValueMarkedInlineButWasNotBoundInTheOptEnv(richTextOfQualifiedValRef (mkLocalValRef v)), m)) UnknownValInfo @@ -3316,11 +3319,13 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, shouldInline, inlineIfLambda, | TupleValue _ | UnionCaseValue _ | RecdValue _ when shouldInline -> failwith "tuple, union and record values cannot be marked 'inline'" - | UnknownValue when shouldInline && cenv.settings.alwaysInline -> + // No diagnostics when preparing an inline body for export: the reference is exported + // as-is and resolved at the expansion site, where the caller's environment is complete. + | UnknownValue when shouldInline && cenv.settings.alwaysInline && cenv.optimizing -> warning(Error(FSComp.SR.optValueMarkedInlineHasUnexpectedValue(), m)) None - | _ when shouldInline && cenv.settings.alwaysInline -> + | _ when shouldInline && cenv.settings.alwaysInline && cenv.optimizing -> warning(Error(FSComp.SR.optValueMarkedInlineCouldNotBeInlined(), m)) None @@ -3366,7 +3371,9 @@ and OptimizeVal cenv env expr (v: ValRef, m) = e, AddValEqualityInfo g m v einfo | None -> - if cenv.settings.alwaysInline then + // As in GetInfoForLocalValue: a failed inline is only an error when optimizing for this + // site, not when the body is merely being prepared for export. + if cenv.optimizing && cenv.settings.alwaysInline then if v.ShouldInline then match valInfoForVal.ValExprInfo with | UnknownValue -> error(Error(FSComp.SR.optFailedToInlineValue(richTextOfValName g v.Deref), m)) @@ -4531,6 +4538,8 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = let exprOptimized, einfo = let env = if vref.IsCompilerGenerated && Option.isSome env.latestBoundId then env else {env with latestBoundId=Some vref.Id} + // Bodies of inline bindings are prepared for export (optimized later, at the expansion + // site), which is why diagnostics depending on a complete environment are suppressed. let cenv = if vref.InlineInfo.ShouldInline then { cenv with optimizing=false} else cenv let arityInfo = InferValReprInfoOfBinding g AllowTypeDirectedDetupling.No vref expr let exprOptimized, einfo = OptimizeLambdas (Some vref) cenv env arityInfo expr vref.Type @@ -4640,8 +4649,30 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = errorRecovery exn vref.Range raise (ReportedError (Some exn)) +/// Optimize a group in dependency order, then restore source order so downstream consumers retain +/// the original binding layout. +and OptimizeInDependencyOrder xs order processOne state = + let xsArray = List.toArray xs + let results, state = + (state, order) + ||> List.mapFold (fun state idx -> + let result, state = processOne state xsArray[idx] + (idx, result), state) + + // The order is a permutation of the indexes, so scatter the results back to source order. + let resultsByIndex = Array.zeroCreate xs.Length + + for idx, result in results do + resultsByIndex[idx] <- result + + List.ofArray resultsByIndex, state + and OptimizeBindings cenv isRec env xs = - List.mapFold (OptimizeBinding cenv isRec) env xs + if isRec && xs |> List.exists (fun (TBind(vref, _, _)) -> vref.ShouldInline) then + let order = GetBindingOptimizationOrder cenv false true xs + OptimizeInDependencyOrder xs order (OptimizeBinding cenv isRec) env + else + List.mapFold (OptimizeBinding cenv isRec) env xs and OptimizeModuleExprWithSig cenv env mty def = let g = cenv.g @@ -4731,11 +4762,124 @@ and OptimizeModuleExprWithSig cenv env mty def = and mkValBind (bind: Binding) info = (mkLocalValRef bind.Var, info) +/// Used before optimization to publish dependencies before a binding that may inline them. +/// Cycle-tolerant depth-first post-order over dependency indexes: each node appears exactly +/// once, after all of its dependencies. Nodes are marked on entry, so cyclic back-edges +/// into nodes still being processed are skipped. +and TopologicalPostOrder guard (dependencies: int array array) (roots: int list) = + let ordered = ResizeArray() + let visited = HashSet() + + let rec visit idx = + if visited.Add idx then + guard (fun () -> + for depIdx in dependencies[idx] do + if depIdx <> idx then + visit depIdx) + + ordered.Add idx + + for root in roots do + visit root + + List.ofSeq ordered + +/// Route recursive bindings through the dependency scheduler so inline callers see optimized siblings. +and GetBindingOptimizationOrder cenv inlineDependenciesOnly preferLowArity (binds: Binding list) = + GetGroupOptimizationOrder cenv inlineDependenciesOnly preferLowArity [ + for bind in binds -> + let arity = + bind.Var.ValReprInfo + |> Option.map (fun repr -> repr.TotalArgCount) + |> Option.defaultValue 0 + + [ bind.Var ], arity, Choice1Of2 bind.Expr + ] + +/// Compute a dependency-first processing schedule for the elements of a recursive group: each +/// element publishes its vals to the optimization environment only once processed, so a caller +/// optimized before an element it depends on can observe an incomplete optimization environment. +/// Elements are (vals defined, arity, dependency source): a binding defines its own val, +/// a nested module defines every val in its contents. +and GetGroupOptimizationOrder + cenv + inlineDependenciesOnly + preferLowArity + (elements: (Val list * int * Choice) list) + = + let elemsArray = elements |> List.toArray + + let elemIndexByStamp = + elements + |> List.indexed + |> List.collect (fun (idx, (definedVals, _, _)) -> + definedVals |> List.map (fun (v: Val) -> v.Stamp, idx)) + |> Map.ofList + + let addDependency depIdxs (v: Val) = + match elemIndexByStamp |> Map.tryFind v.Stamp with + | Some depIdx when not inlineDependenciesOnly || v.ShouldInline -> + Set.add depIdx depIdxs + | _ -> depIdxs + + let addFreeVars depIdxs (fvs: FreeVars) = + let depIdxs = + (depIdxs, fvs.FreeLocals |> Zset.elements) + ||> Seq.fold (fun depIdxs v -> addDependency depIdxs v) + + (depIdxs, fvs.FreeTyvars.FreeTraitSolutions |> Zset.elements) + ||> Seq.fold (fun depIdxs v -> addDependency depIdxs v) + + let rec addBindingDependencies depIdxs expr = + cenv.stackGuard.Guard(fun () -> + let depIdxs = + addFreeVars depIdxs (freeInExpr (CollectLocalsWithStackGuard()) expr) + + let folder = + { ExprFolder0 with + exprIntercept = + (fun _exprF noInterceptF depIdxs expr -> + let depIdxs = + match expr with + // Member-constraint calls can hide the real sibling dependency behind + // a witness expression, so fold over the resolved witness as well. + | Expr.Op(TOp.TraitCall traitInfo, _, args, m) -> + match ConstraintSolver.CodegenWitnessExprForTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo args with + | OkResult (_, Some witnessExpr) -> addBindingDependencies depIdxs witnessExpr + | _ -> depIdxs + | _ -> depIdxs + + noInterceptF depIdxs expr) } + + FoldExpr folder depIdxs expr) + + let dependencyIndexes = + elements + |> List.map (fun (_, _, source) -> + (match source with + | Choice1Of2 expr -> addBindingDependencies Set.empty expr + // Note: trait-call witnesses inside nested module contents are not resolved here. + | Choice2Of2 mdef -> + addFreeVars Set.empty (freeInModuleOrNamespace (CollectLocalsWithStackGuard()) mdef)) + |> Set.toArray) + |> List.toArray + + let rootOrder = + [ 0 .. elements.Length - 1 ] + |> (if preferLowArity then + List.sortBy (fun idx -> + let _, arity, _ = elemsArray[idx] + arity, -idx) + else + id) + + TopologicalPostOrder cenv.stackGuard.Guard dependencyIndexes rootOrder + and OptimizeModuleContents cenv (env, bindInfosColl) input = match input with | TMDefRec(isRec, opens, tycons, mbinds, m) -> let env = if isRec then BindInternalValsToUnknown cenv (allValsOfModDef input) env else env - let mbindInfos, (env, bindInfosColl) = OptimizeModuleBindings cenv (env, bindInfosColl) mbinds + let mbindInfos, (env, bindInfosColl) = OptimizeModuleBindings cenv isRec (env, bindInfosColl) mbinds let mbinds, minfos = List.unzip mbindInfos let binds = minfos |> List.choose (function Choice1Of2 (x, _) -> Some x | _ -> None) let binfos = minfos |> List.choose (function Choice1Of2 (_, x) -> Some x | _ -> None) @@ -4765,8 +4909,48 @@ and OptimizeModuleContents cenv (env, bindInfosColl) input = let (defs, info), (env, bindInfosColl) = OptimizeModuleDefs cenv (env, bindInfosColl) defs (TMDefs defs, info), (env, bindInfosColl) -and OptimizeModuleBindings cenv (env, bindInfosColl) xs = - List.mapFold (OptimizeModuleBinding cenv) (env, bindInfosColl) xs +and OptimizeModuleBindings cenv isRec (env, bindInfosColl) xs = + let (|DependencyOrder|_|) = + function + | [] | [ _ ] -> None + | xs when isRec -> + let elements = + xs + |> List.map (function + | ModuleOrNamespaceBinding.Binding bind -> + let arity = + bind.Var.ValReprInfo + |> Option.map (fun repr -> repr.TotalArgCount) + |> Option.defaultValue 0 + + [ bind.Var ], arity, Choice1Of2 bind.Expr + | ModuleOrNamespaceBinding.Module(_, def) -> + List.ofSeq (allValsOfModDef def), 0, Choice2Of2 def) + + let hasInlineVal = + elements + |> List.exists (fun (definedVals, _, _) -> + definedVals |> List.exists (fun (v: Val) -> v.ShouldInline)) + + if hasInlineVal then + let preferLowArity = + xs + |> List.forall (function + | ModuleOrNamespaceBinding.Binding bind -> bind.Var.IsMember + | ModuleOrNamespaceBinding.Module _ -> true) + + let order = GetGroupOptimizationOrder cenv true preferLowArity elements + Some order + else + None + | _ -> None + + match xs with + | DependencyOrder order -> + // Keep the emitted binding list in source order; only the optimization schedule changes. + OptimizeInDependencyOrder xs order (OptimizeModuleBinding cenv) (env, bindInfosColl) + | _ -> + List.mapFold (OptimizeModuleBinding cenv) (env, bindInfosColl) xs and OptimizeModuleBinding cenv (env, bindInfosColl) x = match x with diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Regression_RecursiveInlineMemberDependencies.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Regression_RecursiveInlineMemberDependencies.fs new file mode 100644 index 00000000000..8b4258800b3 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Inlining/Regression_RecursiveInlineMemberDependencies.fs @@ -0,0 +1,233 @@ +namespace EmittedIL.Inlining + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler + +module Regression_RecursiveInlineMemberDependencies = + + let private assertCompiles source = + source + |> withOptimize + |> compile + |> shouldSucceed + |> ignore + + [] + let ``Inline members that depend on sibling member access compile`` () = + FSharp """ +module MemberAccessDependencyRepro + +type ValidationBuilder() = + member inline _.Return(value: int) : int = value + + member inline this.Bind(value: int, binder: int -> int) : int = + let result = this.Source value + binder result + + member inline this.Source(value: int) : int = value + +let inline run (builder: ValidationBuilder) = + builder.Bind(1, fun x -> x + 1) +""" + |> assertCompiles + + [] + let ``Trait-witness inline overload consumers compile`` () = + FSharp """ +module TraitWitnessOverloadRepro + +open System.Runtime.InteropServices + +type Default1 = class end + +type Intersperse = + inherit Default1 + + static member inline Intersperse (x: '``Collection<'T>``, e: 'T, []_impl: Default1) = + x + + static member Intersperse (x: list<'T>, e: 'T, []_impl: Intersperse) = + x + + static member inline Invoke (sep: 'T) (source: '``Collection<'T>``) = + let inline call_2 (a: ^a, b: ^b, s) = + ((^a or ^b): (static member Intersperse: _ * _ * _ -> _) (b, s, a)) + + let inline call (a: 'a, b: 'b, s) = + call_2 (a, b, s) + + call (Unchecked.defaultof, source, sep) : '``Collection<'T>`` + +let _ = Intersperse.Invoke 0 [1] +""" + |> assertCompiles + + [] + let ``Issue 1565 example 1 compiles`` () = + FSharp """ +module Issue1565Example1 + +let inline checkBounds f (g: 'b -> ^c) (tp: ^a) = + let convertFrom = (^a: (static member name: string) ()) + let convertTo = (^c: (static member name : string) ()) + let value = (^a: (member Value: 'b) tp) + + if f value then + g value + else + failwithf "Cannot convert from %s to %s." convertFrom convertTo + +[] +type ConverterA = + val Value: sbyte + new(v) = { Value = v } + + static member inline name with get () = "converter-a" + + static member inline convert(x: ConverterA): ConverterB = + checkBounds ((>=) 0y) (byte >> ConverterB) x + +and [] ConverterB = + val Value: byte + new(v) = { Value = v } + + static member inline name with get () = "converter-b" +""" + |> assertCompiles + + [] + let ``Issue 1565 example 2 compiles`` () = + FSharp """ +module Issue1565Example2 + +[] +type MyType = + | Integer = 0b0001 + | Float = 0b0010 + +module Test = + [] + type SomeType = + | Int of int64 + | Float of float + + override x.Equals other = + match other with + | :? SomeType as y -> + match SomeType.getType x &&& SomeType.getType y with + | MyType.Integer -> int64 x = int64 y + | MyType.Float -> float x = float y + | _ -> false + | _ -> false + + override x.GetHashCode() = + match x with + | Int i -> hash i + | Float f -> hash f + + static member inline op_Explicit(n: SomeType): float = + match n with + | Int i -> float i + | Float f -> f + + static member inline op_Explicit(n: SomeType): int64 = + match n with + | Int i -> i + | Float f -> int64 f + + static member inline getType x = + match x with + | Int _ -> MyType.Integer + | Float _ -> MyType.Float +""" + |> assertCompiles + + [] + let ``Issue 1565 example 3 compiles`` () = + FSharp """ +module Test + +type SomeType = + | Int of int64 + | Float of float + + static member MyEquals(x, other: SomeType) = + float x = float other + + static member inline op_Explicit(n: SomeType): float = + match n with + | Int i -> float i + | Float f -> f + + static member inline op_Explicit(n: SomeType): int64 = + match n with + | Int i -> i + | Float f -> int64 f +""" + |> assertCompiles + + [] + let ``Recursive group with nested module reorders let rec inline dependencies`` () = + FSharp """ +module rec MixedLetRec + +let consumer (x: int) = worker x + +module Separator = + let marker = 0 + +let rec worker (x: int) : int = helper x +and inline helper (x: int) : int = x + x +""" + |> assertCompiles + + [] + let ``Recursive group member depends on inline value in later nested module`` () = + FSharp """ +module rec MixedGroup + +type Builder() = + member _.Run(x: int) = Helper.twice x + +module Helper = + let inline twice (x: int) = x + x + +let result = Builder().Run 21 +""" + |> assertCompiles + + [] + let ``Trait-witness dependency into later nested module compiles`` () = + FSharp """ +module rec TraitWitnessOnlyEdge + +type User() = + member _.Run() = + let inline invoke (x: ^T) = + (^T: (static member DoIt: ^T -> int) x) + + invoke (Helpers.Intersp()) + +module Helpers = + type Intersp() = + static member inline DoIt(x: Intersp) = 42 +""" + |> assertCompiles + + + [] + let ``Deep recursive inline expression compiles`` () = + let nestedExpression = + [ 1 .. 512 ] + |> List.fold (fun body _ -> $"if true then ({body}) else 0") "0" + + FSharp $""" +module DeepRecursiveInlineExpression + +let rec inline evaluate value = + {nestedExpression} + +let _ = evaluate 0 +""" + |> assertCompiles diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index cc7e109373f..ecb19bd30bb 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -287,6 +287,7 @@ +