[WIP] Fuse Seq.* calls

src/fsharp/FSharp.Compiler.Unittests/FSharp.Compiler.Unittests.fsproj

@@ -55,14 +55,15 @@
     <Reference Include="System.Net" Condition="'$(TargetFramework)' == 'sl5' " />
     <Reference Include="System.Observable" Condition="'$(TargetFramework)' == 'sl3-wp' " />
     <Reference Include="System.ValueTuple">
-        <HintPath>..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll</HintPath>
+      <HintPath>..\..\..\packages\System.ValueTuple.4.0.0-rc3-24212-01\lib\netstandard1.1\System.ValueTuple.dll</HintPath>
     </Reference>
   </ItemGroup>
   <ItemGroup>
     <Compile Include="NUnitFrameworkShims.fs" Condition="'$(TargetFramework)' == 'sl3-wp'" />
     <Compile Include="NunitHelpers.fs" />
     <Compile Include="CompilerTestHelpers.fs" />
     <Compile Include="ManglingNameOfProvidedTypes.fs" />
+    <Compile Include="SeqFusion.fs" />
     <Compile Include="HashIfExpression.fs" />
     <Compile Include="ProductVersion.fs" />
     <Compile Include="EditDistance.fs" />

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
+
+[<TestFixture>]
+type SeqFusionTestsModule() =
+
+    [<Test>]
+    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)
+
+    [<Test>]
+    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)
+
+    [<Test>]
+    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)
+
+    [<Test>]
+    member this.FusisonOfTwoMapsKeepsSideEffectOrder() =
+        let list = List<string>()
+        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)
+
+    [<Test>]
+    member this.FusisonOfMapIntoIterKeepsSideEffectOrder() =
+        let list = List<string>()
+        let data = ["hello"; "world"; "!"]
+        let results = List<int>()
+
+        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)

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

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