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..a867667af8f --- /dev/null +++ b/src/fsharp/FSharp.Compiler.Unittests/SeqFusion.fs @@ -0,0 +1,53 @@ +// 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 +open System.Collections.Generic + +[] +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 [10; 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) + + [] + member this.FusisonOfTwoMapsKeepsSideEffectOrder() = + let list = List() + let data = ["hello"; "world"; "!"] + 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 + + // 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 9bb4ba0ecde..594051be677 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 + // 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) + Expr.App(Expr.Val(innerValRef,_,_),_,[gInType;_], + [Expr.Lambda(_,None,None,gVals,g,_,gRetType) + rest],_)],m2) when + 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 = + Expr.App(outerSeqMap,ttype1,[gInType;fOutType], + [Expr.Lambda (newUnique(), None, None, gVals, newApp, m1, gRetType) + rest],m2) + + 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