Optimizing string concatenations to use String.Concat overloads (#5570)

* Optimize String.Concat calls

* Small refactor

* Added test

* Another test

* Fixing tests

* using /noca

* Fixing test

* Fixing tests again

* Minor adjustments from feedback

* Quick fix

* More tests

* Updated baselines + more tests

* Added better way to test IL directly in unit tests

* Moved StringConcat.fs tests

* Removed bad file

* Using FSharpChecker directly

* Added more tests

* Comparing lines for tests

* Better IL check output

* Small cleanup

* Fixed test

src/fsharp/Optimizer.fs

@@ -1764,7 +1764,15 @@ let TryDetectQueryQuoteAndRun cenv (expr:Expr) =
         //printfn "Not eliminating because no Run found"
         None
                 
-
+let IsSystemStringConcatOverload (methRef: ILMethodRef) =
+    methRef.Name = "Concat" && methRef.DeclaringTypeRef.FullName = "System.String" && 
+    methRef.ReturnType.BasicQualifiedName = "System.String" &&
+    methRef.ArgTypes |> List.forall(fun ilty -> ilty.BasicQualifiedName = "System.String")
+
+let IsSystemStringConcatArray (methRef: ILMethodRef) =
+    methRef.Name = "Concat" && methRef.DeclaringTypeRef.FullName = "System.String" && 
+    methRef.ReturnType.BasicQualifiedName = "System.String" &&
+    methRef.ArgTypes.Length = 1 && methRef.ArgTypes.Head.BasicQualifiedName = "System.String[]"
     
 //-------------------------------------------------------------------------
 // The traversal
@@ -1824,7 +1832,6 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr =
         assert ("unexpected reclink" = "")
         failwith "Unexpected reclink"
 
-
 //-------------------------------------------------------------------------
 // Optimize/analyze an object expression
 //------------------------------------------------------------------------- 
@@ -1874,9 +1881,54 @@ and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) =
       Info=UnknownValue}
 
 //-------------------------------------------------------------------------
-// Optimize/analyze an application of an intrinsic operator to arguments
+// Make and optimize String.Concat calls
 //------------------------------------------------------------------------- 
 
+and MakeOptimizedSystemStringConcatCall cenv env m args =
+    let rec optimizeArg e accArgs =
+        match e, accArgs with
+        | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ], _), _ when IsSystemStringConcatArray methRef ->
+            optimizeArgs args accArgs
+
+        | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, args, _), _ when IsSystemStringConcatOverload methRef ->
+            optimizeArgs args accArgs
+
+        // Optimize string constants, e.g. "1" + "2" will turn into "12"
+        | Expr.Const(Const.String str1, _, _), Expr.Const(Const.String str2, _, _) :: accArgs ->
+            mkString cenv.g m (str1 + str2) :: accArgs
+
+        | arg, _ -> arg :: accArgs
+
+    and optimizeArgs args accArgs =
+        (args, accArgs)
+        ||> List.foldBack (fun arg accArgs -> optimizeArg arg accArgs)
+
+    let args = optimizeArgs args []
+
+    let e =
+        match args with
+        | [ arg ] ->
+            arg
+        | [ arg1; arg2 ] -> 
+            mkStaticCall_String_Concat2 cenv.g m arg1 arg2
+        | [ arg1; arg2; arg3 ] ->
+            mkStaticCall_String_Concat3 cenv.g m arg1 arg2 arg3
+        | [ arg1; arg2; arg3; arg4 ] ->
+            mkStaticCall_String_Concat4 cenv.g m arg1 arg2 arg3 arg4
+        | args ->
+            let arg = mkArray (cenv.g.string_ty, args, m)
+            mkStaticCall_String_Concat_Array cenv.g m arg
+
+    match e with
+    | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _) as op, tyargs, args, m) when IsSystemStringConcatOverload methRef || IsSystemStringConcatArray methRef ->
+        OptimizeExprOpReductions cenv env (op, tyargs, args, m)
+    | _ ->
+        OptimizeExpr cenv env e
+
+//-------------------------------------------------------------------------
+// Optimize/analyze an application of an intrinsic operator to arguments
+//-------------------------------------------------------------------------
+
 and OptimizeExprOp cenv env (op, tyargs, args, m) =
 
     // Special cases 
@@ -1940,22 +1992,30 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) =
     // if the types match up. 
     | TOp.ILAsm([], [ty]), _, [a] when typeEquiv cenv.g (tyOfExpr cenv.g a) ty -> OptimizeExpr cenv env a
 
