From 4de5a927b640d73e6326e4c758b0bb04c8cd695a Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 08:18:51 +0200 Subject: [PATCH 01/10] Try to deforest Seq.map calls --- src/fsharp/Optimizer.fs | 22 ++++++++++++++++++++-- src/fsharp/TastOps.fs | 4 ++-- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 9cf43ef02d8..4867cb2aea8 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -1670,7 +1670,6 @@ let TryDetectQueryQuoteAndRun cenv (expr:Expr) = //------------------------------------------------------------------------- let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = - // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need // complete inference types. let expr = NormalizeAndAdjustPossibleSubsumptionExprs cenv.g expr @@ -1679,7 +1678,7 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = match expr with // treat the common linear cases to avoid stack overflows, using an explicit continuation - | Expr.Sequential _ | Expr.Let _ -> OptimizeLinearExpr cenv env expr (fun x -> x) + | Expr.Sequential _ | Expr.Let _ -> OptimizeLinearExpr cenv env expr id | Expr.Const (c,m,ty) -> OptimizeConst cenv env expr (c,m,ty) | Expr.Val (v,_vFlags,m) -> OptimizeVal cenv env expr (v,m) @@ -2610,6 +2609,25 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = // we beta-reduced, hence reoptimize OptimizeExpr cenv env newExpr | _ -> + match expr' with + | Expr.App(Expr.Val(valRef,flag1,range1),ttype1,tinst1, + [(Expr.Lambda(_,None,None,_l14,_,m1,rty1) as outerL) + Expr.App(Expr.Val(valRef2,_,_),_,_, + [Expr.Lambda(_,None,None,l24,l25,_,rty2) + rest],_)],r1) when + valRefEq cenv.g valRef cenv.g.seq_map_vref && + valRefEq cenv.g valRef2 cenv.g.seq_map_vref + -> + let newApp = Expr.App(outerL,TType_fun(rty2, rty1),[],[l25],r1) + + let reduced = + Expr.App(Expr.Val(valRef,flag1,range1),ttype1,tinst1, + [Expr.Lambda (newUnique(), None, None, l24, newApp, m1, rty2) + rest],r1) + + OptimizeExpr cenv env reduced + | _ -> + // regular // Determine if this application is a critical tailcall diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 7166be59bee..6285a69c810 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -5641,8 +5641,8 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress let mkExprAddrOfExpr g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m = let optBind, addre = mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m match optBind with - | None -> (fun x -> x), addre - | Some (tmp,rval) -> (fun x -> mkCompGenLet m tmp rval x), addre + | None -> id, addre + | Some (tmp,rval) -> mkCompGenLet m tmp rval, addre let mkTupleFieldGet g (tupInfo,e,tinst,i,m) = let wrap,e' = mkExprAddrOfExpr g (evalTupInfoIsStruct tupInfo) false NeverMutates e None m From 5bf434dce7029732097fc889d31bf922470dceff Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 16:03:01 +0200 Subject: [PATCH 02/10] Add unit tests for fusion --- .../FSharp.Compiler.Unittests.fsproj | 2 ++ .../FSharp.Compiler.Unittests/SeqFusion.fs | 27 +++++++++++++++++++ 2 files changed, 29 insertions(+) create mode 100644 src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs diff --git a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj index f2a9b07b926..62e287d31b0 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj +++ b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj @@ -48,12 +48,14 @@ ..\..\..\packages\System.ValueTuple.4.3.1\lib\netstandard1.0\System.ValueTuple.dll + ..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll + diff --git a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs new file mode 100644 index 00000000000..99f6d16a78c --- /dev/null +++ b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs @@ -0,0 +1,27 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace FSharp.Compiler.Unittests + +open System +open NUnit.Framework + +[] +type SeqFusionTestsModule() = + + [] + member this.FuseTwoMapsWithSameType() = + let data = [3; 1; 2] + let result = Seq.map (fun x -> x * 2) (Seq.map (fun x -> x + 2) data) + Assert.areEqual ([12; 6; 8]) (Seq.toList result) + + [] + member this.FuseTwoMapsWithSameType_String() = + let data = ["hello"; "world"; "!"] + let result = Seq.map (fun x -> "hello" + x) (Seq.map (fun (y:string) -> " " + y) data) + Assert.areEqual (["hello hello"; "hello world"; "hello !"]) (Seq.toList result) + + [] + member this.FuseTwoMapsWithDifferentType() = + let data = ["hello"; "world"; "!"] + let result = Seq.map (fun x -> x * 3) (Seq.map (fun (y:string) -> y.Length) data) + Assert.areEqual ([15; 15; 3]) (Seq.toList result) \ No newline at end of file From c03a656e5c38f074c14ed1ae81969592a6857263 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 16:50:28 +0200 Subject: [PATCH 03/10] Fix types --- src/fsharp/Optimizer.fs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 4867cb2aea8..d498ee4f75d 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2610,19 +2610,20 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = OptimizeExpr cenv env newExpr | _ -> match expr' with - | Expr.App(Expr.Val(valRef,flag1,range1),ttype1,tinst1, - [(Expr.Lambda(_,None,None,_l14,_,m1,rty1) as outerL) - Expr.App(Expr.Val(valRef2,_,_),_,_, - [Expr.Lambda(_,None,None,l24,l25,_,rty2) + // Rewrite Seq.map f (Seq.map g) xs into Seq.map (fun x -> f(g x)) xs + | Expr.App(Expr.Val(valRef,_,_) as outerSeqMap,ttype1,[_;t12], + [(Expr.Lambda(_,None,None,_,_,m1,rty1) as outerL) + Expr.App(Expr.Val(valRef2,_,_),_,[t21;_], + [Expr.Lambda(_,None,None,gVals,g,_,gRetType) rest],_)],r1) when valRefEq cenv.g valRef cenv.g.seq_map_vref && valRefEq cenv.g valRef2 cenv.g.seq_map_vref -> - let newApp = Expr.App(outerL,TType_fun(rty2, rty1),[],[l25],r1) + let newApp = Expr.App(outerL,TType_fun(gRetType, rty1),[],[g],r1) let reduced = - Expr.App(Expr.Val(valRef,flag1,range1),ttype1,tinst1, - [Expr.Lambda (newUnique(), None, None, l24, newApp, m1, rty2) + Expr.App(outerSeqMap,ttype1,[t21;t12], + [Expr.Lambda (newUnique(), None, None, gVals, newApp, m1, gRetType) rest],r1) OptimizeExpr cenv env reduced From 46a2ee8fd6ee35ce15f4514426c6d89d0eb01ce7 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 16:59:10 +0200 Subject: [PATCH 04/10] cleanup --- src/fsharp/Optimizer.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index d498ee4f75d..7b2746116d7 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2612,19 +2612,19 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = match expr' with // Rewrite Seq.map f (Seq.map g) xs into Seq.map (fun x -> f(g x)) xs | Expr.App(Expr.Val(valRef,_,_) as outerSeqMap,ttype1,[_;t12], - [(Expr.Lambda(_,None,None,_,_,m1,rty1) as outerL) + [(Expr.Lambda(_,None,None,_,_,m1,fRetType) as f) Expr.App(Expr.Val(valRef2,_,_),_,[t21;_], [Expr.Lambda(_,None,None,gVals,g,_,gRetType) - rest],_)],r1) when + rest],_)],m2) when valRefEq cenv.g valRef cenv.g.seq_map_vref && valRefEq cenv.g valRef2 cenv.g.seq_map_vref -> - let newApp = Expr.App(outerL,TType_fun(gRetType, rty1),[],[g],r1) + let newApp = Expr.App(f,TType_fun(gRetType, fRetType),[],[g],m2) let reduced = Expr.App(outerSeqMap,ttype1,[t21;t12], [Expr.Lambda (newUnique(), None, None, gVals, newApp, m1, gRetType) - rest],r1) + rest],m2) OptimizeExpr cenv env reduced | _ -> From 4c42233cf1cbad8def50668ec83dc2f69240ff78 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 17:16:26 +0200 Subject: [PATCH 05/10] Test order of evaluation --- .../FSharp.Compiler.Unittests/SeqFusion.fs | 21 ++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs index 99f6d16a78c..3aa14fa43a6 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs +++ b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs @@ -4,6 +4,7 @@ namespace FSharp.Compiler.Unittests open System open NUnit.Framework +open System.Collections.Generic [] type SeqFusionTestsModule() = @@ -12,16 +13,30 @@ type SeqFusionTestsModule() = member this.FuseTwoMapsWithSameType() = let data = [3; 1; 2] let result = Seq.map (fun x -> x * 2) (Seq.map (fun x -> x + 2) data) - Assert.areEqual ([12; 6; 8]) (Seq.toList result) + Assert.areEqual [12; 6; 8] (Seq.toList result) [] member this.FuseTwoMapsWithSameType_String() = let data = ["hello"; "world"; "!"] let result = Seq.map (fun x -> "hello" + x) (Seq.map (fun (y:string) -> " " + y) data) - Assert.areEqual (["hello hello"; "hello world"; "hello !"]) (Seq.toList result) + Assert.areEqual ["hello hello"; "hello world"; "hello !"] (Seq.toList result) [] member this.FuseTwoMapsWithDifferentType() = let data = ["hello"; "world"; "!"] let result = Seq.map (fun x -> x * 3) (Seq.map (fun (y:string) -> y.Length) data) - Assert.areEqual ([15; 15; 3]) (Seq.toList result) \ No newline at end of file + Assert.areEqual [15; 15; 3] (Seq.toList result) + + [] + member this.FusisonOfTwoMapsKeepsSideEffectOrder() = + let list = List() + let data = ["hello"; "world"; "!"] + let result = Seq.map (fun x -> x * 3) (Seq.map (fun y -> list.Add y; y.Length) data) + + // seq is not evaluated yet + Assert.areEqual 0 list.Count + + // evaluate it + Assert.areEqual [15; 15; 3] (Seq.toList result) + + Assert.areEqual data (Seq.toList list) \ No newline at end of file From e0b01e7b8aaa8acf9c46d139eda1c9c26ee75e69 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 17:23:16 +0200 Subject: [PATCH 06/10] Unit test worked --- src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs index 3aa14fa43a6..194341ef0ff 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs +++ b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs @@ -13,7 +13,7 @@ type SeqFusionTestsModule() = member this.FuseTwoMapsWithSameType() = let data = [3; 1; 2] let result = Seq.map (fun x -> x * 2) (Seq.map (fun x -> x + 2) data) - Assert.areEqual [12; 6; 8] (Seq.toList result) + Assert.areEqual [10; 6; 8] (Seq.toList result) [] member this.FuseTwoMapsWithSameType_String() = From cfd8d8423e29cfc6c49532fd405065b9d53b6631 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 9 Sep 2016 08:43:31 +0200 Subject: [PATCH 07/10] Check evaluation order --- src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs | 4 ++-- src/fsharp/Optimizer.fs | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs index 194341ef0ff..ebf20d51c34 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs +++ b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs @@ -31,7 +31,7 @@ type SeqFusionTestsModule() = member this.FusisonOfTwoMapsKeepsSideEffectOrder() = let list = List() let data = ["hello"; "world"; "!"] - let result = Seq.map (fun x -> x * 3) (Seq.map (fun y -> list.Add y; y.Length) data) + let result = Seq.map (fun x -> list.Add(x.ToString()); x * 3) (Seq.map (fun y -> list.Add y; y.Length) data) // seq is not evaluated yet Assert.areEqual 0 list.Count @@ -39,4 +39,4 @@ type SeqFusionTestsModule() = // evaluate it Assert.areEqual [15; 15; 3] (Seq.toList result) - Assert.areEqual data (Seq.toList list) \ No newline at end of file + Assert.areEqual ["hello"; "5"; "world"; "5"; "!"; "1"] (Seq.toList list) \ No newline at end of file diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 7b2746116d7..429d484ffef 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2611,9 +2611,9 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = | _ -> match expr' with // Rewrite Seq.map f (Seq.map g) xs into Seq.map (fun x -> f(g x)) xs - | Expr.App(Expr.Val(valRef,_,_) as outerSeqMap,ttype1,[_;t12], + | Expr.App(Expr.Val(valRef,_,_) as outerSeqMap,ttype1,[_;fOutType], [(Expr.Lambda(_,None,None,_,_,m1,fRetType) as f) - Expr.App(Expr.Val(valRef2,_,_),_,[t21;_], + Expr.App(Expr.Val(valRef2,_,_),_,[gInType;_], [Expr.Lambda(_,None,None,gVals,g,_,gRetType) rest],_)],m2) when valRefEq cenv.g valRef cenv.g.seq_map_vref && @@ -2622,7 +2622,7 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = let newApp = Expr.App(f,TType_fun(gRetType, fRetType),[],[g],m2) let reduced = - Expr.App(outerSeqMap,ttype1,[t21;t12], + Expr.App(outerSeqMap,ttype1,[gInType;fOutType], [Expr.Lambda (newUnique(), None, None, gVals, newApp, m1, gRetType) rest],m2) From e85020acc54ede99118aa050d6e7082f78c72fc5 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 9 Sep 2016 10:13:21 +0200 Subject: [PATCH 08/10] Add test for Seq.iter --- src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs | 11 +++++++++++ src/fsharp/Optimizer.fs | 9 ++++----- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs index ebf20d51c34..a867667af8f 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs +++ b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs @@ -39,4 +39,15 @@ type SeqFusionTestsModule() = // evaluate it Assert.areEqual [15; 15; 3] (Seq.toList result) + Assert.areEqual ["hello"; "5"; "world"; "5"; "!"; "1"] (Seq.toList list) + + [] + member this.FusisonOfMapIntoIterKeepsSideEffectOrder() = + let list = List() + let data = ["hello"; "world"; "!"] + let results = List() + + Seq.iter (fun x -> results.Add x) (Seq.map (fun x -> list.Add(x.ToString()); x * 3) (Seq.map (fun y -> list.Add y; y.Length) data)) + + Assert.areEqual [15; 15; 3] (Seq.toList results) Assert.areEqual ["hello"; "5"; "world"; "5"; "!"; "1"] (Seq.toList list) \ No newline at end of file diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 429d484ffef..0f84b4f0f7f 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2611,14 +2611,13 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = | _ -> match expr' with // Rewrite Seq.map f (Seq.map g) xs into Seq.map (fun x -> f(g x)) xs - | Expr.App(Expr.Val(valRef,_,_) as outerSeqMap,ttype1,[_;fOutType], + | Expr.App(Expr.Val(outerValRef,_,_) as outerSeqMap,ttype1,[_;fOutType], [(Expr.Lambda(_,None,None,_,_,m1,fRetType) as f) - Expr.App(Expr.Val(valRef2,_,_),_,[gInType;_], + Expr.App(Expr.Val(innerValRef,_,_),_,[gInType;_], [Expr.Lambda(_,None,None,gVals,g,_,gRetType) rest],_)],m2) when - valRefEq cenv.g valRef cenv.g.seq_map_vref && - valRefEq cenv.g valRef2 cenv.g.seq_map_vref - -> + valRefEq cenv.g innerValRef cenv.g.seq_map_vref && + valRefEq cenv.g outerValRef cenv.g.seq_map_vref -> let newApp = Expr.App(f,TType_fun(gRetType, fRetType),[],[g],m2) let reduced = From ce82cf469e22c7302c10207d0e13f867013c007b Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 21 Jun 2017 10:03:28 +0200 Subject: [PATCH 09/10] fix merge issue --- .../FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj index 62e287d31b0..0cfbad943c9 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj +++ b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj @@ -48,7 +48,6 @@ ..\..\..\packages\System.ValueTuple.4.3.1\lib\netstandard1.0\System.ValueTuple.dll - ..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll From cb0ea380ce7e2296e7f04021a56d4131ad857885 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Wed, 21 Jun 2017 10:45:10 +0200 Subject: [PATCH 10/10] fix naming --- src/fsharp/Optimizer.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 0f84b4f0f7f..dcfcd73963c 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2609,7 +2609,7 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = // we beta-reduced, hence reoptimize OptimizeExpr cenv env newExpr | _ -> - match expr' with + match newExpr with // Rewrite Seq.map f (Seq.map g) xs into Seq.map (fun x -> f(g x)) xs | Expr.App(Expr.Val(outerValRef,_,_) as outerSeqMap,ttype1,[_;fOutType], [(Expr.Lambda(_,None,None,_,_,m1,fRetType) as f)