diff --git a/src/absil/il.fs b/src/absil/il.fs index 61c5a33a845..818d63346ef 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -2582,6 +2582,8 @@ type ILGlobals(primaryScopeRef) = let m_typ_IntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_IntPtr)) let m_typ_UIntPtr = ILType.Value (mkILNonGenericTySpec (m_mkSysILTypeRef tname_UIntPtr)) + let m_typ_IEquatableT = mkILBoxedType (mkILTySpec (m_mkSysILTypeRef "System.IEquatable`1", [ mkILTyvarTy 1us ])) + member x.primaryAssemblyScopeRef = m_typ_Object.TypeRef.Scope member x.primaryAssemblyName = m_typ_Object.TypeRef.Scope.AssemblyRef.Name member x.typ_Object = m_typ_Object @@ -2602,6 +2604,7 @@ type ILGlobals(primaryScopeRef) = member x.typ_Double = m_typ_Double member x.typ_Bool = m_typ_Bool member x.typ_Char = m_typ_Char + member x.typ_IEquatableT = m_typ_IEquatableT /// For debugging [] diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 668459088fd..59c9d40c108 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -1583,6 +1583,7 @@ type ILGlobals = member typ_Double: ILType member typ_Bool: ILType member typ_Char: ILType + member typ_IEquatableT: ILType /// Build the table of commonly used references given functions to find types in system assemblies diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs index 344c0e1412a..180ccf6efa2 100644 --- a/src/fsharp/CompileOptions.fs +++ b/src/fsharp/CompileOptions.fs @@ -416,6 +416,11 @@ let SetOptimizeOn(tcConfigB : TcConfigBuilder) = let SetOptimizeSwitch (tcConfigB : TcConfigBuilder) switch = if (switch = OptionSwitch.On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB) +let SetSpecificOptimizeSwitch (tcConfigB : TcConfigBuilder) n switch = + match n with + | "equality" -> tcConfigB.optSettings <- { tcConfigB.optSettings with optimizeComparisonLogic = (switch = OptionSwitch.On) } + | _ -> failwithf "dodgy flag %s" n + let SetTailcallSwitch (tcConfigB : TcConfigBuilder) switch = tcConfigB.emitTailcalls <- (switch = OptionSwitch.On) @@ -696,6 +701,8 @@ let codeGenerationFlags isFsi (tcConfigB : TcConfigBuilder) = let codegen = [CompilerOption("optimize", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, Some (FSComp.SR.optsOptimize())) + CompilerOption("optimize", tagNone, OptionStringListSwitch (SetSpecificOptimizeSwitch tcConfigB) , None, + Some (FSComp.SR.optsOptimize())) CompilerOption("tailcalls", tagNone, OptionSwitch (SetTailcallSwitch tcConfigB), None, Some (FSComp.SR.optsTailcalls())) CompilerOption("deterministic", tagNone, OptionSwitch (SetDeterministicSwitch tcConfigB), None, diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 96d94d16e93..05e367a720c 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -261,6 +261,7 @@ type OptimizationSettings = jitOptUser : bool option localOptUser : bool option crossModuleOptUser : bool option + optimizeComparisonLogic : bool /// size after which we start chopping methods in two, though only at match targets bigTargetSize : int /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations @@ -278,6 +279,7 @@ type OptimizationSettings = { abstractBigTargets = false jitOptUser = None localOptUser = None + optimizeComparisonLogic = false /// size after which we start chopping methods in two, though only at match targets bigTargetSize = 100 /// size after which we start enforcing splitting sub-expressions to new methods, to avoid hitting .NET IL limitations @@ -2479,7 +2481,34 @@ and DevirtualizeApplication cenv env (vref:ValRef) ty tyargs args m = let wrap, args = TakeAddressOfStructArgumentIfNeeded cenv vref ty args m let transformedExpr = wrap (MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m)) OptimizeExpr cenv env transformedExpr - + +and DevirtualizeGenericEqualityIntrinsic cenv env receiver arg m = + let call = mkCall_IEquatableT_Equals cenv.g m receiver arg + OptimizeExpr cenv env call + +/// Check if a type 'ty' implements 'IEquatable' +and IsIEquatableTy cenv m ty = + let searchTy = mkAppTy cenv.g.system_GenericIEquatable_tcref [ty] + ExistsInEntireHierarchyOfType (fun t -> typeEquiv cenv.g t searchTy) cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty + +/// Check if a type 'ty' implements 'IStructuralEquatable' +and IsIStructuralEquatableTy cenv m ty = + let searchTy = mkAppTy cenv.g.tcref_System_IStructuralEquatable [] + ExistsInEntireHierarchyOfType (fun t -> typeEquiv cenv.g t searchTy) cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes ty + +/// Check if a type 'ty' is a structural F# type with default structural equality semantics +and IsGeneratedHashAndEqualsTy g ty = + isAnonRecdTy g ty || + (isAppTy g ty && + (let tcref = tcrefOfAppTy g ty + tcref.GeneratedHashAndEqualsValues.IsSome && tcref.GeneratedHashAndEqualsWithComparerValues.IsSome)) + +/// Check if we can (perhaps optimistically) convert the reduced optimization of 'a = b' to '(a :> IEquatable).Equals(b)' +and CanOptimizeGenericEqualityIntrinsicToIEquatableEquals cenv m ty = + IsIEquatableTy cenv m ty && + not (isAnyTupleTy cenv.g ty) && + (IsGeneratedHashAndEqualsTy cenv.g ty || (cenv.settings.optimizeComparisonLogic && not (IsIStructuralEquatableTy cenv m ty))) + and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match f, tyargs, args with @@ -2536,7 +2565,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparer - | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args && not(isRefTupleTy cenv.g ty) -> + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_outer_vref ty args && not(isRefTupleTy cenv.g ty) -> let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, _, withcEqualsVal), [x; y] -> @@ -2606,7 +2635,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match vref with | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) | None -> None - + // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty @@ -2675,6 +2704,9 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = MightMakeCriticalTailcall = false Info=UnknownValue}) + | Expr.Val(v, _, _), [_], [receiver; arg] when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && CanOptimizeGenericEqualityIntrinsicToIEquatableEquals cenv m (tyOfExpr cenv.g receiver) -> + Some(DevirtualizeGenericEqualityIntrinsic cenv env receiver arg m) + | _ -> None /// Attempt to inline an application of a known value at callsites diff --git a/src/fsharp/Optimizer.fsi b/src/fsharp/Optimizer.fsi index d99d3703589..6ff56865a00 100644 --- a/src/fsharp/Optimizer.fsi +++ b/src/fsharp/Optimizer.fsi @@ -12,6 +12,7 @@ type OptimizationSettings = jitOptUser : bool option localOptUser : bool option crossModuleOptUser : bool option + optimizeComparisonLogic : bool bigTargetSize : int veryBigExprSize : int lambdaInlineThreshold : int diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 1c2361f711b..8b71bb55fce 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -6386,6 +6386,9 @@ let mspec_String_Concat4 (g: TcGlobals) = let mspec_String_Concat_Array (g: TcGlobals) = mkILNonGenericStaticMethSpecInTy (g.ilg.typ_String, "Concat", [ mkILArr1DTy g.ilg.typ_String ], g.ilg.typ_String) +let mspec_IEquatableT_Equals (g: TcGlobals) = + mkILNonGenericMethSpecInTy (g.ilg.typ_IEquatableT, ILCallingConv.Instance, "Equals", [ mkILTyvarTy 0us ], g.ilg.typ_Bool) + let fspec_Missing_Value (g: TcGlobals) = IL.mkILFieldSpecInTy(g.iltyp_Missing, "Value", g.iltyp_Missing) let mkInitializeArrayMethSpec (g: TcGlobals) = @@ -6623,6 +6626,21 @@ 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) +let mkCall_IEquatableT_Equals g m receiver arg = + let mspec = mspec_IEquatableT_Equals g + let receiverTy = tyOfExpr g receiver + let isStruct = isStructTy g receiverTy + + let wrap, finalExpr, valUseFlag = + if isStruct then + let wrap, addrOfReceiver, _, _ = mkExprAddrOfExpr g true false Mutates.NeverMutates receiver None m + wrap, addrOfReceiver, ValUseFlag.PossibleConstrainedCall(receiverTy) + else + id, receiver, ValUseFlag.NormalValUse + + Expr.Op(TOp.ILCall(isStruct, false, false, false, valUseFlag, false, false, mspec.MethodRef, [receiverTy], [], [g.bool_ty]), [], [finalExpr; arg], m) + |> wrap + // Quotations can't contain any IL. // As a result, we aim to get rid of all IL generation in the typechecker and pattern match // compiler, or else train the quotation generator to understand the generated IL. diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi index badacfda0ea..04a14db85cd 100755 --- a/src/fsharp/TastOps.fsi +++ b/src/fsharp/TastOps.fsi @@ -1965,6 +1965,8 @@ val mkStaticCall_String_Concat4 : TcGlobals -> range -> Expr -> Expr -> Expr -> val mkStaticCall_String_Concat_Array : TcGlobals -> range -> Expr -> Expr +val mkCall_IEquatableT_Equals : TcGlobals -> range -> Expr -> Expr -> Expr + //------------------------------------------------------------------------- // operations primarily associated with the optimization to fix // up loops to generate .NET code that does not include array bound checks diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index 485f5882354..0162beea2d3 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -269,10 +269,14 @@ type range(code1:int64, code2: int64) = override r.ToString() = sprintf "%s (%d,%d--%d,%d) IsSynthetic=%b" r.FileName r.StartLine r.StartColumn r.EndLine r.EndColumn r.IsSynthetic -let mkRange filePath startPos endPos = range (fileIndexOfFileAux true filePath, startPos, endPos) + interface IEquatable with -let equals (r1: range) (r2: range) = - r1.Code1 = r2.Code1 && r1.Code2 = r2.Code2 + member this.Equals(m) = this.Code1 = m.Code1 && this.Code2 = m.Code2 + +let mkRange f b e = + // remove relative parts from full path + let normalizedFilePath = if Path.IsPathRooted f then try Path.GetFullPath f with _ -> f else f + range (fileIndexOfFile normalizedFilePath, b, e) let mkFileIndexRange fileIndex startPos endPos = range (fileIndex, startPos, endPos) diff --git a/src/fsharp/range.fsi b/src/fsharp/range.fsi index 6549b008dcf..ceba49f064c 100755 --- a/src/fsharp/range.fsi +++ b/src/fsharp/range.fsi @@ -2,6 +2,7 @@ module public Microsoft.FSharp.Compiler.Range +open System open System.Text open System.Collections.Generic open Internal.Utilities @@ -91,6 +92,8 @@ type range = /// The range where all values are zero static member Zero : range + + interface IEquatable /// This view of range marks uses file indexes explicitly val mkFileIndexRange : FileIndex -> pos -> pos -> range