Span for .. in .. do optimization

src/fsharp/TastOps.fs

@@ -1757,11 +1757,14 @@ let isStructRecordOrUnionTyconTy g ty =
     | ValueSome tcref -> tcref.Deref.IsStructRecordOrUnionTycon
     | _ -> false
 
+let isStructTyconRef (tcref: TyconRef) =
+    let tycon = tcref.Deref
+    tycon.IsStructRecordOrUnionTycon || tycon.IsStructOrEnumTycon
+
 let isStructTy g ty =
     match tryDestAppTy g ty with
     | ValueSome tcref -> 
-        let tycon = tcref.Deref
-        tycon.IsStructRecordOrUnionTycon || tycon.IsStructOrEnumTycon
+        isStructTyconRef tcref
     | _ -> 
         isStructAnonRecdTy g ty || isStructTupleTy g ty
 
@@ -3014,7 +3017,7 @@ let isByrefLikeTyconRef (g: TcGlobals) m (tcref: TyconRef) =
     | None -> 
        let res = 
            isByrefTyconRef g tcref ||
-           TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref
+           (isStructTyconRef tcref && TyconRefHasAttribute g m g.attrib_IsByRefLikeAttribute tcref)
        tcref.SetIsByRefLike res
        res
 
@@ -3023,11 +3026,45 @@ let isSpanLikeTyconRef g m tcref =
     not (isByrefTyconRef g tcref)
 
 let isByrefLikeTy g m ty = 
-    ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g m tcref | _ -> false) 
+    ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g m tcref | _ -> false)
 
 let isSpanLikeTy g m ty =
     isByrefLikeTy g m ty && 
-    not (isByrefTy g ty) 
+    not (isByrefTy g ty)
+
+let isSpanTyconRef g m tcref =
+    isByrefLikeTyconRef g m tcref &&
+    tcref.CompiledRepresentationForNamedType.BasicQualifiedName = "System.Span`1"
+
+let isSpanTy g m ty =
+    ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isSpanTyconRef g m tcref | _ -> false)
+
+let rec tryDestSpanTy g m ty =
+    match tryAppTy g ty with
+    | ValueSome(tcref, [ty]) when isSpanTyconRef g m tcref -> ValueSome(struct(tcref, ty))
+    | _ -> ValueNone
+
+let destSpanTy g m ty =
+    match tryDestSpanTy g m ty with
+    | ValueSome(struct(tcref, ty)) -> struct(tcref, ty)
+    | _ -> failwith "destSpanTy"
+
+let isReadOnlySpanTyconRef g m tcref =
+    isByrefLikeTyconRef g m tcref &&
+    tcref.CompiledRepresentationForNamedType.BasicQualifiedName = "System.ReadOnlySpan`1"
+
+let isReadOnlySpanTy g m ty =
+    ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isReadOnlySpanTyconRef g m tcref | _ -> false)
+
+let tryDestReadOnlySpanTy g m ty =
+    match tryAppTy g ty with
+    | ValueSome(tcref, [ty]) when isReadOnlySpanTyconRef g m tcref -> ValueSome(struct(tcref, ty))
+    | _ -> ValueNone
+
+let destReadOnlySpanTy g m ty =
+    match tryDestReadOnlySpanTy g m ty with
+    | ValueSome(struct(tcref, ty)) -> struct(tcref, ty)
+    | _ -> failwith "destReadOnlySpanTy"    
 
 //-------------------------------------------------------------------------
 // List and reference types...

src/fsharp/TastOps.fsi

@@ -2078,6 +2078,18 @@ val isByrefLikeTy : TcGlobals -> range -> TType -> bool
 /// Check if the type is a byref-like but not a byref.
 val isSpanLikeTy : TcGlobals -> range -> TType -> bool
 
+val isSpanTy : TcGlobals -> range -> TType -> bool
+
+val tryDestSpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) voption
+
+val destSpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType)
+
+val isReadOnlySpanTy : TcGlobals -> range -> TType -> bool
+
+val tryDestReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType) voption
+
+val destReadOnlySpanTy : TcGlobals -> range -> TType -> struct(TyconRef * TType)
+
 //-------------------------------------------------------------------------
 // Tuple constructors/destructors
 //------------------------------------------------------------------------- 

src/fsharp/TcGlobals.fs

@@ -458,7 +458,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   let v_struct_tuple5_tcr      = findSysTyconRef sys "ValueTuple`5" 
   let v_struct_tuple6_tcr      = findSysTyconRef sys "ValueTuple`6" 
   let v_struct_tuple7_tcr      = findSysTyconRef sys "ValueTuple`7" 