-    | _ -> 
-        // Reductions 
-        let args', arginfos = OptimizeExprsThenConsiderSplits cenv env args
-        let knownValue = 
-            match op, arginfos with 
-            | TOp.ValFieldGet (rf), [e1info] -> TryOptimizeRecordFieldGet cenv env (e1info, rf, tyargs, m) 
-            | TOp.TupleFieldGet (tupInfo, n), [e1info] -> TryOptimizeTupleFieldGet cenv env (tupInfo, e1info, tyargs, n, m)
-            | TOp.UnionCaseFieldGet (cspec, n), [e1info] -> TryOptimizeUnionCaseGet cenv env (e1info, cspec, tyargs, n, m)
-            | _ -> None
-        match knownValue with 
-        | Some valu -> 
-            match TryOptimizeVal cenv env (false, valu, m)  with 
-            | Some res -> OptimizeExpr cenv env res  (* discard e1 since guard ensures it has no effects *)
-            | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu
-        | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos UnknownValue
+    // Optimize calls when concatenating strings, e.g. "1" + "2" + "3" + "4" .. etc.
+    | TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ] when IsSystemStringConcatArray methRef ->
+        MakeOptimizedSystemStringConcatCall cenv env m args
+    | TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, args when IsSystemStringConcatOverload methRef ->
+        MakeOptimizedSystemStringConcatCall cenv env m args
 
+    | _ -> 
+        // Reductions
+        OptimizeExprOpReductions cenv env (op, tyargs, args, m)
+
+and OptimizeExprOpReductions cenv env (op, tyargs, args, m) =
+    let args', arginfos = OptimizeExprsThenConsiderSplits cenv env args
+    let knownValue = 
+        match op, arginfos with 
+        | TOp.ValFieldGet (rf), [e1info] -> TryOptimizeRecordFieldGet cenv env (e1info, rf, tyargs, m) 
+        | TOp.TupleFieldGet (tupInfo, n), [e1info] -> TryOptimizeTupleFieldGet cenv env (tupInfo, e1info, tyargs, n, m)
+        | TOp.UnionCaseFieldGet (cspec, n), [e1info] -> TryOptimizeUnionCaseGet cenv env (e1info, cspec, tyargs, n, m)
+        | _ -> None
+    match knownValue with 
+    | Some valu -> 
+        match TryOptimizeVal cenv env (false, valu, m)  with 
+        | Some res -> OptimizeExpr cenv env res  (* discard e1 since guard ensures it has no effects *)
+        | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu
+    | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos UnknownValue
 
 and OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu =
     // The generic case - we may collect information, but the construction/projection doesn't disappear 
@@ -2682,7 +2742,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m)
         // Inlining:  beta reducing 
         let expr' = MakeApplicationAndBetaReduce cenv.g (f2', f2ty, [tyargs], args', m)
         // Inlining: reoptimizing
-        Some (OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} expr')
+        Some(OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} expr')
           
     | _ -> None
 

src/fsharp/TastOps.fs

@@ -6366,6 +6366,18 @@ let mkIsInst ty e m = mkAsmExpr ([ isinst ], [ty], [e], [ ty ], m)
 let mspec_Type_GetTypeFromHandle (g: TcGlobals) = IL.mkILNonGenericStaticMethSpecInTy(g.ilg.typ_Type, "GetTypeFromHandle", [g.iltyp_RuntimeTypeHandle], g.ilg.typ_Type)
 let mspec_String_Length (g: TcGlobals) = mkILNonGenericInstanceMethSpecInTy (g.ilg.typ_String, "get_Length", [], g.ilg.typ_Int32)
 
+let mspec_String_Concat2 (g: TcGlobals) = 
+    mkILNonGenericStaticMethSpecInTy (g.ilg.typ_String, "Concat", [ g.ilg.typ_String; g.ilg.typ_String ], g.ilg.typ_String)
+
+let mspec_String_Concat3 (g: TcGlobals) = 
+    mkILNonGenericStaticMethSpecInTy (g.ilg.typ_String, "Concat", [ g.ilg.typ_String; g.ilg.typ_String; g.ilg.typ_String ], g.ilg.typ_String)
+
+let mspec_String_Concat4 (g: TcGlobals) = 
+    mkILNonGenericStaticMethSpecInTy (g.ilg.typ_String, "Concat", [ g.ilg.typ_String; g.ilg.typ_String; g.ilg.typ_String; g.ilg.typ_String ], g.ilg.typ_String)
+
+let mspec_String_Concat_Array (g: TcGlobals) = 
+    mkILNonGenericStaticMethSpecInTy (g.ilg.typ_String, "Concat", [ mkILArr1DTy g.ilg.typ_String ], g.ilg.typ_String)
+
 let fspec_Missing_Value (g: TcGlobals) = IL.mkILFieldSpecInTy(g.iltyp_Missing, "Value", g.iltyp_Missing)
 
 let mkInitializeArrayMethSpec (g: TcGlobals) = 
