From ffb1b739c82af7b2b8d39af625a847fd7b7f5d91 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 08:18:51 +0200 Subject: [PATCH 1/8] Try to deforest Seq.map calls --- src/fsharp/Optimizer.fs | 22 ++++++++++++++++++++-- src/fsharp/TastOps.fs | 6 +++--- 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 9bb4ba0ecde..e8087943f7a 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -1690,7 +1690,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 @@ -1699,7 +1698,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) @@ -2618,6 +2617,25 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = // we beta-reduced, hence reoptimize OptimizeExpr cenv env expr' | _ -> + 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 8e5ddb25045..ae8848b6a68 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -5180,7 +5180,7 @@ let rec tyOfExpr g e = | TOp.Goto _ | TOp.Label _ | TOp.Return -> //assert false; //errorR(InternalError("unexpected goto/label/return in tyOfExpr",m)); - // It doesn't matter what type we return here. THis is only used in free variable analysis in the code generator + // It doesn't matter what type we return here. This is only used in free variable analysis in the code generator g.unit_ty //-------------------------------------------------------------------------- @@ -5546,8 +5546,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 ce3c88adf9b5b216b5ea0e57a185d199b9ba3f32 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 16:03:01 +0200 Subject: [PATCH 2/8] Add unit tests for fusion --- .../FSharp.Compiler.Unittests.fsproj | 3 ++- .../FSharp.Compiler.Unittests/SeqFusion.fs | 27 +++++++++++++++++++ 2 files changed, 29 insertions(+), 1 deletion(-) 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 20f9c1fbbc0..3788672c664 100644 --- a/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj +++ b/src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj @@ -55,7 +55,7 @@ - ..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll + ..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll @@ -63,6 +63,7 @@ + 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 cf21e54a70da60d861ad4abeb07e376bc15288f0 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 16:50:28 +0200 Subject: [PATCH 3/8] 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 e8087943f7a..46fa7955126 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2618,19 +2618,20 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = OptimizeExpr cenv env expr' | _ -> 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 647e8dcc0ac35887f3cc6897afd676643c1d8cdf Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 16:59:10 +0200 Subject: [PATCH 4/8] 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 46fa7955126..96afdffb6f1 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2620,19 +2620,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 e177f17d0d8ee8da7ea64f8c85f08c3d297c89b8 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 17:16:26 +0200 Subject: [PATCH 5/8] 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 4bf34c6ea38251a647eddf693b25029ebc751b29 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Thu, 8 Sep 2016 17:23:16 +0200 Subject: [PATCH 6/8] 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 4e5f010721804cc601f9b76e05396865b7bba52d Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 9 Sep 2016 08:43:31 +0200 Subject: [PATCH 7/8] 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 96afdffb6f1..01b90ba27f8 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2619,9 +2619,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 && @@ -2630,7 +2630,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 c3e871da91743182e2f1f65971ac3e08a285be5d Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Fri, 9 Sep 2016 10:13:21 +0200 Subject: [PATCH 8/8] 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 01b90ba27f8..594051be677 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2619,14 +2619,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 =