-  let v_struct_tuple8_tcr      = findSysTyconRef sys "ValueTuple`8" 
+  let v_struct_tuple8_tcr      = findSysTyconRef sys "ValueTuple`8"
 
   let v_choice2_tcr     = mk_MFCore_tcref fslibCcu "Choice`2" 
   let v_choice3_tcr     = mk_MFCore_tcref fslibCcu "Choice`3" 
@@ -728,7 +728,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
   let v_fail_static_init_info      = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "FailStaticInit"                       , None                 , None                          , [],      ([[v_unit_ty]], v_unit_ty))
   let v_check_this_info            = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref,                    "CheckThis"                            , None                 , None                          , [vara],      ([[varaTy]], varaTy))
   let v_quote_to_linq_lambda_info  = makeIntrinsicValRef(fslib_MFLinqRuntimeHelpersQuotationConverter_nleref,  "QuotationToLambdaExpression"          , None                 , None                          , [vara],      ([[mkQuotedExprTy varaTy]], mkLinqExpressionTy varaTy))
-    
+
   let tref_DebuggableAttribute = findSysILTypeRef tname_DebuggableAttribute
   let tref_CompilerGeneratedAttribute  = findSysILTypeRef tname_CompilerGeneratedAttribute
 

src/fsharp/TypeChecker.fs

@@ -3043,6 +3043,24 @@ let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseF
 let TryFindIntrinsicOrExtensionMethInfo (cenv: cenv) (env: TcEnv) m ad nm ty = 
     AllMethInfosOfTypeInScope cenv.infoReader env.NameEnv (Some(nm), ad) IgnoreOverrides m ty
 
+let TryFindFSharpSignatureInstanceGetterProperty (cenv: cenv) (env: TcEnv) m nm ty (sigTys: TType list) =
+    TryFindPropInfo cenv.infoReader m env.AccessRights nm ty
+    |> List.tryFind (fun propInfo ->
+        not propInfo.IsStatic && propInfo.HasGetter &&
+        (
+            match propInfo.GetterMethod.GetParamTypes(cenv.amap, m, []) with
+            | [] -> false
+            | argTysList ->
+
+                let argTys = (argTysList |> List.reduce (@)) @ [ propInfo.GetterMethod.GetFSharpReturnTy(cenv.amap, m, []) ] in
+                if argTys.Length <> sigTys.Length then 
+                    false 
+                else
+                    (argTys, sigTys)
+                    ||> List.forall2 (typeEquiv cenv.g)
+        )
+    )
+
 /// Build the 'test and dispose' part of a 'use' statement 
 let BuildDisposableCleanup cenv env m (v: Val) = 
     v.SetHasBeenReferenced() 
@@ -7112,6 +7130,25 @@ and TcAnonRecdExpr cenv overallTy env tpenv (isStruct, optOrigExpr, unsortedArgs
 
 
 and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWholeExpr, spForLoop) =
+    let tryGetOptimizeSpanMethodsAux g m ty isReadOnlySpan =
+        match (if isReadOnlySpan then tryDestReadOnlySpanTy g m ty else tryDestSpanTy g m ty) with
+        | ValueSome(struct(_, destTy)) ->
+            match TryFindFSharpSignatureInstanceGetterProperty cenv env m "Item" ty [ g.int32_ty; (if isReadOnlySpan then mkInByrefTy g destTy else mkByrefTy g destTy) ], 
+                  TryFindFSharpSignatureInstanceGetterProperty cenv env m "Length" ty [ g.int32_ty ] with
+            | Some(itemPropInfo), Some(lengthPropInfo) -> 
+                ValueSome(struct(itemPropInfo.GetterMethod, lengthPropInfo.GetterMethod, isReadOnlySpan))
+            | _ -> 
+                ValueNone
+        | _ ->
+            ValueNone
+
+    let tryGetOptimizeSpanMethods g m ty =
+        let result = tryGetOptimizeSpanMethodsAux g m ty false
+        if result.IsSome then
+            result
+        else
+            tryGetOptimizeSpanMethodsAux g m ty true
+
     UnifyTypes cenv env mWholeExpr overallTy cenv.g.unit_ty
 
     let mPat = pat.Range
@@ -7136,7 +7173,7 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol
             let arrVar, arrExpr = mkCompGenLocal mEnumExpr "arr" enumExprTy
             let idxVar, idxExpr = mkCompGenLocal mPat "idx" cenv.g.int32_ty
             let elemTy = destArrayTy cenv.g enumExprTy