@@ -6587,6 +6599,21 @@ let mkGetStringLength g m e =
     /// ILCall(useCallvirt, isProtected, valu, newobj, valUseFlags, isProp, noTailCall, mref, actualTypeInst, actualMethInst, retTy)
     Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, true, false, mspec.MethodRef, [], [], [g.int32_ty]), [], [e], m)
 
+let mkStaticCall_String_Concat2 g m arg1 arg2 =
+    let mspec = mspec_String_Concat2 g
+    Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2], m)
+
+let mkStaticCall_String_Concat3 g m arg1 arg2 arg3 =
+    let mspec = mspec_String_Concat3 g
+    Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2; arg3], m)
+
+let mkStaticCall_String_Concat4 g m arg1 arg2 arg3 arg4 =
+    let mspec = mspec_String_Concat4 g
+    Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg1; arg2; arg3; arg4], m)
+
+let mkStaticCall_String_Concat_Array g m arg =
+    let mspec = mspec_String_Concat_Array g
+    Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, false, false, mspec.MethodRef, [], [], [g.string_ty]), [], [arg], m)
 
 // Quotations can't contain any IL.
 // As a result, we aim to get rid of all IL generation in the typechecker and pattern match

src/fsharp/TastOps.fsi

@@ -1386,6 +1386,11 @@ val mkCallNewQuerySource : TcGlobals -> range -> TType -> TType -> Expr -> Expr
 
 val mkArray : TType * Exprs * range -> Expr
 
+val mkStaticCall_String_Concat2 : TcGlobals -> range -> Expr -> Expr -> Expr
+val mkStaticCall_String_Concat3 : TcGlobals -> range -> Expr -> Expr -> Expr -> Expr
+val mkStaticCall_String_Concat4 : TcGlobals -> range -> Expr -> Expr -> Expr -> Expr -> Expr
+val mkStaticCall_String_Concat_Array : TcGlobals -> range -> Expr -> Expr
+
 //-------------------------------------------------------------------------
 // operations primarily associated with the optimization to fix
 // up loops to generate .NET code that does not include array bound checks

tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj

@@ -44,7 +44,7 @@
     <Reference Include="System.Numerics" Condition="'$(TargetDotnetProfile)' == 'net40'" />
     <Reference Include="System.Core" />
     <Reference Include="System.ValueTuple">
-        <HintPath>..\..\..\packages\System.ValueTuple.$(SystemValueTuplePackageVersion)\lib\netstandard1.0\System.ValueTuple.dll</HintPath>
+      <HintPath>..\..\..\packages\System.ValueTuple.$(SystemValueTuplePackageVersion)\lib\netstandard1.0\System.ValueTuple.dll</HintPath>
     </Reference>
   </ItemGroup>
   <ItemGroup>
@@ -54,6 +54,8 @@
     <Compile Include="HashIfExpression.fs" />
     <Compile Include="ProductVersion.fs" />
     <Compile Include="EditDistance.fs" />
+    <Compile Include="ILHelpers.fs" />
+    <Compile Include="Language\StringConcat.fs" />
   </ItemGroup>
   <ItemGroup>
     <ProjectReference Include="$(FSharpSourcesRoot)\fsharp\FSharp.Compiler.Private\FSharp.Compiler.Private.fsproj">

tests/FSharp.Compiler.UnitTests/ILHelpers.fs

