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 ed1e382d6c7..f30157e9921 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -1,5 +1,6 @@ ### Fixed +* Fix internal error FS0192 "Iterate2D" when a `[]` parameter auto-quotes an argument that captures a not-yet-generalized use of an inferred generically-recursive function. The auto-quoted (`Expr.WithValue`) copy now keeps a fresh link to the recursive-value use so it receives the same inferred type arguments as the executable expression at the letrec point. ([Issue #20379](https://github.com/dotnet/fsharp/issues/20379)) * Fix `NativePtr.stackalloc` nested in a larger expression (e.g. a call argument or the right of an assignment) producing an assembly that throws `InvalidProgramException` at load. ([Issue #8083](https://github.com/dotnet/fsharp/issues/8083), [PR #20302](https://github.com/dotnet/fsharp/pull/20302)) * Fix internal error "Unexpected generalized type variables when compiling an active pattern" when an active pattern is used in a `let` binding whose right-hand side is a generic value, e.g. `let (T) = id`. Such a binding is now checked like the equivalent `match` and is not generalized. ([Issue #16856](https://github.com/dotnet/fsharp/issues/16856), [PR #20383](https://github.com/dotnet/fsharp/pull/20383)) * Fix Release-only (`--optimize+`) `System.InvalidProgramException` from `Seq.collect` / `yield!` over a value-type (struct) collection implementing `seq<'T>` (e.g. `ImmutableArray<_>`) when materialised with `List.ofSeq` / `Seq.toList` / `Seq.toArray` or a list/array comprehension. The collector lowering now boxes a struct sub-collection to `seq<'T>` before calling `AddMany`/`AddManyAndClose` (matching the coercion the type checker already inserts for `yield!`), and uses `unit` as the try/finally result type instead of the body type (removing a spurious `ldnull` store). ([Issue #20203](https://github.com/dotnet/fsharp/issues/20203)) diff --git a/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs b/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs index 3c00c0ee66d..b4289eae422 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs @@ -1491,7 +1491,7 @@ module internal Makers = // Use "Expr.WithValue" if it exists in FSharp.Core match vref.TryDeref with | ValueSome _ -> - let copyOfExpr = copyExpr g ValCopyFlag.CloneAll e1 + let copyOfExpr = copyExprKeepingRecursiveValLinks g ValCopyFlag.CloneAll e1 let quoteOfCopyOfExpr = Expr.Quote(copyOfExpr, ref None, false, m, qty) mkApps diff --git a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs index 92d440d6f6d..d12a4a22c90 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs @@ -1654,9 +1654,42 @@ module internal ExprRemapping = tps', tmenvinner type RemapContext = - { g: TcGlobals; stackGuard: StackGuard } + { + g: TcGlobals + stackGuard: StackGuard + // When set, an Expr.Link that refers to a recursive value still in its letrec scope is copied as a + // fresh link that keeps pointing at the original fixup node, rather than being inlined at copy time. + // This lets an auto-quoted (WithValue) copy of a recursive-value use receive the inferred type + // arguments that AdjustAndForgetUsesOfRecValue inserts at the letrec point. See issue #20379. + keepRecursiveValLinks: bool + } - let mkRemapContext g stackGuard = { g = g; stackGuard = stackGuard } + let mkRemapContext g stackGuard = + { + g = g + stackGuard = stackGuard + keepRecursiveValLinks = false + } + + /// Detect an Expr.Link that stands for a use of a recursive *function* value which is still within its + /// letrec scope (and will therefore be fixed up by AdjustAndForgetUsesOfRecValue once type arguments are + /// inferred). Only function-valued recursive bindings are matched: they are bound as lambdas and so are + /// never rewritten by the lazy-initialization morph in EliminateInitializationGraphs, whereas a monomorphic + /// recursive *data* value would have this same shared fixup node re-mutated to a lazy 'Force', leaking that + /// node into the captured quotation. See issue #20379. + let isRecursiveValFixupLink (eref: Expr ref) = + match stripDebugPoints eref.Value with + | Expr.Val(vref, _, _) + // A recursive-use fixup node is always a type-only application with no value args (see mkTyAppExpr and + // the shape AdjustAndForgetUsesOfRecValue accepts), so match that exact shape. + | Expr.App(Expr.Val(vref, _, _), _, _, [], _) -> + match vref.RecursiveValInfo with + | ValInRecScope _ -> + match vref.ValReprInfo with + | Some info -> info.NumCurriedArgs > 0 + | None -> false + | ValNotInRecScope -> false + | _ -> false let rec remapAttribImpl ctxt tmenv (Attrib(tcref, kind, args, props, isGetOrSetAttr, targets, m)) = Attrib( @@ -1862,7 +1895,14 @@ module internal ExprRemapping = | Expr.App(e1, e1ty, tyargs, args, m) -> remapAppExpr ctxt compgen tmenv (e1, e1ty, tyargs, args, m) expr - | Expr.Link eref -> remapExprImpl ctxt compgen tmenv eref.Value + | Expr.Link eref -> + if ctxt.keepRecursiveValLinks && isRecursiveValFixupLink eref then + // Keep a fresh link that still points at the original recursive-use fixup node so the + // quoted copy also receives the inferred type arguments inserted later at the letrec point, + // instead of snapshotting the not-yet-generalized value. See issue #20379. + Expr.Link(ref (Expr.Link eref)) + else + remapExprImpl ctxt compgen tmenv eref.Value | Expr.StaticOptimization(cs, e2, e3, m) -> // note that type instantiation typically resolve the static constraints here @@ -2445,6 +2485,7 @@ module internal ExprRemapping = { g = g stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = false } remapAttribImpl ctxt tmenv attrib @@ -2454,6 +2495,7 @@ module internal ExprRemapping = { g = g stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = false } remapExprImpl ctxt compgen tmenv expr @@ -2463,6 +2505,7 @@ module internal ExprRemapping = { g = g stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = false } remapPossibleForallTyImpl ctxt tmenv ty @@ -2472,6 +2515,7 @@ module internal ExprRemapping = { g = g stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = false } copyAndRemapAndBindModTy ctxt compgen Remap.Empty mtyp |> fst @@ -2481,6 +2525,20 @@ module internal ExprRemapping = { g = g stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = false + } + + remapExprImpl ctxt compgen Remap.Empty e + + /// Copy an expression for use as the definition inside an auto-quotation (Expr.WithValue), keeping fresh + /// links to any recursive-value uses that are still within their letrec scope so the copy also receives + /// the inferred type arguments applied later by AdjustAndForgetUsesOfRecValue. See issue #20379. + let copyExprKeepingRecursiveValLinks g compgen e = + let ctxt = + { + g = g + stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = true } remapExprImpl ctxt compgen Remap.Empty e @@ -2490,6 +2548,7 @@ module internal ExprRemapping = { g = g stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = false } remapImplFile ctxt compgen Remap.Empty e |> fst @@ -2499,6 +2558,7 @@ module internal ExprRemapping = { g = g stackGuard = StackGuard("RemapExprStackGuardDepth") + keepRecursiveValLinks = false } remapExprImpl ctxt CloneAll (mkInstRemap tpinst) e diff --git a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi index 5372d2a2511..8a4f1bd308b 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi @@ -227,6 +227,11 @@ module internal ExprRemapping = /// Copy an entire expression using the given copying flags val copyExpr: TcGlobals -> ValCopyFlag -> Expr -> Expr + /// Copy an expression for use as the definition inside an auto-quotation (Expr.WithValue), keeping fresh + /// links to recursive-value uses still within their letrec scope so the copy also receives the inferred + /// type arguments applied later by AdjustAndForgetUsesOfRecValue. See issue #20379. + val copyExprKeepingRecursiveValLinks: TcGlobals -> ValCopyFlag -> Expr -> Expr + /// Copy an entire implementation file using the given copying flags val copyImplFile: TcGlobals -> ValCopyFlag -> CheckedImplFile -> CheckedImplFile diff --git a/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs index 07ba21f7b5c..0e2aa2da618 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/CodeQuotationTests.fs @@ -200,4 +200,283 @@ printfn "Both F# record field orderings produce equivalent results" |> asExe |> withLangVersionPreview |> compileAndRun + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + // [] on a parameter + inferred generic recursion must not ICE (FS0192 Iterate2D). + [] + let ``ReflectedDefinition parameter with inferred generic recursion compiles - issue 20379`` () = + FSharp """ +module Test20379 + +open Microsoft.FSharp.Quotations + +type Capture = + static member Run([] body: Expr int>) = 0 + +let rec loop x = + Capture.Run(fun n -> loop x) + """ + |> asLibrary + |> compile + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + // Original attachment's essential 'append' shape: inferred generic recursion under an auto-quoted parameter. + [] + let ``ReflectedDefinition parameter with recursive append shape compiles - issue 20379`` () = + FSharp """ +module Test20379Append + +open Microsoft.FSharp.Quotations + +type Capture = + static member Run([] body: Expr<'T list -> 'T list>) : 'T list = [] + +let rec append xs ys = + Capture.Run(fun zs -> + match xs with + | [] -> ys + | h :: t -> h :: append t ys) + """ + |> asLibrary + |> compile + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + // Runtime seed: inferred two-parameter generic recursion must preserve exact generic-argument order, + // and the auto-quoted definition must agree with the executed value. + [] + let ``ReflectedDefinition parameter preserves generic argument order at runtime - issue 20379`` () = + Fsx """ +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns +open Microsoft.FSharp.Linq.RuntimeHelpers + +let mutable captured: Expr option = None + +type Capture = + static member Run([] body: Expr int>) = + captured <- Some body + 7 + +let rec loop x y = + Capture.Run(fun n -> if n = 0 then 7 else loop x y) + +let check<'T, 'U> (x: 'T) (y: 'U) = + if loop x y <> 7 then failwith "Unexpected result" + match captured with + | Some(WithValue(value, _, (Lambda(v, IfThenElse(_, _, Call(None, method, [_; _]))) as definition))) -> + if v.Name <> "n" then failwith "Lambda parameter changed" + if method.GetGenericArguments() <> [|typeof<'T>; typeof<'U>|] then failwith "Incorrect generic arguments" + let actual = unbox int> value + let reflected = LeafExpressionConverter.EvaluateQuotation definition |> unbox int> + if actual 1 <> 7 || reflected 1 <> 7 then failwith "Value and quotation disagree" + | expression -> failwithf "Unexpected quotation: %A" expression + +check 42 "text" +check "text" 42 + """ + |> asExe + |> compileAndRun + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + [] + let ``Mutual inferred generic recursion under auto-quote compiles both directions - issue 20379`` () = + FSharp """ +module Test20379Mutual + +open Microsoft.FSharp.Quotations + +type Capture = + static member Run([] body: Expr int>) = 0 + +let rec ping x y = + Capture.Run(fun n -> pong x y) +and pong x y = + Capture.Run(fun n -> ping x y) + """ + |> asLibrary + |> compile + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + [] + let ``Auto-quote with nested lambdas captured and shadowed names agrees value and quotation - issue 20379`` () = + Fsx """ +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns +open Microsoft.FSharp.Linq.RuntimeHelpers + +let mutable captured: Expr option = None + +type Capture = + static member Run([] body: Expr int>) = + captured <- Some body + 7 + +let rec loop x y = + let k = 3 + let rec helper (m: int) = if m <= 0 then k else helper (m - 1) + Capture.Run(fun n -> + let n = n + helper 2 + if n = 0 then 7 else loop x y) + +let check<'T, 'U> (x: 'T) (y: 'U) = + if loop x y <> 7 then failwith "Unexpected result" + match captured with + | Some(WithValue(value, _, definition)) -> + let actual = unbox int> value + let reflected = LeafExpressionConverter.EvaluateQuotation definition |> unbox int> + if actual 1 <> reflected 1 then failwith "Value and quotation disagree" + | expression -> failwithf "Unexpected quotation: %A" expression + +check 42 "text" + """ + |> asExe + |> compileAndRun + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + [] + [] + [] + let ``Auto-quote inferred generic recursion works for static and instance methods - issue 20379`` (decl: string) (call: string) = + FSharp(sprintf """ +module Test20379Methods + +open Microsoft.FSharp.Quotations + +type Capture() = + %s ([] body: Expr int>) = 0 + +let rec loop x y = + %s(fun n -> if n = 0 then 7 else loop x y) + """ decl call) + |> asLibrary + |> compile + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + [] + let ``Auto-quote inferred generic recursion works across an F# assembly boundary - issue 20379`` () = + let lib = + FSharp """ +namespace Api +open Microsoft.FSharp.Quotations +type Capture = + static member Run([] body: Expr int>) = 0 + """ + |> withName "Api20379" + |> asLibrary + + FSharp """ +module Consumer20379 +open Api +let rec loop x y = + Capture.Run(fun n -> if n = 0 then 7 else loop x y) + """ + |> withReferences [ lib ] + |> asLibrary + |> compile + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 + [] + let ``Auto-quoted argument is constructed exactly once - issue 20379`` () = + Fsx """ +open Microsoft.FSharp.Quotations + +let mutable constructions = 0 + +type Capture = + static member Run([] body: Expr int>) = 0 + +let makeBody () = + constructions <- constructions + 1 + (fun (n: int) -> n) + +let rec loop x y = + Capture.Run(makeBody ()) + +let _ = loop 1 2 +if constructions <> 1 then failwithf "Expected exactly one construction, got %d" constructions + """ + |> asExe + |> compileAndRun + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 - controls that must keep working + [] + [] body: Expr int>) = 0\nlet rec loop x y = Capture.Run(fun n -> if n = 0 then 7 else loop x y)")>] + [] body: Expr int>) = 0\nlet go x = Capture.Run(fun n -> n + 1)")>] + [ int) = 0\nlet rec loop x y = Capture.Run(fun n -> if n = 0 then 7 else loop x y)")>] + [ int>) = 0\nlet rec loop x y = Capture.Run(<@ fun n -> if n = 0 then 7 else loop x y @>)")>] + [] body: Expr int>) = 0\nlet rec loop (x: int) = Capture.Run(fun n -> if n = 0 then 7 else loop x)")>] + [] body: Expr int>) = 0\nlet rec loop<'T, 'U> (x: 'T) (y: 'U) = Capture.Run(fun n -> if n = 0 then 7 else loop x y)")>] + let ``Auto-quote controls keep compiling - issue 20379`` (_name: string) (body: string) = + FSharp(sprintf "module Test20379Controls\nopen Microsoft.FSharp.Quotations\n%s" body) + |> asLibrary + |> compile + |> shouldSucceed + + // https://github.com/dotnet/fsharp/issues/20379 - inner generic functions remain unsupported (FS1230), not an ICE + [] + let ``Inner generic function inside quotation remains FS1230 - issue 20379`` () = + FSharp """ +module Test20379InnerGeneric +open Microsoft.FSharp.Quotations +type Capture = + static member Run([] body: Expr int>) = 0 +let rec loop x y = + Capture.Run(fun n -> + let inline g (z: 'a) = z + if n = 0 then 7 else loop (g x) (g y)) + """ + |> asLibrary + |> compile + |> shouldFail + |> withErrorCode 1230 + + // https://github.com/dotnet/fsharp/issues/20379 + // A monomorphic recursive *data* value (lazy-initialized 'let rec') gains nothing from fixup-link + // preservation. Its recursive-use fixup node is re-mutated to a lazy 'Force' by the initialization-graph + // elimination, so preserving the link would leak that 'Force' into the captured quotation. The auto-quoted + // definition must reference the value directly, exactly as before the issue 20379 fix. + [] + let ``Auto-quote of monomorphic recursive data value does not leak a lazy Force - issue 20379`` () = + Fsx """ +open Microsoft.FSharp.Quotations +open Microsoft.FSharp.Quotations.Patterns + +#nowarn "21" +#nowarn "40" + +let mutable captured: Expr option = None + +type Capture = + static member Run([] body: Expr int>) = + captured <- Some body + (fun (n: int) -> n) + +let rec data : int -> int = + Capture.Run(fun n -> data n) + +if data 3 <> 3 then failwith "Unexpected result" + +let rec containsForce expr = + match expr with + | Call(_, method, _) when method.Name = "Force" -> true + | ExprShape.ShapeVar _ -> false + | ExprShape.ShapeLambda(_, body) -> containsForce body + | ExprShape.ShapeCombination(_, args) -> List.exists containsForce args + +match captured with +| Some(WithValue(_, _, definition)) -> + if containsForce definition then failwithf "Lazy Force leaked into quotation: %A" definition +| expression -> failwithf "Unexpected quotation: %A" expression + """ + |> asExe + |> compileAndRun |> shouldSucceed \ No newline at end of file