-            
+
             // Evaluate the array index lookup
             let bodyExprFixup elemVar bodyExpr = mkCompGenLet mForLoopStart elemVar (mkLdelem cenv.g mForLoopStart elemTy arrExpr idxExpr) bodyExpr
 
@@ -7145,13 +7182,37 @@ and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWhol
 
             // Ask for a loop over integers for the given range
             (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero cenv.g mForLoopStart, mkDecr cenv.g mForLoopStart (mkLdlen cenv.g mForLoopStart arrExpr)))
-
+        
         | _ -> 
+            // try optimize 'for i in span do' for span or readonlyspan
+            match tryGetOptimizeSpanMethods cenv.g mWholeExpr enumExprTy with
+            | ValueSome(struct(getItemMethInfo, getLengthMethInfo, isReadOnlySpan)) ->
+                let tcVal = LightweightTcValForUsingInBuildMethodCall cenv.g
+                let spanVar, spanExpr = mkCompGenLocal mEnumExpr "span" enumExprTy
+                let idxVar, idxExpr = mkCompGenLocal mPat "idx" cenv.g.int32_ty
+                let struct(_, elemTy) = if isReadOnlySpan then destReadOnlySpanTy cenv.g mWholeExpr enumExprTy else destSpanTy cenv.g mWholeExpr enumExprTy
+                let elemAddrTy = if isReadOnlySpan then mkInByrefTy cenv.g elemTy else mkByrefTy cenv.g elemTy
+
+                // Evaluate the span index lookup
+                let bodyExprFixup elemVar bodyExpr = 
+                    let elemAddrVar, _ = mkCompGenLocal mForLoopStart "addr" elemAddrTy
+                    let e = mkCompGenLet mForLoopStart elemVar (mkAddrGet mForLoopStart (mkLocalValRef elemAddrVar)) bodyExpr
+                    let getItemCallExpr, _ = BuildMethodCall tcVal cenv.g cenv.amap PossiblyMutates mWholeExpr true getItemMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [ idxExpr ]
+                    mkCompGenLet mForLoopStart elemAddrVar getItemCallExpr e
+
+                // Evaluate the span expression once and put it in spanVar
+                let overallExprFixup overallExpr = mkCompGenLet mForLoopStart spanVar enumExpr overallExpr
+
+                let getLengthCallExpr, _ = BuildMethodCall tcVal cenv.g cenv.amap PossiblyMutates mWholeExpr true getLengthMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] []
+
+                // Ask for a loop over integers for the given range
+                (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero cenv.g mForLoopStart, mkDecr cenv.g mForLoopStart getLengthCallExpr))
 
-            let enumerableVar, enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy
-            let enumeratorVar, enumeratorExpr, _, enumElemTy, getEnumExpr, getEnumTy, guardExpr, _, currentExpr = 
-                AnalyzeArbitraryExprAsEnumerable cenv env true mEnumExpr enumExprTy enumerableExprInVar
-            (enumElemTy, (fun _ x -> x), id, Choice3Of3(enumerableVar, enumeratorVar, enumeratorExpr, getEnumExpr, getEnumTy, guardExpr, currentExpr))
+            | _ ->
+                let enumerableVar, enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy
+                let enumeratorVar, enumeratorExpr, _, enumElemTy, getEnumExpr, getEnumTy, guardExpr, _, currentExpr = 
+                    AnalyzeArbitraryExprAsEnumerable cenv env true mEnumExpr enumExprTy enumerableExprInVar
+                (enumElemTy, (fun _ x -> x), id, Choice3Of3(enumerableVar, enumeratorVar, enumeratorExpr, getEnumExpr, getEnumTy, guardExpr, currentExpr))
 
     let pat, _, vspecs, envinner, tpenv = TcMatchPattern cenv enumElemTy env tpenv (pat, None)
     let elemVar, pat =      

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

@@ -17,11 +17,6 @@
     <Compile Include="HashIfExpression.fs" />
     <Compile Include="ProductVersion.fs" />
     <Compile Include="EditDistance.fs" />
-    <Compile Include="Compiler.fs" />
-    <Compile Include="ILHelpers.fs" />
-    <Compile Include="Language\AnonRecords.fs" />
-    <Compile Include="Language\StringConcat.fs" />
-    <Compile Include="SourceTextTests.fs" />
   </ItemGroup>
 
   <ItemGroup>

