From 2b00c4f5f8bf3baa5b631f8256fedeb8cf8a5eeb Mon Sep 17 00:00:00 2001 From: kerams Date: Sun, 19 Mar 2023 19:18:26 +0100 Subject: [PATCH 1/4] Try fix static compilation of state machines --- src/Compiler/Optimize/LowerStateMachines.fs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Optimize/LowerStateMachines.fs b/src/Compiler/Optimize/LowerStateMachines.fs index 5a6fadcfd6d..342154e43e5 100644 --- a/src/Compiler/Optimize/LowerStateMachines.fs +++ b/src/Compiler/Optimize/LowerStateMachines.fs @@ -313,11 +313,14 @@ type LowerStateMachine(g: TcGlobals) = | Some innerExpr2 -> Some (Expr.DebugPoint (dp, innerExpr2)) | None -> None + | Expr.App _ -> + TryReduceExpr env expr args id + | _ -> None // Apply a single expansion of resumable code at the outermost position in an arbitrary expression - let rec TryReduceExpr (env: env) expr args remake = + and TryReduceExpr (env: env) expr args remake = if sm_verbose then printfn "expanding defns and reducing %A..." expr //if sm_verbose then printfn "checking %A for possible resumable code application..." expr match expr with From fba89992dfe12606b10cd941f60a3f06d85c8e41 Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 29 Apr 2023 11:53:35 +0200 Subject: [PATCH 2/4] See what happens --- src/Compiler/Optimize/LowerStateMachines.fs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Compiler/Optimize/LowerStateMachines.fs b/src/Compiler/Optimize/LowerStateMachines.fs index 342154e43e5..6fad1502ce3 100644 --- a/src/Compiler/Optimize/LowerStateMachines.fs +++ b/src/Compiler/Optimize/LowerStateMachines.fs @@ -187,8 +187,16 @@ type LowerStateMachine(g: TcGlobals) = | Expr.Let (defn, bodyExpr, _, _) when isStateMachineBindingVar g defn.Var -> if sm_verbose then printfn "binding %A --> %A..." defn.Var defn.Expr let envR = { env with ResumableCodeDefns = env.ResumableCodeDefns.Add defn.Var defn.Expr } + let envR, _ = BindResumableCodeDefinitions envR defn.Expr BindResumableCodeDefinitions envR bodyExpr + | Expr.Lambda (valParams = valParams; bodyExpr = bodyExpr; overallType = ty) when isReturnsResumableCodeTy g ty -> + if sm_verbose then printfn "binding fun %A --> %A..." valParams bodyExpr + BindResumableCodeDefinitions env bodyExpr + + | Expr.DebugPoint (_, expr) -> + BindResumableCodeDefinitions env expr + // Eliminate 'if __useResumableCode ...' | IfUseResumableStateMachinesExpr g (thenExpr, _) -> if sm_verbose then printfn "eliminating 'if __useResumableCode...'" From bf795bcbe48825c8032183152490422e627d5d9b Mon Sep 17 00:00:00 2001 From: kerams Date: Sat, 29 Apr 2023 12:40:18 +0200 Subject: [PATCH 3/4] Try harder --- src/Compiler/Optimize/LowerStateMachines.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Optimize/LowerStateMachines.fs b/src/Compiler/Optimize/LowerStateMachines.fs index 6fad1502ce3..7986cec3e04 100644 --- a/src/Compiler/Optimize/LowerStateMachines.fs +++ b/src/Compiler/Optimize/LowerStateMachines.fs @@ -194,8 +194,9 @@ type LowerStateMachine(g: TcGlobals) = if sm_verbose then printfn "binding fun %A --> %A..." valParams bodyExpr BindResumableCodeDefinitions env bodyExpr - | Expr.DebugPoint (_, expr) -> - BindResumableCodeDefinitions env expr + | Expr.DebugPoint (_, innerExpr) -> + let envR, _ = BindResumableCodeDefinitions env innerExpr + envR, expr // Eliminate 'if __useResumableCode ...' | IfUseResumableStateMachinesExpr g (thenExpr, _) -> From 84067185be9295ceab7678e1b0eec38893f1ba7d Mon Sep 17 00:00:00 2001 From: kerams Date: Sun, 30 Apr 2023 11:34:58 +0200 Subject: [PATCH 4/4] Add a test --- .../Language/StateMachineTests.fs | 91 +++++++++++++++++++ 1 file changed, 91 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/StateMachineTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/StateMachineTests.fs index c2dca0d1fb4..3cf3c4f3020 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/StateMachineTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/StateMachineTests.fs @@ -102,6 +102,97 @@ let compute () = // multiple invocations to trigger tiered compilation for i in 1 .. 100 do compute().Wait () +""" + |> withOptimize + |> compileExeAndRun + |> shouldSucceed + + [] // https://github.com/dotnet/fsharp/issues/12839#issuecomment-1292310944 + let ``Tasks with a for loop over tuples are statically compilable``() = + FSharp """ +module TestProject1 + +let ret i = task { return i } + +let one (f: seq) = task { + let mutable sum = 0 + + let! x = ret 1 + sum <- sum + x + + for name, _whatever, i in f do + let! x = ret i + sum <- sum + x + + System.Console.Write name + + let! x = ret i + sum <- sum + x + + let! x = ret 1 + sum <- sum + x + + return sum +} + +let two (f: seq) = task { + let mutable sum = 0 + + let! x = ret 1 + sum <- sum + x + + for name, _whatever, i in f do + let! x = ret i + sum <- sum + x + + System.Console.Write name + + let! x = ret 1 + sum <- sum + x + + return sum +} + +let three (f: seq) = task { + let mutable sum = 0 + + let! x = ret 1 + sum <- sum + x + + for name, _whatever, i in f do + let! x = ret i + sum <- sum + x + + System.Console.Write name + + return sum +} + +let four (f: seq) = task { + let mutable sum = 0 + + let! x = ret 5 + sum <- sum + x + + for name, _i in f do + System.Console.Write name + + let! x = ret 1 + sum <- sum + x + + return sum +} + +if (one [ ("", "", 1); ("", "", 2) ]).Result <> 8 then + failwith "unexpected result one" +if (one []).Result <> 2 then + failwith "unexpected result one" +if (two [ ("", "", 2) ]).Result <> 4 then + failwith "unexpected result two" +if (three [ ("", "", 5) ]).Result <> 6 then + failwith "unexpected result three" +if (four [ ("", 10) ]).Result <> 6 then + failwith "unexpected result four" """ |> withOptimize |> compileExeAndRun