+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.UnitTests
+
+open System
+open System.IO
+open System.Diagnostics
+
+open NUnit.Framework
+
+open Microsoft.FSharp.Compiler.SourceCodeServices
+
+module ILChecker =
+
+    let checker = FSharpChecker.Create()
+
+    let private (++) a b = Path.Combine(a,b)
+
+    let private getfullpath workDir path =
+        let rooted =
+            if Path.IsPathRooted(path) then path
+            else Path.Combine(workDir, path)
+        rooted |> Path.GetFullPath
+
+    let private fileExists workDir path = 
+        if path |> getfullpath workDir |> File.Exists then Some path else None
+
+    let private requireFile nm = 
+        if fileExists __SOURCE_DIRECTORY__ nm |> Option.isSome then nm else failwith (sprintf "couldn't find %s. Running 'build test' once might solve this issue" nm)
+
+    let private exec exe args =
+        let startInfo = ProcessStartInfo(exe, String.concat " " args)
+        startInfo.RedirectStandardError <- true
+        startInfo.UseShellExecute <- false
+        use p = Process.Start(startInfo)
+        p.WaitForExit()
+        p.StandardError.ReadToEnd(), p.ExitCode
+
+    /// Compile the source and check to see if the expected IL exists.
+    /// The first line of each expected IL string is found first.
+    let check source expectedIL =
+        let SCRIPT_ROOT = __SOURCE_DIRECTORY__
+        let packagesDir = SCRIPT_ROOT ++ ".." ++ ".." ++ "packages"
+        let Is64BitOperatingSystem = sizeof<nativeint> = 8
+        let architectureMoniker = if Is64BitOperatingSystem then "x64" else "x86"
+        let ildasmExe = requireFile (packagesDir ++ ("runtime.win-" + architectureMoniker + ".Microsoft.NETCore.ILDAsm.2.0.3") ++ "runtimes" ++ ("win-" + architectureMoniker) ++ "native" ++ "ildasm.exe")
+        let coreclrDll = requireFile (packagesDir ++ ("runtime.win-" + architectureMoniker + ".Microsoft.NETCore.Runtime.CoreCLR.2.0.3") ++ "runtimes" ++ ("win-" + architectureMoniker) ++ "native" ++ "coreclr.dll")
+
+        let tmp = Path.GetTempFileName()
+        let tmpFs = Path.ChangeExtension(tmp, ".fs")
+        let tmpDll = Path.ChangeExtension(tmp, ".dll")
+        let tmpIL = Path.ChangeExtension(tmp, ".il")
+
+        let mutable errorMsgOpt = None
+        try
+            // ildasm requires coreclr.dll to run which has already been restored to the packages directory
+            File.Copy(coreclrDll, Path.GetDirectoryName(ildasmExe) ++ "coreclr.dll", overwrite=true)
+
+            File.WriteAllText(tmpFs, source)
+
+            let errors, exitCode = checker.Compile([| "fsc.exe"; "--optimize+"; "-o"; tmpDll; "-a"; tmpFs |]) |> Async.RunSynchronously
+            let errors =
+                String.concat "\n" (errors |> Array.map (fun x -> x.Message))
+
+            if exitCode = 0 then
+                exec ildasmExe [ sprintf "%s /out=%s" tmpDll tmpIL ] |> ignore
+
+                let text = File.ReadAllText(tmpIL)
+                let blockComments = @"/\*(.*?)\*/"
+                let lineComments = @"//(.*?)\r?\n"
+                let strings = @"""((\\[^\n]|[^""\n])*)"""
+                let verbatimStrings = @"@(""[^""]*"")+"
+                let textNoComments =
+                    System.Text.RegularExpressions.Regex.Replace(text, 
+                        blockComments + "|" + lineComments + "|" + strings + "|" + verbatimStrings, 
+                        (fun me -> 
+                            if (me.Value.StartsWith("/*") || me.Value.StartsWith("//")) then
+                                if me.Value.StartsWith("//") then Environment.NewLine else String.Empty
+                            else
+                                me.Value), System.Text.RegularExpressions.RegexOptions.Singleline)
+                
+                expectedIL
+                |> List.iter (fun (ilCode: string) ->
+                    let expectedLines = ilCode.Split('\n')
+                    let startIndex = textNoComments.IndexOf(expectedLines.[0])
+                    if startIndex = -1 || textNoComments.Length < startIndex + ilCode.Length then
+                        errorMsgOpt <- Some("==EXPECTED CONTAINS==\n" + ilCode + "\n")
+                    else
+                        let errors = ResizeArray()
+                        let actualLines = textNoComments.Substring(startIndex, textNoComments.Length - startIndex).Split('\n')
+                        for i = 0 to expectedLines.Length - 1 do
+                            let expected = expectedLines.[i].Trim()
+                            let actual = actualLines.[i].Trim()
+                            if expected <> actual then
+                                errors.Add(sprintf "\n==\nName: %s\n\nExpected:\t %s\nActual:\t\t %s\n==" actualLines.[0] expected actual)
+
+                        if errors.Count > 0 then
+                            let msg = String.concat "\n" errors + "\n\n\n==EXPECTED==\n" + ilCode + "\n"
+                            errorMsgOpt <- Some(msg + "\n\n\n==ACTUAL==\n" + String.Join("\n", actualLines, 0, expectedLines.Length))
+                )
+
+                match errorMsgOpt with
+                | Some(msg) -> errorMsgOpt <- Some(msg + "\n\n\n==ENTIRE ACTUAL==\n" + textNoComments)
+                | _ -> ()
+            else
+                errorMsgOpt <- Some(errors)
+        finally
+            try File.Delete(tmp) with | _ -> ()
+            try File.Delete(tmpFs) with | _ -> ()
+            try File.Delete(tmpDll) with | _ -> ()
+            try File.Delete(tmpIL) with | _ -> ()
+
+            match errorMsgOpt with
+            | Some(errorMsg) -> 
+                Assert.Fail(errorMsg)
+            | _ -> ()
+            

tests/fsharp/tests.fs

@@ -1878,7 +1878,7 @@ module OptimizationTests =
             |> Seq.filter (fun line -> line.Contains(".locals init"))
             |> Seq.length
 
-        log "Ran ok - optimizations removed %d textual occurrences of optimizable identifiers from target IL" numElim 
+        log "Ran ok - optimizations removed %d textual occurrences of optimizable identifiers from target IL" numElim
 
     [<Test>]
     let stats () =