tests/FSharp.Compiler.UnitTests/Compiler.fs → tests/fsharp/Compiler/CompilerAssert.fs

@@ -3,22 +3,41 @@
 namespace FSharp.Compiler.UnitTests
 
 open System
+open System.IO
+open System.Text
+open System.Diagnostics
 open FSharp.Compiler.Text
 open FSharp.Compiler.SourceCodeServices
+open FSharp.Compiler.Interactive.Shell
 
 open NUnit.Framework
 
 [<RequireQualifiedAccess>]
-module Compiler =
+module CompilerAssert =
 
     let checker = FSharpChecker.Create()
 
+    let private config = TestFramework.initializeSuite ()
+
     let private defaultProjectOptions =
         {
             ProjectFileName = "Z:\\test.fsproj"
             ProjectId = None
             SourceFiles = [|"test.fs"|]
+#if !NETCOREAPP
             OtherOptions = [||]
+#else
+            OtherOptions = 
+                // Hack: Currently a hack to get the runtime assemblies for netcore in order to compile.
+                let assemblies =
+                    typeof<obj>.Assembly.Location
+                    |> Path.GetDirectoryName
+                    |> Directory.EnumerateFiles
+                    |> Seq.toArray
+                    |> Array.filter (fun x -> x.ToLowerInvariant().Contains("system."))
+                    |> Array.map (fun x -> sprintf "-r:%s" x)
+                Array.append [|"--targetprofile:netcore"; "--noframework"|] assemblies
+#endif
             ReferencedProjects = [||]
             IsIncompleteTypeCheckEnvironment = false
             UseScriptResolutionRules = false
@@ -29,7 +48,7 @@ module Compiler =
             Stamp = None
         }
 
-    let AssertPass (source: string) =
+    let Pass (source: string) =
         let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously
 
         Assert.True(parseResults.Errors.Length = 0, sprintf "Parse errors: %A" parseResults.Errors)
@@ -40,7 +59,7 @@ module Compiler =
 
         Assert.True(typeCheckResults.Errors.Length = 0, sprintf "Type Check errors: %A" typeCheckResults.Errors)
 
-    let AssertSingleErrorTypeCheck (source: string) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) =
+    let TypeCheckSingleError (source: string) (expectedErrorNumber: int) (expectedErrorRange: int * int * int * int) (expectedErrorMsg: string) =
         let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions) |> Async.RunSynchronously
 
         Assert.True(parseResults.Errors.Length = 0, sprintf "Parse errors: %A" parseResults.Errors)
@@ -56,4 +75,40 @@ module Compiler =
             Assert.AreEqual(expectedErrorNumber, info.ErrorNumber, "expectedErrorNumber")
             Assert.AreEqual(expectedErrorRange, (info.StartLineAlternate, info.StartColumn, info.EndLineAlternate, info.EndColumn), "expectedErrorRange")
             Assert.AreEqual(expectedErrorMsg, info.Message, "expectedErrorMsg")
-        )
+        )
+
+    let RunScript (source: string) (expectedErrorMessages: string list) =
+        // Intialize output and input streams
+        use inStream = new StringReader("")
+        use outStream = new StringWriter()
+        use errStream = new StringWriter()
+
+        // Build command line arguments & start FSI session
+        let argv = [| "C:\\fsi.exe" |]
+#if !NETCOREAPP
+        let allArgs = Array.append argv [|"--noninteractive"|]
+#else
+        let allArgs = Array.append argv [|"--noninteractive"; "--targetprofile:netcore"|]
+#endif
+
+        let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration()
+        use fsiSession = FsiEvaluationSession.Create(fsiConfig, allArgs, inStream, outStream, errStream, collectible = true)
+
+        let ch, errors = fsiSession.EvalInteractionNonThrowing source
+
+        let errorMessages = ResizeArray()
+        errors
+        |> Seq.iter (fun error -> errorMessages.Add(error.Message))
+
+        match ch with
+        | Choice2Of2 ex -> errorMessages.Add(ex.Message)
+        | _ -> ()
+
+        if expectedErrorMessages.Length <> errorMessages.Count then
+            Assert.Fail(sprintf "Expected error messages: %A \n\n Actual error messages: %A" expectedErrorMessages errorMessages)
+        else
+            (expectedErrorMessages, errorMessages)
+            ||> Seq.iter2 (fun expectedErrorMessage errorMessage ->
+                Assert.AreEqual(expectedErrorMessage, errorMessage)
+            )
+