Skip to content

Commit

Permalink
Span for .. in .. do optimization (#6213)
Browse files Browse the repository at this point in the history
* Trying to optimize span in for loop

* Added Span_GetItem call

* Almost success with optimization

* Fixed code gen

* Added Span optimization tests

* Added ReadOnlySpan opt

* Cleaning up tests

* Moving tests around

* Trying to figure out span tests

* Trying to fix some tests

* Trying to get some more tests passing

* Fixed range

* Trying to get tests to pass again

* Fixing tests for netcore

* Fix build

* When a solution becomes unloaded, we should clear F#'s cache (#6420)

* Changing if directives

* Simplifying

* Using a type shape for span optimization

* Fixing one test

* Drastically simplified looking at the type shape for Span

* Simplified a bit more

* RunScript has expected error messages

* Add back net472

* Feedback

* Update SpanOptimizationTests.fs

* Update SpanOptimizationTests.fs
  • Loading branch information
TIHan authored and KevinRansom committed Apr 16, 2019
1 parent 3149b48 commit 08f6169
Show file tree
Hide file tree
Showing 15 changed files with 571 additions and 78 deletions.
47 changes: 42 additions & 5 deletions src/fsharp/TastOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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

Expand All @@ -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...
Expand Down
12 changes: 12 additions & 0 deletions src/fsharp/TastOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
//-------------------------------------------------------------------------
Expand Down
4 changes: 2 additions & 2 deletions src/fsharp/TcGlobals.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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

Expand Down
73 changes: 67 additions & 6 deletions src/fsharp/TypeChecker.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3045,6 +3045,24 @@ let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseF
let TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty =
AllMethInfosOfTypeInScope collectionSettings 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()
Expand Down Expand Up @@ -7117,6 +7135,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
Expand All @@ -7141,7 +7178,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

Expand All @@ -7150,13 +7187,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 =
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
)

Loading

0 comments on commit 08f6169

Please sign in to comment.