From 3814613b4ed12c567036498b899239b8f5e9f083 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 9 May 2022 19:23:44 +0200 Subject: [PATCH 01/91] WIP: Support implementing statics in interfaces --- src/fsharp/CheckExpressions.fs | 35 +++++++++++++++- src/fsharp/SyntaxTreeOps.fs | 8 ++++ src/fsharp/SyntaxTreeOps.fsi | 2 + src/fsharp/pars.fsy | 20 +++++---- .../Interop/StaticsInInterfaces.fs | 41 ++++++++++++++++++- 5 files changed, 95 insertions(+), 11 deletions(-) diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 12eb6f4ccd9..a1adff7d4b8 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -11279,6 +11279,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl envinner: TcEnv, tpenv, declKind, + synTyparDecls, newslotsOK, overridesOK, tcrefContainerInfo, @@ -11286,7 +11287,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl id: Ident, vis2, declaredTypars, - memberFlagsOpt, + memberFlagsOpt: SynMemberFlags option, thisIdOpt, bindingAttribs, valSynInfo, @@ -11302,7 +11303,37 @@ and AnalyzeRecursiveStaticMemberOrValDecl // name for the member and the information about which type it is augmenting match tcrefContainerInfo, memberFlagsOpt with + | Some(MemberOrValContainerInfo(tcref, optIntfSlotTy, _, _, declaredTyconTypars)), Some memberFlags + when memberFlags.MemberKind = SynMemberKind.Member && + memberFlags.IsInstance = false && + memberFlags.IsOverrideOrExplicitImpl = true -> + + CheckMemberFlags optIntfSlotTy newslotsOK overridesOK memberFlags id.idRange + CheckForNonAbstractInterface declKind tcref memberFlags id.idRange + + let isExtrinsic = (declKind = ExtrinsicExtensionBinding) + let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, _ = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner + let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic + + + let (ExplicitTyparInfo(_, declaredTypars, infer)) = explicitTyparInfo + + let domainTy = NewInferenceType g + + let optInferredImplSlotTys, declaredTypars = + ApplyAbstractSlotInference cenv envinner (domainTy, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, objTy, optIntfSlotTy, valSynInfo, memberFlags, bindingAttribs) + + let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) + + let memberInfo = + let isExtrinsic = (declKind = ExtrinsicExtensionBinding) + MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, bindingAttribs, optInferredImplSlotTys, memberFlags, valSynInfo, id, false) + + envinner, tpenv, id, None, Some memberInfo, vis, vis2, None, enclosingDeclaredTypars, None, explicitTyparInfo, bindingRhs, declaredTypars + | Some(MemberOrValContainerInfo(tcref, optIntfSlotTy, baseValOpt, _safeInitInfo, declaredTyconTypars)), Some memberFlags -> + assert (Option.isNone optIntfSlotTy) CheckMemberFlags None newslotsOK overridesOK memberFlags id.idRange @@ -11488,7 +11519,7 @@ and AnalyzeRecursiveDecl | SynPat.Named (SynIdent(id,_), _, vis2, _) -> AnalyzeRecursiveStaticMemberOrValDecl - (cenv, envinner, tpenv, declKind, + (cenv, envinner, tpenv, declKind, synTyparDecls, newslotsOK, overridesOK, tcrefContainerInfo, vis1, id, vis2, declaredTypars, memberFlagsOpt, thisIdOpt, bindingAttribs, diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs index a27775a174d..b1141eb9b8a 100644 --- a/src/fsharp/SyntaxTreeOps.fs +++ b/src/fsharp/SyntaxTreeOps.fs @@ -698,6 +698,14 @@ let StaticMemberFlags trivia k : SynMemberFlags = IsFinal=false Trivia=trivia } +let ImplementStaticMemberFlags trivia k : SynMemberFlags = + { MemberKind=k + IsInstance=false + IsDispatchSlot=false + IsOverrideOrExplicitImpl=true + IsFinal=false + Trivia=trivia } + let MemberSynMemberFlagsTrivia (mMember: range) : SynMemberFlagsTrivia = { MemberRange = Some mMember OverrideRange = None diff --git a/src/fsharp/SyntaxTreeOps.fsi b/src/fsharp/SyntaxTreeOps.fsi index 7f66c937e75..e1068212b1a 100644 --- a/src/fsharp/SyntaxTreeOps.fsi +++ b/src/fsharp/SyntaxTreeOps.fsi @@ -300,6 +300,8 @@ val AbstractMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> Syn val StaticMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags +val ImplementStaticMemberFlags: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags + val MemberSynMemberFlagsTrivia: mMember: range -> SynMemberFlagsTrivia val OverrideSynMemberFlagsTrivia: mOverride: range -> SynMemberFlagsTrivia diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 3bf8597b5ce..9ee981d30d6 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -2325,28 +2325,32 @@ objectImplementationMembers: /* One member in an object expression or interface implementation */ objectImplementationMember: - | opt_attributes memberOrOverride memberCore opt_ODECLEND + | opt_attributes staticMemberOrMemberOrOverride memberCore opt_ODECLEND { let rangeStart = rhs parseState 1 - $3 None (OverrideMemberFlags $2) $1 rangeStart } + $3 None $2 $1 rangeStart } - | opt_attributes memberOrOverride autoPropsDefnDecl opt_ODECLEND + | opt_attributes staticMemberOrMemberOrOverride autoPropsDefnDecl opt_ODECLEND { let rangeStart = rhs parseState 1 - $3 $1 false (OverrideMemberFlags $2) rangeStart } + $3 $1 false $2 rangeStart } - | opt_attributes memberOrOverride error + | opt_attributes staticMemberOrMemberOrOverride error { [] } | opt_attributes error memberCore opt_ODECLEND { [] } -memberOrOverride: +staticMemberOrMemberOrOverride: + | STATIC MEMBER + { let mStatic = rhs parseState 1 + let mMember = rhs parseState 2 + ImplementStaticMemberFlags(StaticMemberSynMemberFlagsTrivia mStatic mMember) } | MEMBER { let mMember = rhs parseState 1 - MemberSynMemberFlagsTrivia mMember } + OverrideMemberFlags(MemberSynMemberFlagsTrivia mMember) } | OVERRIDE { let mOverride = rhs parseState 1 - OverrideSynMemberFlagsTrivia mOverride } + OverrideMemberFlags(OverrideSynMemberFlagsTrivia mOverride) } /* The core of the right-hand-side of a simple type definition */ diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index ebbcc958077..6ba5081eec8 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -68,4 +68,43 @@ let main _ = |> withReferences [csharpLib] |> compileAndRun |> shouldSucceed - // TODO: test operators, test implementing statics. \ No newline at end of file + + #if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can implement static methods declared in interfaces from C#`` () = + + let csharpLib = csharpBaseClass + + let fsharpSource = + """ +open System +open StaticsInInterfaces + +type MyRepeatSequence() = + interface IGetNext with + static member Next(other: MyRepeatSequence) : MyRepeatSequence = other + +[] +let main _ = + + let mutable str = MyRepeatSequence () + let res = [ for i in 0..10 do + yield string(str) + str <- MyRepeatSequence.Next(str) ] + + if res <> ["A"; "AA"; "AAA"; "AAAA"; "AAAAA"; "AAAAAA"; "AAAAAAA"; "AAAAAAAA"; "AAAAAAAAA"; "AAAAAAAAAA"; "AAAAAAAAAAA"] then + failwith $"Unexpected result: %A{res}" + + if string(str) <> "AAAAAAAAAAAA" then + failwith $"Unexpected result %s{string(str)}" + 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> withReferences [csharpLib] + |> compileAndRun + |> shouldSucceed \ No newline at end of file From ff0deda617826cd3041198c53fe46481c2118a64 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 9 May 2022 14:43:11 +0100 Subject: [PATCH 02/91] Cleanup (#13113) * cleanup * split files * rename * split infos.fs and SymbolHelpres.fs * split infos.fs and SymbolHelpres.fs * fix code formating * rename autobox --> LowerLocalMutables * adjust names * block --> ImmutableArray * format * Error --> SRDiagnostic * Error --> SRDiagnostic * this -> _ * rename and cleanup * rename Diagnostic --> FormattedDiagnostic * format sigs * format sigs * fix build * fix build --- src/fsharp/AccessibilityLogic.fs | 3 +- src/fsharp/AttributeChecking.fs | 10 +- src/fsharp/AttributeChecking.fsi | 2 +- src/fsharp/AugmentWithHashCompare.fs | 14 +- src/fsharp/BuildGraph.fs | 20 +- src/fsharp/BuildGraph.fsi | 2 +- src/fsharp/CheckComputationExpressions.fs | 2 +- src/fsharp/CheckDeclarations.fs | 21 +- src/fsharp/CheckDeclarations.fsi | 4 +- src/fsharp/CheckExpressions.fs | 75 ++- src/fsharp/CheckExpressions.fsi | 52 +- src/fsharp/CheckFormatStrings.fs | 2 +- src/fsharp/CompilerConfig.fs | 22 +- src/fsharp/CompilerConfig.fsi | 10 +- src/fsharp/CompilerDiagnostics.fs | 98 ++-- src/fsharp/CompilerDiagnostics.fsi | 64 +-- src/fsharp/CompilerImports.fs | 12 +- src/fsharp/CompilerImports.fsi | 10 +- src/fsharp/CompilerOptions.fs | 22 +- src/fsharp/ConstraintSolver.fs | 9 +- src/fsharp/ConstraintSolver.fsi | 2 +- src/fsharp/CreateILModule.fs | 2 +- .../DependencyManager/DependencyProvider.fs | 2 +- src/fsharp/DetupleArgs.fs | 2 +- .../{ErrorLogger.fs => DiagnosticsLogger.fs} | 159 +++--- ...{ErrorLogger.fsi => DiagnosticsLogger.fsi} | 87 ++-- .../FSharp.Build/FSharpEmbedResXSource.fs | 14 +- .../FSharp.Build/FSharpEmbedResourceText.fs | 12 +- .../FSharp.Build/Microsoft.FSharp.Targets | 4 +- .../FSharp.Compiler.Service.fsproj | 56 +- src/fsharp/FSharp.Core/Query.fs | 8 +- src/fsharp/FSharp.Core/async.fs | 2 +- .../FSharp.Core/fslib-extra-pervasives.fs | 22 +- src/fsharp/FSharp.Core/list.fs | 72 +-- src/fsharp/FSharp.Core/local.fs | 2 +- src/fsharp/FSharp.Core/map.fs | 4 +- src/fsharp/FSharp.Core/option.fs | 242 +++++++-- src/fsharp/FSharp.Core/prim-types.fs | 4 +- src/fsharp/FSharp.Core/quotations.fs | 24 +- src/fsharp/FSharp.Core/quotations.fsi | 12 +- src/fsharp/FSharp.Core/seq.fs | 2 +- src/fsharp/FSharp.Core/string.fs | 4 +- .../FSharp.DependencyManager.fs | 2 +- src/fsharp/FindUnsolved.fs | 2 +- src/fsharp/FxResolver.fs | 2 +- src/fsharp/IlxGen.fs | 10 +- src/fsharp/{block.fs => ImmutableArray.fs} | 53 +- src/fsharp/ImmutableArray.fsi | 57 +++ src/fsharp/InfoReader.fs | 3 +- src/fsharp/InfoReader.fsi | 1 + src/fsharp/InnerLambdasToTopLevelFuncs.fs | 2 +- src/fsharp/LegacyHostedCompilerForTesting.fs | 100 +++- src/fsharp/LexFilter.fs | 2 +- src/fsharp/LowerCalls.fs | 53 ++ src/fsharp/LowerCalls.fsi | 10 + src/fsharp/LowerComputedCollections.fs | 272 ++++++++++ src/fsharp/LowerComputedCollections.fsi | 10 + .../{autobox.fs => LowerLocalMutables.fs} | 6 +- .../{autobox.fsi => LowerLocalMutables.fsi} | 2 +- ...LowerCallsAndSeqs.fs => LowerSequences.fs} | 394 +-------------- ...werCallsAndSeqs.fsi => LowerSequences.fsi} | 16 +- src/fsharp/LowerStateMachines.fs | 10 +- src/fsharp/MethodCalls.fs | 3 +- src/fsharp/MethodCalls.fsi | 2 +- src/fsharp/MethodOverrides.fs | 3 +- src/fsharp/NameResolution.fs | 63 ++- src/fsharp/NicePrint.fs | 13 +- src/fsharp/OptimizeInputs.fs | 6 +- src/fsharp/Optimizer.fs | 14 +- src/fsharp/ParseAndCheckInputs.fs | 34 +- src/fsharp/ParseAndCheckInputs.fsi | 16 +- src/fsharp/ParseHelpers.fs | 2 +- src/fsharp/PatternMatchCompilation.fs | 50 +- src/fsharp/PostInferenceChecks.fs | 3 +- src/fsharp/QueueList.fs | 2 +- src/fsharp/QuotationTranslator.fs | 2 +- src/fsharp/ScriptClosure.fs | 20 +- src/fsharp/ScriptClosure.fsi | 2 +- src/fsharp/SignatureConformance.fs | 5 +- src/fsharp/StaticLinking.fs | 6 +- src/fsharp/SyntaxTreeOps.fs | 2 +- src/fsharp/TypeHierarchy.fs | 409 +++++++++++++++ src/fsharp/TypeHierarchy.fsi | 174 +++++++ src/fsharp/TypeProviders.fs | 2 +- src/fsharp/TypeRelations.fs | 4 +- src/fsharp/TypedTree.fs | 12 +- src/fsharp/TypedTreeOps.fs | 97 +++- src/fsharp/TypedTreeOps.fsi | 32 +- src/fsharp/TypedTreePickle.fs | 4 +- src/fsharp/XmlDoc.fs | 2 +- src/fsharp/XmlDocFileWriter.fs | 2 +- src/fsharp/absil/il.fs | 365 +++++++------- src/fsharp/absil/il.fsi | 2 +- src/fsharp/absil/illib.fs | 2 +- src/fsharp/absil/ilmorph.fs | 2 +- src/fsharp/absil/ilread.fs | 2 +- src/fsharp/absil/ilreflect.fs | 4 +- src/fsharp/absil/ilwrite.fs | 2 +- src/fsharp/absil/ilwritepdb.fs | 2 +- src/fsharp/block.fsi | 63 --- src/fsharp/fsc.fs | 130 ++--- src/fsharp/fsc.fsi | 49 +- src/fsharp/fscmain.fs | 6 +- src/fsharp/fsi/console.fs | 2 +- src/fsharp/fsi/fsi.fs | 76 +-- src/fsharp/fsi/fsimain.fs | 8 +- src/fsharp/import.fs | 23 +- src/fsharp/import.fsi | 11 +- src/fsharp/infos.fs | 477 ++---------------- src/fsharp/infos.fsi | 165 ------ src/fsharp/lex.fsl | 2 +- src/fsharp/lexhelp.fs | 4 +- src/fsharp/lexhelp.fsi | 6 +- src/fsharp/pars.fsy | 2 +- src/fsharp/pplex.fsl | 2 +- src/fsharp/pppars.fsy | 2 +- src/fsharp/service/FSharpCheckerResults.fs | 60 +-- src/fsharp/service/FSharpCheckerResults.fsi | 2 +- src/fsharp/service/FSharpParseFileResults.fs | 4 +- src/fsharp/service/IncrementalBuild.fs | 154 +++--- src/fsharp/service/IncrementalBuild.fsi | 7 +- src/fsharp/service/SemanticClassification.fs | 7 +- src/fsharp/service/ServiceAssemblyContent.fs | 4 +- .../service/ServiceCompilerDiagnostics.fs | 2 +- src/fsharp/service/ServiceDeclarationLists.fs | 10 +- src/fsharp/service/ServiceLexing.fs | 28 +- src/fsharp/service/ServiceNavigation.fs | 45 +- .../service/ServiceParamInfoLocations.fs | 30 +- src/fsharp/service/ServiceParseTreeWalk.fs | 2 +- src/fsharp/service/ServiceParsedInputOps.fs | 6 +- src/fsharp/service/ServiceStructure.fs | 2 +- src/fsharp/service/service.fs | 103 ++-- src/fsharp/symbols/Exprs.fs | 3 +- src/fsharp/symbols/FSharpDiagnostic.fs | 207 ++++++++ src/fsharp/symbols/FSharpDiagnostic.fsi | 130 +++++ src/fsharp/symbols/SymbolHelpers.fs | 212 +------- src/fsharp/symbols/SymbolHelpers.fsi | 116 ----- src/fsharp/symbols/Symbols.fs | 19 +- src/fsharp/tainted.fs | 6 +- src/fsharp/utils/CompilerLocationUtils.fs | 2 +- src/fsharp/utils/prim-lexing.fs | 2 +- src/fsharp/utils/sformat.fs | 2 +- .../MapSourceRootsTests.fs | 43 +- .../WriteCodeFragmentTests.fs | 32 +- .../checkedOperatorsNoOverflow.fs | 2 +- .../EmittedIL/Misc/AbstractClass.fs | 2 +- .../SteppingMatch/SteppingMatch09.fs | 6 +- .../EmittedIL/Tuples/OptionalArg01.fs | 2 +- .../Printing/ParamArrayInSignatures.fsx | 2 +- tests/FSharp.Compiler.UnitTests/BlockTests.fs | 14 +- .../CompilerTestHelpers.fs | 2 +- .../HashIfExpression.fs | 99 ++-- .../FSharp.Core/ComparersRegression.fs | 2 +- .../Microsoft.FSharp.Control/AsyncModule.fs | 2 +- .../Microsoft.FSharp.Control/AsyncType.fs | 4 +- .../MailboxProcessorType.fs | 6 +- .../FSharp.Core/PrimTypes.fs | 2 +- tests/benchmarks/TaskPerf/option.fs | 4 +- tests/fsharp/tests.fs | 16 +- tests/service/Common.fs | 38 +- tests/service/PatternMatchCompilationTests.fs | 82 +-- tests/service/ProjectAnalysisTests.fs | 4 +- tests/service/data/TestTP/ProvidedTypes.fs | 2 +- .../Completion/CompletionProvider.fs | 2 +- .../FSharp.Editor/Options/EditorOptions.fs | 2 +- .../FSharp.ProjectSystem.FSharp/Project.fs | 2 +- .../src/FSharp.VS.FSI/fsiTextBufferStream.fs | 2 +- .../ProvidedTypes.fs | 4 +- .../UnitTests/BraceMatchingServiceTests.fs | 2 +- .../UnitTests/CompletionProviderTests.fs | 2 +- .../DocumentDiagnosticAnalyzerTests.fs | 2 +- .../Tests.LanguageService.Completion.fs | 50 +- .../Tests.LanguageService.ErrorList.fs | 8 +- .../Tests.LanguageService.GotoDefinition.fs | 8 +- .../Tests.LanguageService.ParameterInfo.fs | 93 ++-- .../Tests.LanguageService.QuickInfo.fs | 10 +- .../Tests.LanguageService.Script.fs | 6 +- .../Tests.LanguageService.TimeStamp.fs | 8 +- .../Tests.ProjectSystem.Project.fs | 4 +- .../Tests.ProjectSystem.References.fs | 4 +- .../UnitTests/TestLib.LanguageService.fs | 69 ++- vsintegration/tests/UnitTests/Tests.Watson.fs | 6 +- .../UnitTests/Workspace/WorkspaceTests.fs | 20 +- 183 files changed, 3483 insertions(+), 2946 deletions(-) rename src/fsharp/{ErrorLogger.fs => DiagnosticsLogger.fs} (85%) rename src/fsharp/{ErrorLogger.fsi => DiagnosticsLogger.fsi} (83%) rename src/fsharp/{block.fs => ImmutableArray.fs} (74%) create mode 100644 src/fsharp/ImmutableArray.fsi create mode 100644 src/fsharp/LowerCalls.fs create mode 100644 src/fsharp/LowerCalls.fsi create mode 100644 src/fsharp/LowerComputedCollections.fs create mode 100644 src/fsharp/LowerComputedCollections.fsi rename src/fsharp/{autobox.fs => LowerLocalMutables.fs} (98%) rename src/fsharp/{autobox.fsi => LowerLocalMutables.fsi} (88%) rename src/fsharp/{LowerCallsAndSeqs.fs => LowerSequences.fs} (68%) rename src/fsharp/{LowerCallsAndSeqs.fsi => LowerSequences.fsi} (68%) create mode 100644 src/fsharp/TypeHierarchy.fs create mode 100644 src/fsharp/TypeHierarchy.fsi delete mode 100644 src/fsharp/block.fsi create mode 100644 src/fsharp/symbols/FSharpDiagnostic.fs create mode 100644 src/fsharp/symbols/FSharpDiagnostic.fsi diff --git a/src/fsharp/AccessibilityLogic.fs b/src/fsharp/AccessibilityLogic.fs index e9d917016ed..4a70f268ddf 100644 --- a/src/fsharp/AccessibilityLogic.fs +++ b/src/fsharp/AccessibilityLogic.fs @@ -6,12 +6,13 @@ module internal FSharp.Compiler.AccessibilityLogic open Internal.Utilities.Library open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index 14e92c80b43..9d1cc9ac5ca 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -9,12 +9,14 @@ open System.Collections.Generic open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders @@ -87,7 +89,7 @@ type AttribInfo = match x with | FSAttribInfo(_g, Attrib(tcref, _, _, _, _, _, _)) -> tcref | ILAttribInfo (g, amap, scoref, a, m) -> - let ty = ImportILType scoref amap m [] a.Method.DeclaringType + let ty = RescopeAndImportILType scoref amap m [] a.Method.DeclaringType tcrefOfAppTy g ty member x.ConstructorArguments = @@ -101,7 +103,7 @@ type AttribInfo = | ILAttribInfo (_g, amap, scoref, cattr, m) -> let parms, _args = decodeILAttribData cattr [ for argTy, arg in Seq.zip cattr.Method.FormalArgTypes parms -> - let ty = ImportILType scoref amap m [] argTy + let ty = RescopeAndImportILType scoref amap m [] argTy let obj = evalILAttribElem arg ty, obj ] @@ -116,7 +118,7 @@ type AttribInfo = | ILAttribInfo (_g, amap, scoref, cattr, m) -> let _parms, namedArgs = decodeILAttribData cattr [ for nm, argTy, isProp, arg in namedArgs -> - let ty = ImportILType scoref amap m [] argTy + let ty = RescopeAndImportILType scoref amap m [] argTy let obj = evalILAttribElem arg let isField = not isProp ty, nm, isField, obj ] diff --git a/src/fsharp/AttributeChecking.fsi b/src/fsharp/AttributeChecking.fsi index 25db0ca1679..430fe36f0db 100644 --- a/src/fsharp/AttributeChecking.fsi +++ b/src/fsharp/AttributeChecking.fsi @@ -7,7 +7,7 @@ module internal FSharp.Compiler.AttributeChecking open System.Collections.Generic open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 59869f2dfbe..8e2646ada99 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -5,8 +5,7 @@ module internal FSharp.Compiler.AugmentWithHashCompare open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Infos +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Xml @@ -14,6 +13,7 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy let mkIComparableCompareToSlotSig (g: TcGlobals) = TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [[TSlotParam(Some("obj"), g.obj_ty, false, false, false, [])]], Some g.int_ty) @@ -175,7 +175,7 @@ let mkEqualsTestConjuncts g m exprs = List.foldBack (fun e acc -> mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty e acc (mkFalse g m)) a b let mkMinimalTy (g: TcGlobals) (tcref: TyconRef) = - if tcref.Deref.IsExceptionDecl then [], g.exn_ty + if tcref.Deref.IsFSharpException then [], g.exn_ty else generalizeTyconRef g tcref // check for nulls @@ -679,7 +679,7 @@ let isTrueFSharpStructTycon _g (tycon: Tycon) = let canBeAugmentedWithEquals g (tycon: Tycon) = tycon.IsUnionTycon || tycon.IsRecordTycon || - (tycon.IsExceptionDecl && isNominalExnc tycon) || + (tycon.IsFSharpException && isNominalExnc tycon) || isTrueFSharpStructTycon g tycon let canBeAugmentedWithCompare g (tycon: Tycon) = @@ -918,7 +918,7 @@ let MakeValsForEqualsAugmentation g (tcref: TyconRef) = let tps = tcref.Typars m let objEqualsVal = mkValSpec g tcref ty vis (Some(mkEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsObjTy g ty)) unaryArg - let nocEqualsVal = mkValSpec g tcref ty vis (if tcref.Deref.IsExceptionDecl then None else Some(mkGenericIEquatableEqualsSlotSig g ty)) "Equals" (tps +-> (mkEqualsTy g ty)) unaryArg + let nocEqualsVal = mkValSpec g tcref ty vis (if tcref.Deref.IsFSharpException then None else Some(mkGenericIEquatableEqualsSlotSig g ty)) "Equals" (tps +-> (mkEqualsTy g ty)) unaryArg objEqualsVal, nocEqualsVal let MakeValsForEqualityWithComparerAugmentation g (tcref: TyconRef) = @@ -1032,7 +1032,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon (mkCompGenBind withcEqualsVal.Deref withcEqualsExpr)] if tycon.IsUnionTycon then mkStructuralEquatable mkUnionHashWithComparer mkUnionEqualityWithComparer elif (tycon.IsRecordTycon || tycon.IsStructOrEnumTycon) then mkStructuralEquatable mkRecdHashWithComparer mkRecdEqualityWithComparer - elif tycon.IsExceptionDecl then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer + elif tycon.IsFSharpException then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer else [] let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = @@ -1066,7 +1066,7 @@ let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = [ mkCompGenBind nocEqualsVal.Deref nocEqualsExpr mkCompGenBind objEqualsVal.Deref objEqualsExpr ] - if tycon.IsExceptionDecl then mkEquals mkExnEquality + if tycon.IsFSharpException then mkEquals mkExnEquality elif tycon.IsUnionTycon then mkEquals mkUnionEquality elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkEquals mkRecdEquality else [] diff --git a/src/fsharp/BuildGraph.fs b/src/fsharp/BuildGraph.fs index ca8409a22e6..2c287c11f3e 100644 --- a/src/fsharp/BuildGraph.fs +++ b/src/fsharp/BuildGraph.fs @@ -7,7 +7,7 @@ open System.Threading open System.Threading.Tasks open System.Diagnostics open System.Globalization -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library [] @@ -15,12 +15,12 @@ type NodeCode<'T> = Node of Async<'T> let wrapThreadStaticInfo computation = async { - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger let phase = CompileThreadStatic.BuildPhase try return! computation finally - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase } @@ -72,7 +72,7 @@ type NodeCodeBuilder() = member _.Using(value: CompilationGlobalsScope, binder: CompilationGlobalsScope -> NodeCode<'U>) = Node( async { - CompileThreadStatic.ErrorLogger <- value.ErrorLogger + CompileThreadStatic.DiagnosticsLogger <- value.DiagnosticsLogger CompileThreadStatic.BuildPhase <- value.BuildPhase try return! binder value |> Async.AwaitNodeCode @@ -90,19 +90,19 @@ type NodeCode private () = Node(wrapThreadStaticInfo Async.CancellationToken) static member RunImmediate (computation: NodeCode<'T>, ct: CancellationToken) = - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger let phase = CompileThreadStatic.BuildPhase try try let work = async { - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase return! computation |> Async.AwaitNodeCode } Async.StartImmediateAsTask(work, cancellationToken=ct).Result finally - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase with | :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> @@ -112,18 +112,18 @@ type NodeCode private () = NodeCode.RunImmediate(computation, CancellationToken.None) static member StartAsTask_ForTesting (computation: NodeCode<'T>, ?ct: CancellationToken) = - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger let phase = CompileThreadStatic.BuildPhase try let work = async { - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase return! computation |> Async.AwaitNodeCode } Async.StartAsTask(work, cancellationToken=defaultArg ct CancellationToken.None) finally - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase static member CancellationToken = cancellationToken diff --git a/src/fsharp/BuildGraph.fsi b/src/fsharp/BuildGraph.fsi index 1a475c97225..169164d6ff5 100644 --- a/src/fsharp/BuildGraph.fsi +++ b/src/fsharp/BuildGraph.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.BuildGraph open System open System.Threading open System.Threading.Tasks -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library /// Represents code that can be run as part of the build graph. diff --git a/src/fsharp/CheckComputationExpressions.fs b/src/fsharp/CheckComputationExpressions.fs index 64dde88c6d9..e27825992d9 100644 --- a/src/fsharp/CheckComputationExpressions.fs +++ b/src/fsharp/CheckComputationExpressions.fs @@ -9,7 +9,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckExpressions open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 9ce89d6306f..bebef739d09 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.CheckExpressions open FSharp.Compiler.CheckComputationExpressions open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -35,6 +35,7 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS @@ -374,7 +375,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath (env: // Bind elements of data definitions for exceptions and types (fields, etc.) //------------------------------------------------------------------------- -exception NotUpperCaseConstructor of range +exception NotUpperCaseConstructor of range: range let CheckNamespaceModuleOrTypeName (g: TcGlobals) (id: Ident) = // type names '[]' etc. are used in fslib @@ -678,7 +679,7 @@ let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target = | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m) -exception ParameterlessStructCtor of range +exception ParameterlessStructCtor of range: range let MakeSafeInitField (g: TcGlobals) env m isStatic = let id = @@ -2290,7 +2291,7 @@ module MutRecBindingChecking = let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, m, moduleRange, openDeclsRef)) -> Some (target, m, moduleRange, openDeclsRef) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) - let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) + let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsFSharpException) // Add the type definitions, exceptions, modules and "open" declarations. // The order here is sensitive. The things added first will be resolved in an environment @@ -2475,7 +2476,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial bindsm scopem mutRecNSInfo (env let overridesOK = DeclKind.CanOverrideOrImplement declKind members |> List.collect (function | SynMemberDefn.Interface(interfaceType=intfTy; members=defnOpt) -> - let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref let m = intfTy.Range if tcref.IsTypeAbbrev then error(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveInterfaceDeclaration(), m)) if tcref.IsEnumTycon then error(Error(FSComp.SR.tcEnumerationsCannotHaveInterfaceDeclaration(), m)) @@ -2600,7 +2601,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tycon && scSet.Contains tycon.Stamp then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref let m = tycon.Range let genericIComparableTy = mkAppTy g.system_GenericIComparable_tcref [ty] @@ -2623,7 +2624,7 @@ module AddAugmentationDeclarations = PublishInterface cenv env.DisplayEnv tcref m true g.mk_IStructuralComparable_ty PublishInterface cenv env.DisplayEnv tcref m true g.mk_IComparable_ty - if not tycon.IsExceptionDecl && not hasExplicitGenericIComparable then + if not tycon.IsFSharpException && not hasExplicitGenericIComparable then PublishInterface cenv env.DisplayEnv tcref m true genericIComparableTy tcaug.SetCompare (mkLocalValRef cvspec1, mkLocalValRef cvspec2) tcaug.SetCompareWith (mkLocalValRef cvspec3) @@ -2684,7 +2685,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tycon then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref let m = tycon.Range // Note: tycon.HasOverride only gives correct results after we've done the type augmentation @@ -2701,7 +2702,7 @@ module AddAugmentationDeclarations = let vspec1, vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) - if not tycon.IsExceptionDecl then + if not tycon.IsFSharpException then PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy g.system_GenericIEquatable_tcref [ty]) PublishValueDefn cenv env ModuleOrMemberBinding vspec1 PublishValueDefn cenv env ModuleOrMemberBinding vspec2 @@ -4606,7 +4607,7 @@ module EstablishTypeDefinitionCores = (envMutRecPrelim, withAttrs) ||> MutRecShapes.extendEnvs (fun envForDecls decls -> let tycons = decls |> List.choose (function MutRecShape.Tycon (_, Some (tycon, _)) -> Some tycon | _ -> None) - let exns = tycons |> List.filter (fun tycon -> tycon.IsExceptionDecl) + let exns = tycons |> List.filter (fun tycon -> tycon.IsFSharpException) let envForDecls = (envForDecls, exns) ||> List.fold (AddLocalExnDefnAndReport cenv.tcSink scopem) envForDecls) diff --git a/src/fsharp/CheckDeclarations.fsi b/src/fsharp/CheckDeclarations.fsi index 4d31b04abdf..40b485d060c 100644 --- a/src/fsharp/CheckDeclarations.fsi +++ b/src/fsharp/CheckDeclarations.fsi @@ -74,6 +74,6 @@ val CheckOneSigFile: ParsedSigFileInput -> Cancellable -exception ParameterlessStructCtor of range +exception ParameterlessStructCtor of range: range -exception NotUpperCaseConstructor of range +exception NotUpperCaseConstructor of range: range diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index a1adff7d4b8..44a40d21c55 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -38,6 +38,7 @@ open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS @@ -63,50 +64,94 @@ let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 80 //------------------------------------------------------------------------- exception BakedInMemberConstraintName of string * range + exception FunctionExpected of DisplayEnv * TType * range + exception NotAFunction of DisplayEnv * TType * range * range + exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range * bool + exception Recursion of DisplayEnv * Ident * TType * TType * range + exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range + exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range + exception LetRecCheckedAtRuntime of range + exception LetRecUnsound of DisplayEnv * ValRef list * range + exception TyconBadArgs of DisplayEnv * TyconRef * int * range + exception UnionCaseWrongArguments of DisplayEnv * int * int * range + exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range + exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range + exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range + exception MissingFields of string list * range + exception FunctionValueUnexpected of DisplayEnv * TType * range + exception UnitTypeExpected of DisplayEnv * TType * range + exception UnitTypeExpectedWithEquality of DisplayEnv * TType * range + exception UnitTypeExpectedWithPossibleAssignment of DisplayEnv * TType * bool * string * range + exception UnitTypeExpectedWithPossiblePropertySetter of DisplayEnv * TType * string * string * range + exception UnionPatternsBindDifferentNames of range + exception VarBoundTwice of Ident + exception ValueRestriction of DisplayEnv * InfoReader * bool * Val * Typar * range + exception ValNotMutable of DisplayEnv * ValRef * range + exception ValNotLocal of DisplayEnv * ValRef * range + exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range + exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range + exception CoercionTargetSealed of DisplayEnv * TType * range + exception UpcastUnnecessary of range + exception TypeTestUnnecessary of range + exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range + exception SelfRefObjCtor of bool * range + exception VirtualAugmentationOnNullValuedType of range + exception NonVirtualAugmentationOnNullValuedType of range + exception UseOfAddressOfOperator of range + exception DeprecatedThreadStaticBindingWarning of range + exception IntfImplInIntrinsicAugmentation of range + exception IntfImplInExtrinsicAugmentation of range + exception OverrideInIntrinsicAugmentation of range + exception OverrideInExtrinsicAugmentation of range + exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range + exception StandardOperatorRedefinitionWarning of string * range -exception InvalidInternalsVisibleToAssemblyName of (*badName*)string * (*fileName option*) string option + +exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option /// Represents information about the initialization field used to check that object constructors /// have completed before fields are accessed. @@ -1818,19 +1863,19 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> let values, vspecMap = let sink = { new ITypecheckResultsSink with - member this.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports + member _.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports - member this.NotifyNameResolution(pos, item, itemTyparInst, occurence, nenv, ad, m, replacing) = + member _.NotifyNameResolution(pos, item, itemTyparInst, occurence, nenv, ad, m, replacing) = notifyNameResolution (pos, item, item, itemTyparInst, occurence, nenv, ad, m, replacing) - member this.NotifyMethodGroupNameResolution(pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) = + member _.NotifyMethodGroupNameResolution(pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) = notifyNameResolution (pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) - member this.NotifyExprHasType(_, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals - member this.NotifyFormatSpecifierLocation(_, _) = () - member this.NotifyOpenDeclaration _ = () - member this.CurrentSourceText = None - member this.FormatStringCheckContext = None } + member _.NotifyExprHasType(_, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals + member _.NotifyFormatSpecifierLocation(_, _) = () + member _.NotifyOpenDeclaration _ = () + member _.CurrentSourceText = None + member _.FormatStringCheckContext = None } use _h = WithNewTypecheckResultsSink(sink, cenv.tcSink) MakeAndPublishSimpleVals cenv env names @@ -8619,9 +8664,11 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen cenv overallTy env item tp let SEEN_NAMED_ARGUMENT = -1 - // dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: - // regular notation for named parameters Some(Value = 5) can mean either 1) create option with value - result of equality operation or 2) create option using named arg syntax. - // so far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. + // Dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: + // regular notation for named parameters Some(Value = 5) can mean either + // 1) create "bool option" with value - result of equality operation or + // 2) create "int option" using named arg syntax. + // So far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. for _, id, arg in namedCallerArgs do match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with @@ -11339,7 +11386,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl CheckMemberFlags None newslotsOK overridesOK memberFlags id.idRange CheckForNonAbstractInterface declKind tcref memberFlags id.idRange - if memberFlags.MemberKind = SynMemberKind.Constructor && tcref.Deref.IsExceptionDecl then + if memberFlags.MemberKind = SynMemberKind.Constructor && tcref.Deref.IsFSharpException then error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(), id.idRange)) let isExtrinsic = (declKind = ExtrinsicExtensionBinding) diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index badd1b17da0..d2513565511 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -11,7 +11,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -107,59 +107,105 @@ type TcEnv = eIsControlFlow: bool } member DisplayEnv: DisplayEnv + member NameEnv: NameResolutionEnv + member AccessRights: AccessorDomain //------------------------------------------------------------------------- // Some of the exceptions arising from type checking. These should be moved to -// use ErrorLogger. +// use DiagnosticsLogger. //------------------------------------------------------------------------- exception BakedInMemberConstraintName of string * range + exception FunctionExpected of DisplayEnv * TType * range + exception NotAFunction of DisplayEnv * TType * range * range + exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range * bool + exception Recursion of DisplayEnv * Ident * TType * TType * range + exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range + exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range + exception LetRecCheckedAtRuntime of range + exception LetRecUnsound of DisplayEnv * ValRef list * range + exception TyconBadArgs of DisplayEnv * TyconRef * int * range + exception UnionCaseWrongArguments of DisplayEnv * int * int * range + exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range + exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range + exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range + exception MissingFields of string list * range + exception UnitTypeExpected of DisplayEnv * TType * range + exception UnitTypeExpectedWithEquality of DisplayEnv * TType * range + exception UnitTypeExpectedWithPossiblePropertySetter of DisplayEnv * TType * string * string * range + exception UnitTypeExpectedWithPossibleAssignment of DisplayEnv * TType * bool * string * range + exception FunctionValueUnexpected of DisplayEnv * TType * range + exception UnionPatternsBindDifferentNames of range + exception VarBoundTwice of Ident + exception ValueRestriction of DisplayEnv * InfoReader * bool * Val * Typar * range + exception ValNotMutable of DisplayEnv * ValRef * range + exception ValNotLocal of DisplayEnv * ValRef * range + exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range + exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range + exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range + exception CoercionTargetSealed of DisplayEnv * TType * range + exception UpcastUnnecessary of range + exception TypeTestUnnecessary of range + exception SelfRefObjCtor of bool * range + exception VirtualAugmentationOnNullValuedType of range + exception NonVirtualAugmentationOnNullValuedType of range + exception UseOfAddressOfOperator of range + exception DeprecatedThreadStaticBindingWarning of range + exception IntfImplInIntrinsicAugmentation of range + exception IntfImplInExtrinsicAugmentation of range + exception OverrideInIntrinsicAugmentation of range + exception OverrideInExtrinsicAugmentation of range + exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range + exception StandardOperatorRedefinitionWarning of string * range -exception InvalidInternalsVisibleToAssemblyName of string (*fileName option*) * string option (*badName*) + +exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option val TcFieldInit: range -> ILFieldInit -> Const diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs index 10f91b62498..5d24e1050d9 100644 --- a/src/fsharp/CheckFormatStrings.fs +++ b/src/fsharp/CheckFormatStrings.fs @@ -367,7 +367,7 @@ let parseFormatStringInternal (m: range) (fragRanges: range list) (g: TcGlobals) parseLoop acc (i+1, fragLine, fragCol+1) fragments | 'd' | 'i' | 'u' | 'B' | 'o' | 'x' | 'X' -> - if ch = 'B' then ErrorLogger.checkLanguageFeatureError g.langVersion Features.LanguageFeature.PrintfBinaryFormat m + if ch = 'B' then DiagnosticsLogger.checkLanguageFeatureError g.langVersion Features.LanguageFeature.PrintfBinaryFormat m if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString()) collectSpecifierLocation fragLine fragCol 1 let i = skipPossibleInterpolationHole (i+1) diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index 835cf68894d..7027e682d8e 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis @@ -368,7 +368,7 @@ type TcConfigBuilder = mutable useHighEntropyVA: bool mutable inputCodePage: int option mutable embedResources: string list - mutable errorSeverityOptions: FSharpDiagnosticOptions + mutable diagnosticsOptions: FSharpDiagnosticOptions mutable mlCompatibility: bool mutable checkOverflow: bool mutable showReferenceResolutions: bool @@ -430,7 +430,7 @@ type TcConfigBuilder = mutable legacyReferenceResolver: LegacyReferenceResolver mutable showFullPaths: bool - mutable errorStyle: ErrorStyle + mutable diagnosticStyle: DiagnosticStyle mutable utf8output: bool mutable flatErrors: bool @@ -579,7 +579,7 @@ type TcConfigBuilder = projectReferences = [] knownUnresolvedReferences = [] loadedSources = [] - errorSeverityOptions = FSharpDiagnosticOptions.Default + diagnosticsOptions = FSharpDiagnosticOptions.Default embedResources = [] inputCodePage = None subsystemVersion = 4, 0 // per spec for 357994 @@ -646,7 +646,7 @@ type TcConfigBuilder = includewin32manifest = true linkResources = [] showFullPaths = false - errorStyle = ErrorStyle.DefaultErrors + diagnosticStyle = DiagnosticStyle.Default utf8output = false flatErrors = false @@ -770,8 +770,8 @@ type TcConfigBuilder = | Some n -> // nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- true - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with WarnOff = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOff } + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with WarnOff = ListSet.insert (=) n tcConfigB.diagnosticsOptions.WarnOff } member tcConfigB.TurnWarningOn(m, s: string) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter @@ -780,8 +780,8 @@ type TcConfigBuilder = | Some n -> // warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- false - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with WarnOn = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOn } + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with WarnOn = ListSet.insert (=) n tcConfigB.diagnosticsOptions.WarnOn } member tcConfigB.AddIncludePath (m, path, pathIncludedFrom) = let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path @@ -1062,7 +1062,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.useHighEntropyVA = data.useHighEntropyVA member _.inputCodePage = data.inputCodePage member _.embedResources = data.embedResources - member _.errorSeverityOptions = data.errorSeverityOptions + member _.diagnosticsOptions = data.diagnosticsOptions member _.mlCompatibility = data.mlCompatibility member _.checkOverflow = data.checkOverflow member _.showReferenceResolutions = data.showReferenceResolutions @@ -1118,7 +1118,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.includewin32manifest = data.includewin32manifest member _.linkResources = data.linkResources member _.showFullPaths = data.showFullPaths - member _.errorStyle = data.errorStyle + member _.diagnosticStyle = data.diagnosticStyle member _.utf8output = data.utf8output member _.flatErrors = data.flatErrors member _.maxErrors = data.maxErrors diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index 8caa6028a6a..99c2684caae 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Text @@ -256,7 +256,7 @@ type TcConfigBuilder = mutable embedResources: string list - mutable errorSeverityOptions: FSharpDiagnosticOptions + mutable diagnosticsOptions: FSharpDiagnosticOptions mutable mlCompatibility: bool @@ -366,7 +366,7 @@ type TcConfigBuilder = mutable showFullPaths: bool - mutable errorStyle: ErrorStyle + mutable diagnosticStyle: DiagnosticStyle mutable utf8output: bool @@ -566,7 +566,7 @@ type TcConfig = member embedResources: string list - member errorSeverityOptions: FSharpDiagnosticOptions + member diagnosticsOptions: FSharpDiagnosticOptions member mlCompatibility: bool @@ -674,7 +674,7 @@ type TcConfig = member showFullPaths: bool - member errorStyle: ErrorStyle + member diagnosticStyle: DiagnosticStyle member utf8output: bool diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index a5b4bfc37a9..38cdc428e77 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticMessage open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp @@ -125,8 +125,8 @@ let GetRangeOfDiagnostic(diag: PhasedDiagnostic) = | NotUpperCaseConstructor m | RecursiveUseCheckedAtRuntime (_, _, m) | LetRecEvaluatedOutOfOrder (_, _, _, m) - | Error (_, m) - | ErrorWithSuggestions (_, m, _, _) + | DiagnosticWithText (_, _, m) + | DiagnosticWithSuggestions (_, _, m, _, _) | SyntaxError (_, m) | InternalError (_, m) | InterfaceNotRevealed(_, _, m) @@ -340,8 +340,8 @@ let GetDiagnosticNumber(diag: PhasedDiagnostic) = | WrappedError(e, _) -> GetFromException e - | Error ((n, _), _) -> n - | ErrorWithSuggestions ((n, _), _, _, _) -> n + | DiagnosticWithText (n, _, _) -> n + | DiagnosticWithSuggestions (n, _, _, _, _) -> n | Failure _ -> 192 | IllegalFileNameChar(fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar)) #if !NO_TYPEPROVIDERS @@ -358,8 +358,8 @@ let GetWarningLevel diag = | LetRecEvaluatedOutOfOrder _ | DefensiveCopyWarning _ -> 5 - | Error((n, _), _) - | ErrorWithSuggestions((n, _), _, _, _) -> + | DiagnosticWithText(n, _, _) + | DiagnosticWithSuggestions(n, _, _, _, _) -> // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint..." // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...." // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint..." @@ -1356,7 +1356,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diag: PhasedDiagnostic) (canSuggestN | None -> os.AppendString(OverrideDoesntOverride1E().Format sig1) | Some minfoVirt -> - // https://github.com/Microsoft/visualfsharp/issues/35 + // https://github.com/dotnet/fsharp/issues/35 // Improve error message when attempting to override generic return type with unit: // we need to check if unit was used as a type argument let hasUnitTType_app (types: TType list) = @@ -1480,9 +1480,9 @@ let OutputPhasedErrorR (os: StringBuilder) (diag: PhasedDiagnostic) (canSuggestN os.AppendString(NonUniqueInferredAbstractSlot3E().Format ty1 ty2) os.AppendString(NonUniqueInferredAbstractSlot4E().Format) - | Error ((_, s), _) -> os.AppendString s + | DiagnosticWithText (_, s, _) -> os.AppendString s - | ErrorWithSuggestions ((_, s), _, idText, suggestionF) -> + | DiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> os.AppendString(DecompileOpName s) suggestNames suggestionF idText @@ -1740,32 +1740,32 @@ let SanitizeFileName fileName implicitIncludeDir = fileName [] -type DiagnosticLocation = +type FormattedDiagnosticLocation = { Range: range File: string TextRepresentation: string IsEmpty: bool } [] -type DiagnosticCanonicalInformation = +type FormattedDiagnosticCanonicalInformation = { ErrorNumber: int Subcategory: string TextRepresentation: string } [] -type DiagnosticDetailedInfo = - { Location: DiagnosticLocation option - Canonical: DiagnosticCanonicalInformation +type FormattedDiagnosticDetailedInfo = + { Location: FormattedDiagnosticLocation option + Canonical: FormattedDiagnosticCanonicalInformation Message: string } [] -type Diagnostic = +type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string - | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo + | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = - let outputWhere (showFullPaths, errorStyle) m: DiagnosticLocation = +let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = + let outputWhere (showFullPaths, diagnosticStyle) m: FormattedDiagnosticLocation = if equals m rangeStartup || equals m rangeCmdArgs then { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" } else @@ -1775,30 +1775,30 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt else SanitizeFileName file implicitIncludeDir let text, m, file = - match errorStyle with - | ErrorStyle.EmacsErrors -> + match diagnosticStyle with + | DiagnosticStyle.Emacs -> let file = file.Replace("\\", "/") (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output - | ErrorStyle.DefaultErrors -> + | DiagnosticStyle.Default -> let file = file.Replace('/', Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file - // We may also want to change TestErrors to be 1-based - | ErrorStyle.TestErrors -> + // We may also want to change Test to be 1-based + | DiagnosticStyle.Test -> let file = file.Replace("/", "\\") let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - | ErrorStyle.GccErrors -> + | DiagnosticStyle.Gcc -> let file = file.Replace('/', Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file // Here, we want the complete range information so Project Systems can generate proper squiggles - | ErrorStyle.VSErrors -> + | DiagnosticStyle.VisualStudio -> // Show prefix only for real files. Otherwise, we just want a truncated error like: // parse error FS0031: blah blah if not (equals m range0) && not (equals m rangeStartup) && not (equals m rangeCmdArgs) then @@ -1812,19 +1812,19 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt match diag.Exception with | ReportedError _ -> assert ("" = "Unexpected ReportedError") // this should never happen - Seq.empty + [| |] | StopProcessing -> assert ("" = "Unexpected StopProcessing") // this should never happen - Seq.empty + [| |] | _ -> let errors = ResizeArray() let report diag = let OutputWhere diag = match GetRangeOfDiagnostic diag with - | Some m -> Some(outputWhere (showFullPaths, errorStyle) m) + | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) | None -> None - let OutputCanonicalInformation(subcategory, errorNumber) : DiagnosticCanonicalInformation = + let OutputCanonicalInformation(subcategory, errorNumber) : FormattedDiagnosticCanonicalInformation = let message = match severity with | FSharpDiagnosticSeverity.Error -> "error" @@ -1832,9 +1832,9 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt | FSharpDiagnosticSeverity.Info | FSharpDiagnosticSeverity.Hidden -> "info" let text = - match errorStyle with + match diagnosticStyle with // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. - | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory message errorNumber + | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber | _ -> sprintf "%s FS%04d: " message errorNumber { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} @@ -1846,14 +1846,14 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt OutputPhasedDiagnostic os mainError flattenErrors suggestNames os.ToString() - let entry: DiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message } + let entry: FormattedDiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message } - errors.Add (Diagnostic.Long(severity, entry)) + errors.Add (FormattedDiagnostic.Long(severity, entry)) let OutputRelatedError(diag: PhasedDiagnostic) = - match errorStyle with + match diagnosticStyle with // Give a canonical string when --vserror. - | ErrorStyle.VSErrors -> + | DiagnosticStyle.VisualStudio -> let relWhere = OutputWhere mainError // mainError? let relCanonical = OutputCanonicalInformation(diag.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code let relMessage = @@ -1861,13 +1861,13 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt OutputPhasedDiagnostic os diag flattenErrors suggestNames os.ToString() - let entry: DiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} - errors.Add( Diagnostic.Long (severity, entry) ) + let entry: FormattedDiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} + errors.Add (FormattedDiagnostic.Long (severity, entry) ) | _ -> let os = StringBuilder() OutputPhasedDiagnostic os diag flattenErrors suggestNames - errors.Add( Diagnostic.Short(severity, os.ToString()) ) + errors.Add (FormattedDiagnostic.Short(severity, os.ToString()) ) relatedErrors |> List.iter OutputRelatedError @@ -1881,20 +1881,20 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt #endif | x -> report x - errors:> seq<_> + errors.ToArray() /// used by fsc.exe and fsi.exe, but not by VS /// prints error and related errors to the specified StringBuilder -let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity) os (diag: PhasedDiagnostic) = +let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity) os (diag: PhasedDiagnostic) = // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage. - let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity, diag, true) + let errors = CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity, diag, true) for e in errors do Printf.bprintf os "\n" match e with - | Diagnostic.Short(_, txt) -> + | FormattedDiagnostic.Short(_, txt) -> os.AppendString txt |> ignore - | Diagnostic.Long(_, details) -> + | FormattedDiagnostic.Long(_, details) -> match details.Location with | Some l when not l.IsEmpty -> os.AppendString l.TextRepresentation | _ -> () @@ -1960,7 +1960,7 @@ let ReportDiagnosticAsError options (diag, severity) = // Scoped #nowarn pragmas -/// Build an ErrorLogger that delegates to another ErrorLogger but filters warnings turned off by the given pragma declarations +/// Build an DiagnosticsLogger that delegates to another DiagnosticsLogger but filters warnings turned off by the given pragma declarations // // NOTE: we allow a flag to turn of strict file checking. This is because file names sometimes don't match due to use of // #line directives, e.g. for pars.fs/pars.fsy. In this case we just test by line number - in most cases this is sufficient @@ -1968,8 +1968,8 @@ let ReportDiagnosticAsError options (diag, severity) = // However this is indicative of a more systematic problem where source-line // sensitive operations (lexfilter and warning filtering) do not always // interact well with #line directives. -type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: ErrorLogger) = - inherit ErrorLogger("ErrorLoggerFilteringByScopedPragmas") +type DiagnosticsLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: DiagnosticsLogger) = + inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedPragmas") override x.DiagnosticSink (phasedError, severity) = if severity = FSharpDiagnosticSeverity.Error then @@ -1998,5 +1998,5 @@ type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOp override _.ErrorCount = errorLogger.ErrorCount -let GetErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) = - ErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) :> ErrorLogger +let GetDiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) = + DiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) :> DiagnosticsLogger diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index 79f2de1ce4c..46e8644ba24 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.CompilerDiagnostics open System.Text open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -64,7 +64,7 @@ val OutputDiagnostic: implicitIncludeDir: string * showFullPaths: bool * flattenErrors: bool * - errorStyle: ErrorStyle * + diagnosticStyle: DiagnosticStyle * severity: FSharpDiagnosticSeverity -> StringBuilder -> PhasedDiagnostic -> @@ -74,56 +74,56 @@ val OutputDiagnostic: val OutputDiagnosticContext: prefix: string -> fileLineFunction: (string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit -/// Part of LegacyHostedCompilerForTesting +/// Get an error logger that filters the reporting of warnings based on scoped pragma information +val GetDiagnosticsLoggerFilteringByScopedPragmas: + checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * DiagnosticsLogger -> DiagnosticsLogger + +val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string + +/// Indicates if we should report a diagnostic as a warning +val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Indicates if we should report a diagnostic as a warning +val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Indicates if we should report a warning as an error +val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Used internally and in LegacyHostedCompilerForTesting [] -type DiagnosticLocation = +type FormattedDiagnosticLocation = { Range: range File: string TextRepresentation: string IsEmpty: bool } -/// Part of LegacyHostedCompilerForTesting +/// Used internally and in LegacyHostedCompilerForTesting [] -type DiagnosticCanonicalInformation = +type FormattedDiagnosticCanonicalInformation = { ErrorNumber: int Subcategory: string TextRepresentation: string } -/// Part of LegacyHostedCompilerForTesting +/// Used internally and in LegacyHostedCompilerForTesting [] -type DiagnosticDetailedInfo = - { Location: DiagnosticLocation option - Canonical: DiagnosticCanonicalInformation +type FormattedDiagnosticDetailedInfo = + { Location: FormattedDiagnosticLocation option + Canonical: FormattedDiagnosticCanonicalInformation Message: string } -/// Part of LegacyHostedCompilerForTesting +/// Used internally and in LegacyHostedCompilerForTesting [] -type Diagnostic = +type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string - | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo + | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo -/// Part of LegacyHostedCompilerForTesting -val CollectDiagnostic: +/// Used internally and in LegacyHostedCompilerForTesting +val CollectFormattedDiagnostics: implicitIncludeDir: string * showFullPaths: bool * flattenErrors: bool * - errorStyle: ErrorStyle * + diagnosticStyle: DiagnosticStyle * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> - seq - -/// Get an error logger that filters the reporting of warnings based on scoped pragma information -val GetErrorLoggerFilteringByScopedPragmas: - checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * ErrorLogger -> ErrorLogger - -val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string - -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a warning as an error -val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + FormattedDiagnostic [] diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index 4353f5ec4ef..bafd28ed504 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -23,7 +23,7 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig open FSharp.Compiler.DependencyManager -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis @@ -172,11 +172,11 @@ let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemappi else [ ] -exception AssemblyNotResolved of (*originalName*) string * range +exception AssemblyNotResolved of originalName: string * range: range -exception MSBuildReferenceResolutionWarning of (*MSBuild warning code*)string * (*Message*)string * range +exception MSBuildReferenceResolutionWarning of message: string * warningCode: string * range: range -exception MSBuildReferenceResolutionError of (*MSBuild warning code*)string * (*Message*)string * range +exception MSBuildReferenceResolutionError of message: string * warningCode: string * range: range let OpenILBinary(fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, tryGetMetadataSnapshot) = let opts: ILReaderOptions = @@ -1327,7 +1327,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse runtimeAssemblyAttributes: ILAttribute list, entityToInjectInto, invalidateCcu: Event<_>, m) = - let startingErrorCount = CompileThreadStatic.ErrorLogger.ErrorCount + let startingErrorCount = CompileThreadStatic.DiagnosticsLogger.ErrorCount // Find assembly level TypeProviderAssemblyAttributes. These will point to the assemblies that // have class which implement ITypeProvider and which have TypeProviderAttribute on them. @@ -1454,7 +1454,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse with e -> errorRecovery e m - if startingErrorCount bool @@ -156,7 +156,7 @@ type TcImports = member FindDllInfo: CompilationThreadToken * range * string -> ImportedBinary - member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> option + member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> ImportedBinary option member FindCcuFromAssemblyRef: CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index 78fa1a59808..4df98259688 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -19,7 +19,7 @@ open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open FSharp.Compiler.Text open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities @@ -613,15 +613,15 @@ let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = | false, _ -> None [ CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with GlobalWarnAsError = switch <> OptionSwitch.Off }), None, Some (FSComp.SR.optsWarnaserrorPM())) CompilerOption("warnaserror", tagWarnList, OptionStringListSwitch (fun n switch -> match trimFStoInt n with | Some n -> - let options = tcConfigB.errorSeverityOptions - tcConfigB.errorSeverityOptions <- + let options = tcConfigB.diagnosticsOptions + tcConfigB.diagnosticsOptions <- if switch = OptionSwitch.Off then { options with WarnAsError = ListSet.remove (=) n options.WarnAsError @@ -633,8 +633,8 @@ let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = | None -> ()), None, Some (FSComp.SR.optsWarnaserror())) CompilerOption("warn", tagInt, OptionInt (fun n -> - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with WarnLevel = if (n >= 0 && n <= 5) then n else error(Error (FSComp.SR.optsInvalidWarningLevel n, rangeCmdArgs)) } ), None, Some (FSComp.SR.optsWarn())) @@ -1057,7 +1057,7 @@ let testFlag tcConfigB = OptionString (fun s -> match s with | "StackSpan" -> tcConfigB.internalTestSpanStackReferring <- true - | "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors + | "ErrorRanges" -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Test | "Tracking" -> tracking <- true (* general purpose on/off diagnostics flag *) | "NoNeedToTailcall" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportNoNeedToTailcall = true } | "FunctionSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportFunctionSizes = true } @@ -1077,12 +1077,12 @@ let testFlag tcConfigB = // Not shown in fsc.exe help, no warning on use, motivation is for use from tooling. let editorSpecificFlags (tcConfigB: TcConfigBuilder) = - [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None) + [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.VisualStudio), None, None) CompilerOption("validate-type-providers", tagNone, OptionUnit id, None, None) // preserved for compatibility's sake, no longer has any effect CompilerOption("LCID", tagInt, OptionInt ignore, None, None) CompilerOption("flaterrors", tagNone, OptionUnit (fun () -> tcConfigB.flatErrors <- true), None, None) CompilerOption("sqmsessionguid", tagNone, OptionString ignore, None, None) - CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None) + CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Gcc), None, None) CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some s), None, None) CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) CompilerOption("noconditionalerasure", tagNone, OptionUnit (fun () -> tcConfigB.noConditionalErasure <- true), None, None) @@ -1314,7 +1314,7 @@ let mlKeywordsFlag = let gnuStyleErrorsFlag tcConfigB = CompilerOption ("gnu-style-errors", tagNone, - OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.EmacsErrors), + OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Emacs), Some(DeprecatedCommandLineOptionNoDescription("--gnu-style-errors", rangeCmdArgs)), None) let deprecatedFlagsBoth tcConfigB = diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 4a91626e7d3..293ce77491e 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -51,7 +51,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Import open FSharp.Compiler.InfoReader @@ -66,6 +66,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //------------------------------------------------------------------------- @@ -354,7 +355,7 @@ let MakeConstraintSolverEnv contextInfo css m denv = /// Check whether a type variable occurs in the r.h.s. of a type, e.g. to catch /// infinite equations such as -/// 'a = list<'a> +/// 'a = 'a list let rec occursCheck g un ty = match stripTyEqns g ty with | TType_ucase(_, l) @@ -975,7 +976,7 @@ let CheckWarnIfRigid (csenv: ConstraintSolverEnv) ty1 (r: Typar) ty = let rec SolveTyparEqualsTypePart1 (csenv: ConstraintSolverEnv) m2 (trace: OptionalTrace) ty1 r ty = trackErrors { // The types may still be equivalent due to abbreviations, which we are trying not to eliminate if typeEquiv csenv.g ty1 ty then () else - // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/Microsoft/visualfsharp/issues/1170 + // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/dotnet/fsharp/issues/1170 if occursCheck csenv.g r ty then return! ErrorD (ConstraintSolverInfiniteTypes(csenv.DisplayEnv, csenv.eContextInfo, ty1, ty, csenv.m, m2)) else // Note: warn _and_ continue! do! CheckWarnIfRigid csenv ty1 r ty @@ -1902,7 +1903,7 @@ and GetSupportOfMemberConstraint (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = tys |> List.forall (isAnyParTy csenv.g >> not) -// This may be relevant to future bug fixes, see https://github.com/Microsoft/visualfsharp/issues/3814 +// This may be relevant to future bug fixes, see https://github.com/dotnet/fsharp/issues/3814 // /// Check if some part of the support is solved. // and SupportOfMemberConstraintIsPartiallySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = // tys |> List.exists (isAnyParTy csenv.g >> not) diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 8a305067831..353f0aab107 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -4,7 +4,7 @@ module internal FSharp.Compiler.ConstraintSolver open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader diff --git a/src/fsharp/CreateILModule.fs b/src/fsharp/CreateILModule.fs index ea2bf785a11..c510fcca310 100644 --- a/src/fsharp/CreateILModule.fs +++ b/src/fsharp/CreateILModule.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.IO open FSharp.Compiler.OptimizeInputs diff --git a/src/fsharp/DependencyManager/DependencyProvider.fs b/src/fsharp/DependencyManager/DependencyProvider.fs index f3c99e6186f..aeb5f43f3e8 100644 --- a/src/fsharp/DependencyManager/DependencyProvider.fs +++ b/src/fsharp/DependencyManager/DependencyProvider.fs @@ -238,7 +238,7 @@ type ReflectionDependencyManagerProvider(theType: Type, member _.HelpMessages = instance |> helpMessagesProperty /// Resolve the dependencies for the given arguments - member this.ResolveDependencies(scriptDir, mainScriptName, scriptName, scriptExt, packageManagerTextLines, tfm, rid, timeout): IResolveDependenciesResult = + member _.ResolveDependencies(scriptDir, mainScriptName, scriptName, scriptExt, packageManagerTextLines, tfm, rid, timeout): IResolveDependenciesResult = // The ResolveDependencies method, has two signatures, the original signaature in the variable resolveDeps and the updated signature resolveDepsEx // the resolve method can return values in two different tuples: // (bool * string list * string list * string list) diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index e7aac1ac894..718cc21e87a 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -5,7 +5,7 @@ module internal FSharp.Compiler.Detuple open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/DiagnosticsLogger.fs similarity index 85% rename from src/fsharp/ErrorLogger.fs rename to src/fsharp/DiagnosticsLogger.fs index 776c91519bc..6dd5ee7aef7 100644 --- a/src/fsharp/ErrorLogger.fs +++ b/src/fsharp/DiagnosticsLogger.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module FSharp.Compiler.ErrorLogger +module FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Diagnostics open FSharp.Compiler.Features @@ -14,12 +14,12 @@ open Internal.Utilities.Library.Extras /// Represents the style being used to format errors [] -type ErrorStyle = - | DefaultErrors - | EmacsErrors - | TestErrors - | VSErrors - | GccErrors +type DiagnosticStyle = + | Default + | Emacs + | Test + | VisualStudio + | Gcc /// Thrown when we want to add some range information to a .NET exception exception WrappedError of exn * range with @@ -66,46 +66,60 @@ let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ let StopProcessing<'T> = StopProcessingExn None -exception Error of (int * string) * range with // int is e.g. 191 in FS0191 +// int is e.g. 191 in FS0191 +exception DiagnosticWithText of number: int * message: string * range: range with override this.Message = match this :> exn with - | Error((_, msg), _) -> msg + | DiagnosticWithText(_, msg, _) -> msg | _ -> "impossible" -exception InternalError of msg: string * range with +exception InternalError of message: string * range: range with override this.Message = match this :> exn with | InternalError(msg, m) -> msg + m.ToString() | _ -> "impossible" -exception UserCompilerMessage of string * int * range +exception UserCompilerMessage of message: string * number: int * range: range -exception LibraryUseOnly of range +exception LibraryUseOnly of range: range -exception Deprecated of string * range +exception Deprecated of message: string * range: range -exception Experimental of string * range +exception Experimental of message: string * range: range -exception PossibleUnverifiableCode of range +exception PossibleUnverifiableCode of range: range -exception UnresolvedReferenceNoRange of (*assemblyName*) string +exception UnresolvedReferenceNoRange of assemblyName: string -exception UnresolvedReferenceError of (*assemblyName*) string * range +exception UnresolvedReferenceError of assemblyName: string * range: range -exception UnresolvedPathReferenceNoRange of (*assemblyName*) string * (*path*) string with +exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string with override this.Message = match this :> exn with | UnresolvedPathReferenceNoRange(assemblyName, path) -> sprintf "Assembly: %s, full path: %s" assemblyName path | _ -> "impossible" -exception UnresolvedPathReference of (*assemblyName*) string * (*path*) string * range +exception UnresolvedPathReference of assemblyName: string * path: string * range: range -exception ErrorWithSuggestions of (int * string) * range * string * Suggestions with // int is e.g. 191 in FS0191 +exception DiagnosticWithSuggestions of number: int * message: string * range: range * identifier: string * suggestions: Suggestions with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | ErrorWithSuggestions((_, msg), _, _, _) -> msg + | DiagnosticWithSuggestions(_, msg, _, _, _) -> msg | _ -> "impossible" +/// The F# compiler code currently uses 'Error(...)' in many places to create +/// an DiagnosticWithText as an exception even if it's a warning. +/// +/// We will eventually rename this to remove this use of "Error" +let Error ((n, text), m) = + DiagnosticWithText (n, text, m) + +/// The F# compiler code currently uses 'ErrorWithSuggestions(...)' in many places to create +/// an DiagnosticWithText as an exception even if it's a warning. +/// +/// We will eventually rename this to remove this use of "Error" +let ErrorWithSuggestions ((n, message), m, id, suggestions) = + DiagnosticWithSuggestions (n, message, m, id, suggestions) let inline protectAssemblyExploration dflt f = try @@ -168,32 +182,44 @@ type BuildPhase = module BuildPhaseSubcategory = [] let DefaultPhase = "" + [] let Compile = "compile" + [] let Parameter = "parameter" + [] let Parse = "parse" + [] let TypeCheck = "typecheck" + [] let CodeGen = "codegen" + [] let Optimize = "optimize" + [] let IlxGen = "ilxgen" + [] let IlGen = "ilgen" + [] let Output = "output" + [] let Interactive = "interactive" + [] let Internal = "internal" // Compiler ICE [] type PhasedDiagnostic = - { Exception:exn; Phase:BuildPhase } + { Exception:exn + Phase:BuildPhase } /// Construct a phased error static member Create(exn:exn, phase:BuildPhase) : PhasedDiagnostic = @@ -266,27 +292,30 @@ type PhasedDiagnostic = [] [] -type ErrorLogger(nameForDebugging:string) = +type DiagnosticsLogger(nameForDebugging:string) = abstract ErrorCount: int + // The 'Impl' factoring enables a developer to place a breakpoint at the non-Impl // code just below and get a breakpoint for all error logger implementations. abstract DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - member _.DebugDisplay() = sprintf "ErrorLogger(%s)" nameForDebugging + + member _.DebugDisplay() = sprintf "DiagnosticsLogger(%s)" nameForDebugging let DiscardErrorsLogger = - { new ErrorLogger("DiscardErrorsLogger") with - member x.DiagnosticSink(phasedError, severity) = () - member x.ErrorCount = 0 } - -let AssertFalseErrorLogger = - { new ErrorLogger("AssertFalseErrorLogger") with - // TODO: reenable these asserts in the compiler service - member x.DiagnosticSink(phasedError, severity) = (* assert false; *) () - member x.ErrorCount = (* assert false; *) 0 + { new DiagnosticsLogger("DiscardErrorsLogger") with + member _.DiagnosticSink(phasedError, severity) = () + member _.ErrorCount = 0 + } + +let AssertFalseDiagnosticsLogger = + { new DiagnosticsLogger("AssertFalseDiagnosticsLogger") with + // TODO: reenable these asserts in the compiler service + member _.DiagnosticSink(phasedError, severity) = (* assert false; *) () + member _.ErrorCount = (* assert false; *) 0 } -type CapturingErrorLogger(nm) = - inherit ErrorLogger(nm) +type CapturingDiagnosticsLogger(nm) = + inherit DiagnosticsLogger(nm) let mutable errorCount = 0 let diagnostics = ResizeArray() @@ -298,7 +327,7 @@ type CapturingErrorLogger(nm) = member _.Diagnostics = diagnostics |> Seq.toList - member _.CommitDelayedDiagnostics(errorLogger:ErrorLogger) = + member _.CommitDelayedDiagnostics(errorLogger:DiagnosticsLogger) = // Eagerly grab all the errors and warnings from the mutable collection let errors = diagnostics.ToArray() errors |> Array.iter errorLogger.DiagnosticSink @@ -306,12 +335,12 @@ type CapturingErrorLogger(nm) = /// Type holds thread-static globals for use by the compile. type internal CompileThreadStatic = [] - static val mutable private buildPhase : BuildPhase + static val mutable private buildPhase: BuildPhase [] - static val mutable private errorLogger : ErrorLogger + static val mutable private errorLogger: DiagnosticsLogger - static member BuildPhaseUnchecked = CompileThreadStatic.buildPhase (* This can be a null value *) + static member BuildPhaseUnchecked = CompileThreadStatic.buildPhase static member BuildPhase with get() = @@ -320,16 +349,16 @@ type internal CompileThreadStatic = | _ -> CompileThreadStatic.buildPhase and set v = CompileThreadStatic.buildPhase <- v - static member ErrorLogger + static member DiagnosticsLogger with get() = match box CompileThreadStatic.errorLogger with - | Null -> AssertFalseErrorLogger + | Null -> AssertFalseDiagnosticsLogger | _ -> CompileThreadStatic.errorLogger and set v = CompileThreadStatic.errorLogger <- v [] -module ErrorLoggerExtensions = +module DiagnosticsLoggerExtensions = open System.Reflection // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV @@ -365,7 +394,7 @@ module ErrorLoggerExtensions = raise exn | _ -> () - type ErrorLogger with + type DiagnosticsLogger with member x.EmitDiagnostic (exn, severity) = match exn with @@ -439,25 +468,25 @@ let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) = member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase } /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer: ErrorLogger -> #ErrorLogger) = - let oldErrorLogger = CompileThreadStatic.ErrorLogger - CompileThreadStatic.ErrorLogger <- errorLoggerTransformer oldErrorLogger +let PushDiagnosticsLoggerPhaseUntilUnwind(errorLoggerTransformer: DiagnosticsLogger -> #DiagnosticsLogger) = + let oldDiagnosticsLogger = CompileThreadStatic.DiagnosticsLogger + CompileThreadStatic.DiagnosticsLogger <- errorLoggerTransformer oldDiagnosticsLogger { new IDisposable with member _.Dispose() = - CompileThreadStatic.ErrorLogger <- oldErrorLogger } + CompileThreadStatic.DiagnosticsLogger <- oldDiagnosticsLogger } let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase -let SetThreadErrorLoggerNoUnwind errorLogger = CompileThreadStatic.ErrorLogger <- errorLogger +let SetThreadDiagnosticsLoggerNoUnwind errorLogger = CompileThreadStatic.DiagnosticsLogger <- errorLogger /// This represents the thread-local state established as each task function runs as part of the build. /// /// Use to reset error and warning handlers. -type CompilationGlobalsScope(errorLogger: ErrorLogger, buildPhase: BuildPhase) = - let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) +type CompilationGlobalsScope(errorLogger: DiagnosticsLogger, buildPhase: BuildPhase) = + let unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase - member _.ErrorLogger = errorLogger + member _.DiagnosticsLogger = errorLogger member _.BuildPhase = buildPhase // Return the disposable object that cleans up @@ -469,31 +498,31 @@ type CompilationGlobalsScope(errorLogger: ErrorLogger, buildPhase: BuildPhase) = // Global functions are still used by parser and TAST ops. /// Raises an exception with error recovery and returns unit. -let errorR exn = CompileThreadStatic.ErrorLogger.ErrorR exn +let errorR exn = CompileThreadStatic.DiagnosticsLogger.ErrorR exn /// Raises a warning with error recovery and returns unit. -let warning exn = CompileThreadStatic.ErrorLogger.Warning exn +let warning exn = CompileThreadStatic.DiagnosticsLogger.Warning exn /// Raises a warning with error recovery and returns unit. -let informationalWarning exn = CompileThreadStatic.ErrorLogger.InformationalWarning exn +let informationalWarning exn = CompileThreadStatic.DiagnosticsLogger.InformationalWarning exn /// Raises a special exception and returns 'T - can be caught later at an errorRecovery point. -let error exn = CompileThreadStatic.ErrorLogger.Error exn +let error exn = CompileThreadStatic.DiagnosticsLogger.Error exn /// Simulates an error. For test purposes only. -let simulateError (p : PhasedDiagnostic) = CompileThreadStatic.ErrorLogger.SimulateError p +let simulateError (p : PhasedDiagnostic) = CompileThreadStatic.DiagnosticsLogger.SimulateError p -let diagnosticSink (phasedError, severity) = CompileThreadStatic.ErrorLogger.DiagnosticSink (phasedError, severity) +let diagnosticSink (phasedError, severity) = CompileThreadStatic.DiagnosticsLogger.DiagnosticSink (phasedError, severity) let errorSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Error) let warnSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Warning) -let errorRecovery exn m = CompileThreadStatic.ErrorLogger.ErrorRecovery exn m +let errorRecovery exn m = CompileThreadStatic.DiagnosticsLogger.ErrorRecovery exn m -let stopProcessingRecovery exn m = CompileThreadStatic.ErrorLogger.StopProcessingRecovery exn m +let stopProcessingRecovery exn m = CompileThreadStatic.DiagnosticsLogger.StopProcessingRecovery exn m -let errorRecoveryNoRange exn = CompileThreadStatic.ErrorLogger.ErrorRecoveryNoRange exn +let errorRecoveryNoRange exn = CompileThreadStatic.DiagnosticsLogger.ErrorRecoveryNoRange exn let report f = f() @@ -511,16 +540,16 @@ let mlCompatWarning s m = warning(UserCompilerMessage(FSComp.SR.mlCompatMessage let mlCompatError s m = errorR(UserCompilerMessage(FSComp.SR.mlCompatError s, 62, m)) let suppressErrorReporting f = - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger try let errorLogger = - { new ErrorLogger("suppressErrorReporting") with + { new DiagnosticsLogger("suppressErrorReporting") with member _.DiagnosticSink(_phasedError, _isError) = () member _.ErrorCount = 0 } - SetThreadErrorLoggerNoUnwind errorLogger + SetThreadDiagnosticsLoggerNoUnwind errorLogger f() finally - SetThreadErrorLoggerNoUnwind errorLogger + SetThreadDiagnosticsLoggerNoUnwind errorLogger let conditionallySuppressErrorReporting cond f = if cond then suppressErrorReporting f else f() @@ -713,7 +742,7 @@ type StackGuard(maxDepth: int) = depth <- depth + 1 try if depth % maxDepth = 0 then - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger let buildPhase = CompileThreadStatic.BuildPhase async { do! Async.SwitchToNewThread() diff --git a/src/fsharp/ErrorLogger.fsi b/src/fsharp/DiagnosticsLogger.fsi similarity index 83% rename from src/fsharp/ErrorLogger.fsi rename to src/fsharp/DiagnosticsLogger.fsi index eb36563e984..b003fac96dd 100644 --- a/src/fsharp/ErrorLogger.fsi +++ b/src/fsharp/DiagnosticsLogger.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.ErrorLogger +module internal FSharp.Compiler.DiagnosticsLogger open System open FSharp.Compiler.Diagnostics @@ -9,12 +9,12 @@ open FSharp.Compiler.Text /// Represents the style being used to format errors [] -type ErrorStyle = - | DefaultErrors - | EmacsErrors - | TestErrors - | VSErrors - | GccErrors +type DiagnosticStyle = + | Default + | Emacs + | Test + | VisualStudio + | Gcc /// Thrown when we want to add some range information to a .NET exception exception WrappedError of exn * range @@ -41,29 +41,41 @@ val (|StopProcessing|_|): exn: exn -> unit option val StopProcessing<'T> : exn -exception Error of (int * string) * range +/// Represents a diagnostic exeption whose text comes via SR.* +exception DiagnosticWithText of number: int * message: string * range: range -exception InternalError of msg: string * range +/// Creates a diagnostic exeption whose text comes via SR.* +val Error: (int * string) * range -> exn -exception UserCompilerMessage of string * int * range +exception InternalError of message: string * range: range -exception LibraryUseOnly of range +exception UserCompilerMessage of message: string * number: int * range: range -exception Deprecated of string * range +exception LibraryUseOnly of range: range -exception Experimental of string * range +exception Deprecated of message: string * range: range -exception PossibleUnverifiableCode of range +exception Experimental of message: string * range: range -exception UnresolvedReferenceNoRange of string +exception PossibleUnverifiableCode of range: range -exception UnresolvedReferenceError of string * range +exception UnresolvedReferenceNoRange of assemblyName: string -exception UnresolvedPathReferenceNoRange of string * string +exception UnresolvedReferenceError of assemblyName: string * range: range -exception UnresolvedPathReference of string * string * range +exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string -exception ErrorWithSuggestions of (int * string) * range * string * Suggestions +exception UnresolvedPathReference of assemblyName: string * path: string * range: range + +exception DiagnosticWithSuggestions of + number: int * + message: string * + range: range * + identifier: string * + suggestions: Suggestions + +/// Creates a DiagnosticWithSuggestions whose text comes via SR.* +val ErrorWithSuggestions: (int * string) * range * string * Suggestions -> exn val inline protectAssemblyExploration: dflt: 'a -> f: (unit -> 'a) -> 'a @@ -155,9 +167,9 @@ type PhasedDiagnostic = member Subcategory: unit -> string [] -type ErrorLogger = +type DiagnosticsLogger = - new: nameForDebugging: string -> ErrorLogger + new: nameForDebugging: string -> DiagnosticsLogger member DebugDisplay: unit -> string @@ -165,16 +177,16 @@ type ErrorLogger = abstract member ErrorCount: int -val DiscardErrorsLogger: ErrorLogger +val DiscardErrorsLogger: DiagnosticsLogger -val AssertFalseErrorLogger: ErrorLogger +val AssertFalseDiagnosticsLogger: DiagnosticsLogger -type CapturingErrorLogger = - inherit ErrorLogger +type CapturingDiagnosticsLogger = + inherit DiagnosticsLogger - new: nm: string -> CapturingErrorLogger + new: nm: string -> CapturingDiagnosticsLogger - member CommitDelayedDiagnostics: errorLogger: ErrorLogger -> unit + member CommitDelayedDiagnostics: errorLogger: DiagnosticsLogger -> unit override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit @@ -189,10 +201,10 @@ type CompileThreadStatic = static member BuildPhaseUnchecked: BuildPhase - static member ErrorLogger: ErrorLogger with get, set + static member DiagnosticsLogger: DiagnosticsLogger with get, set [] -module ErrorLoggerExtensions = +module DiagnosticsLoggerExtensions = val tryAndDetectDev15: bool @@ -202,25 +214,32 @@ module ErrorLoggerExtensions = /// Reraise an exception if it is one we want to report to Watson. val ReraiseIfWatsonable: exn: exn -> unit - type ErrorLogger with + type DiagnosticsLogger with member ErrorR: exn: exn -> unit + member Warning: exn: exn -> unit + member Error: exn: exn -> 'b + member SimulateError: ph: PhasedDiagnostic -> 'a + member ErrorRecovery: exn: exn -> m: range -> unit + member StopProcessingRecovery: exn: exn -> m: range -> unit + member ErrorRecoveryNoRange: exn: exn -> unit /// NOTE: The change will be undone when the returned "unwind" object disposes val PushThreadBuildPhaseUntilUnwind: phase: BuildPhase -> IDisposable /// NOTE: The change will be undone when the returned "unwind" object disposes -val PushErrorLoggerPhaseUntilUnwind: errorLoggerTransformer: (ErrorLogger -> #ErrorLogger) -> IDisposable +val PushDiagnosticsLoggerPhaseUntilUnwind: + errorLoggerTransformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit -val SetThreadErrorLoggerNoUnwind: errorLogger: ErrorLogger -> unit +val SetThreadDiagnosticsLoggerNoUnwind: errorLogger: DiagnosticsLogger -> unit /// Reports an error diagnostic and continues val errorR: exn: exn -> unit @@ -384,10 +403,10 @@ type StackGuard = /// /// Use to reset error and warning handlers. type CompilationGlobalsScope = - new: errorLogger: ErrorLogger * buildPhase: BuildPhase -> CompilationGlobalsScope + new: errorLogger: DiagnosticsLogger * buildPhase: BuildPhase -> CompilationGlobalsScope interface IDisposable - member ErrorLogger: ErrorLogger + member DiagnosticsLogger: DiagnosticsLogger member BuildPhase: BuildPhase diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs index b24e0fc1a77..fc8b9167d38 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs @@ -93,30 +93,32 @@ module internal {1} = None [] - member this.EmbeddedResource + member _.EmbeddedResource with get() = _embeddedText and set(value) = _embeddedText <- value [] - member this.IntermediateOutputPath + member _.IntermediateOutputPath with get() = _outputPath and set(value) = _outputPath <- value - member this.TargetFramework + member _.TargetFramework with get() = _targetFramework and set(value) = _targetFramework <- value [] - member this.GeneratedSource + member _.GeneratedSource with get() = _generatedSource interface ITask with - member this.BuildEngine + member _.BuildEngine with get() = _buildEngine and set(value) = _buildEngine <- value - member this.HostObject + + member _.HostObject with get() = _hostObject and set(value) = _hostObject <- value + member this.Execute() = let getBooleanMetadata (metadataName:string) (defaultValue:bool) (item:ITaskItem) = match item.GetMetadata(metadataName) with diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs index 7081761e2c5..f43fef77a43 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs @@ -452,28 +452,28 @@ open Printf None [] - member this.EmbeddedText + member _.EmbeddedText with get() = _embeddedText and set(value) = _embeddedText <- value [] - member this.IntermediateOutputPath + member _.IntermediateOutputPath with get() = _outputPath and set(value) = _outputPath <- value [] - member this.GeneratedSource + member _.GeneratedSource with get() = _generatedSource [] - member this.GeneratedResx + member _.GeneratedResx with get() = _generatedResx interface ITask with - member this.BuildEngine + member _.BuildEngine with get() = _buildEngine and set(value) = _buildEngine <- value - member this.HostObject + member _.HostObject with get() = _hostObject and set(value) = _hostObject <- value member this.Execute() = diff --git a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets index e200ed8a7b0..3ba06c1e4bf 100644 --- a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets +++ b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets @@ -288,8 +288,8 @@ this file. correct list of resources based on the build system being used. This could be a bit simpler, but xbuild doesn't seem to support msbuild 4.0 'item functions' like Distinct(). - Reference: https://github.com/Microsoft/visualfsharp/pull/2595 - https://github.com/Microsoft/visualfsharp/pull/2605 + Reference: https://github.com/dotnet/fsharp/pull/2595 + https://github.com/dotnet/fsharp/pull/2605 --> Utilities\lib.fs - - Utilities\block.fsi + + Utilities\ImmutableArray.fsi - - Utilities\block.fs + + Utilities\ImmutableArray.fs Utilities\rational.fsi @@ -241,11 +241,11 @@ ErrorLogging\TextLayoutRender.fs - - ErrorLogging\ErrorLogger.fsi + + ErrorLogging\DiagnosticsLogger.fsi - - ErrorLogging\ErrorLogger.fs + + ErrorLogging\DiagnosticsLogger.fs ErrorLogging\ErrorResolutionHints.fsi @@ -549,6 +549,12 @@ Logic\import.fs + + Logic\TypeHierarchy.fsi + + + Logic\TypeHierarchy.fs + Logic\infos.fsi @@ -687,11 +693,23 @@ Optimize\InnerLambdasToTopLevelFuncs.fs - - Optimize\LowerCallsAndSeqs.fsi + + Optimize\LowerCalls.fsi + + + Optimize\LowerCalls.fs + + + Optimize\LowerSequences.fsi - - Optimize\LowerCallsAndSeqs.fs + + Optimize\LowerSequences.fs + + + Optimize\LowerComputedCollections.fsi + + + Optimize\LowerComputedCollections.fs Optimize\LowerStateMachines.fsi @@ -699,11 +717,11 @@ Optimize\LowerStateMachines.fs - - Optimize\autobox.fsi + + Optimize\LowerLocalMutables.fsi - - Optimize\autobox.fs + + Optimize\LowerLocalMutables.fs CodeGen\IlxGen.fsi @@ -812,6 +830,12 @@ + + Symbols/FSharpDiagnostic.fsi + + + Symbols/FSharpDiagnostic.fs + Symbols/SymbolHelpers.fsi diff --git a/src/fsharp/FSharp.Core/Query.fs b/src/fsharp/FSharp.Core/Query.fs index 8d54ff85228..18fec9dfef8 100644 --- a/src/fsharp/FSharp.Core/Query.fs +++ b/src/fsharp/FSharp.Core/Query.fs @@ -45,8 +45,8 @@ module ForwardDeclarations = let mutable Query = { new IQueryMethods with - member this.Execute(_) = failwith "IQueryMethods.Execute should never be called" - member this.EliminateNestedQueries(_) = failwith "IQueryMethods.EliminateNestedQueries should never be called" + member _.Execute(_) = failwith "IQueryMethods.Execute should never be called" + member _.EliminateNestedQueries(_) = failwith "IQueryMethods.EliminateNestedQueries should never be called" } type QueryBuilder() = @@ -1925,8 +1925,8 @@ module Query = do ForwardDeclarations.Query <- { new ForwardDeclarations.IQueryMethods with - member this.Execute q = QueryExecute q - member this.EliminateNestedQueries e = EliminateNestedQueries e + member _.Execute q = QueryExecute q + member _.EliminateNestedQueries e = EliminateNestedQueries e } diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index ccfb8dd75db..0620810dac8 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -865,7 +865,7 @@ namespace Microsoft.FSharp.Control let mutable result = None // The continuations for the result - let mutable savedConts: list> = [] + let mutable savedConts: SuspendedAsync<'T> list = [] // The WaitHandle event for the result. Only created if needed, and set to null when disposed. let mutable resEvent = null diff --git a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs index 534ae14958c..789533419b0 100644 --- a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs +++ b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs @@ -328,9 +328,9 @@ namespace Microsoft.FSharp.Core.CompilerServices let mutable filePath : string = null let mutable line : int = 0 let mutable column : int = 0 - member this.FilePath with get() = filePath and set v = filePath <- v - member this.Line with get() = line and set v = line <- v - member this.Column with get() = column and set v = column <- v + member _.FilePath with get() = filePath and set v = filePath <- v + member _.Line with get() = line and set v = line <- v + member _.Column with get() = column and set v = column <- v [] type TypeProviderEditorHideMethodsAttribute() = @@ -349,14 +349,14 @@ namespace Microsoft.FSharp.Core.CompilerServices let mutable isInvalidationSupported : bool = false let mutable useResolutionFolderAtRuntime : bool = false let mutable systemRuntimeAssemblyVersion : System.Version = null - member this.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v - member this.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v - member this.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v - member this.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v - member this.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v - member this.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v - member this.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v - member this.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName + member _.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v + member _.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v + member _.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v + member _.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v + member _.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v + member _.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v + member _.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v + member _.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName type IProvidedNamespace = abstract NamespaceName : string diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index cd22fb65be3..d0eeda4e854 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -42,7 +42,7 @@ namespace Microsoft.FSharp.Collections [] let concat lists = Microsoft.FSharp.Primitives.Basics.List.concat lists - let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection:'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list:'T list) = + let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection: 'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list: 'T list) = let dict = Dictionary comparer let rec loop srcList = match srcList with @@ -56,13 +56,13 @@ namespace Microsoft.FSharp.Collections Microsoft.FSharp.Primitives.Basics.List.countBy dict getKey // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let countByValueType (projection:'T->'Key) (list:'T list) = countByImpl HashIdentity.Structural<'Key> projection id list + let countByValueType (projection: 'T->'Key) (list: 'T list) = countByImpl HashIdentity.Structural<'Key> projection id list // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let countByRefType (projection:'T->'Key) (list:'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list + let countByRefType (projection: 'T->'Key) (list: 'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list [] - let countBy (projection:'T->'Key) (list:'T list) = + let countBy (projection: 'T->'Key) (list: 'T list) = match list with | [] -> [] | _ -> @@ -84,7 +84,7 @@ namespace Microsoft.FSharp.Collections Microsoft.FSharp.Primitives.Basics.List.mapFold mapping state list [] - let mapFoldBack<'T, 'State, 'Result> (mapping:'T -> 'State -> 'Result * 'State) list state = + let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) list state = match list with | [] -> [], state | [h] -> let h', s' = mapping h state in [h'], s' @@ -99,19 +99,19 @@ namespace Microsoft.FSharp.Collections loop ([], state) (rev list) [] - let inline iter ([] action) (list:'T list) = for x in list do action x + let inline iter ([] action) (list: 'T list) = for x in list do action x [] - let distinct (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list + let distinct (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list [] - let distinctBy projection (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list + let distinctBy projection (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list [] - let ofArray (array:'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array + let ofArray (array: 'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array [] - let toArray (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list + let toArray (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list [] let empty<'T> = ([ ] : 'T list) @@ -154,7 +154,7 @@ namespace Microsoft.FSharp.Collections let choose chooser list = Microsoft.FSharp.Primitives.Basics.List.choose chooser list [] - let splitAt index (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list + let splitAt index (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list [] let take count (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.take count list @@ -233,14 +233,14 @@ namespace Microsoft.FSharp.Collections | h :: t -> fold reduction h t [] - let scan<'T, 'State> folder (state:'State) (list:'T list) = + let scan<'T, 'State> folder (state:'State) (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.scan folder state list [] let inline singleton value = [value] [] - let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:list<'T1>) (list2:list<'T2>) = + let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:'T1 list) (list2:'T2 list) = let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder) let rec loop acc list1 list2 = match list1, list2 with @@ -258,7 +258,7 @@ namespace Microsoft.FSharp.Collections // this version doesn't causes stack overflow - it uses a private stack [] - let foldBack<'T, 'State> folder (list:'T list) (state:'State) = + let foldBack<'T, 'State> folder (list: 'T list) (state:'State) = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) match list with | [] -> state @@ -283,7 +283,7 @@ namespace Microsoft.FSharp.Collections let arrn = arr.Length foldArraySubRight f arr 0 (arrn - 2) arr.[arrn - 1] - let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr:_[]) start fin initState = + let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr: _[]) start fin initState = let mutable state = initState let mutable res = [state] for i = fin downto start do @@ -292,7 +292,7 @@ namespace Microsoft.FSharp.Collections res [] - let scanBack<'T, 'State> folder (list:'T list) (state:'State) = + let scanBack<'T, 'State> folder (list: 'T list) (state:'State) = match list with | [] -> [state] | [h] -> @@ -428,17 +428,17 @@ namespace Microsoft.FSharp.Collections [] let where predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list - let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf:'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = + let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf: 'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.groupBy comparer keyf getKey list // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let groupByValueType (keyf:'T->'Key) (list:'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list + let groupByValueType (keyf: 'T->'Key) (list: 'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let groupByRefType (keyf:'T->'Key) (list:'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list + let groupByRefType (keyf: 'T->'Key) (list: 'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list [] - let groupBy (projection:'T->'Key) (list:'T list) = + let groupBy (projection: 'T->'Key) (list: 'T list) = match list with | [] -> [] | _ -> @@ -548,13 +548,19 @@ namespace Microsoft.FSharp.Collections loop 0 list [] - let findIndexBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate + let findIndexBack predicate list = + list + |> toArray + |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate [] - let tryFindIndexBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate + let tryFindIndexBack predicate list = + list + |> toArray + |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate [] - let inline sum (list:list<'T>) = + let inline sum (list: 'T list) = match list with | [] -> LanguagePrimitives.GenericZero<'T> | t -> @@ -564,7 +570,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline sumBy ([] projection: 'T -> 'U) (list:list<'T>) = + let inline sumBy ([] projection: 'T -> 'U) (list: 'T list) = match list with | [] -> LanguagePrimitives.GenericZero<'U> | t -> @@ -574,7 +580,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline max (list:list<_>) = + let inline max (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -585,7 +591,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline maxBy projection (list:list<_>) = + let inline maxBy projection (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -599,7 +605,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline min (list:list<_>) = + let inline min (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -610,7 +616,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline minBy projection (list:list<_>) = + let inline minBy projection (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -624,7 +630,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline average (list:list<'T>) = + let inline average (list: 'T list) = match list with | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | xs -> @@ -636,7 +642,7 @@ namespace Microsoft.FSharp.Collections LanguagePrimitives.DivideByInt sum count [] - let inline averageBy ([] projection: 'T -> 'U) (list:list<'T>) = + let inline averageBy ([] projection: 'T -> 'U) (list: 'T list) = match list with | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | xs -> @@ -654,7 +660,7 @@ namespace Microsoft.FSharp.Collections let allPairs list1 list2 = Microsoft.FSharp.Primitives.Basics.List.allPairs list1 list2 [] - let inline compareWith ([] comparer:'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = + let inline compareWith ([] comparer: 'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = let rec loop list1 list2 = match list1, list2 with | head1 :: tail1, head2 :: tail2 -> @@ -670,14 +676,14 @@ namespace Microsoft.FSharp.Collections let permute indexMap list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.permute indexMap |> ofArray [] - let exactlyOne (list: list<_>) = + let exactlyOne (list: _ list) = match list with | [x] -> x | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | _ -> invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) [] - let tryExactlyOne (list: list<_>) = + let tryExactlyOne (list: _ list) = match list with | [x] -> Some x | _ -> None diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 99de5a7b172..16c7c77e63e 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -531,7 +531,7 @@ module internal List = let inline ofSeq (e : IEnumerable<'T>) = match e with - | :? list<'T> as l -> l + | :? ('T list) as l -> l | :? ('T[]) as arr -> ofArray arr | _ -> use ie = e.GetEnumerator() diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 31458e94db3..8a4c0b64fb0 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -453,8 +453,8 @@ module MapTree = let ofSeq comparer (c : seq<'Key * 'T>) = match c with - | :? array<'Key * 'T> as xs -> ofArray comparer xs - | :? list<'Key * 'T> as xs -> ofList comparer xs + | :? (('Key * 'T)[]) as xs -> ofArray comparer xs + | :? (('Key * 'T) list) as xs -> ofList comparer xs | _ -> use ie = c.GetEnumerator() mkFromEnumerator comparer empty ie diff --git a/src/fsharp/FSharp.Core/option.fs b/src/fsharp/FSharp.Core/option.fs index 552d1c9231f..8b28af7531d 100644 --- a/src/fsharp/FSharp.Core/option.fs +++ b/src/fsharp/FSharp.Core/option.fs @@ -8,49 +8,94 @@ open Microsoft.FSharp.Core.Operators module Option = [] - let get option = match option with None -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) | Some x -> x + let get option = + match option with + | None -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) + | Some x -> x [] - let inline isSome option = match option with None -> false | Some _ -> true + let inline isSome option = + match option with + | None -> false + | Some _ -> true [] - let inline isNone option = match option with None -> true | Some _ -> false + let inline isNone option = + match option with + | None -> true + | Some _ -> false [] - let defaultValue value option = match option with None -> value | Some v -> v + let defaultValue value option = + match option with + | None -> value + | Some v -> v [] - let defaultWith defThunk option = match option with None -> defThunk () | Some v -> v + let defaultWith defThunk option = + match option with + | None -> defThunk () + | Some v -> v [] - let orElse ifNone option = match option with None -> ifNone | Some _ -> option + let orElse ifNone option = + match option with + | None -> ifNone + | Some _ -> option [] - let orElseWith ifNoneThunk option = match option with None -> ifNoneThunk () | Some _ -> option + let orElseWith ifNoneThunk option = + match option with + | None -> ifNoneThunk () + | Some _ -> option [] - let count option = match option with None -> 0 | Some _ -> 1 + let count option = + match option with + | None -> 0 + | Some _ -> 1 [] - let fold<'T,'State> folder (state:'State) (option: option<'T>) = match option with None -> state | Some x -> folder state x + let fold<'T,'State> folder (state:'State) (option: 'T option) = + match option with + | None -> state + | Some x -> folder state x [] - let foldBack<'T,'State> folder (option: option<'T>) (state:'State) = match option with None -> state | Some x -> folder x state + let foldBack<'T,'State> folder (option: option<'T>) (state:'State) = + match option with + | None -> state + | Some x -> folder x state [] - let exists predicate option = match option with None -> false | Some x -> predicate x + let exists predicate option = + match option with + | None -> false + | Some x -> predicate x [] - let forall predicate option = match option with None -> true | Some x -> predicate x + let forall predicate option = + match option with + | None -> true + | Some x -> predicate x [] - let inline contains value option = match option with None -> false | Some v -> v = value + let inline contains value option = + match option with + | None -> false + | Some v -> v = value [] - let iter action option = match option with None -> () | Some x -> action x + let iter action option = + match option with + | None -> () + | Some x -> action x [] - let map mapping option = match option with None -> None | Some x -> Some (mapping x) + let map mapping option = + match option with + | None -> None + | Some x -> Some (mapping x) [] let map2 mapping option1 option2 = @@ -65,78 +110,151 @@ module Option = | _ -> None [] - let bind binder option = match option with None -> None | Some x -> binder x + let bind binder option = + match option with + | None -> None + | Some x -> binder x [] - let flatten option = match option with None -> None | Some x -> x + let flatten option = + match option with + | None -> None + | Some x -> x [] - let filter predicate option = match option with None -> None | Some x -> if predicate x then Some x else None + let filter predicate option = + match option with + | None -> None + | Some x -> if predicate x then Some x else None [] - let toArray option = match option with None -> [| |] | Some x -> [| x |] + let toArray option = + match option with + | None -> [| |] + | Some x -> [| x |] [] - let toList option = match option with None -> [ ] | Some x -> [ x ] + let toList option = + match option with + | None -> [ ] + | Some x -> [ x ] [] - let toNullable option = match option with None -> System.Nullable() | Some v -> System.Nullable(v) + let toNullable option = + match option with + | None -> System.Nullable() + | Some v -> System.Nullable(v) [] - let ofNullable (value:System.Nullable<'T>) = if value.HasValue then Some value.Value else None + let ofNullable (value:System.Nullable<'T>) = + if value.HasValue then + Some value.Value + else + None [] - let ofObj value = match value with null -> None | _ -> Some value + let ofObj value = + match value with + | null -> None + | _ -> Some value [] - let toObj value = match value with None -> null | Some x -> x + let toObj value = + match value with + | None -> null + | Some x -> x module ValueOption = [] - let get voption = match voption with ValueNone -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) | ValueSome x -> x + let get voption = + match voption with + | ValueNone -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) + | ValueSome x -> x [] - let inline isSome voption = match voption with ValueNone -> false | ValueSome _ -> true + let inline isSome voption = + match voption with + | ValueNone -> false + | ValueSome _ -> true [] - let inline isNone voption = match voption with ValueNone -> true | ValueSome _ -> false + let inline isNone voption = + match voption with + | ValueNone -> true + | ValueSome _ -> false [] - let defaultValue value voption = match voption with ValueNone -> value | ValueSome v -> v + let defaultValue value voption = + match voption with + | ValueNone -> value + | ValueSome v -> v [] - let defaultWith defThunk voption = match voption with ValueNone -> defThunk () | ValueSome v -> v + let defaultWith defThunk voption = + match voption with + | ValueNone -> defThunk () + | ValueSome v -> v [] - let orElse ifNone voption = match voption with ValueNone -> ifNone | ValueSome _ -> voption + let orElse ifNone voption = + match voption with + | ValueNone -> ifNone + | ValueSome _ -> voption [] - let orElseWith ifNoneThunk voption = match voption with ValueNone -> ifNoneThunk () | ValueSome _ -> voption + let orElseWith ifNoneThunk voption = + match voption with + | ValueNone -> ifNoneThunk () + | ValueSome _ -> voption [] - let count voption = match voption with ValueNone -> 0 | ValueSome _ -> 1 + let count voption = + match voption with + | ValueNone -> 0 + | ValueSome _ -> 1 [] - let fold<'T,'State> folder (state:'State) (voption: voption<'T>) = match voption with ValueNone -> state | ValueSome x -> folder state x + let fold<'T,'State> folder (state:'State) (voption: voption<'T>) = + match voption with + | ValueNone -> state + | ValueSome x -> folder state x [] - let foldBack<'T,'State> folder (voption: voption<'T>) (state:'State) = match voption with ValueNone -> state | ValueSome x -> folder x state + let foldBack<'T,'State> folder (voption: voption<'T>) (state:'State) = + match voption with + | ValueNone -> state + | ValueSome x -> folder x state [] - let exists predicate voption = match voption with ValueNone -> false | ValueSome x -> predicate x + let exists predicate voption = + match voption with + | ValueNone -> false + | ValueSome x -> predicate x [] - let forall predicate voption = match voption with ValueNone -> true | ValueSome x -> predicate x + let forall predicate voption = + match voption with + | ValueNone -> true + | ValueSome x -> predicate x [] - let inline contains value voption = match voption with ValueNone -> false | ValueSome v -> v = value + let inline contains value voption = + match voption with + | ValueNone -> false + | ValueSome v -> v = value [] - let iter action voption = match voption with ValueNone -> () | ValueSome x -> action x + let iter action voption = + match voption with + | ValueNone -> () + | ValueSome x -> action x [] - let map mapping voption = match voption with ValueNone -> ValueNone | ValueSome x -> ValueSome (mapping x) + let map mapping voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> ValueSome (mapping x) [] let map2 mapping voption1 voption2 = @@ -151,28 +269,56 @@ module ValueOption = | _ -> ValueNone [] - let bind binder voption = match voption with ValueNone -> ValueNone | ValueSome x -> binder x + let bind binder voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> binder x [] - let flatten voption = match voption with ValueNone -> ValueNone | ValueSome x -> x + let flatten voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> x [] - let filter predicate voption = match voption with ValueNone -> ValueNone | ValueSome x -> if predicate x then ValueSome x else ValueNone + let filter predicate voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> if predicate x then ValueSome x else ValueNone [] - let toArray voption = match voption with ValueNone -> [| |] | ValueSome x -> [| x |] + let toArray voption = + match voption with + | ValueNone -> [| |] + | ValueSome x -> [| x |] [] - let toList voption = match voption with ValueNone -> [ ] | ValueSome x -> [ x ] + let toList voption = + match voption with + | ValueNone -> [ ] + | ValueSome x -> [ x ] [] - let toNullable voption = match voption with ValueNone -> System.Nullable() | ValueSome v -> System.Nullable(v) + let toNullable voption = + match voption with + | ValueNone -> System.Nullable() + | ValueSome v -> System.Nullable(v) [] - let ofNullable (value:System.Nullable<'T>) = if value.HasValue then ValueSome value.Value else ValueNone + let ofNullable (value:System.Nullable<'T>) = + if value.HasValue then + ValueSome value.Value + else + ValueNone [] - let ofObj value = match value with null -> ValueNone | _ -> ValueSome value + let ofObj value = + match value with + | null -> ValueNone + | _ -> ValueSome value [] - let toObj value = match value with ValueNone -> null | ValueSome x -> x + let toObj value = + match value with + | ValueNone -> null + | ValueSome x -> x diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index bef9923e35b..baa7fd5cb0b 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -3625,7 +3625,7 @@ namespace Microsoft.FSharp.Collections //------------------------------------------------------------------------- and - ListDebugView<'T>(l:list<'T>) = + ListDebugView<'T>(l: 'T list) = let ListDebugViewMaxLength = 50 // default displayed Max Length let ListDebugViewMaxFullLength = 5000 // display only when FullList opened (5000 is a super big display used to cut-off an infinite list or undebuggably huge one) @@ -5395,7 +5395,7 @@ namespace Microsoft.FSharp.Core member _.GetEnumerator () = variableStepRangeEnumerator () interface IEnumerable with - member this.GetEnumerator () = (variableStepRangeEnumerator ()) :> IEnumerator } + member _.GetEnumerator () = (variableStepRangeEnumerator ()) :> IEnumerator } let inline simpleIntegralRange minValue maxValue n step m = if step <> LanguagePrimitives.GenericOne || n > m || n = minValue || m = maxValue then diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 03ca84a5667..81d02f40a54 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -377,7 +377,7 @@ module Patterns = let ES ts = List.map E ts let (|E|) (e: Expr) = e.Tree - let (|ES|) (es: list) = es |> List.map (fun e -> e.Tree) + let (|ES|) (es: Expr list) = es |> List.map (fun e -> e.Tree) let (|FrontAndBack|_|) es = let rec loop acc xs = match xs with [] -> None | [h] -> Some (List.rev acc, h) | h :: t -> loop (h :: acc) t loop [] es @@ -742,7 +742,7 @@ module Patterns = if (not (assignableFrom expectedType receivedType)) then invalidArg "receivedType" (String.Format(threeHoleSR, name, expectedType, receivedType)) - let checkArgs (paramInfos: ParameterInfo[]) (args:list) = + let checkArgs (paramInfos: ParameterInfo[]) (args: Expr list) = if (paramInfos.Length <> args.Length) then invalidArg "args" (SR.GetString(SR.QincorrectNumArgs)) List.iter2 ( fun (p:ParameterInfo) a -> checkTypesWeakSR p.ParameterType (typeOf a) "args" (SR.GetString(SR.QtmmInvalidParam))) @@ -837,7 +837,7 @@ module Patterns = mkFE1 (TupleGetOp (ty, n)) x // Records - let mkNewRecord (ty, args:list) = + let mkNewRecord (ty, args: Expr list) = let mems = FSharpType.GetRecordFields(ty, publicOrPrivateBindingFlags) if (args.Length <> mems.Length) then invalidArg "args" (SR.GetString(SR.QincompatibleRecordLength)) List.iter2 (fun (minfo: PropertyInfo) a -> checkTypesSR minfo.PropertyType (typeOf a) "recd" (SR.GetString(SR.QtmmIncorrectArgForRecord))) (Array.toList mems) args @@ -845,7 +845,7 @@ module Patterns = // Discriminated unions - let mkNewUnionCase (unionCase:UnionCaseInfo, args:list) = + let mkNewUnionCase (unionCase:UnionCaseInfo, args: Expr list) = if Unchecked.defaultof = unionCase then raise (new ArgumentNullException()) let sargs = unionCase.GetFields() if (args.Length <> sargs.Length) then invalidArg "args" (SR.GetString(SR.QunionNeedsDiffNumArgs)) @@ -897,7 +897,7 @@ module Patterns = mkFE2 (InstanceFieldSetOp finfo) (obj, value) | true -> invalidArg "finfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkCtorCall (ci:ConstructorInfo, args:list) = + let mkCtorCall (ci:ConstructorInfo, args: Expr list) = if Unchecked.defaultof = ci then raise (new ArgumentNullException()) checkArgs (ci.GetParameters()) args mkFEN (NewObjectOp ci) args @@ -905,7 +905,7 @@ module Patterns = let mkDefaultValue (ty: Type) = mkFE0 (DefaultValueOp ty) - let mkStaticPropGet (pinfo: PropertyInfo, args:list) = + let mkStaticPropGet (pinfo: PropertyInfo, args: Expr list) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanRead) then invalidArg "pinfo" (SR.GetString(SR.QreadingSetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -913,7 +913,7 @@ module Patterns = | true -> mkFEN (StaticPropGetOp pinfo) args | false -> invalidArg "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) - let mkInstancePropGet (obj, pinfo: PropertyInfo, args:list) = + let mkInstancePropGet (obj, pinfo: PropertyInfo, args: Expr list) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanRead) then invalidArg "pinfo" (SR.GetString(SR.QreadingSetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -923,7 +923,7 @@ module Patterns = mkFEN (InstancePropGetOp pinfo) (obj :: args) | true -> invalidArg "pinfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkStaticPropSet (pinfo: PropertyInfo, args:list, value: Expr) = + let mkStaticPropSet (pinfo: PropertyInfo, args: Expr list, value: Expr) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanWrite) then invalidArg "pinfo" (SR.GetString(SR.QwritingGetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -931,7 +931,7 @@ module Patterns = | true -> mkFEN (StaticPropSetOp pinfo) (args@[value]) | false -> invalidArg "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) - let mkInstancePropSet (obj, pinfo: PropertyInfo, args:list, value: Expr) = + let mkInstancePropSet (obj, pinfo: PropertyInfo, args: Expr list, value: Expr) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanWrite) then invalidArg "pinfo" (SR.GetString(SR.QwritingGetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -941,7 +941,7 @@ module Patterns = mkFEN (InstancePropSetOp pinfo) (obj :: (args@[value])) | true -> invalidArg "pinfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkInstanceMethodCall (obj, minfo:MethodInfo, args:list) = + let mkInstanceMethodCall (obj, minfo:MethodInfo, args: Expr list) = if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) checkArgs (minfo.GetParameters()) args match minfo.IsStatic with @@ -959,7 +959,7 @@ module Patterns = mkFEN (InstanceMethodCallWOp (minfo, minfoW, nWitnesses)) (obj::args) | true -> invalidArg "minfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkStaticMethodCall (minfo:MethodInfo, args:list) = + let mkStaticMethodCall (minfo:MethodInfo, args: Expr list) = if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) checkArgs (minfo.GetParameters()) args match minfo.IsStatic with @@ -1002,7 +1002,7 @@ module Patterns = | [x] -> mkApplication (f, x) | _ -> mkApplication (f, mkNewTuple args) - let mkApplications(f: Expr, es:list>) = mkLLinear mkTupledApplication (f, es) + let mkApplications(f: Expr, es: Expr list list) = mkLLinear mkTupledApplication (f, es) let mkIteratedLambdas(vs, b) = mkRLinear mkLambda (vs, b) diff --git a/src/fsharp/FSharp.Core/quotations.fsi b/src/fsharp/FSharp.Core/quotations.fsi index 32728b76f74..42946640323 100644 --- a/src/fsharp/FSharp.Core/quotations.fsi +++ b/src/fsharp/FSharp.Core/quotations.fsi @@ -266,7 +266,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ (fun (x, y) z -> x + y + z) (1,2) 3 @>. /// - static member Applications: functionExpr: Expr * arguments: list> -> Expr + static member Applications: functionExpr: Expr * arguments: Expr list list -> Expr /// Builds an expression that represents a call to an static method or module-bound function /// @@ -292,7 +292,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ Console.WriteLine("Hello World") @>. /// - static member Call: methodInfo: MethodInfo * arguments: list -> Expr + static member Call: methodInfo: MethodInfo * arguments: Expr list -> Expr /// Builds an expression that represents a call to an instance method associated with an object /// @@ -319,7 +319,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ Console.Out.WriteLine("Hello World") @>. /// - static member Call: obj: Expr * methodInfo: MethodInfo * arguments: list -> Expr + static member Call: obj: Expr * methodInfo: MethodInfo * arguments: Expr list -> Expr /// Builds an expression that represents a call to an static method or module-bound function, potentially passing additional witness arguments /// @@ -1253,7 +1253,7 @@ type Expr = /// /// The resulting expression. static member Deserialize: - qualifyingType: System.Type * spliceTypes: list * spliceExprs: list * bytes: byte [] -> Expr + qualifyingType: Type * spliceTypes: Type list * spliceExprs: Expr list * bytes: byte [] -> Expr /// This function is called automatically when quotation syntax (<@ @>) and other sources of /// quotations are used. @@ -2248,7 +2248,7 @@ module ExprShape = /// /// [] - val (|ShapeVar|ShapeLambda|ShapeCombination|): input: Expr -> Choice)> + val (|ShapeVar|ShapeLambda|ShapeCombination|): input: Expr -> Choice /// Re-build combination expressions. The first parameter should be an object /// returned by the ShapeCombination case of the active pattern in this module. @@ -2259,4 +2259,4 @@ module ExprShape = /// The rebuilt expression. /// /// - val RebuildShapeCombination: shape: obj * arguments: list -> Expr + val RebuildShapeCombination: shape: obj * arguments: Expr list -> Expr diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 7020fd084df..fb6fd554ff7 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -695,7 +695,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source match source with | :? ('T[]) as a -> a.Length = 0 - | :? list<'T> as a -> a.IsEmpty + | :? ('T list) as a -> a.IsEmpty | :? ICollection<'T> as a -> a.Count = 0 | _ -> use ie = source.GetEnumerator() diff --git a/src/fsharp/FSharp.Core/string.fs b/src/fsharp/FSharp.Core/string.fs index 4ed8b4e9183..a653cbf20b7 100644 --- a/src/fsharp/FSharp.Core/string.fs +++ b/src/fsharp/FSharp.Core/string.fs @@ -32,10 +32,10 @@ namespace Microsoft.FSharp.Core | _ -> String.Join(sep, strings, 0, strings.Length) match strings with - | :? array as arr -> + | :? (string[]) as arr -> concatArray sep arr - | :? list as lst -> + | :? (string list) as lst -> lst |> List.toArray |> concatArray sep diff --git a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs index 43332d53373..38cff9c84b2 100644 --- a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs +++ b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs @@ -269,7 +269,7 @@ type FSharpDependencyManager (outputDirectory:string option) = sprintf """ #r "nuget:FSharp.Data";; // %s 'FSharp.Data' %s""" (SR.loadNugetPackage()) (SR.highestVersion()) |] - member this.ResolveDependencies(scriptDirectory: string, scriptName: string, scriptExt: string, packageManagerTextLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int) : obj = + member _.ResolveDependencies(scriptDirectory: string, scriptName: string, scriptExt: string, packageManagerTextLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int) : obj = ignore scriptName let poundRprefix = match scriptExt with diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 725cb437ea1..508ef4d9e3f 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -7,7 +7,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps diff --git a/src/fsharp/FxResolver.fs b/src/fsharp/FxResolver.fs index 79a37c5b486..ff75963c159 100644 --- a/src/fsharp/FxResolver.fs +++ b/src/fsharp/FxResolver.fs @@ -14,7 +14,7 @@ open System.Runtime.InteropServices open Internal.Utilities.FSharpEnvironment open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.ILBinaryReader -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Text open FSharp.Compiler.IO diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index effc65e80cd..da750053eba 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -20,11 +20,10 @@ open FSharp.Compiler.AbstractIL.ILX open FSharp.Compiler.AbstractIL.ILX.Types open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Import -open FSharp.Compiler.LowerCallsAndSeqs open FSharp.Compiler.LowerStateMachines open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -38,6 +37,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations let IlxGenStackGuardDepth = StackGuard.GetDepthOption "IlxGen" @@ -2368,13 +2368,13 @@ and GenExprPreSteps (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr sequel = //ProcessDebugPointForExpr cenv cgbuf expr - match (if compileSequenceExpressions then LowerComputedListOrArrayExpr cenv.tcVal g cenv.amap expr else None) with + match (if compileSequenceExpressions then LowerComputedCollectionExpressions.LowerComputedListOrArrayExpr cenv.tcVal g cenv.amap expr else None) with | Some altExpr -> GenExpr cenv cgbuf eenv altExpr sequel true | None -> - match (if compileSequenceExpressions then ConvertSequenceExprToObject g cenv.amap expr else None) with + match (if compileSequenceExpressions then LowerSequenceExpressions.ConvertSequenceExprToObject g cenv.amap expr else None) with | Some info -> GenSequenceExpr cenv cgbuf eenv info sequel true @@ -7442,7 +7442,7 @@ and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = | TMDefRec(_isRec, opens, tycons, mbinds, m) -> let eenvinner = AddDebugImportsToEnv cenv eenv opens for tc in tycons do - if tc.IsExceptionDecl then + if tc.IsFSharpException then GenExnDef cenv cgbuf.mgbuf eenvinner m tc else GenTypeDef cenv cgbuf.mgbuf lazyInitInfo eenvinner m tc diff --git a/src/fsharp/block.fs b/src/fsharp/ImmutableArray.fs similarity index 74% rename from src/fsharp/block.fs rename to src/fsharp/ImmutableArray.fs index 91cec44bd12..d2c4f424615 100644 --- a/src/fsharp/block.fs +++ b/src/fsharp/ImmutableArray.fs @@ -2,22 +2,19 @@ module Internal.Utilities.Library.Block open System.Collections.Immutable -type block<'T> = ImmutableArray<'T> -type blockbuilder<'T> = ImmutableArray<'T>.Builder - [] -module BlockBuilder = +module ImmutableArrayBuilder = - let create size : blockbuilder<'T> = + let create size : ImmutableArray<'T>.Builder = ImmutableArray.CreateBuilder(size) [] -module Block = +module ImmutableArray = [] let empty<'T> = ImmutableArray<'T>.Empty - let init n (f: int -> 'T) : block<_> = + let init n (f: int -> 'T) : ImmutableArray<_> = match n with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(f 0) @@ -30,29 +27,29 @@ module Block = builder.Add(f i) builder.MoveToImmutable() - let iter f (arr: block<'T>) = + let iter f (arr: ImmutableArray<'T>) = for i = 0 to arr.Length - 1 do f arr[i] - let iteri f (arr: block<'T>) = + let iteri f (arr: ImmutableArray<'T>) = for i = 0 to arr.Length - 1 do f i arr[i] - let iter2 f (arr1: block<'T1>) (arr2: block<'T2>) = + let iter2 f (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." for i = 0 to arr1.Length - 1 do f arr1[i] arr2[i] - let iteri2 f (arr1: block<'T1>) (arr2: block<'T2>) = + let iteri2 f (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." for i = 0 to arr1.Length - 1 do f i arr1[i] arr2[i] - let map (mapper: 'T -> 'U) (arr: block<'T>) : block<_> = + let map (mapper: 'T -> 'U) (arr: ImmutableArray<'T>) : ImmutableArray<_> = match arr.Length with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper arr[0]) @@ -62,7 +59,7 @@ module Block = builder.Add(mapper arr[i]) builder.MoveToImmutable() - let mapi (mapper: int -> 'T -> 'U) (arr: block<'T>) : block<_> = + let mapi (mapper: int -> 'T -> 'U) (arr: ImmutableArray<'T>) : ImmutableArray<_> = match arr.Length with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper 0 arr[0]) @@ -72,7 +69,7 @@ module Block = builder.Add(mapper i arr[i]) builder.MoveToImmutable() - let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = + let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) : ImmutableArray<_> = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -85,7 +82,7 @@ module Block = builder.Add(mapper arr1[i] arr2[i]) builder.MoveToImmutable() - let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = + let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) : ImmutableArray<_> = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -98,7 +95,7 @@ module Block = builder.Add(mapper i arr1[i] arr2[i]) builder.MoveToImmutable() - let concat (arrs: block>) : block<'T> = + let concat (arrs: ImmutableArray>) : ImmutableArray<'T> = match arrs.Length with | 0 -> ImmutableArray.Empty | 1 -> arrs[0] @@ -113,12 +110,12 @@ module Block = builder.AddRange(arrs[i]) builder.MoveToImmutable() - let forall predicate (arr: block<'T>) = + let forall predicate (arr: ImmutableArray<'T>) = let len = arr.Length let rec loop i = i >= len || (predicate arr[i] && loop (i+1)) loop 0 - let forall2 predicate (arr1: block<'T1>) (arr2: block<'T2>) = + let forall2 predicate (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -127,18 +124,18 @@ module Block = let rec loop i = i >= len1 || (f.Invoke(arr1[i], arr2[i]) && loop (i+1)) loop 0 - let tryFind predicate (arr: block<'T>) = + let tryFind predicate (arr: ImmutableArray<'T>) = let rec loop i = if i >= arr.Length then None else if predicate arr[i] then Some arr[i] else loop (i+1) loop 0 - let tryFindIndex predicate (arr: block<'T>) = + let tryFindIndex predicate (arr: ImmutableArray<'T>) = let len = arr.Length let rec go n = if n >= len then None elif predicate arr[n] then Some n else go (n+1) go 0 - let tryPick chooser (arr: block<'T>) = + let tryPick chooser (arr: ImmutableArray<'T>) = let rec loop i = if i >= arr.Length then None else match chooser arr[i] with @@ -149,13 +146,13 @@ module Block = let ofSeq (xs: 'T seq) = ImmutableArray.CreateRange(xs) - let append (arr1: block<'T1>) (arr2: block<'T1>) : block<_> = + let append (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T1>) : ImmutableArray<_> = arr1.AddRange(arr2) - let createOne (item: 'T) : block<_> = + let createOne (item: 'T) : ImmutableArray<_> = ImmutableArray.Create(item) - let filter predicate (arr: block<'T>) : block<'T> = + let filter predicate (arr: ImmutableArray<'T>) : ImmutableArray<'T> = let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do if predicate arr[i] then @@ -163,12 +160,12 @@ module Block = builder.Capacity <- builder.Count builder.MoveToImmutable() - let exists predicate (arr: block<'T>) = + let exists predicate (arr: ImmutableArray<'T>) = let len = arr.Length let rec loop i = i < len && (predicate arr[i] || loop (i+1)) len > 0 && loop 0 - let choose (chooser: 'T -> 'U option) (arr: block<'T>) : block<'U> = + let choose (chooser: 'T -> 'U option) (arr: ImmutableArray<'T>) : ImmutableArray<'U> = let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do let result = chooser arr[i] @@ -177,9 +174,9 @@ module Block = builder.Capacity <- builder.Count builder.MoveToImmutable() - let isEmpty (arr: block<_>) = arr.IsEmpty + let isEmpty (arr: ImmutableArray<_>) = arr.IsEmpty - let fold folder state (arr: block<_>) = + let fold folder state (arr: ImmutableArray<_>) = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) let mutable state = state for i = 0 to arr.Length - 1 do diff --git a/src/fsharp/ImmutableArray.fsi b/src/fsharp/ImmutableArray.fsi new file mode 100644 index 00000000000..a1cd577350e --- /dev/null +++ b/src/fsharp/ImmutableArray.fsi @@ -0,0 +1,57 @@ +[] +module internal Internal.Utilities.Library.Block + +open System.Collections.Immutable + +[] +module ImmutableArrayBuilder = + + val create: size: int -> ImmutableArray<'T>.Builder + +[] +module ImmutableArray = + + [] + val empty<'T> : ImmutableArray<'T> + + val init: n: int -> f: (int -> 'T) -> ImmutableArray<'T> + + val iter: f: ('T -> unit) -> ImmutableArray<'T> -> unit + + val iteri: f: (int -> 'T -> unit) -> ImmutableArray<'T> -> unit + + val iter2: f: ('T1 -> 'T2 -> unit) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> unit + + val iteri2: f: (int -> 'T1 -> 'T2 -> unit) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> unit + + val map: mapper: ('T1 -> 'T2) -> ImmutableArray<'T1> -> ImmutableArray<'T2> + + val mapi: mapper: (int -> 'T1 -> 'T2) -> ImmutableArray<'T1> -> ImmutableArray<'T2> + + val concat: ImmutableArray> -> ImmutableArray<'T> + + val forall: predicate: ('T -> bool) -> ImmutableArray<'T> -> bool + + val forall2: predicate: ('T1 -> 'T2 -> bool) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> bool + + val tryFind: predicate: ('T -> bool) -> ImmutableArray<'T> -> 'T option + + val tryFindIndex: predicate: ('T -> bool) -> ImmutableArray<'T> -> int option + + val tryPick: chooser: ('T1 -> 'T2 option) -> ImmutableArray<'T1> -> 'T2 option + + val ofSeq: seq<'T> -> ImmutableArray<'T> + + val append: ImmutableArray<'T> -> ImmutableArray<'T> -> ImmutableArray<'T> + + val createOne: 'T -> ImmutableArray<'T> + + val filter: predicate: ('T -> bool) -> ImmutableArray<'T> -> ImmutableArray<'T> + + val exists: predicate: ('T -> bool) -> ImmutableArray<'T> -> bool + + val choose: chooser: ('T -> 'U option) -> ImmutableArray<'T> -> ImmutableArray<'U> + + val isEmpty: ImmutableArray<'T> -> bool + + val fold: folder: ('State -> 'T -> 'State) -> 'State -> ImmutableArray<'T> -> 'State diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 0cfdaa825e7..da69bbbbc0a 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -10,7 +10,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Syntax @@ -20,6 +20,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations /// Use the given function to select some of the member values from the members of an F# type diff --git a/src/fsharp/InfoReader.fsi b/src/fsharp/InfoReader.fsi index 487e0de771d..c7e375d5042 100644 --- a/src/fsharp/InfoReader.fsi +++ b/src/fsharp/InfoReader.fsi @@ -12,6 +12,7 @@ open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.Xml +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypedTree /// Try to select an F# value when querying members, and if so return a MethInfo that wraps the F# value. diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index 578201a3601..edc81950c2f 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Detuple.GlobalUsageAnalysis -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Text.Layout diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index 5408af60981..26b43155830 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -10,19 +10,54 @@ open System.IO open System.Text.RegularExpressions open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.AbstractIL.ILBinaryReader open Internal.Utilities.Library +/// Part of LegacyHostedCompilerForTesting +/// +/// Yet another DiagnosticsLogger implementation, capturing the messages but only up to the maxerrors maximum +type internal InProcDiagnosticsLoggerProvider() = + let errors = ResizeArray() + let warnings = ResizeArray() + + member _.Provider = + { new DiagnosticsLoggerProvider() with + + member _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + + { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with + + member _.HandleTooManyErrors text = + warnings.Add(FormattedDiagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) + + member _.HandleIssue(tcConfigBuilder, err, severity) = + // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf + let diagnostics = + CollectFormattedDiagnostics + (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, + tcConfigBuilder.flatErrors, tcConfigBuilder.diagnosticStyle, severity, err, true) + match severity with + | FSharpDiagnosticSeverity.Error -> + errors.AddRange(diagnostics) + | FSharpDiagnosticSeverity.Warning -> + warnings.AddRange(diagnostics) + | _ -> ()} + :> DiagnosticsLogger } + + member _.CapturedErrors = errors.ToArray() + + member _.CapturedWarnings = warnings.ToArray() + /// build issue location type internal Location = { - StartLine : int - StartColumn : int - EndLine : int - EndColumn : int + StartLine: int + StartColumn: int + EndLine: int + EndColumn: int } type internal CompilationIssueType = Warning | Error @@ -30,19 +65,19 @@ type internal CompilationIssueType = Warning | Error /// build issue details type internal CompilationIssue = { - Location : Location - Subcategory : string - Code : string - File : string - Text : string - Type : CompilationIssueType + Location: Location + Subcategory: string + Code: string + File: string + Text: string + Type: CompilationIssueType } /// combined warning and error details type internal FailureDetails = { - Warnings : CompilationIssue list - Errors : CompilationIssue list + Warnings: CompilationIssue list + Errors: CompilationIssue list } type internal CompilationResult = @@ -51,29 +86,38 @@ type internal CompilationResult = [] type internal CompilationOutput = - { Errors : Diagnostic[] - Warnings : Diagnostic[] } + { Errors: FormattedDiagnostic[] + Warnings: FormattedDiagnostic[] } type internal InProcCompiler(legacyReferenceResolver) = - member this.Compile(argv) = + member _.Compile(argv) = // Explanation: Compilation happens on whichever thread calls this function. let ctok = AssumeCompilationThreadWithoutEvidence () - let loggerProvider = InProcErrorLoggerProvider() + let loggerProvider = InProcDiagnosticsLoggerProvider() let mutable exitCode = 0 let exiter = { new Exiter with - member this.Exit n = exitCode <- n; raise StopProcessing } + member _.Exit n = exitCode <- n; raise StopProcessing } try - mainCompile(ctok, argv, legacyReferenceResolver, false, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.Yes, exiter, loggerProvider.Provider, None, None) + CompileFromCommandLineArguments ( + ctok, argv, legacyReferenceResolver, + false, ReduceMemoryFlag.Yes, + CopyFSharpCoreFlag.Yes, exiter, + loggerProvider.Provider, None, None + ) with | StopProcessing -> () - | ReportedError _ | WrappedError(ReportedError _,_) -> + | ReportedError _ + | WrappedError(ReportedError _,_) -> exitCode <- 1 () - let output : CompilationOutput = { Warnings = loggerProvider.CapturedWarnings; Errors = loggerProvider.CapturedErrors } + let output: CompilationOutput = + { Warnings = loggerProvider.CapturedWarnings + Errors = loggerProvider.CapturedErrors } + exitCode = 0, output /// in-proc version of fsc.exe @@ -88,10 +132,10 @@ type internal FscCompiler(legacyReferenceResolver) = EndLine = 0 } - /// converts short and long issue types to the same CompilationIssue representation - let convert issue : CompilationIssue = + /// Converts short and long issue types to the same CompilationIssue representation + let convert issue = match issue with - | Diagnostic.Short(severity, text) -> + | FormattedDiagnostic.Short(severity, text) -> { Location = emptyLocation Code = "" @@ -100,7 +144,7 @@ type internal FscCompiler(legacyReferenceResolver) = Text = text Type = if (severity = FSharpDiagnosticSeverity.Error) then CompilationIssueType.Error else CompilationIssueType.Warning } - | Diagnostic.Long(severity, details) -> + | FormattedDiagnostic.Long(severity, details) -> let loc, file = match details.Location with | Some l when not l.IsEmpty -> @@ -136,7 +180,7 @@ type internal FscCompiler(legacyReferenceResolver) = fun arg -> regex.IsMatch(arg) /// do compilation as if args was argv to fsc.exe - member this.Compile(args : string array) = + member _.Compile(args: string[]) = // args.[0] is later discarded, assuming it is just the path to fsc. // compensate for this in case caller didn't know let args = @@ -177,8 +221,8 @@ module internal CompilerHelpers = /// splits a provided command line string into argv array /// currently handles quotes, but not escaped quotes - let parseCommandLine (commandLine : string) = - let folder (inQuote : bool, currArg : string, argLst : string list) ch = + let parseCommandLine (commandLine: string) = + let folder (inQuote: bool, currArg: string, argLst: string list) ch = match (ch, inQuote) with | '"', _ -> (not inQuote, currArg, argLst) diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 323347b78eb..5396ffdaabd 100644 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Lexhelp open FSharp.Compiler.ParseHelpers diff --git a/src/fsharp/LowerCalls.fs b/src/fsharp/LowerCalls.fs new file mode 100644 index 00000000000..5e58eea4911 --- /dev/null +++ b/src/fsharp/LowerCalls.fs @@ -0,0 +1,53 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerCalls + +open Internal.Utilities.Library +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps + +let LowerCallsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsRewrite" + +//---------------------------------------------------------------------------- +// Expansion of calls to methods with statically known arity + +let InterceptExpr g cont expr = + + match expr with + | Expr.Val (vref, flags, m) -> + match vref.ValReprInfo with + | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) + | None -> None + + // App (Val v, tys, args) + | Expr.App (Expr.Val (vref, flags, _) as f0, f0ty, tyargsl, argsl, m) -> + // Only transform if necessary, i.e. there are not enough arguments + match vref.ValReprInfo with + | Some(topValInfo) -> + let argsl = List.map cont argsl + let f0 = + if topValInfo.AritiesOfArgs.Length > argsl.Length + then fst(AdjustValForExpectedArity g m vref flags topValInfo) + else f0 + + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) + | None -> None + + | Expr.App (f0, f0ty, tyargsl, argsl, m) -> + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) + + | _ -> None + +/// An "expr -> expr" pass that eta-expands under-applied values of +/// known arity to lambda expressions and beta-var-reduces to bind +/// any known arguments. The results are later optimized by the peephole +/// optimizer in opt.fs +let LowerImplFile g assembly = + let rwenv = + { PreIntercept = Some(InterceptExpr g) + PreInterceptBinding=None + PostTransform= (fun _ -> None) + RewriteQuotations=false + StackGuard = StackGuard(LowerCallsRewriteStackGuardDepth) } + assembly |> RewriteImplFile rwenv diff --git a/src/fsharp/LowerCalls.fsi b/src/fsharp/LowerCalls.fsi new file mode 100644 index 00000000000..aecb0ff3f9e --- /dev/null +++ b/src/fsharp/LowerCalls.fsi @@ -0,0 +1,10 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerCalls + +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TypedTree + +/// Expands under-applied values of known arity to lambda expressions, and then reduce to bind +/// any known arguments. The results are later optimized by Optimizer.fs +val LowerImplFile: g: TcGlobals -> assembly: TypedImplFile -> TypedImplFile diff --git a/src/fsharp/LowerComputedCollections.fs b/src/fsharp/LowerComputedCollections.fs new file mode 100644 index 00000000000..054a6d9f559 --- /dev/null +++ b/src/fsharp/LowerComputedCollections.fs @@ -0,0 +1,272 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerComputedCollectionExpressions + +open Internal.Utilities.Library +open FSharp.Compiler.AccessibilityLogic +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.InfoReader +open FSharp.Compiler.LowerSequenceExpressions +open FSharp.Compiler.MethodCalls +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TypeRelations +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy + +let LowerComputedCollectionsStackGuardDepth = StackGuard.GetDepthOption "LowerComputedCollections" + +/// Build the 'test and dispose' part of a 'use' statement +let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = + let disposeMethod = + match GetIntrinsicMethInfosOfType infoReader (Some "Dispose") AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m g.system_IDisposable_ty with + | [x] -> x + | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) + // For struct types the test is simpler + if isStructTy g v.Type then + assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) + // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive + // copy of it. + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] + + disposeExpr + else + let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let inpe = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) + mkIsInstConditional g m g.system_IDisposable_ty inpe disposeObjVar disposeExpr (mkUnit g m) + +let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = + let listCollectorTy = tyOfExpr g collExpr + let addMethod = + match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with + | [x] -> x + | _ -> error(InternalError("no " + name + " method found on Collector", m)) + let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args + expr + +let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "Add" collExpr [arg] + +let mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "AddMany" collExpr [arg] + +let mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "AddManyAndClose" collExpr [arg] + +let mkCallCollectorClose tcVal (g: TcGlobals) infoReader m collExpr = + mkCallCollectorMethod tcVal g infoReader m "Close" collExpr [] + +let LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr = + let infoReader = InfoReader(g, amap) + let collVal, collExpr = mkMutableCompGenLocal m "@collector" collectorTy + //let collExpr = mkValAddr m false (mkLocalValRef collVal) + let rec ConvertSeqExprCode isUninteresting isTailcall expr = + match expr with + | SeqYield g (e, m) -> + let exprR = mkCallCollectorAdd tcVal g infoReader m collExpr e + Result.Ok (false, exprR) + + | SeqDelay g (delayedExpr, _elemTy) -> + ConvertSeqExprCode isUninteresting isTailcall delayedExpr + + | SeqAppend g (e1, e2, m) -> + let res1 = ConvertSeqExprCode false false e1 + let res2 = ConvertSeqExprCode false isTailcall e2 + match res1, res2 with + | Result.Ok (_, e1R), Result.Ok (closed2, e2R) -> + let exprR = mkSequential m e1R e2R + Result.Ok (closed2, exprR) + | Result.Error msg, _ | _, Result.Error msg -> Result.Error msg + + | SeqWhile g (guardExpr, bodyExpr, spWhile, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + let exprR = mkWhile g (spWhile, NoSpecialWhileLoopMarker, guardExpr, bodyExprR, m) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqUsing g (resource, v, bodyExpr, _elemTy, spBind, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + // printfn "found Seq.using" + let cleanupE = BuildDisposableCleanup tcVal g infoReader m v + let exprR = + mkLet spBind m v resource + (mkTryFinally g (bodyExprR, cleanupE, m, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqForEach g (inp, v, bodyExpr, _genElemTy, mFor, mIn, spIn) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + // printfn "found Seq.for" + let inpElemTy = v.Type + let inpEnumTy = mkIEnumeratorTy g inpElemTy + let enumv, enumve = mkCompGenLocal m "enum" inpEnumTy + let guardExpr = callNonOverloadedILMethod g amap m "MoveNext" inpEnumTy [enumve] + let cleanupE = BuildDisposableCleanup tcVal g infoReader m enumv + + // A debug point should get emitted prior to both the evaluation of 'inp' and the call to GetEnumerator + let addForDebugPoint e = Expr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, e) + + let spInAsWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No + + let exprR = + mkInvisibleLet mFor enumv (callNonOverloadedILMethod g amap mFor "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) + (mkTryFinally g + (mkWhile g (spInAsWhile, NoSpecialWhileLoopMarker, guardExpr, + (mkInvisibleLet mIn v + (callNonOverloadedILMethod g amap mIn "get_Current" inpEnumTy [enumve])) + bodyExprR, mIn), + cleanupE, + mFor, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) + |> addForDebugPoint + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqTryFinally g (bodyExpr, compensation, spTry, spFinally, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + let exprR = + mkTryFinally g (bodyExprR, compensation, m, tyOfExpr g bodyExpr, spTry, spFinally) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqEmpty g m -> + let exprR = mkUnit g m + Result.Ok(false, exprR) + + | Expr.Sequential (x1, bodyExpr, NormalSeq, m) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = Expr.Sequential (x1, bodyExprR, NormalSeq, m) + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.Let (bind, bodyExpr, m, _) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = mkLetBind m bind bodyExprR + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.LetRec (binds, bodyExpr, m, _) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = mkLetRecBinds m binds bodyExprR + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.Match (spBind, exprm, pt, targets, m, ty) -> + // lower all the targets. abandon if any fail to lower + let resTargets = + targets |> Array.map (fun (TTarget(vs, targetExpr, flags)) -> + match ConvertSeqExprCode false false targetExpr with + | Result.Ok (_, targetExprR) -> + Result.Ok (TTarget(vs, targetExprR, flags)) + | Result.Error msg -> Result.Error msg ) + + if resTargets |> Array.forall (function Result.Ok _ -> true | _ -> false) then + let tglArray = Array.map (function Result.Ok v -> v | _ -> failwith "unreachable") resTargets + + let exprR = primMkMatch (spBind, exprm, pt, tglArray, m, ty) + Result.Ok(false, exprR) + else + resTargets |> Array.pick (function Result.Error msg -> Some (Result.Error msg) | _ -> None) + + | Expr.DebugPoint(dp, innerExpr) -> + let resInnerExpr = ConvertSeqExprCode isUninteresting isTailcall innerExpr + match resInnerExpr with + | Result.Ok (flag, innerExprR) -> + let exprR = Expr.DebugPoint(dp, innerExprR) + Result.Ok (flag, exprR) + | Result.Error msg -> Result.Error msg + + // yield! e ---> (for x in e -> x) + + | arbitrarySeqExpr -> + let m = arbitrarySeqExpr.Range + if isUninteresting then + // printfn "FAILED - not worth compiling an unrecognized Seq.toList at %s " (stringOfRange m) + Result.Error () + else + // If we're the final in a sequential chain then we can AddMany, Close and return + if isTailcall then + let exprR = mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr + // Return 'true' to indicate the collector was closed and the overall result of the expression is the result + Result.Ok(true, exprR) + else + let exprR = mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr + Result.Ok(false, exprR) + + + // Perform conversion + match ConvertSeqExprCode true true overallSeqExpr with + | Result.Ok (closed, overallSeqExprR) -> + mkInvisibleLet m collVal (mkDefault (m, collectorTy)) + (if closed then + // If we ended with AddManyAndClose then we're done + overallSeqExprR + else + mkSequential m + overallSeqExprR + (mkCallCollectorClose tcVal g infoReader m collExpr)) + |> Some + | Result.Error () -> + None + +let (|OptionalCoerce|) expr = + match expr with + | Expr.Op (TOp.Coerce, _, [arg], _) -> arg + | _ -> expr + +// Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression +// which only adds a 'seq' call outside of FSharp.Core +let (|OptionalSeq|_|) g amap expr = + match expr with + // use 'seq { ... }' as an indicator + | Seq g (e, elemTy) -> + Some (e, elemTy) + | _ -> + // search for the relevant element type + match tyOfExpr g expr with + | SeqElemTy g amap expr.Range elemTy -> + Some (expr, elemTy) + | _ -> None + +let (|SeqToList|_|) g expr = + match expr with + | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m) + | _ -> None + +let (|SeqToArray|_|) g expr = + match expr with + | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m) + | _ -> None + +let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = + // If ListCollector is in FSharp.Core then this optimization kicks in + if g.ListCollector_tcr.CanDeref then + + match overallExpr with + | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> + let collectorTy = g.mk_ListCollector_ty overallElemTy + LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr + + | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> + let collectorTy = g.mk_ArrayCollector_ty overallElemTy + LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr + + | _ -> None + else + None diff --git a/src/fsharp/LowerComputedCollections.fsi b/src/fsharp/LowerComputedCollections.fsi new file mode 100644 index 00000000000..a1656361776 --- /dev/null +++ b/src/fsharp/LowerComputedCollections.fsi @@ -0,0 +1,10 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerComputedCollectionExpressions + +open FSharp.Compiler.Import +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TypedTree + +val LowerComputedListOrArrayExpr: + tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr option diff --git a/src/fsharp/autobox.fs b/src/fsharp/LowerLocalMutables.fs similarity index 98% rename from src/fsharp/autobox.fs rename to src/fsharp/LowerLocalMutables.fs index 84a2756d6d5..08b46d70727 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/LowerLocalMutables.fs @@ -1,11 +1,11 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.AutoBox +module internal FSharp.Compiler.LowerLocalMutables open Internal.Utilities.Collections open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps @@ -21,7 +21,7 @@ type cenv = { g: TcGlobals amap: Import.ImportMap } - override x.ToString() = "" + override _.ToString() = "" /// Find all the mutable locals that escape a method, function or lambda expression let DecideEscapes syntacticArgs body = diff --git a/src/fsharp/autobox.fsi b/src/fsharp/LowerLocalMutables.fsi similarity index 88% rename from src/fsharp/autobox.fsi rename to src/fsharp/LowerLocalMutables.fsi index 1c2f32b13a6..614bdda7164 100644 --- a/src/fsharp/autobox.fsi +++ b/src/fsharp/LowerLocalMutables.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.AutoBox +module internal FSharp.Compiler.LowerLocalMutables open FSharp.Compiler.Import open FSharp.Compiler.TcGlobals diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerSequences.fs similarity index 68% rename from src/fsharp/LowerCallsAndSeqs.fs rename to src/fsharp/LowerSequences.fs index 1d014f7d0b4..b82947b11ff 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerSequences.fs @@ -1,68 +1,23 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerCallsAndSeqs +module internal FSharp.Compiler.LowerSequenceExpressions -open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax -open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text -open FSharp.Compiler.TypeRelations open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy -let LowerCallsAndSeqsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsAndSeqsRewrite" - -//---------------------------------------------------------------------------- -// Eta-expansion of calls to top-level-methods - -let InterceptExpr g cont expr = - - match expr with - | Expr.Val (vref, flags, m) -> - match vref.ValReprInfo with - | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) - | None -> None - - // App (Val v, tys, args) - | Expr.App (Expr.Val (vref, flags, _) as f0, f0ty, tyargsl, argsl, m) -> - // Only transform if necessary, i.e. there are not enough arguments - match vref.ValReprInfo with - | Some(topValInfo) -> - let argsl = List.map cont argsl - let f0 = - if topValInfo.AritiesOfArgs.Length > argsl.Length - then fst(AdjustValForExpectedArity g m vref flags topValInfo) - else f0 - - Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) - | None -> None - - | Expr.App (f0, f0ty, tyargsl, argsl, m) -> - Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) - - | _ -> None - -/// An "expr -> expr" pass that eta-expands under-applied values of -/// known arity to lambda expressions and beta-var-reduces to bind -/// any known arguments. The results are later optimized by the peephole -/// optimizer in opt.fs -let LowerImplFile g assembly = - let rwenv = - { PreIntercept = Some(InterceptExpr g) - PreInterceptBinding=None - PostTransform= (fun _ -> None) - RewriteQuotations=false - StackGuard = StackGuard(LowerCallsAndSeqsRewriteStackGuardDepth) } - assembly |> RewriteImplFile rwenv +let LowerSequenceExpressionsStackGuardDepth = StackGuard.GetDepthOption "LowerSequenceExpressions" //---------------------------------------------------------------------------- // General helpers @@ -112,107 +67,9 @@ type LoweredSeqFirstPhaseResult = asyncVars: FreeVars } -let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals - -let (|Seq|_|) g expr = - match expr with - // use 'seq { ... }' as an indicator - | ValApp g g.seq_vref ([elemTy], [e], _m) -> Some (e, elemTy) - | _ -> None - let IsPossibleSequenceExpr g overallExpr = match overallExpr with Seq g _ -> true | _ -> false -/// Detect a 'yield x' within a 'seq { ... }' -let (|SeqYield|_|) g expr = - match expr with - | ValApp g g.seq_singleton_vref (_, [arg], m) -> Some (arg, m) - | _ -> None - -/// Detect a 'expr; expr' within a 'seq { ... }' -let (|SeqAppend|_|) g expr = - match expr with - | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> Some (arg1, arg2, m) - | _ -> None - -/// Detect a 'while gd do expr' within a 'seq { ... }' -let (|SeqWhile|_|) g expr = - match expr with - | ValApp g g.seq_generated_vref (_, [Expr.Lambda (_, _, _, [dummyv], guardExpr, _, _);innerExpr], m) - when not (isVarFreeInExpr dummyv guardExpr) -> - - // The debug point for 'while' is attached to the innerExpr, see TcSequenceExpression - let mWhile = innerExpr.Range - let spWhile = match mWhile.NotedSourceConstruct with NotedSourceConstruct.While -> DebugPointAtWhile.Yes mWhile | _ -> DebugPointAtWhile.No - Some (guardExpr, innerExpr, spWhile, m) - - | _ -> - None - -let (|SeqTryFinally|_|) g expr = - match expr with - | ValApp g g.seq_finally_vref (_, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _) as arg2], m) - when not (isVarFreeInExpr dummyv compensation) -> - - // The debug point for 'try' and 'finally' are attached to the first and second arguments - // respectively, see TcSequenceExpression - let mTry = arg1.Range - let mFinally = arg2.Range - let spTry = match mTry.NotedSourceConstruct with NotedSourceConstruct.Try -> DebugPointAtTry.Yes mTry | _ -> DebugPointAtTry.No - let spFinally = match mFinally.NotedSourceConstruct with NotedSourceConstruct.Finally -> DebugPointAtFinally.Yes mFinally | _ -> DebugPointAtFinally.No - - Some (arg1, compensation, spTry, spFinally, m) - - | _ -> - None - -let (|SeqUsing|_|) g expr = - match expr with - | ValApp g g.seq_using_vref ([_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, mBind, _)], m) -> - // The debug point mFor at the 'use x = ... ' gets attached to the lambda - let spBind = match mBind.NotedSourceConstruct with NotedSourceConstruct.Binding -> DebugPointAtBinding.Yes mBind | _ -> DebugPointAtBinding.NoneAtInvisible - Some (resource, v, body, elemTy, spBind, m) - | _ -> - None - -let (|SeqForEach|_|) g expr = - match expr with - // Nested for loops are represented by calls to Seq.collect - | ValApp g g.seq_collect_vref ([_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> - // The debug point mIn at the 'in' gets attached to the first argument, see TcSequenceExpression - let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No - Some (inp, v, body, genElemTy, mFor, mIn, spIn) - - // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. - | ValApp g g.seq_map_vref ([_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> - let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No - // The debug point mFor at the 'for' gets attached to the first argument, see TcSequenceExpression - Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) - - | _ -> None - -let (|SeqDelay|_|) g expr = - match expr with - | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) - when not (isVarFreeInExpr v e) -> - Some (e, elemTy) - | _ -> None - -let (|SeqEmpty|_|) g expr = - match expr with - | ValApp g g.seq_empty_vref (_, [], m) -> Some m - | _ -> None - -let (|SeqToList|_|) g expr = - match expr with - | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None - -let (|SeqToArray|_|) g expr = - match expr with - | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None - let tyConfirmsToSeq g ty = match tryTcrefOfAppTy g ty with | ValueSome tcref -> @@ -866,246 +723,3 @@ let ConvertSequenceExprToObject g amap overallExpr = None | _ -> None -/// Build the 'test and dispose' part of a 'use' statement -let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = - let disposeMethod = - match GetIntrinsicMethInfosOfType infoReader (Some "Dispose") AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m g.system_IDisposable_ty with - | [x] -> x - | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) - // For struct types the test is simpler - if isStructTy g v.Type then - assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) - // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive - // copy of it. - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] - //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] - - disposeExpr - else - let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] - let inpe = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) - mkIsInstConditional g m g.system_IDisposable_ty inpe disposeObjVar disposeExpr (mkUnit g m) - -let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = - let listCollectorTy = tyOfExpr g collExpr - let addMethod = - match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with - | [x] -> x - | _ -> error(InternalError("no " + name + " method found on Collector", m)) - let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args - expr - -let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "Add" collExpr [arg] - -let mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "AddMany" collExpr [arg] - -let mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "AddManyAndClose" collExpr [arg] - -let mkCallCollectorClose tcVal (g: TcGlobals) infoReader m collExpr = - mkCallCollectorMethod tcVal g infoReader m "Close" collExpr [] - -let LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr = - let infoReader = InfoReader(g, amap) - let collVal, collExpr = mkMutableCompGenLocal m "@collector" collectorTy - //let collExpr = mkValAddr m false (mkLocalValRef collVal) - let rec ConvertSeqExprCode isUninteresting isTailcall expr = - match expr with - | SeqYield g (e, m) -> - let exprR = mkCallCollectorAdd tcVal g infoReader m collExpr e - Result.Ok (false, exprR) - - | SeqDelay g (delayedExpr, _elemTy) -> - ConvertSeqExprCode isUninteresting isTailcall delayedExpr - - | SeqAppend g (e1, e2, m) -> - let res1 = ConvertSeqExprCode false false e1 - let res2 = ConvertSeqExprCode false isTailcall e2 - match res1, res2 with - | Result.Ok (_, e1R), Result.Ok (closed2, e2R) -> - let exprR = mkSequential m e1R e2R - Result.Ok (closed2, exprR) - | Result.Error msg, _ | _, Result.Error msg -> Result.Error msg - - | SeqWhile g (guardExpr, bodyExpr, spWhile, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - let exprR = mkWhile g (spWhile, NoSpecialWhileLoopMarker, guardExpr, bodyExprR, m) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqUsing g (resource, v, bodyExpr, _elemTy, spBind, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - // printfn "found Seq.using" - let cleanupE = BuildDisposableCleanup tcVal g infoReader m v - let exprR = - mkLet spBind m v resource - (mkTryFinally g (bodyExprR, cleanupE, m, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqForEach g (inp, v, bodyExpr, _genElemTy, mFor, mIn, spIn) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - // printfn "found Seq.for" - let inpElemTy = v.Type - let inpEnumTy = mkIEnumeratorTy g inpElemTy - let enumv, enumve = mkCompGenLocal m "enum" inpEnumTy - let guardExpr = callNonOverloadedILMethod g amap m "MoveNext" inpEnumTy [enumve] - let cleanupE = BuildDisposableCleanup tcVal g infoReader m enumv - - // A debug point should get emitted prior to both the evaluation of 'inp' and the call to GetEnumerator - let addForDebugPoint e = Expr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, e) - - let spInAsWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No - - let exprR = - mkInvisibleLet mFor enumv (callNonOverloadedILMethod g amap mFor "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) - (mkTryFinally g - (mkWhile g (spInAsWhile, NoSpecialWhileLoopMarker, guardExpr, - (mkInvisibleLet mIn v - (callNonOverloadedILMethod g amap mIn "get_Current" inpEnumTy [enumve])) - bodyExprR, mIn), - cleanupE, - mFor, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) - |> addForDebugPoint - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqTryFinally g (bodyExpr, compensation, spTry, spFinally, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - let exprR = - mkTryFinally g (bodyExprR, compensation, m, tyOfExpr g bodyExpr, spTry, spFinally) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqEmpty g m -> - let exprR = mkUnit g m - Result.Ok(false, exprR) - - | Expr.Sequential (x1, bodyExpr, NormalSeq, m) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = Expr.Sequential (x1, bodyExprR, NormalSeq, m) - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.Let (bind, bodyExpr, m, _) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = mkLetBind m bind bodyExprR - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.LetRec (binds, bodyExpr, m, _) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = mkLetRecBinds m binds bodyExprR - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.Match (spBind, exprm, pt, targets, m, ty) -> - // lower all the targets. abandon if any fail to lower - let resTargets = - targets |> Array.map (fun (TTarget(vs, targetExpr, flags)) -> - match ConvertSeqExprCode false false targetExpr with - | Result.Ok (_, targetExprR) -> - Result.Ok (TTarget(vs, targetExprR, flags)) - | Result.Error msg -> Result.Error msg ) - - if resTargets |> Array.forall (function Result.Ok _ -> true | _ -> false) then - let tglArray = Array.map (function Result.Ok v -> v | _ -> failwith "unreachable") resTargets - - let exprR = primMkMatch (spBind, exprm, pt, tglArray, m, ty) - Result.Ok(false, exprR) - else - resTargets |> Array.pick (function Result.Error msg -> Some (Result.Error msg) | _ -> None) - - | Expr.DebugPoint(dp, innerExpr) -> - let resInnerExpr = ConvertSeqExprCode isUninteresting isTailcall innerExpr - match resInnerExpr with - | Result.Ok (flag, innerExprR) -> - let exprR = Expr.DebugPoint(dp, innerExprR) - Result.Ok (flag, exprR) - | Result.Error msg -> Result.Error msg - - // yield! e ---> (for x in e -> x) - - | arbitrarySeqExpr -> - let m = arbitrarySeqExpr.Range - if isUninteresting then - // printfn "FAILED - not worth compiling an unrecognized Seq.toList at %s " (stringOfRange m) - Result.Error () - else - // If we're the final in a sequential chain then we can AddMany, Close and return - if isTailcall then - let exprR = mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr - // Return 'true' to indicate the collector was closed and the overall result of the expression is the result - Result.Ok(true, exprR) - else - let exprR = mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr - Result.Ok(false, exprR) - - - // Perform conversion - match ConvertSeqExprCode true true overallSeqExpr with - | Result.Ok (closed, overallSeqExprR) -> - mkInvisibleLet m collVal (mkDefault (m, collectorTy)) - (if closed then - // If we ended with AddManyAndClose then we're done - overallSeqExprR - else - mkSequential m - overallSeqExprR - (mkCallCollectorClose tcVal g infoReader m collExpr)) - |> Some - | Result.Error () -> - None - -let (|OptionalCoerce|) expr = - match expr with - | Expr.Op (TOp.Coerce, _, [arg], _) -> arg - | _ -> expr - -// Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression -// which only adds a 'seq' call outside of FSharp.Core -let (|OptionalSeq|_|) g amap expr = - match expr with - // use 'seq { ... }' as an indicator - | Seq g (e, elemTy) -> - Some (e, elemTy) - | _ -> - // search for the relevant element type - match tyOfExpr g expr with - | SeqElemTy g amap expr.Range elemTy -> - Some (expr, elemTy) - | _ -> None - -let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = - // If ListCollector is in FSharp.Core then this optimization kicks in - if g.ListCollector_tcr.CanDeref then - - match overallExpr with - | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> - let collectorTy = g.mk_ListCollector_ty overallElemTy - LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - - | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> - let collectorTy = g.mk_ArrayCollector_ty overallElemTy - LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - - | _ -> None - else - None diff --git a/src/fsharp/LowerCallsAndSeqs.fsi b/src/fsharp/LowerSequences.fsi similarity index 68% rename from src/fsharp/LowerCallsAndSeqs.fsi rename to src/fsharp/LowerSequences.fsi index ae761a19700..aa675cda5c0 100644 --- a/src/fsharp/LowerCallsAndSeqs.fsi +++ b/src/fsharp/LowerSequences.fsi @@ -1,17 +1,18 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerCallsAndSeqs +module internal FSharp.Compiler.LowerSequenceExpressions open FSharp.Compiler.Import +open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.Text -/// An "expr -> expr" pass that eta-expands under-applied values of -/// known arity to lambda expressions and beta-var-reduces to bind -/// any known arguments. The results are later optimized by the peephole -/// optimizer in opt.fs -val LowerImplFile: g: TcGlobals -> assembly: TypedImplFile -> TypedImplFile +/// Detect a 'seq' type +val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType option + +val callNonOverloadedILMethod: + g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr /// Analyze a TAST expression to detect the elaborated form of a sequence expression. /// Then compile it to a state machine represented as a TAST containing goto, return and label nodes. @@ -26,6 +27,3 @@ val ConvertSequenceExprToObject: (ValRef * ValRef * ValRef * ValRef list * Expr * Expr * Expr * TType * range) option val IsPossibleSequenceExpr: g: TcGlobals -> overallExpr: Expr -> bool - -val LowerComputedListOrArrayExpr: - tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr option diff --git a/src/fsharp/LowerStateMachines.fs b/src/fsharp/LowerStateMachines.fs index 65798f93ade..c0530768877 100644 --- a/src/fsharp/LowerStateMachines.fs +++ b/src/fsharp/LowerStateMachines.fs @@ -2,23 +2,19 @@ module internal FSharp.Compiler.LowerStateMachines -open System.Collections.Generic open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming -open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -let LowerStateMachineStackGuardDepth = GetEnvInteger "FSHARP_LowerStateMachine" 50 - -let mkLabelled m l e = mkCompGenSequential m (Expr.Op (TOp.Label l, [], [], m)) e +let LowerStateMachineStackGuardDepth = StackGuard.GetDepthOption "LowerStateMachines" type StateMachineConversionFirstPhaseResult = { @@ -125,13 +121,11 @@ type env = { ResumableCodeDefns: ValMap TemplateStructTy: TType option - //MachineAddrExpr: Expr option } static member Empty = { ResumableCodeDefns = ValMap.Empty TemplateStructTy = None - //MachineAddrExpr = None } /// Detect prefix of expanded, optimized state machine expressions diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 8ae36bc1d28..e4b4251178d 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -10,7 +10,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -26,6 +26,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS diff --git a/src/fsharp/MethodCalls.fsi b/src/fsharp/MethodCalls.fsi index e6b94be5b3f..b8fe0a53560 100644 --- a/src/fsharp/MethodCalls.fsi +++ b/src/fsharp/MethodCalls.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.MethodCalls open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 5e5e040d76d..9da0e71f765 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -7,7 +7,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.Features @@ -20,6 +20,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //------------------------------------------------------------------------- diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 1ed0a835f9e..6e927ff49c8 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -32,6 +32,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders @@ -1315,7 +1316,7 @@ and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs /// Add an F# exception definition to the name resolution environment let AddExceptionDeclsToNameEnv bulkAddMode nenv (ecref: TyconRef) = - assert ecref.IsExceptionDecl + assert ecref.IsFSharpException let item = Item.ExnCase ecref {nenv with eUnqualifiedItems = @@ -1524,8 +1525,8 @@ let AddResults res1 res2 = | Exception (UndefinedName(n1, _, _, _) as e1), Exception (UndefinedName(n2, _, _, _) as e2) -> if n1 < n2 then Exception e2 else Exception e1 // Prefer more concrete errors about things being undefined - | Exception (UndefinedName _ as e1), Exception (Error _) -> Exception e1 - | Exception (Error _), Exception (UndefinedName _ as e2) -> Exception e2 + | Exception (UndefinedName _ as e1), Exception (DiagnosticWithText _) -> Exception e1 + | Exception (DiagnosticWithText _), Exception (UndefinedName _ as e2) -> Exception e2 | Exception e1, Exception _ -> Exception e1 let NoResultsOrUsefulErrors = Result [] @@ -1840,14 +1841,23 @@ let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = [] type CapturedNameResolution(i: Item, tpinst, io: ItemOccurence, nre: NameResolutionEnv, ad: AccessorDomain, m: range) = - member this.Pos = m.End - member this.Item = i - member this.ItemWithInst = ({ Item = i; TyparInst = tpinst } : ItemWithInst) - member this.ItemOccurence = io - member this.DisplayEnv = nre.DisplayEnv - member this.NameResolutionEnv = nre - member this.AccessorDomain = ad - member this.Range = m + + member _.Pos = m.End + + member _.Item = i + + member _.ItemWithInst = ({ Item = i; TyparInst = tpinst } : ItemWithInst) + + member _.ItemOccurence = io + + member _.DisplayEnv = nre.DisplayEnv + + member _.NameResolutionEnv = nre + + member _.AccessorDomain = ad + + member _.Range = m + member this.DebugToString() = sprintf "%A: %+A" (this.Pos.Line, this.Pos.Column) i @@ -1860,10 +1870,13 @@ type TcResolutions static let empty = TcResolutions(ResizeArray 0, ResizeArray 0, ResizeArray 0, ResizeArray 0) - member this.CapturedEnvs = capturedEnvs - member this.CapturedExpressionTypings = capturedExprTypes - member this.CapturedNameResolutions = capturedNameResolutions - member this.CapturedMethodGroupResolutions = capturedMethodGroupResolutions + member _.CapturedEnvs = capturedEnvs + + member _.CapturedExpressionTypings = capturedExprTypes + + member _.CapturedNameResolutions = capturedNameResolutions + + member _.CapturedMethodGroupResolutions = capturedMethodGroupResolutions static member Empty = empty @@ -1889,7 +1902,7 @@ type TcSymbolUses(g, capturedNameResolutions: ResizeArray ItemsAreEffectivelyEqual g item symbolUse.ItemWithInst.Item) then yield symbolUse |] - member this.AllUsesOfSymbols = allUsesOfSymbols + member _.AllUsesOfSymbols = allUsesOfSymbols - member this.GetFormatSpecifierLocationsAndArity() = formatSpecifierLocations + member _.GetFormatSpecifierLocationsAndArity() = formatSpecifierLocations static member Empty = TcSymbolUses(Unchecked.defaultof<_>, ResizeArray(), Array.empty) @@ -1968,16 +1981,16 @@ type TcResultsSinkImpl(tcGlobals, ?sourceText: ISourceText) = { SourceText = sourceText LineStartPositions = positions }) - member this.GetResolutions() = + member _.GetResolutions() = TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions) - member this.GetSymbolUses() = + member _.GetSymbolUses() = TcSymbolUses(tcGlobals, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray()) - member this.GetOpenDeclarations() = + member _.GetOpenDeclarations() = capturedOpenDeclarations |> Seq.distinctBy (fun x -> x.Range, x.AppliedScope, x.IsOwnNamespace) |> Seq.toArray - member this.GetFormatSpecifierLocations() = + member _.GetFormatSpecifierLocations() = capturedFormatSpecifierLocations.ToArray() interface ITypecheckResultsSink with @@ -4347,7 +4360,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE nenv.TyconsByDemangledNameAndArity(fullyQualified).Values |> Seq.filter (fun tcref -> not (tcref.LogicalName.Contains ",") && - not tcref.IsExceptionDecl && + not tcref.IsFSharpException && not (IsTyconUnseen ad g ncenv.amap m tcref)) |> Seq.map (ItemOfTyconRef ncenv m) |> Seq.toList @@ -4945,7 +4958,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a | Item.Types _ -> for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do - if not tcref.IsExceptionDecl + if not tcref.IsFSharpException && not (tcref.LogicalName.Contains ",") && not (IsTyconUnseen ad g ncenv.amap m tcref) then yield ItemOfTyconRef ncenv m tcref diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index ac03dbc080c..7a2312dff16 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -12,8 +12,9 @@ open Internal.Utilities.Library.Extras open Internal.Utilities.Rational open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax @@ -23,11 +24,11 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Layout open FSharp.Compiler.Text.LayoutRender open FSharp.Compiler.Text.TaggedText -open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.AccessibilityLogic +open FSharp.Compiler.TypeHierarchy +open FSharp.Compiler.Xml open FSharp.Core.Printf @@ -2063,7 +2064,7 @@ module TastDefinitionPrinting = let layoutTyconDefns denv infoReader ad m (tycons: Tycon list) = match tycons with | [] -> emptyL - | [h] when h.IsExceptionDecl -> layoutExnDefn denv infoReader (mkLocalEntityRef h) + | [h] when h.IsFSharpException -> layoutExnDefn denv infoReader (mkLocalEntityRef h) | h :: t -> let x = layoutTyconDefn denv infoReader ad m false WordL.keywordType (mkLocalEntityRef h) let xs = List.map (mkLocalEntityRef >> layoutTyconDefn denv infoReader ad m false (wordL (tagKeyword "and"))) t @@ -2174,7 +2175,7 @@ module TastDefinitionPrinting = if eref.IsModuleOrNamespace then layoutModuleOrNamespace denv infoReader ad m false eref.Deref |> layoutXmlDocOfEntity denv infoReader eref - elif eref.IsExceptionDecl then + elif eref.IsFSharpException then layoutExnDefn denv infoReader eref else layoutTyconDefn denv infoReader ad m true WordL.keywordType eref @@ -2504,7 +2505,7 @@ let minimalStringsOfTwoTypes denv t1 t2= match attempt4 with | Some res -> res | None -> - // https://github.com/Microsoft/visualfsharp/issues/2561 + // https://github.com/dotnet/fsharp/issues/2561 // still identical, we better (try to) show assembly qualified name to disambiguate let denv = denv.SetOpenPaths [] let denv = { denv with includeStaticParametersInTypeNames=true } diff --git a/src/fsharp/OptimizeInputs.fs b/src/fsharp/OptimizeInputs.fs index c40f7c3569f..97cfd577807 100644 --- a/src/fsharp/OptimizeInputs.fs +++ b/src/fsharp/OptimizeInputs.fs @@ -1,7 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -// # FSComp.SR.opts - module internal FSharp.Compiler.OptimizeInputs open System.IO @@ -80,7 +78,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM optEnvFirstLoop, isIncrementalFragment, tcConfig.fsiMultiAssemblyEmit, tcConfig.emitTailcalls, hidden, implFile) - let implFile = AutoBox.TransformImplFile tcGlobals importMap implFile + let implFile = LowerLocalMutables.TransformImplFile tcGlobals importMap implFile // Only do this on the first pass! let optSettings = { optSettings with abstractBigTargets = false; reportingPhase = false } @@ -118,7 +116,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM else implFile let implFile = - LowerCallsAndSeqs.LowerImplFile tcGlobals implFile + LowerCalls.LowerImplFile tcGlobals implFile let implFile, optEnvFinalSimplify = if tcConfig.doFinalSimplify then diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index e58d6d3a5ec..b4ebb0838c8 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -13,8 +13,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Infos +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Text.Range open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.Syntax @@ -29,6 +28,7 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypedTreePickle +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations open System.Collections.Generic @@ -379,12 +379,12 @@ type OptimizationSettings = /// Determines if we should eliminate for-loops around an expr if it has no effect /// - /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 + /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/dotnet/fsharp/pull/376 member x.EliminateForLoop = x.LocalOptimizationsEnabled /// Determines if we should eliminate try/with or try/finally around an expr if it has no effect /// - /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 + /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/dotnet/fsharp/pull/376 member _.EliminateTryWithAndTryFinally = false /// Determines if we should eliminate first part of sequential expression if it has no effect @@ -1110,7 +1110,7 @@ let OrTailcalls l = List.exists (fun x -> x.MightMakeCriticalTailcall) l let OptimizeList f l = l |> List.map f |> List.unzip -let NoExprs : Expr list * list> = [], [] +let NoExprs : Expr list * Summary list = [], [] /// Common ways of building new value infos let CombineValueInfos einfos res = @@ -1386,7 +1386,7 @@ let IsKnownOnlyMutableBeforeUse (vref: ValRef) = // | SingleUnion of int // member x.Next = let (SingleUnion i) = x in SingleUnion (i+1) // -// See https://github.com/Microsoft/visualfsharp/issues/5136 +// See https://github.com/dotnet/fsharp/issues/5136 // // // note: allocating an object with observable identity (i.e. a name) @@ -1643,7 +1643,7 @@ let rec RewriteBoolLogicTree (targets: DecisionTreeTarget[], outerCaseTree, oute and RewriteBoolLogicCase data (TCase(test, tree)) = TCase(test, RewriteBoolLogicTree data tree) -/// Repeatedly combine switch-over-match decision trees, see https://github.com/Microsoft/visualfsharp/issues/635. +/// Repeatedly combine switch-over-match decision trees, see https://github.com/dotnet/fsharp/issues/635. /// The outer decision tree is doing a switch over a boolean result, the inner match is producing only /// constant boolean results in its targets. let rec CombineBoolLogic expr = diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 2f533c7ff1c..66f55246223 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -20,7 +20,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp @@ -266,7 +266,7 @@ let DeduplicateParsedInputModuleName (moduleNamesDict: ModuleNamesDict) input = let inputT = ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput (fileName, qualNameOfFileT, scopedPragmas, hashDirectives, modules, trivia)) inputT, moduleNamesDictT -let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, defaultNamespace, fileName, isLastCompiland) = +let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: DiagnosticsLogger, lexbuf: UnicodeLexing.Lexbuf, defaultNamespace, fileName, isLastCompiland) = // The assert below is almost ok, but it fires in two cases: // - fsi.exe sometimes passes "stdin" as a dummy file name // - if you have a #line directive, e.g. @@ -275,8 +275,8 @@ let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: E // Delay sending errors and warnings until after the file is parsed. This gives us a chance to scrape the // #nowarn declarations for the file - let delayLogger = CapturingErrorLogger("Parsing") - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayLogger) + let delayLogger = CapturingDiagnosticsLogger("Parsing") + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayLogger) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let mutable scopedPragmas = [] @@ -308,8 +308,8 @@ let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: E input finally // OK, now commit the errors, since the ScopedPragmas will (hopefully) have been scraped - let filteringErrorLogger = GetErrorLoggerFilteringByScopedPragmas(false, scopedPragmas, diagnosticOptions, errorLogger) - delayLogger.CommitDelayedDiagnostics filteringErrorLogger + let filteringDiagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, scopedPragmas, diagnosticOptions, errorLogger) + delayLogger.CommitDelayedDiagnostics filteringDiagnosticsLogger type Tokenizer = unit -> Parser.token @@ -412,7 +412,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileNam TestInteractionParserAndExit (tokenizer, lexbuf) // Parse the input - let res = ParseInput((fun _ -> tokenizer ()), tcConfig.errorSeverityOptions, errorLogger, lexbuf, None, fileName, isLastCompiland) + let res = ParseInput((fun _ -> tokenizer ()), tcConfig.diagnosticsOptions, errorLogger, lexbuf, None, fileName, isLastCompiland) // Report the statistics for testing purposes if tcConfig.reportNumDecls then @@ -488,7 +488,7 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, fileName, isLastC EmptyParsedInput(fileName, isLastCompiland) /// Parse multiple input files from disk -let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorLogger: ErrorLogger, exiter: Exiter, createErrorLogger: Exiter -> CapturingErrorLogger, retryLocked) = +let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorLogger: DiagnosticsLogger, exiter: Exiter, createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, retryLocked) = try let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofList @@ -497,14 +497,14 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorL let mutable exitCode = 0 let delayedExiter = { new Exiter with - member this.Exit n = exitCode <- n; raise StopProcessing } + member _.Exit n = exitCode <- n; raise StopProcessing } // Check input files and create delayed error loggers before we try to parallel parse. - let delayedErrorLoggers = + let delayedDiagnosticsLoggers = sourceFiles |> Array.map (fun (fileName, _) -> checkInputFile tcConfig fileName - createErrorLogger(delayedExiter) + createDiagnosticsLogger(delayedExiter) ) let results = @@ -512,16 +512,16 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorL try sourceFiles |> ArrayParallel.mapi (fun i (fileName, isLastCompiland) -> - let delayedErrorLogger = delayedErrorLoggers[i] + let delayedDiagnosticsLogger = delayedDiagnosticsLoggers[i] let directoryName = Path.GetDirectoryName fileName - let input = parseInputFileAux(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayedErrorLogger, retryLocked) + let input = parseInputFileAux(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayedDiagnosticsLogger, retryLocked) (input, directoryName) ) finally - delayedErrorLoggers - |> Array.iter (fun delayedErrorLogger -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger + delayedDiagnosticsLoggers + |> Array.iter (fun delayedDiagnosticsLogger -> + delayedDiagnosticsLogger.CommitDelayedDiagnostics errorLogger ) with | StopProcessing -> @@ -968,7 +968,7 @@ let CheckOneInput /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig:TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = // 'use' ensures that the warning handler is restored at the end - use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.errorSeverityOptions, oldLogger) ) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun oldLogger -> GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.diagnosticsOptions, oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck RequireCompilationThread ctok diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 2b438899ad7..95406e74a72 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -12,7 +12,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.DependencyManager -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text @@ -35,7 +35,7 @@ val DeduplicateParsedInputModuleName: ModuleNamesDict -> ParsedInput -> ParsedIn val ParseInput: lexer: (Lexbuf -> Parser.token) * diagnosticOptions: FSharpDiagnosticOptions * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * lexbuf: Lexbuf * defaultNamespace: string option * fileName: string * @@ -62,7 +62,7 @@ val ParseOneInputStream: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * retryLocked: bool * stream: Stream -> ParsedInput @@ -73,7 +73,7 @@ val ParseOneInputSourceText: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * sourceText: ISourceText -> ParsedInput @@ -83,7 +83,7 @@ val ParseOneInputFile: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * retryLocked: bool -> ParsedInput @@ -93,7 +93,7 @@ val ParseOneInputLexbuf: lexbuf: Lexbuf * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger -> + errorLogger: DiagnosticsLogger -> ParsedInput val EmptyParsedInput: fileName: string * isLastCompiland: (bool * bool) -> ParsedInput @@ -103,9 +103,9 @@ val ParseInputFiles: tcConfig: TcConfig * lexResourceManager: Lexhelp.LexResourceManager * sourceFiles: string list * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * exiter: Exiter * - createErrorLogger: (Exiter -> CapturingErrorLogger) * + createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) * retryLocked: bool -> (ParsedInput * string) list diff --git a/src/fsharp/ParseHelpers.fs b/src/fsharp/ParseHelpers.fs index 63b99d61a17..aafb8174345 100644 --- a/src/fsharp/ParseHelpers.fs +++ b/src/fsharp/ParseHelpers.fs @@ -3,7 +3,7 @@ module FSharp.Compiler.ParseHelpers open FSharp.Compiler.AbstractIL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 94d930751f6..5c60efab813 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -10,7 +10,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax @@ -55,21 +55,21 @@ type Pattern = member this.Range = match this with - | TPat_const(_, m) -> m - | TPat_wild m -> m - | TPat_as(_, _, m) -> m - | TPat_disjs(_, m) -> m - | TPat_conjs(_, m) -> m - | TPat_query(_, _, m) -> m - | TPat_unioncase(_, _, _, m) -> m - | TPat_exnconstr(_, _, m) -> m - | TPat_tuple(_, _, _, m) -> m - | TPat_array(_, _, m) -> m - | TPat_recd(_, _, _, m) -> m - | TPat_range(_, _, m) -> m - | TPat_null m -> m - | TPat_isinst(_, _, _, m) -> m - | TPat_error m -> m + | TPat_const(_, m) -> m + | TPat_wild m -> m + | TPat_as(_, _, m) -> m + | TPat_disjs(_, m) -> m + | TPat_conjs(_, m) -> m + | TPat_query(_, _, m) -> m + | TPat_unioncase(_, _, _, m) -> m + | TPat_exnconstr(_, _, m) -> m + | TPat_tuple(_, _, _, m) -> m + | TPat_array(_, _, m) -> m + | TPat_recd(_, _, _, m) -> m + | TPat_range(_, _, m) -> m + | TPat_null m -> m + | TPat_isinst(_, _, _, m) -> m + | TPat_error m -> m and PatternValBinding = PBind of Val * TypeScheme @@ -430,9 +430,9 @@ type Implication = /// /// Example: /// match x with -/// | :? option -> ... +/// | :? (int option) -> ... /// | null -> ... -/// Nothing can be learned. If ':? option' succeeds, 'null' may still have to be run. +/// Nothing can be learned. If ':? (int option)' succeeds, 'null' may still have to be run. let computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 = if TypeNullIsTrueValue g tgtTy1 then Implication.Nothing @@ -443,9 +443,9 @@ let computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 = /// /// Example: /// match x with -/// | :? option -> ... +/// | :? (int option) -> ... /// | null -> ... -/// If ':? option' fails then 'null' will fail +/// If ':? (int option)' fails then 'null' will fail let computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = if TypeNullIsTrueValue g tgtTy1 then Implication.Fails @@ -463,8 +463,8 @@ let computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = /// Example: /// match x with /// | null -> ... -/// | :? option -> ... -/// For any inputs where 'null' succeeds, ':? option' will succeed +/// | :? (int option) -> ... +/// For any inputs where 'null' succeeds, ':? (int option)' will succeed let computeWhatSuccessfulNullTestImpliesAboutTypeTest g tgtTy2 = if TypeNullIsTrueValue g tgtTy2 then Implication.Succeeds @@ -518,8 +518,8 @@ let computeWhatSuccessfulTypeTestImpliesAboutTypeTest g amap m tgtTy1 tgtTy2 = // // This doesn't apply to types with null as true value: // match x with - // | :? option -> ... - // | :? option -> ... + // | :? (int option) -> ... + // | :? (string option) -> ... // // Here on 'null' input the first pattern succeeds, and the second pattern will also succeed elif isSealedTy g tgtTy1 && @@ -859,7 +859,7 @@ let rec BuildSwitch inpExprOpt g expr edges dflt m = compactify (Some (h :: prev :: moreprev)) t | Const.Char cprev, Const.Char cnext when (int32 cprev + 1 = int32 cnext) -> compactify (Some (h :: prev :: moreprev)) t - | _ -> (List.rev (prev :: moreprev)) :: compactify None edges + | _ -> (List.rev (prev :: moreprev)) :: compactify None edges | _ -> failwith "internal error: compactify" let edgeGroups = compactify None edges' diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 1a053ff5334..5d2179339fc 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -13,7 +13,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -26,6 +26,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //-------------------------------------------------------------------------- diff --git a/src/fsharp/QueueList.fs b/src/fsharp/QueueList.fs index cb823d0bd87..19591b66c8b 100644 --- a/src/fsharp/QueueList.fs +++ b/src/fsharp/QueueList.fs @@ -68,7 +68,7 @@ module internal QueueList = let forall f (x:QueueList<_>) = Seq.forall f x - let ofList (x:list<_>) = QueueList(x) + let ofList (x:_ list) = QueueList(x) let toList (x:QueueList<_>) = Seq.toList x diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 1c91fe606a0..050c7601157 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -9,7 +9,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.QuotationPickler open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming diff --git a/src/fsharp/ScriptClosure.fs b/src/fsharp/ScriptClosure.fs index 56846ed8510..03e1910ecef 100644 --- a/src/fsharp/ScriptClosure.fs +++ b/src/fsharp/ScriptClosure.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.ParseAndCheckInputs @@ -117,7 +117,7 @@ module ScriptPreprocessClosure = tcConfig: TcConfig, codeContext, lexResourceManager: Lexhelp.LexResourceManager, - errorLogger: ErrorLogger + errorLogger: DiagnosticsLogger ) = // fsc.exe -- COMPILED\!INTERACTIVE @@ -185,8 +185,8 @@ module ScriptPreprocessClosure = match basicReferences with | None -> - let errorLogger = CapturingErrorLogger("ScriptDefaultReferences") - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingDiagnosticsLogger("ScriptDefaultReferences") + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let references, useDotNetFramework = tcConfigB.FxResolver.GetDefaultReferences useFsiAuxLib // If the user requested .NET Core scripting but something went wrong and we reverted to @@ -357,13 +357,13 @@ module ScriptPreprocessClosure = //printfn "visiting %s" fileName if IsScript fileName || parseRequired then let parseResult, parseDiagnostics = - let errorLogger = CapturingErrorLogger("FindClosureParse") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingDiagnosticsLogger("FindClosureParse") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let result = ParseScriptClosureInput (fileName, sourceText, tcConfig, codeContext, lexResourceManager, errorLogger) result, errorLogger.Diagnostics - let errorLogger = CapturingErrorLogger("FindClosureMetaCommands") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingDiagnosticsLogger("FindClosureMetaCommands") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let pathOfMetaCommandSource = Path.GetDirectoryName fileName let preSources = tcConfig.GetAvailableLoadedSources() @@ -429,9 +429,9 @@ module ScriptPreprocessClosure = // Resolve all references. let references, unresolvedReferences, resolutionDiagnostics = - let errorLogger = CapturingErrorLogger("GetLoadClosure") + let errorLogger = CapturingDiagnosticsLogger("GetLoadClosure") - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let references, unresolvedReferences = TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig) let references = references |> List.map (fun ar -> ar.resolvedPath, ar) references, unresolvedReferences, errorLogger.Diagnostics diff --git a/src/fsharp/ScriptClosure.fsi b/src/fsharp/ScriptClosure.fsi index b6b80c8b60f..dfdc34f9dcd 100644 --- a/src/fsharp/ScriptClosure.fsi +++ b/src/fsharp/ScriptClosure.fsi @@ -9,7 +9,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.Text diff --git a/src/fsharp/SignatureConformance.fs b/src/fsharp/SignatureConformance.fs index 22dea30b046..8e31f63b248 100644 --- a/src/fsharp/SignatureConformance.fs +++ b/src/fsharp/SignatureConformance.fs @@ -10,15 +10,16 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos +open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.InfoReader +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders diff --git a/src/fsharp/StaticLinking.fs b/src/fsharp/StaticLinking.fs index 09e48552ef0..94d3c7f3f33 100644 --- a/src/fsharp/StaticLinking.fs +++ b/src/fsharp/StaticLinking.fs @@ -13,7 +13,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.OptimizeInputs open FSharp.Compiler.Text.Range @@ -197,9 +197,9 @@ let StaticLinkILModules (tcConfig:TcConfig, ilGlobals, tcImports, ilxMainModule, type Node = { name: string data: ILModuleDef - ccu: option + ccu: CcuThunk option refs: ILReferences - mutable edges: list + mutable edges: Node list mutable visited: bool } // Find all IL modules that are to be statically linked given the static linking roots. diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs index b1141eb9b8a..6c9bfee5163 100644 --- a/src/fsharp/SyntaxTreeOps.fs +++ b/src/fsharp/SyntaxTreeOps.fs @@ -3,7 +3,7 @@ module FSharp.Compiler.SyntaxTreeOps open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Syntax.PrettyNaming diff --git a/src/fsharp/TypeHierarchy.fs b/src/fsharp/TypeHierarchy.fs new file mode 100644 index 00000000000..2eec1c57ec6 --- /dev/null +++ b/src/fsharp/TypeHierarchy.fs @@ -0,0 +1,409 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.TypeHierarchy + +open System +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Import +open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTreeOps +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.Xml + +#if !NO_TYPEPROVIDERS +open FSharp.Compiler.TypeProviders +#endif + +//------------------------------------------------------------------------- +// Fold the hierarchy. +// REVIEW: this code generalizes the iteration used below for member lookup. +//------------------------------------------------------------------------- + +/// Get the base type of a type, taking into account type instantiations. Return None if the +/// type has no base type. +let GetSuperTypeOfType g amap m ty = +#if !NO_TYPEPROVIDERS + let ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref when tcref.IsProvided -> stripTyEqns g ty + | _ -> stripTyEqnsAndMeasureEqns g ty +#else + let ty = stripTyEqnsAndMeasureEqns g ty +#endif + + match metadataOfTy g ty with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata info -> + let st = info.ProvidedType + let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) + match superOpt with + | None -> None + | Some super -> Some(ImportProvidedType amap m super) +#endif + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> + let tinst = argsOfAppTy g ty + match tdef.Extends with + | None -> None + | Some ilty -> Some (RescopeAndImportILType scoref amap m tinst ilty) + + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + if isFSharpObjModelTy g ty || isFSharpExceptionTy g ty then + let tcref = tcrefOfAppTy g ty + Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) + elif isArrayTy g ty then + Some g.system_Array_ty + elif isRefTy g ty && not (isObjTy g ty) then + Some g.obj_ty + elif isStructTupleTy g ty then + Some g.system_Value_ty + elif isFSharpStructOrEnumTy g ty then + if isFSharpEnumTy g ty then + Some g.system_Enum_ty + else + Some g.system_Value_ty + elif isStructAnonRecdTy g ty then + Some g.system_Value_ty + elif isAnonRecdTy g ty then + Some g.obj_ty + elif isRecdTy g ty || isUnionTy g ty then + Some g.obj_ty + else + None + +/// Make a type for System.Collections.Generic.IList +let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = + TType_app(g.tcref_System_Collections_Generic_IList, [ty], g.knownWithoutNull) + +/// Indicates whether we can skip interface types that lie outside the reference set +[] +type SkipUnrefInterfaces = Yes | No + +let GetImmediateInterfacesOfMetadataType g amap m skipUnref ty (tcref: TyconRef) tinst = + [ + match metadataOfTy g ty with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata info -> + for ity in info.ProvidedType.PApplyArray((fun st -> st.GetInterfaces()), "GetInterfaces", m) do + ImportProvidedType amap m ity +#endif + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> + // ImportILType may fail for an interface if the assembly load set is incomplete and the interface + // comes from another assembly. In this case we simply skip the interface: + // if we don't skip it, then compilation will just fail here, and if type checking + // succeeds with fewer non-dereferencable interfaces reported then it would have + // succeeded with more reported. There are pathological corner cases where this + // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always + // assume those are present. + for ity in tdef.Implements do + if skipUnref = SkipUnrefInterfaces.No || CanRescopeAndImportILType scoref amap m ity then + RescopeAndImportILType scoref amap m tinst ity + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + for ity in tcref.ImmediateInterfaceTypesOfFSharpTycon do + instType (mkInstForAppTy g ty) ity ] + +/// Collect the set of immediate declared interface types for an F# type, but do not +/// traverse the type hierarchy to collect further interfaces. +// +// NOTE: Anonymous record types are not directly considered to implement IComparable, +// IComparable or IEquatable. This is because whether they support these interfaces depend on their +// consitutent types, which may not yet be known in type inference. +let rec GetImmediateInterfacesOfType skipUnref g amap m ty = + [ + match tryAppTy g ty with + | ValueSome(tcref, tinst) -> + // Check if this is a measure-annotated type + match tcref.TypeReprInfo with + | TMeasureableRepr reprTy -> + yield! GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy + | _ -> + yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref ty tcref tinst + + | ValueNone -> + // For tuple types, func types, check if we can eliminate to a type with metadata. + let tyWithMetadata = convertToTypeWithMetadataIfPossible g ty + match tryAppTy g tyWithMetadata with + | ValueSome (tcref, tinst) -> + if isAnyTupleTy g ty then + yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref tyWithMetadata tcref tinst + | _ -> () + + // .NET array types are considered to implement IList + if isArray1DTy g ty then + mkSystemCollectionsGenericIListTy g (destArrayTy g ty) + ] + +// Report the interfaces supported by a measure-annotated type. +// +// For example, consider: +// +// [] +// type A<[] 'm> = A +// +// This measure-annotated type is considered to support the interfaces on its representation type A, +// with the exception that +// +// 1. we rewrite the IComparable and IEquatable interfaces, so that +// IComparable --> IComparable> +// IEquatable --> IEquatable> +// +// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces +// +// This rule is conservative and only applies to IComparable and IEquatable interfaces. +// +// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. +and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = + [ + // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> + for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do + if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m ity) && + not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) then + ity + + // NOTE: we should really only report the IComparable> interface for measure-annotated types + // if the original type supports IComparable somewhere in the hierarchy, likeiwse IEquatable>. + // + // However since F# 2.0 we have always reported these interfaces for all measure-annotated types. + + //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIComparable_tcref [reprTy])) skipUnref g amap m ty then + mkAppTy g.system_GenericIComparable_tcref [ty] + + //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIEquatable_tcref [reprTy])) skipUnref g amap m ty then + mkAppTy g.system_GenericIEquatable_tcref [ty] + ] + +// Check for IComparable, IEquatable and interfaces that derive from these +and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m ity = + ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m ity + +// Check for IComparable, IEquatable and interfaces that derive from these +and ExistsInInterfaceHierarchy p skipUnref g amap m ity = + match ity with + | AppTy g (tcref, tinst) -> + p ity || + (GetImmediateInterfacesOfMetadataType g amap m skipUnref ity tcref tinst + |> List.exists (ExistsInInterfaceHierarchy p skipUnref g amap m)) + | _ -> false + +/// Indicates whether we should visit multiple instantiations of the same generic interface or not +[] +type AllowMultiIntfInstantiations = Yes | No + +/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). +/// Visit base types and interfaces first. +let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = + let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = + + let seenThisTycon = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> Set.contains tcref.Stamp visitedTycon + | _ -> false + + // Do not visit the same type twice. Could only be doing this if we've seen this tycon + if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else + + // Do not visit the same tycon twice, e.g. I and I, collect I only, unless directed to allow this + if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else + + let state = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> + let visitedTycon = Set.add tcref.Stamp visitedTycon + visitedTycon, visited.Add (tcref, ty), acc + | _ -> + state + + if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else + let visitedTycon, visited, acc = + if isInterfaceTy g ty then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) + (loop ndeep g.obj_ty state) + else + match tryDestTyparTy g ty with + | ValueSome tp -> + let state = loop (ndeep+1) g.obj_ty state + List.foldBack + (fun x vacc -> + match x with + | TyparConstraint.MayResolveMember _ + | TyparConstraint.DefaultsTo _ + | TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _ + | TyparConstraint.IsEnum _ + | TyparConstraint.IsDelegate _ + | TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _ + | TyparConstraint.SimpleChoice _ + | TyparConstraint.RequiresDefaultConstructor _ -> vacc + | TyparConstraint.CoercesTo(cty, _) -> + loop (ndeep + 1) cty vacc) + tp.Constraints + state + | _ -> + let state = + if followInterfaces then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) + state + else + state + let state = + Option.foldBack + (loop (ndeep+1)) + (GetSuperTypeOfType g amap m ty) + state + state + let acc = visitor ty acc + (visitedTycon, visited, acc) + loop 0 ty (Set.empty, TyconRefMultiMap<_>.Empty, acc) |> p33 + +/// Fold, do not follow interfaces (unless the type is itself an interface) +let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = + FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc + +/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes f g amap m ty acc + +/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () + +/// Search for one element satisfying a predicate, following interfaces +let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false + +/// Search for one element where a function returns a 'Some' result, following interfaces +let SearchEntireHierarchyOfType f g amap m ty = + FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes + (fun ty acc -> + match acc with + | None -> if f ty then Some ty else None + | Some _ -> acc) + g amap m ty None + +/// Get all super types of the type, including the type itself +let AllSuperTypesOfType g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] + +/// Get all interfaces of a type, including the type itself if it is an interface +let AllInterfacesOfType g amap m allowMultiIntfInst ty = + AllSuperTypesOfType g amap m allowMultiIntfInst ty |> List.filter (isInterfaceTy g) + +/// Check if two types have the same nominal head type +let HaveSameHeadType g ty1 ty2 = + match tryTcrefOfAppTy g ty1 with + | ValueSome tcref1 -> + match tryTcrefOfAppTy g ty2 with + | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 + | _ -> false + | _ -> false + +/// Check if a type has a particular head type +let HasHeadType g tcref ty2 = + match tryTcrefOfAppTy g ty2 with + | ValueSome tcref2 -> tyconRefEq g tcref tcref2 + | ValueNone -> false + +/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) +let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = + ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom + +/// Check if a type exists somewhere in the hierarchy which has the given head type. +let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = + ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom + +/// Read an Abstract IL type from metadata and convert to an F# type. +let ImportILTypeFromMetadata amap m scoref tinst minst ilty = + RescopeAndImportILType scoref amap m (tinst@minst) ilty + +/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. +let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilty getCattrs = + let ty = RescopeAndImportILType scoref amap m (tinst@minst) ilty + // If the type is a byref and one of attributes from a return or parameter has IsReadOnly, then it's a inref. + if isByrefTy amap.g ty && TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ()) then + mkInByrefTy amap.g (destByrefTy amap.g ty) + else + ty + +/// Get the parameter type of an IL method. +let ImportParameterTypeFromMetadata amap m ilty getCattrs scoref tinst mist = + ImportILTypeFromMetadataWithAttributes amap m scoref tinst mist ilty getCattrs + +/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and +/// translating 'void' to 'None'. +let ImportReturnTypeFromMetadata amap m ilty getCattrs scoref tinst minst = + match ilty with + | ILType.Void -> None + | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy getCattrs) + + +/// Copy constraints. If the constraint comes from a type parameter associated +/// with a type constructor then we are simply renaming type variables. If it comes +/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the +/// instantiation associated with 'ty' as well as copying the type parameters associated with +/// M and instantiating their constraints +/// +/// Note: this now looks identical to constraint instantiation. + +let CopyTyparConstraints m tprefInst (tporig: Typar) = + tporig.Constraints + |> List.map (fun tpc -> + match tpc with + | TyparConstraint.CoercesTo(ty, _) -> + TyparConstraint.CoercesTo (instType tprefInst ty, m) + | TyparConstraint.DefaultsTo(priority, ty, _) -> + TyparConstraint.DefaultsTo (priority, instType tprefInst ty, m) + | TyparConstraint.SupportsNull _ -> + TyparConstraint.SupportsNull m + | TyparConstraint.IsEnum (uty, _) -> + TyparConstraint.IsEnum (instType tprefInst uty, m) + | TyparConstraint.SupportsComparison _ -> + TyparConstraint.SupportsComparison m + | TyparConstraint.SupportsEquality _ -> + TyparConstraint.SupportsEquality m + | TyparConstraint.IsDelegate(aty, bty, _) -> + TyparConstraint.IsDelegate (instType tprefInst aty, instType tprefInst bty, m) + | TyparConstraint.IsNonNullableStruct _ -> + TyparConstraint.IsNonNullableStruct m + | TyparConstraint.IsUnmanaged _ -> + TyparConstraint.IsUnmanaged m + | TyparConstraint.IsReferenceType _ -> + TyparConstraint.IsReferenceType m + | TyparConstraint.SimpleChoice (tys, _) -> + TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys, m) + | TyparConstraint.RequiresDefaultConstructor _ -> + TyparConstraint.RequiresDefaultConstructor m + | TyparConstraint.MayResolveMember(traitInfo, _) -> + TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) + +/// The constraints for each typar copied from another typar can only be fixed up once +/// we have generated all the new constraints, e.g. f List, B :> List> ... +let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = + // Checks.. These are defensive programming against early reported errors. + let n0 = formalEnclosingTypars.Length + let n1 = tinst.Length + let n2 = tpsorig.Length + let n3 = tps.Length + if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0, n1)), m)) + if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2, n3)), m)) + + // The real code.. + let renaming, tptys = mkTyparToTyparRenaming tpsorig tps + let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming + (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) + renaming, tptys + diff --git a/src/fsharp/TypeHierarchy.fsi b/src/fsharp/TypeHierarchy.fsi new file mode 100644 index 00000000000..4e840f765bb --- /dev/null +++ b/src/fsharp/TypeHierarchy.fsi @@ -0,0 +1,174 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.TypeHierarchy + +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.Syntax +open FSharp.Compiler.Import +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.Xml +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps + +#if !NO_TYPEPROVIDERS +open FSharp.Compiler.TypeProviders +#endif + +/// Get the base type of a type, taking into account type instantiations. Return None if the +/// type has no base type. +val GetSuperTypeOfType: g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option + +/// Indicates whether we can skip interface types that lie outside the reference set +[] +type SkipUnrefInterfaces = + | Yes + | No + +/// Collect the set of immediate declared interface types for an F# type, but do not +/// traverse the type hierarchy to collect further interfaces. +val GetImmediateInterfacesOfType: + skipUnref: SkipUnrefInterfaces -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType list + +/// Indicates whether we should visit multiple instantiations of the same generic interface or not +[] +type AllowMultiIntfInstantiations = + | Yes + | No + +/// Fold, do not follow interfaces (unless the type is itself an interface) +val FoldPrimaryHierarchyOfType: + f: (TType -> 'a -> 'a) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + acc: 'a -> + 'a + +/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +val FoldEntireHierarchyOfType: + f: (TType -> 'a -> 'a) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + acc: 'a -> + 'a + +/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +val IterateEntireHierarchyOfType: + f: (TType -> unit) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + unit + +/// Search for one element satisfying a predicate, following interfaces +val ExistsInEntireHierarchyOfType: + f: (TType -> bool) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + bool + +/// Search for one element where a function returns a 'Some' result, following interfaces +val SearchEntireHierarchyOfType: + f: (TType -> bool) -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option + +/// Get all super types of the type, including the type itself +val AllSuperTypesOfType: + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + TType list + +/// Get all interfaces of a type, including the type itself if it is an interface +val AllInterfacesOfType: + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + TType list + +/// Check if two types have the same nominal head type +val HaveSameHeadType: g: TcGlobals -> ty1: TType -> ty2: TType -> bool + +/// Check if a type has a particular head type +val HasHeadType: g: TcGlobals -> tcref: TyconRef -> ty2: TType -> bool + +/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) +val ExistsSameHeadTypeInHierarchy: + g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> typeToLookFor: TType -> bool + +/// Check if a type exists somewhere in the hierarchy which has the given head type. +val ExistsHeadTypeInEntireHierarchy: + g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> tcrefToLookFor: TyconRef -> bool + +/// Read an Abstract IL type from metadata and convert to an F# type. +val ImportILTypeFromMetadata: + amap: ImportMap -> m: range -> scoref: ILScopeRef -> tinst: TType list -> minst: TType list -> ilty: ILType -> TType + +/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. +val ImportILTypeFromMetadataWithAttributes: + amap: ImportMap -> + m: range -> + scoref: ILScopeRef -> + tinst: TType list -> + minst: TType list -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + TType + +/// Get the parameter type of an IL method. +val ImportParameterTypeFromMetadata: + amap: ImportMap -> + m: range -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + scoref: ILScopeRef -> + tinst: TType list -> + mist: TType list -> + TType + +/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and +/// translating 'void' to 'None'. +val ImportReturnTypeFromMetadata: + amap: ImportMap -> + m: range -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + scoref: ILScopeRef -> + tinst: TType list -> + minst: TType list -> + TType option + +/// Copy constraints. If the constraint comes from a type parameter associated +/// with a type constructor then we are simply renaming type variables. If it comes +/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the +/// instantiation associated with 'ty' as well as copying the type parameters associated with +/// M and instantiating their constraints +/// +/// Note: this now looks identical to constraint instantiation. + +val CopyTyparConstraints: m: range -> tprefInst: TyparInst -> tporig: Typar -> TyparConstraint list + +/// The constraints for each typar copied from another typar can only be fixed up once +/// we have generated all the new constraints, e.g. f List, B :> List> ... +val FixupNewTypars: + m: range -> + formalEnclosingTypars: Typars -> + tinst: TType list -> + tpsorig: Typars -> + tps: Typars -> + TyparInst * TTypes diff --git a/src/fsharp/TypeProviders.fs b/src/fsharp/TypeProviders.fs index f7c9e752ac6..dd29a44d36d 100644 --- a/src/fsharp/TypeProviders.fs +++ b/src/fsharp/TypeProviders.fs @@ -16,7 +16,7 @@ open Internal.Utilities.FSharpEnvironment open FSharp.Core.CompilerServices open FSharp.Quotations open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Text.Range diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index ea8d5b5dd33..6cbb7547f30 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -6,12 +6,12 @@ module internal FSharp.Compiler.TypeRelations open Internal.Utilities.Collections open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Infos +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy /// Implements a :> b without coercion based on finalized (no type variable) types // Note: This relation is approximate and not part of the language specification. diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 42dddef98b8..975b28ef1c5 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -17,7 +17,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILX.Types open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.QuotationPickler @@ -812,7 +812,7 @@ type Entity = | _ -> x.entity_opt_data <- Some { Entity.NewEmptyEntityOptData() with entity_exn_info = exn_info } /// Indicates if the entity represents an F# exception declaration. - member x.IsExceptionDecl = match x.ExceptionInfo with TExnNone -> false | _ -> true + member x.IsFSharpException = match x.ExceptionInfo with TExnNone -> false | _ -> true /// Demangle the module name, if FSharpModuleWithSuffix is used member x.DemangledModuleOrNamespaceName = @@ -1933,10 +1933,10 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en member _.ActivePatternElemRefLookupTable = activePatternElemRefCache /// Get a list of types defined within this module, namespace or type. - member _.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList + member _.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsFSharpException && not x.IsModuleOrNamespace) |> Seq.toList /// Get a list of F# exception definitions defined within this module, namespace or type. - member _.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList + member _.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsFSharpException) |> Seq.toList /// Get a list of module and namespace definitions defined within this module, namespace or type. member _.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList @@ -3434,7 +3434,7 @@ type EntityRef = member x.ExceptionInfo = x.Deref.ExceptionInfo /// Indicates if the entity represents an F# exception declaration. - member x.IsExceptionDecl = x.Deref.IsExceptionDecl + member x.IsFSharpException = x.Deref.IsFSharpException /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. /// @@ -4062,7 +4062,7 @@ type TType = | TType_measure of measure: Measure /// For now, used only as a discriminant in error message. - /// See https://github.com/Microsoft/visualfsharp/issues/2561 + /// See https://github.com/dotnet/fsharp/issues/2561 member x.GetAssemblyName() = match x with | TType_forall (_tps, ty) -> ty.GetAssemblyName() diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index deecf4724db..868da58b6f3 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -14,7 +14,7 @@ open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -6217,7 +6217,7 @@ let isRecdOrUnionOrStructTyconRefDefinitelyMutable (tcref: TyconRef) = tycon.UnionCasesArray |> Array.exists isUnionCaseDefinitelyMutable elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then // Note: This only looks at the F# fields, causing oddities. - // See https://github.com/Microsoft/visualfsharp/pull/4576 + // See https://github.com/dotnet/fsharp/pull/4576 tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldDefinitelyMutable else false @@ -10085,3 +10085,96 @@ let ComputeUseMethodImpl g (v: Val) = (tcref.GeneratedHashAndEqualsWithComparerValues.IsSome && typeEquiv g oty g.mk_IStructuralEquatable_ty) not isStructural)) + +let (|Seq|_|) g expr = + match expr with + // use 'seq { ... }' as an indicator + | ValApp g g.seq_vref ([elemTy], [e], _m) -> Some (e, elemTy) + | _ -> None + +/// Detect a 'yield x' within a 'seq { ... }' +let (|SeqYield|_|) g expr = + match expr with + | ValApp g g.seq_singleton_vref (_, [arg], m) -> Some (arg, m) + | _ -> None + +/// Detect a 'expr; expr' within a 'seq { ... }' +let (|SeqAppend|_|) g expr = + match expr with + | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> Some (arg1, arg2, m) + | _ -> None + +let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals + +/// Detect a 'while gd do expr' within a 'seq { ... }' +let (|SeqWhile|_|) g expr = + match expr with + | ValApp g g.seq_generated_vref (_, [Expr.Lambda (_, _, _, [dummyv], guardExpr, _, _);innerExpr], m) + when not (isVarFreeInExpr dummyv guardExpr) -> + + // The debug point for 'while' is attached to the innerExpr, see TcSequenceExpression + let mWhile = innerExpr.Range + let spWhile = match mWhile.NotedSourceConstruct with NotedSourceConstruct.While -> DebugPointAtWhile.Yes mWhile | _ -> DebugPointAtWhile.No + Some (guardExpr, innerExpr, spWhile, m) + + | _ -> + None + +let (|SeqTryFinally|_|) g expr = + match expr with + | ValApp g g.seq_finally_vref (_, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _) as arg2], m) + when not (isVarFreeInExpr dummyv compensation) -> + + // The debug point for 'try' and 'finally' are attached to the first and second arguments + // respectively, see TcSequenceExpression + let mTry = arg1.Range + let mFinally = arg2.Range + let spTry = match mTry.NotedSourceConstruct with NotedSourceConstruct.Try -> DebugPointAtTry.Yes mTry | _ -> DebugPointAtTry.No + let spFinally = match mFinally.NotedSourceConstruct with NotedSourceConstruct.Finally -> DebugPointAtFinally.Yes mFinally | _ -> DebugPointAtFinally.No + + Some (arg1, compensation, spTry, spFinally, m) + + | _ -> + None + +let (|SeqUsing|_|) g expr = + match expr with + | ValApp g g.seq_using_vref ([_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, mBind, _)], m) -> + // The debug point mFor at the 'use x = ... ' gets attached to the lambda + let spBind = match mBind.NotedSourceConstruct with NotedSourceConstruct.Binding -> DebugPointAtBinding.Yes mBind | _ -> DebugPointAtBinding.NoneAtInvisible + Some (resource, v, body, elemTy, spBind, m) + | _ -> + None + +let (|SeqForEach|_|) g expr = + match expr with + // Nested for loops are represented by calls to Seq.collect + | ValApp g g.seq_collect_vref ([_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> + // The debug point mIn at the 'in' gets attached to the first argument, see TcSequenceExpression + let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No + Some (inp, v, body, genElemTy, mFor, mIn, spIn) + + // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. + | ValApp g g.seq_map_vref ([_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> + let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No + // The debug point mFor at the 'for' gets attached to the first argument, see TcSequenceExpression + Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) + + | _ -> None + +let (|SeqDelay|_|) g expr = + match expr with + | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) + when not (isVarFreeInExpr v e) -> + Some (e, elemTy) + | _ -> None + +let (|SeqEmpty|_|) g expr = + match expr with + | ValApp g g.seq_empty_vref (_, [], m) -> Some m + | _ -> None + +let isFSharpExceptionTy g ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> tcref.IsFSharpException + | _ -> false diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 76819d6d2fd..045425f3513 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -2609,3 +2609,33 @@ val (|IfThenElseExpr|_|): expr: Expr -> (Expr * Expr * Expr) option /// Determine if a value is a method implementing an interface dispatch slot using a private method impl val ComputeUseMethodImpl: g: TcGlobals -> v: Val -> bool + +/// Detect the de-sugared form of a 'yield x' within a 'seq { ... }' +val (|SeqYield|_|): TcGlobals -> Expr -> (Expr * range) option + +/// Detect the de-sugared form of a 'expr; expr' within a 'seq { ... }' +val (|SeqAppend|_|): TcGlobals -> Expr -> (Expr * Expr * range) option + +/// Detect the de-sugared form of a 'while gd do expr' within a 'seq { ... }' +val (|SeqWhile|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtWhile * range) option + +/// Detect the de-sugared form of a 'try .. finally .. ' within a 'seq { ... }' +val (|SeqTryFinally|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtTry * DebugPointAtFinally * range) option + +/// Detect the de-sugared form of a 'use x = ..' within a 'seq { ... }' +val (|SeqUsing|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * DebugPointAtBinding * range) option + +/// Detect the de-sugared form of a 'for x in collection do ..' within a 'seq { ... }' +val (|SeqForEach|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * range * range * DebugPointAtInOrTo) option + +/// Detect the outer 'Seq.delay' added for a construct 'seq { ... }' +val (|SeqDelay|_|): TcGlobals -> Expr -> (Expr * TType) option + +/// Detect a 'Seq.empty' implicit in the implied 'else' branch of an 'if .. then' in a seq { ... } +val (|SeqEmpty|_|): TcGlobals -> Expr -> range option + +/// Detect a 'seq { ... }' expression +val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option + +/// Indicates if an F# type is the type associated with an F# exception declaration +val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 34edb759454..010e2939431 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -17,7 +17,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.Syntax @@ -1616,7 +1616,7 @@ let rec p_normalized_measure unt st = // numerator and denominator) is used only when absolutely necessary, maintaining // compatibility of formats with versions prior to F# 4.0. // -// See https://github.com/Microsoft/visualfsharp/issues/69 +// See https://github.com/dotnet/fsharp/issues/69 let p_measure_expr unt st = p_normalized_measure (normalizeMeasure st.oglobals unt) st let u_rational st = diff --git a/src/fsharp/XmlDoc.fs b/src/fsharp/XmlDoc.fs index 8f0618ba0a2..81caa767298 100644 --- a/src/fsharp/XmlDoc.fs +++ b/src/fsharp/XmlDoc.fs @@ -9,7 +9,7 @@ open System.Xml open System.Xml.Linq open Internal.Utilities.Library open Internal.Utilities.Collections -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text open FSharp.Compiler.Text.Range diff --git a/src/fsharp/XmlDocFileWriter.fs b/src/fsharp/XmlDocFileWriter.fs index 882b31c4000..813dad3163c 100644 --- a/src/fsharp/XmlDocFileWriter.fs +++ b/src/fsharp/XmlDocFileWriter.fs @@ -5,7 +5,7 @@ module internal FSharp.Compiler.XmlDocFileWriter open System.IO open System.Reflection open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text open FSharp.Compiler.Xml diff --git a/src/fsharp/absil/il.fs b/src/fsharp/absil/il.fs index 5966811ff21..a972c7cd4b1 100644 --- a/src/fsharp/absil/il.fs +++ b/src/fsharp/absil/il.fs @@ -1269,7 +1269,7 @@ type ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } -type ILLocals = list +type ILLocals = ILLocal list [] type ILDebugImport = @@ -1547,7 +1547,7 @@ type ILParameter = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex -type ILParameters = list +type ILParameters = ILParameter list [] type ILReturn = @@ -2564,9 +2564,9 @@ let mkILSimpleTypar nm = CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs MetadataIndex = NoMetadataIdx } -let gparam_of_gactual (_ga: ILType) = mkILSimpleTypar "T" +let genericParamOfGenericActual (_ga: ILType) = mkILSimpleTypar "T" -let mkILFormalTypars (x: ILGenericArgsList) = List.map gparam_of_gactual x +let mkILFormalTypars (x: ILGenericArgsList) = List.map genericParamOfGenericActual x let mkILFormalGenericArgs numtypars (gparams: ILGenericParameterDefs) = List.mapi (fun n _gf -> mkILTyvarTy (uint16 (numtypars + n))) gparams @@ -3192,10 +3192,10 @@ let cdef_cctorCode2CodeOrCreate tag imports f (cd: ILTypeDef) = cd.With(methods = methods) -let code_of_mdef (md: ILMethodDef) = +let codeOfMethodDef (md: ILMethodDef) = match md.Code with | Some x -> x - | None -> failwith "code_of_mdef: not IL" + | None -> failwith "codeOfmdef: not IL" let mkRefToILMethod (tref, md: ILMethodDef) = mkILMethRef (tref, md.CallingConv, md.Name, md.GenericParams.Length, md.ParameterTypes, md.Return.Type) @@ -3244,19 +3244,19 @@ type ILLocalsAllocator (preAlloc: int) = member tmps.Close() = ResizeArray.toList newLocals -let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap ((fun (f: ILFieldDef) -> f.Name), l)) +let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap ((fun (fdef: ILFieldDef) -> fdef.Name), l)) let mkILFields l = mkILFieldsLazy (notlazy l) let emptyILFields = mkILFields [] -let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap ((fun (e: ILEventDef) -> e.Name), l)) +let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap ((fun (edef: ILEventDef) -> edef.Name), l)) let mkILEvents l = mkILEventsLazy (notlazy l) let emptyILEvents = mkILEvents [] -let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap ((fun (p: ILPropertyDef) -> p.Name), l) ) +let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap ((fun (pdef: ILPropertyDef) -> pdef.Name), l) ) let mkILProperties l = mkILPropertiesLazy (notlazy l) @@ -3486,9 +3486,9 @@ let computeILEnumInfo (mdName, mdFields: ILFieldDefs) = match (List.partition (fun (fd: ILFieldDef) -> fd.IsStatic) (mdFields.AsList())) with | staticFields, [vfd] -> { enumType = vfd.FieldType - enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": static field does not have an default value"))) } - | _, [] -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": no non-static field found") - | _, _ -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": more than one non-static field found") + enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": static field does not have an default value"))) } + | _, [] -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": no non-static field found") + | _, _ -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": more than one non-static field found") //--------------------------------------------------------------------- // Primitives to help read signatures. These do not use the file cursor, but @@ -3547,17 +3547,17 @@ let sigptr_get_u64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr uint64 u, sigptr -let float32_of_bits (x: int32) = BitConverter.ToSingle (BitConverter.GetBytes x, 0) +let float32OfBits (x: int32) = BitConverter.ToSingle (BitConverter.GetBytes x, 0) -let float_of_bits (x: int64) = BitConverter.Int64BitsToDouble x +let floatOfBits (x: int64) = BitConverter.Int64BitsToDouble x let sigptr_get_ieee32 bytes sigptr = let u, sigptr = sigptr_get_i32 bytes sigptr - float32_of_bits u, sigptr + float32OfBits u, sigptr let sigptr_get_ieee64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr - float_of_bits u, sigptr + floatOfBits u, sigptr let sigptr_get_intarray n (bytes: byte[]) sigptr = let res = Bytes.zeroCreate n @@ -3651,13 +3651,13 @@ let u32AsBytes (i: uint32) = i32AsBytes (int32 i) let u64AsBytes (i: uint64) = i64AsBytes (int64 i) -let bits_of_float32 (x: float32) = BitConverter.ToInt32 (BitConverter.GetBytes x, 0) +let bitsOfSingle (x: float32) = BitConverter.ToInt32 (BitConverter.GetBytes x, 0) -let bits_of_float (x: float) = BitConverter.DoubleToInt64Bits x +let bitsOfDouble (x: float) = BitConverter.DoubleToInt64Bits x -let ieee32AsBytes i = i32AsBytes (bits_of_float32 i) +let ieee32AsBytes i = i32AsBytes (bitsOfSingle i) -let ieee64AsBytes i = i64AsBytes (bits_of_float i) +let ieee64AsBytes i = i64AsBytes (bitsOfDouble i) let et_END = 0x00uy let et_VOID = 0x01uy @@ -3859,7 +3859,7 @@ let encodeCustomAttrNamedArg (nm, ty, prop, elem) = yield! encodeCustomAttrString nm yield! encodeCustomAttrValue ty elem |] -let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: list<_>) (namedArgs: list<_>) = +let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: _ list) (namedArgs: _ list) = let argTys = mspec.MethodRef.ArgTypes [| yield! [| 0x01uy; 0x00uy; |] for argTy, fixedArg in Seq.zip argTys fixedArgs do @@ -3868,11 +3868,11 @@ let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: list<_>) (namedArgs: for namedArg in namedArgs do yield! encodeCustomAttrNamedArg namedArg |] -let encodeCustomAttr (mspec: ILMethodSpec, fixedArgs: list<_>, namedArgs: list<_>) = +let encodeCustomAttr (mspec: ILMethodSpec, fixedArgs, namedArgs) = let args = encodeCustomAttrArgs mspec fixedArgs namedArgs ILAttribute.Encoded (mspec, args, fixedArgs @ (namedArgs |> List.map (fun (_, _, _, e) -> e))) -let mkILCustomAttribMethRef (mspec: ILMethodSpec, fixedArgs: list<_>, namedArgs: list<_>) = +let mkILCustomAttribMethRef (mspec: ILMethodSpec, fixedArgs, namedArgs) = encodeCustomAttr (mspec, fixedArgs, namedArgs) let mkILCustomAttribute (tref, argTys, argvs, propvs) = @@ -3892,7 +3892,7 @@ let getCustomAttrData cattr = // as a compressed int to indicate the size followed by an array of UTF8 characters.) // - A set of properties, encoded as the named arguments to a custom attribute would be (as // in §23.3, beginning with NumNamed). -let mkPermissionSet (action, attributes: list) = +let mkPermissionSet (action, attributes: (ILTypeRef * (string * ILType * ILAttribElem) list) list) = let bytes = [| yield (byte '.') yield! z_unsigned_int attributes.Length @@ -4104,8 +4104,8 @@ let decodeILAttribData (ca: ILAttribute) = try let parser = ILTypeSigParser n parser.ParseTypeSpec(), sigptr - with e -> - failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" e.Message) + with exn -> + failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" exn.Message) | ILType.Boxed tspec when tspec.Name = "System.Object" -> let et, sigptr = sigptr_get_u8 bytes sigptr if et = 0xFFuy then @@ -4197,116 +4197,119 @@ let emptyILRefs = MethodReferences = [||] FieldReferences = [||] } -(* Now find references. *) -let refs_of_assemblyRef (s: ILReferencesAccumulator) x = s.refsA.Add x |> ignore +let refsOfILAssemblyRef (s: ILReferencesAccumulator) x = + s.refsA.Add x |> ignore -let refs_of_modref (s: ILReferencesAccumulator) x = s.refsM.Add x |> ignore +let refsOfILModuleRef (s: ILReferencesAccumulator) x = + s.refsM.Add x |> ignore -let refs_of_scoref s x = +let refsOfScopeRef s x = match x with | ILScopeRef.Local -> () - | ILScopeRef.Assembly assemblyRef -> refs_of_assemblyRef s assemblyRef - | ILScopeRef.Module modref -> refs_of_modref s modref - | ILScopeRef.PrimaryAssembly -> refs_of_assemblyRef s s.ilg.primaryAssemblyRef + | ILScopeRef.Assembly assemblyRef -> refsOfILAssemblyRef s assemblyRef + | ILScopeRef.Module modref -> refsOfILModuleRef s modref + | ILScopeRef.PrimaryAssembly -> refsOfILAssemblyRef s s.ilg.primaryAssemblyRef -let refs_of_tref s (x: ILTypeRef) = refs_of_scoref s x.Scope +let refsOfILTypeRef s (x: ILTypeRef) = refsOfScopeRef s x.Scope -let rec refs_of_typ s x = +let rec refsOfILType s x = match x with | ILType.Void | ILType.TypeVar _ -> () - | ILType.Modified (_, ty1, ty2) -> refs_of_tref s ty1; refs_of_typ s ty2 + | ILType.Modified (_, ty1, ty2) -> refsOfILTypeRef s ty1; refsOfILType s ty2 | ILType.Array (_, ty) - | ILType.Ptr ty | ILType.Byref ty -> refs_of_typ s ty - | ILType.Value tr | ILType.Boxed tr -> refs_of_tspec s tr - | ILType.FunctionPointer mref -> refs_of_callsig s mref + | ILType.Ptr ty | ILType.Byref ty -> refsOfILType s ty + | ILType.Value tr | ILType.Boxed tr -> refsOfILTypeSpec s tr + | ILType.FunctionPointer mref -> refsOfILCallsig s mref -and refs_of_inst s i = refs_of_tys s i +and refsOfILTypeSpec s (x: ILTypeSpec) = + refsOfILTypeRef s x.TypeRef + refsOfILTypes s x.GenericArgs -and refs_of_tspec s (x: ILTypeSpec) = refs_of_tref s x.TypeRef; refs_of_inst s x.GenericArgs +and refsOfILCallsig s csig = + refsOfILTypes s csig.ArgTypes + refsOfILType s csig.ReturnType -and refs_of_callsig s csig = refs_of_tys s csig.ArgTypes; refs_of_typ s csig.ReturnType +and refsOfILGenericParam s x = + refsOfILTypes s x.Constraints -and refs_of_genparam s x = refs_of_tys s x.Constraints +and refsOfILGenericParams s b = + List.iter (refsOfILGenericParam s) b -and refs_of_genparams s b = List.iter (refs_of_genparam s) b - -and refs_of_dloc s ts = refs_of_tref s ts - -and refs_of_mref s (x: ILMethodRef) = - refs_of_dloc s x.DeclaringTypeRef - refs_of_tys s x.mrefArgs - refs_of_typ s x.mrefReturn +and refsOfILMethodRef s (x: ILMethodRef) = + refsOfILTypeRef s x.DeclaringTypeRef + refsOfILTypes s x.mrefArgs + refsOfILType s x.mrefReturn s.refsMs.Add x |> ignore -and refs_of_fref s x = - refs_of_tref s x.DeclaringTypeRef - refs_of_typ s x.Type +and refsOfILFieldRef s x = + refsOfILTypeRef s x.DeclaringTypeRef + refsOfILType s x.Type s.refsFs.Add x |> ignore -and refs_of_ospec s (OverridesSpec (mref, ty)) = - refs_of_mref s mref - refs_of_typ s ty +and refsOfILOverridesSpec s (OverridesSpec (mref, ty)) = + refsOfILMethodRef s mref + refsOfILType s ty -and refs_of_mspec s (x: ILMethodSpec) = - refs_of_mref s x.MethodRef - refs_of_typ s x.DeclaringType - refs_of_inst s x.GenericArgs +and refsOfILMethodSpec s (x: ILMethodSpec) = + refsOfILMethodRef s x.MethodRef + refsOfILType s x.DeclaringType + refsOfILTypes s x.GenericArgs -and refs_of_fspec s x = - refs_of_fref s x.FieldRef - refs_of_typ s x.DeclaringType +and refsOfILFieldSpec s x = + refsOfILFieldRef s x.FieldRef + refsOfILType s x.DeclaringType -and refs_of_tys s l = List.iter (refs_of_typ s) l +and refsOfILTypes s l = List.iter (refsOfILType s) l -and refs_of_token s x = +and refsOfILToken s x = match x with - | ILToken.ILType ty -> refs_of_typ s ty - | ILToken.ILMethod mr -> refs_of_mspec s mr - | ILToken.ILField fr -> refs_of_fspec s fr - -and refs_of_attrib_elem s (e: ILAttribElem) = - match e with - | Type (Some ty) -> refs_of_typ s ty - | TypeRef (Some tref) -> refs_of_tref s tref + | ILToken.ILType ty -> refsOfILType s ty + | ILToken.ILMethod mr -> refsOfILMethodSpec s mr + | ILToken.ILField fr -> refsOfILFieldSpec s fr + +and refsOfILCustomAttrElem s (elem: ILAttribElem) = + match elem with + | Type (Some ty) -> refsOfILType s ty + | TypeRef (Some tref) -> refsOfILTypeRef s tref | Array (ty, els) -> - refs_of_typ s ty - refs_of_attrib_elems s els + refsOfILType s ty + refsOfILCustomAttrElems s els | _ -> () -and refs_of_attrib_elems s els = - els |> List.iter (refs_of_attrib_elem s) +and refsOfILCustomAttrElems s els = + els |> List.iter (refsOfILCustomAttrElem s) -and refs_of_custom_attr s (cattr: ILAttribute) = - refs_of_mspec s cattr.Method - refs_of_attrib_elems s cattr.Elements +and refsOfILCustomAttr s (cattr: ILAttribute) = + refsOfILMethodSpec s cattr.Method + refsOfILCustomAttrElems s cattr.Elements -and refs_of_custom_attrs s (cas : ILAttributes) = - cas.AsArray() |> Array.iter (refs_of_custom_attr s) +and refsOfILCustomAttrs s (cas : ILAttributes) = + cas.AsArray() |> Array.iter (refsOfILCustomAttr s) -and refs_of_varargs s tyso = - Option.iter (refs_of_tys s) tyso +and refsOfILVarArgs s tyso = + Option.iter (refsOfILTypes s) tyso -and refs_of_instr s x = +and refsOfILInstr s x = match x with | I_call (_, mr, varargs) | I_newobj (mr, varargs) | I_callvirt (_, mr, varargs) -> - refs_of_mspec s mr - refs_of_varargs s varargs + refsOfILMethodSpec s mr + refsOfILVarArgs s varargs | I_callconstraint (_, tr, mr, varargs) -> - refs_of_typ s tr - refs_of_mspec s mr - refs_of_varargs s varargs + refsOfILType s tr + refsOfILMethodSpec s mr + refsOfILVarArgs s varargs | I_calli (_, callsig, varargs) -> - refs_of_callsig s callsig; refs_of_varargs s varargs + refsOfILCallsig s callsig; refsOfILVarArgs s varargs | I_jmp mr | I_ldftn mr | I_ldvirtftn mr -> - refs_of_mspec s mr + refsOfILMethodSpec s mr | I_ldsfld (_, fr) | I_ldfld (_, _, fr) | I_ldsflda fr | I_ldflda fr | I_stsfld (_, fr) | I_stfld (_, _, fr) -> - refs_of_fspec s fr + refsOfILFieldSpec s fr | I_isinst ty | I_castclass ty | I_cpobj ty | I_initobj ty | I_ldobj (_, _, ty) | I_stobj (_, _, ty) | I_box ty |I_unbox ty | I_unbox_any ty | I_sizeof ty | I_ldelem_any (_, ty) | I_ldelema (_, _, _, ty) |I_stelem_any (_, ty) | I_newarr (_, ty) | I_mkrefany ty | I_refanyval ty - | EI_ilzero ty -> refs_of_typ s ty - | I_ldtoken token -> refs_of_token s token + | EI_ilzero ty -> refsOfILType s ty + | I_ldtoken token -> refsOfILToken s token | I_stelem _|I_ldelem _|I_ldstr _|I_switch _|I_stloc _|I_stind _ | I_starg _|I_ldloca _|I_ldloc _|I_ldind _ | I_ldarga _|I_ldarg _|I_leave _|I_br _ @@ -4319,119 +4322,117 @@ and refs_of_instr s x = | AI_ldnull | AI_dup | AI_pop | AI_ckfinite | AI_nop | AI_ldc _ | I_seqpoint _ | EI_ldlen_multi _ -> () -and refs_of_il_code s (c: ILCode) = - c.Instrs |> Array.iter (refs_of_instr s) - c.Exceptions |> List.iter (fun e -> e.Clause |> (function - | ILExceptionClause.TypeCatch (ilty, _) -> refs_of_typ s ilty - | _ -> ())) +and refsOfILCode s (c: ILCode) = + for i in c.Instrs do + refsOfILInstr s i + + for exnClause in c.Exceptions do + match exnClause.Clause with + | ILExceptionClause.TypeCatch (ilty, _) -> refsOfILType s ilty + | _ -> () -and refs_of_ilmbody s (il: ILMethodBody) = - List.iter (refs_of_local s) il.Locals - refs_of_il_code s il.Code +and refsOfILMethodBody s (il: ILMethodBody) = + List.iter (refsOfILLocal s) il.Locals + refsOfILCode s il.Code -and refs_of_local s loc = refs_of_typ s loc.Type +and refsOfILLocal s loc = refsOfILType s loc.Type -and refs_of_mbody s x = +and refsOfMethodBody s x = match x with - | MethodBody.IL il -> refs_of_ilmbody s il.Value - | MethodBody.PInvoke attr -> refs_of_modref s attr.Value.Where + | MethodBody.IL il -> refsOfILMethodBody s il.Value + | MethodBody.PInvoke attr -> refsOfILModuleRef s attr.Value.Where | _ -> () -and refs_of_mdef s (md: ILMethodDef) = - List.iter (refs_of_param s) md.Parameters - refs_of_return s md.Return - refs_of_mbody s md.Body - refs_of_custom_attrs s md.CustomAttrs - refs_of_genparams s md.GenericParams - -and refs_of_param s p = refs_of_typ s p.Type - -and refs_of_return s (rt: ILReturn) = refs_of_typ s rt.Type +and refsOfILMethodDef s (md: ILMethodDef) = + List.iter (refsOfILParam s) md.Parameters + refsOfILReturn s md.Return + refsOfMethodBody s md.Body + refsOfILCustomAttrs s md.CustomAttrs + refsOfILGenericParams s md.GenericParams -and refs_of_mdefs s x = Seq.iter (refs_of_mdef s) x +and refsOfILParam s p = refsOfILType s p.Type -and refs_of_event_def s (ed: ILEventDef) = - Option.iter (refs_of_typ s) ed.EventType - refs_of_mref s ed.AddMethod - refs_of_mref s ed.RemoveMethod - Option.iter (refs_of_mref s) ed.FireMethod - List.iter (refs_of_mref s) ed.OtherMethods - refs_of_custom_attrs s ed.CustomAttrs +and refsOfILReturn s (rt: ILReturn) = refsOfILType s rt.Type -and refs_of_events s (x: ILEventDefs) = - List.iter (refs_of_event_def s) (x.AsList()) +and refsOfILMethodDefs s x = Seq.iter (refsOfILMethodDef s) x -and refs_of_property_def s (pd: ILPropertyDef) = - Option.iter (refs_of_mref s) pd.SetMethod - Option.iter (refs_of_mref s) pd.GetMethod - refs_of_typ s pd.PropertyType - refs_of_tys s pd.Args - refs_of_custom_attrs s pd.CustomAttrs +and refsOfILEventDef s (ed: ILEventDef) = + Option.iter (refsOfILType s) ed.EventType + refsOfILMethodRef s ed.AddMethod + refsOfILMethodRef s ed.RemoveMethod + Option.iter (refsOfILMethodRef s) ed.FireMethod + List.iter (refsOfILMethodRef s) ed.OtherMethods + refsOfILCustomAttrs s ed.CustomAttrs -and refs_of_properties s (x: ILPropertyDefs) = - List.iter (refs_of_property_def s) (x.AsList()) +and refsOfILEventDefs s (x: ILEventDefs) = + List.iter (refsOfILEventDef s) (x.AsList()) -and refs_of_fdef s (fd: ILFieldDef) = - refs_of_typ s fd.FieldType - refs_of_custom_attrs s fd.CustomAttrs +and refsOfILPropertyDef s (pd: ILPropertyDef) = + Option.iter (refsOfILMethodRef s) pd.SetMethod + Option.iter (refsOfILMethodRef s) pd.GetMethod + refsOfILType s pd.PropertyType + refsOfILTypes s pd.Args + refsOfILCustomAttrs s pd.CustomAttrs -and refs_of_fields s fields = - List.iter (refs_of_fdef s) fields +and refsOfILPropertyDefs s (x: ILPropertyDefs) = + List.iter (refsOfILPropertyDef s) (x.AsList()) -and refs_of_method_impls s mimpls = - List.iter (refs_of_method_impl s) mimpls +and refsOfILFieldDef s (fd: ILFieldDef) = + refsOfILType s fd.FieldType + refsOfILCustomAttrs s fd.CustomAttrs -and refs_of_method_impl s m = - refs_of_ospec s m.Overrides - refs_of_mspec s m.OverrideBy +and refsOfILFieldDefs s fields = + List.iter (refsOfILFieldDef s) fields -and refs_of_tdef_kind _s _k = () +and refsOfILMethodImpls s mimpls = + List.iter (refsOfILMethodImpl s) mimpls -and refs_of_tdef s (td : ILTypeDef) = - refs_of_types s td.NestedTypes - refs_of_genparams s td.GenericParams - refs_of_tys s td.Implements - Option.iter (refs_of_typ s) td.Extends - refs_of_mdefs s td.Methods - refs_of_fields s (td.Fields.AsList()) - refs_of_method_impls s (td.MethodImpls.AsList()) - refs_of_events s td.Events - refs_of_tdef_kind s td - refs_of_custom_attrs s td.CustomAttrs - refs_of_properties s td.Properties +and refsOfILMethodImpl s m = + refsOfILOverridesSpec s m.Overrides + refsOfILMethodSpec s m.OverrideBy -and refs_of_string _s _ = () +and refsOfILTypeDef s (td : ILTypeDef) = + refsOfILTypeDefs s td.NestedTypes + refsOfILGenericParams s td.GenericParams + refsOfILTypes s td.Implements + Option.iter (refsOfILType s) td.Extends + refsOfILMethodDefs s td.Methods + refsOfILFieldDefs s (td.Fields.AsList()) + refsOfILMethodImpls s (td.MethodImpls.AsList()) + refsOfILEventDefs s td.Events + refsOfILCustomAttrs s td.CustomAttrs + refsOfILPropertyDefs s td.Properties -and refs_of_types s (types: ILTypeDefs) = Seq.iter (refs_of_tdef s) types +and refsOfILTypeDefs s (types: ILTypeDefs) = Seq.iter (refsOfILTypeDef s) types -and refs_of_exported_type s (c: ILExportedTypeOrForwarder) = - refs_of_custom_attrs s c.CustomAttrs +and refsOfILExportedType s (c: ILExportedTypeOrForwarder) = + refsOfILCustomAttrs s c.CustomAttrs -and refs_of_exported_types s (tab: ILExportedTypesAndForwarders) = - List.iter (refs_of_exported_type s) (tab.AsList()) +and refsOfILExportedTypes s (tab: ILExportedTypesAndForwarders) = + List.iter (refsOfILExportedType s) (tab.AsList()) -and refs_of_resource_where s x = +and refsOfILResourceLocation s x = match x with | ILResourceLocation.Local _ -> () - | ILResourceLocation.File (mref, _) -> refs_of_modref s mref - | ILResourceLocation.Assembly aref -> refs_of_assemblyRef s aref + | ILResourceLocation.File (mref, _) -> refsOfILModuleRef s mref + | ILResourceLocation.Assembly aref -> refsOfILAssemblyRef s aref -and refs_of_resource s x = - refs_of_resource_where s x.Location - refs_of_custom_attrs s x.CustomAttrs +and refsOfILResource s x = + refsOfILResourceLocation s x.Location + refsOfILCustomAttrs s x.CustomAttrs -and refs_of_resources s (tab: ILResources) = - List.iter (refs_of_resource s) (tab.AsList()) +and refsOfILResources s (tab: ILResources) = + List.iter (refsOfILResource s) (tab.AsList()) -and refs_of_modul s m = - refs_of_types s m.TypeDefs - refs_of_resources s m.Resources - refs_of_custom_attrs s m.CustomAttrs - Option.iter (refs_of_manifest s) m.Manifest +and refsOfILModule s m = + refsOfILTypeDefs s m.TypeDefs + refsOfILResources s m.Resources + refsOfILCustomAttrs s m.CustomAttrs + Option.iter (refsOfILManifest s) m.Manifest -and refs_of_manifest s (m: ILAssemblyManifest) = - refs_of_custom_attrs s m.CustomAttrs - refs_of_exported_types s m.ExportedTypes +and refsOfILManifest s (m: ILAssemblyManifest) = + refsOfILCustomAttrs s m.CustomAttrs + refsOfILExportedTypes s m.ExportedTypes let computeILRefs ilg modul = let s = @@ -4442,7 +4443,7 @@ let computeILRefs ilg modul = refsMs = HashSet<_>(HashIdentity.Structural) refsFs = HashSet<_>(HashIdentity.Structural) } - refs_of_modul s modul + refsOfILModule s modul { AssemblyReferences = s.refsA.ToArray() ModuleReferences = s.refsM.ToArray() TypeReferences = s.refsTs.ToArray() diff --git a/src/fsharp/absil/il.fsi b/src/fsharp/absil/il.fsi index e8dba23f758..c3d784a77e5 100644 --- a/src/fsharp/absil/il.fsi +++ b/src/fsharp/absil/il.fsi @@ -753,7 +753,7 @@ type internal ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } -type internal ILLocals = list +type internal ILLocals = ILLocal list /// Defines an opened namespace, type relevant to a code location. /// diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 7fce4b83fcc..ac837cd6a81 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -393,7 +393,7 @@ module List = loop [] l let order (eltOrder: IComparer<'T>) = - { new IComparer> with + { new IComparer<'T list> with member _.Compare(xs, ys) = let rec loop xs ys = match xs, ys with diff --git a/src/fsharp/absil/ilmorph.fs b/src/fsharp/absil/ilmorph.fs index f26844c6e92..9ddcdf7df89 100644 --- a/src/fsharp/absil/ilmorph.fs +++ b/src/fsharp/absil/ilmorph.fs @@ -25,7 +25,7 @@ let code_instr2instrs f (code: ILCode) = let mutable nw = 0 for instr in instrs do adjust[old] <- nw - let instrs : list<_> = f instr + let instrs : _ list = f instr for instr2 in instrs do codebuf.Add instr2 nw <- nw + 1 diff --git a/src/fsharp/absil/ilread.fs b/src/fsharp/absil/ilread.fs index 6f2ff19cef2..32ad2e8ca88 100644 --- a/src/fsharp/absil/ilread.fs +++ b/src/fsharp/absil/ilread.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.BinaryConstants open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Support -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open System.Reflection diff --git a/src/fsharp/absil/ilreflect.fs b/src/fsharp/absil/ilreflect.fs index 0710fb71442..35339c31abf 100644 --- a/src/fsharp/absil/ilreflect.fs +++ b/src/fsharp/absil/ilreflect.fs @@ -13,7 +13,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open FSharp.Core.Printf @@ -718,7 +718,7 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = // we should reject methods which don't satisfy parameter types by also checking // type parameters which can be contravariant for delegates for example - // see https://github.com/Microsoft/visualfsharp/issues/2411 + // see https://github.com/dotnet/fsharp/issues/2411 // without this check, subsequent call to convTypes would fail because it // constructs generic type without checking constraints if not (satisfiesAllParameters mrefParameterTypes haveArgTs) then false else diff --git a/src/fsharp/absil/ilwrite.fs b/src/fsharp/absil/ilwrite.fs index 8ea0727798f..b0e77e253f7 100644 --- a/src/fsharp/absil/ilwrite.fs +++ b/src/fsharp/absil/ilwrite.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.Support open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.StrongNameSign open FSharp.Compiler.AbstractIL.ILPdbWriter -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index 5f809518f4f..a6a5bb8afb0 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -16,7 +16,7 @@ open Internal.Utilities open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Support open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range diff --git a/src/fsharp/block.fsi b/src/fsharp/block.fsi deleted file mode 100644 index 13f53ee479b..00000000000 --- a/src/fsharp/block.fsi +++ /dev/null @@ -1,63 +0,0 @@ -[] -module internal Internal.Utilities.Library.Block - -open System.Collections.Immutable - -/// Type alias for System.Collections.Immutable.ImmutableArray<'T> -type block<'T> = ImmutableArray<'T> - -/// Type alias for System.Collections.Immutable.ImmutableArray<'T>.Builder -type blockbuilder<'T> = ImmutableArray<'T>.Builder - -[] -module BlockBuilder = - - val create: size: int -> blockbuilder<'T> - -[] -module Block = - - [] - val empty<'T> : block<'T> - - val init: n: int -> f: (int -> 'T) -> block<'T> - - val iter: f: ('T -> unit) -> block<'T> -> unit - - val iteri: f: (int -> 'T -> unit) -> block<'T> -> unit - - val iter2: f: ('T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit - - val iteri2: f: (int -> 'T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit - - val map: mapper: ('T1 -> 'T2) -> block<'T1> -> block<'T2> - - val mapi: mapper: (int -> 'T1 -> 'T2) -> block<'T1> -> block<'T2> - - val concat: block> -> block<'T> - - val forall: predicate: ('T -> bool) -> block<'T> -> bool - - val forall2: predicate: ('T1 -> 'T2 -> bool) -> block<'T1> -> block<'T2> -> bool - - val tryFind: predicate: ('T -> bool) -> block<'T> -> 'T option - - val tryFindIndex: predicate: ('T -> bool) -> block<'T> -> int option - - val tryPick: chooser: ('T1 -> 'T2 option) -> block<'T1> -> 'T2 option - - val ofSeq: seq<'T> -> block<'T> - - val append: block<'T> -> block<'T> -> block<'T> - - val createOne: 'T -> block<'T> - - val filter: predicate: ('T -> bool) -> block<'T> -> block<'T> - - val exists: predicate: ('T -> bool) -> block<'T> -> bool - - val choose: chooser: ('T -> 'U option) -> block<'T> -> block<'U> - - val isEmpty: block<'T> -> bool - - val fold: folder: ('State -> 'T -> 'State) -> 'State -> block<'T> -> 'State diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 719394dcd26..c18802e084a 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -39,7 +39,7 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader open FSharp.Compiler.IO @@ -62,8 +62,8 @@ open FSharp.Compiler.BuildGraph /// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached [] -type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameForDebugging) = - inherit ErrorLogger(nameForDebugging) +type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameForDebugging) = + inherit DiagnosticsLogger(nameForDebugging) let mutable errors = 0 @@ -73,110 +73,76 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit - override x.ErrorCount = errors + override _.ErrorCount = errors - override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.errorSeverityOptions (err, severity) then + override x.DiagnosticSink(phasedError, severity) = + if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (phasedError, severity) then if errors >= tcConfigB.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) exiter.Exit 1 - x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Error) + x.HandleIssue(tcConfigB, phasedError, FSharpDiagnosticSeverity.Error) errors <- errors + 1 - match err.Exception, tcConfigB.simulateException with + match phasedError.Exception, tcConfigB.simulateException with | InternalError (msg, _), None - | Failure msg, None -> Debug.Assert(false, sprintf "Bug in compiler: %s\n%s" msg (err.Exception.ToString())) - | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (err.Exception.ToString())) + | Failure msg, None -> Debug.Assert(false, sprintf "Bug in compiler: %s\n%s" msg (phasedError.Exception.ToString())) + | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (phasedError.Exception.ToString())) | _ -> () - elif ReportDiagnosticAsWarning tcConfigB.errorSeverityOptions (err, severity) then - x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Warning) + elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (phasedError, severity) then + x.HandleIssue(tcConfigB, phasedError, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo tcConfigB.errorSeverityOptions (err, severity) then - x.HandleIssue(tcConfigB, err, severity) + elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (phasedError, severity) then + x.HandleIssue(tcConfigB, phasedError, severity) /// Create an error logger that counts and prints errors -let ConsoleErrorLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter) = - { new ErrorLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleErrorLoggerUpToMaxErrors") with +let ConsoleDiagnosticsLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter) = + { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleDiagnosticsLoggerUpToMaxErrors") with member _.HandleTooManyErrors(text : string) = DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> Printf.eprintfn "%s" text) member _.HandleIssue(tcConfigB, err, severity) = DoWithDiagnosticColor severity (fun () -> - let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.errorStyle, severity) + let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.diagnosticStyle, severity) writeViaBuffer stderr diag err stderr.WriteLine()) - } :> ErrorLogger + } :> DiagnosticsLogger /// This error logger delays the messages it receives. At the end, call ForwardDelayedDiagnostics /// to send the held messages. -type DelayAndForwardErrorLogger(exiter: Exiter, errorLoggerProvider: ErrorLoggerProvider) = - inherit CapturingErrorLogger("DelayAndForwardErrorLogger") +type DelayAndForwardDiagnosticsLogger(exiter: Exiter, errorLoggerProvider: DiagnosticsLoggerProvider) = + inherit CapturingDiagnosticsLogger("DelayAndForwardDiagnosticsLogger") member x.ForwardDelayedDiagnostics(tcConfigB: TcConfigBuilder) = - let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) x.CommitDelayedDiagnostics errorLogger and [] - ErrorLoggerProvider() = + DiagnosticsLoggerProvider() = - member this.CreateDelayAndForwardLogger exiter = DelayAndForwardErrorLogger(exiter, this) + member this.CreateDelayAndForwardLogger exiter = DelayAndForwardDiagnosticsLogger(exiter, this) - abstract CreateErrorLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> ErrorLogger + abstract CreateDiagnosticsLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> DiagnosticsLogger -/// Part of LegacyHostedCompilerForTesting -/// -/// Yet another ErrorLogger implementation, capturing the messages but only up to the maxerrors maximum -type InProcErrorLoggerProvider() = - let errors = ResizeArray() - let warnings = ResizeArray() - - member _.Provider = - { new ErrorLoggerProvider() with - - member log.CreateErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) = - - { new ErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerErrorLoggerUpToMaxErrors") with - - member this.HandleTooManyErrors text = - warnings.Add(Diagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - - member this.HandleIssue(tcConfigBuilder, err, severity) = - // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf - let diagnostics = - CollectDiagnostic - (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, - tcConfigBuilder.flatErrors, tcConfigBuilder.errorStyle, severity, err, true) - match severity with - | FSharpDiagnosticSeverity.Error -> - errors.AddRange(diagnostics) - | FSharpDiagnosticSeverity.Warning -> - warnings.AddRange(diagnostics) - | _ -> ()} - :> ErrorLogger } - - member _.CapturedErrors = errors.ToArray() - - member _.CapturedWarnings = warnings.ToArray() - -/// The default ErrorLogger implementation, reporting messages to the Console up to the maxerrors maximum +/// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider() = - inherit ErrorLoggerProvider() + inherit DiagnosticsLoggerProvider() - override this.CreateErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) = ConsoleErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) + override _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + ConsoleDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) /// Notify the exiter if any error has occurred -let AbortOnError (errorLogger: ErrorLogger, exiter : Exiter) = +let AbortOnError (errorLogger: DiagnosticsLogger, exiter : Exiter) = if errorLogger.ErrorCount > 0 then exiter.Exit 1 -let TypeCheck (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, assemblyName, niceNameGen, tcEnv0, openDecls0, inputs, exiter: Exiter) = +let TypeCheck (ctok, tcConfig, tcImports, tcGlobals, errorLogger: DiagnosticsLogger, assemblyName, niceNameGen, tcEnv0, openDecls0, inputs, exiter: Exiter) = try if isNil inputs then error(Error(FSComp.SR.fscNoImplementationFiles(), rangeStartup)) let ccuName = assemblyName @@ -416,7 +382,7 @@ type Args<'T> = Args of 'T /// - Check the inputs let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, reduceMemoryUsage: ReduceMemoryFlag, defaultCopyFSharpCore: CopyFSharpCoreFlag, - exiter: Exiter, errorLoggerProvider: ErrorLoggerProvider, disposables: DisposablesTracker) = + exiter: Exiter, errorLoggerProvider: DiagnosticsLoggerProvider, disposables: DisposablesTracker) = // See Bug 735819 let lcidFromCodePage = @@ -454,7 +420,7 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) + let _unwindEL_1 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) // Share intern'd strings across all lexing/parsing let lexResourceManager = Lexhelp.LexResourceManager() @@ -503,10 +469,10 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 - let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics errorLogger @@ -532,9 +498,9 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, ReportTime tcConfig "Parse inputs" use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - let createErrorLogger = (fun exiter -> errorLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingErrorLogger) + let createDiagnosticsLogger = (fun exiter -> errorLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) - let inputs = ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, errorLogger, exiter, createErrorLogger, (*retryLocked*)false) + let inputs = ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, errorLogger, exiter, createDiagnosticsLogger, (*retryLocked*)false) let inputs, _ = (Map.empty, inputs) ||> List.mapFold (fun state (input, x) -> @@ -600,7 +566,7 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outfile, pdbFile, dllReferences, noframework, exiter: Exiter, - errorLoggerProvider: ErrorLoggerProvider, + errorLoggerProvider: DiagnosticsLoggerProvider, disposables: DisposablesTracker, inputs: ParsedInput list) = @@ -646,7 +612,7 @@ let main1OfAst // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) + let _unwindEL_1 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines @@ -662,10 +628,10 @@ let main1OfAst exiter.Exit 1 let dependencyProvider = new DependencyProvider() - let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics errorLogger @@ -731,9 +697,9 @@ let main2(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener let oldLogger = errorLogger let errorLogger = let scopedPragmas = [ for TImplFile (pragmas=pragmas) in typedImplFiles do yield! pragmas ] - GetErrorLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.errorSeverityOptions, oldLogger) + GetDiagnosticsLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.diagnosticsOptions, oldLogger) - let _unwindEL_3 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + let _unwindEL_3 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) // Try to find an AssemblyVersion attribute let assemVerFromAttrib = @@ -770,7 +736,7 @@ let main2(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener /// - optimize /// - encode optimization data let main3(Args (ctok, tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, - errorLogger: ErrorLogger, generatedCcu: CcuThunk, outfile, typedImplFiles, + errorLogger: DiagnosticsLogger, generatedCcu: CcuThunk, outfile, typedImplFiles, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter: Exiter)) = // Encode the signature data @@ -869,7 +835,7 @@ let main4 /// Fifth phase of compilation. /// - static linking -let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, staticLinker, outfile, pdbfile, ilxMainModule, signingInfo, exiter: Exiter)) = +let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: DiagnosticsLogger, staticLinker, outfile, pdbfile, ilxMainModule, signingInfo, exiter: Exiter)) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output @@ -888,7 +854,7 @@ let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, /// Sixth phase of compilation. /// - write the binaries let main6 dynamicAssemblyCreator (Args (ctok, tcConfig, tcImports: TcImports, tcGlobals: TcGlobals, - errorLogger: ErrorLogger, ilxMainModule, outfile, pdbfile, + errorLogger: DiagnosticsLogger, ilxMainModule, outfile, pdbfile, signingInfo, exiter: Exiter)) = ReportTime tcConfig "Write .NET Binary" @@ -990,13 +956,13 @@ let main6 dynamicAssemblyCreator (Args (ctok, tcConfig, tcImports: TcImports, t ReportTime tcConfig "Exiting" /// The main (non-incremental) compilation entry point used by fsc.exe -let mainCompile +let CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, reduceMemoryUsage, defaultCopyFSharpCore, exiter: Exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) = use disposables = new DisposablesTracker() let savedOut = Console.Out - use __ = + use _ = { new IDisposable with member _.Dispose() = try @@ -1011,7 +977,7 @@ let mainCompile |> main6 dynamicAssemblyCreator /// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -let compileOfAst +let CompileFromSyntaxTrees (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, targetDll, targetPdb, dependencies, noframework, exiter, loggerProvider, inputs, tcImportsCapture, dynamicAssemblyCreator) = diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 51593c20689..8a8ba8e91bc 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -6,25 +6,45 @@ open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig -open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.Diagnostics open FSharp.Compiler.CompilerImports -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals [] -type ErrorLoggerProvider = - new: unit -> ErrorLoggerProvider - abstract CreateErrorLoggerUpToMaxErrors: tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> ErrorLogger +type DiagnosticsLoggerProvider = + new: unit -> DiagnosticsLoggerProvider + abstract CreateDiagnosticsLoggerUpToMaxErrors: + tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger -/// The default ErrorLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum +/// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider - inherit ErrorLoggerProvider + inherit DiagnosticsLoggerProvider + +/// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached +/// +/// Used only in LegacyHostedCompilerForTesting +[] +type DiagnosticsLoggerUpToMaxErrors = + inherit DiagnosticsLogger + new: tcConfigB: TcConfigBuilder * exiter: Exiter * nameForDebugging: string -> DiagnosticsLoggerUpToMaxErrors + + /// Called when an error or warning occurs + abstract HandleIssue: + tcConfigB: TcConfigBuilder * error: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + + /// Called when 'too many errors' has occurred + abstract HandleTooManyErrors: text: string -> unit + + override ErrorCount: int + + override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// The main (non-incremental) compilation entry point used by fsc.exe -val mainCompile: +val CompileFromCommandLineArguments: ctok: CompilationThreadToken * argv: string [] * legacyReferenceResolver: LegacyReferenceResolver * @@ -32,13 +52,13 @@ val mainCompile: reduceMemoryUsage: ReduceMemoryFlag * defaultCopyFSharpCore: CopyFSharpCoreFlag * exiter: Exiter * - loggerProvider: ErrorLoggerProvider * + loggerProvider: DiagnosticsLoggerProvider * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit /// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -val compileOfAst: +val CompileFromSyntaxTrees: ctok: CompilationThreadToken * legacyReferenceResolver: LegacyReferenceResolver * reduceMemoryUsage: ReduceMemoryFlag * @@ -49,15 +69,8 @@ val compileOfAst: dependencies: string list * noframework: bool * exiter: Exiter * - loggerProvider: ErrorLoggerProvider * + loggerProvider: DiagnosticsLoggerProvider * inputs: ParsedInput list * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit - -/// Part of LegacyHostedCompilerForTesting -type InProcErrorLoggerProvider = - new: unit -> InProcErrorLoggerProvider - member Provider: ErrorLoggerProvider - member CapturedWarnings: Diagnostic [] - member CapturedErrors: Diagnostic [] diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index 42458640fd6..b75934ac783 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Driver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Text @@ -73,7 +73,7 @@ let main(argv) = // has been reached (e.g. type checking failed, so don't proceed to optimization). let quitProcessExiter = { new Exiter with - member x.Exit(n) = + member _.Exit(n) = try exit n with _ -> @@ -95,7 +95,7 @@ let main(argv) = // thus we can use file-locking memory mapped files. // // This is also one of only two places where CopyFSharpCoreFlag.Yes is set. The other is in LegacyHostedCompilerForTesting. - mainCompile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) + CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) 0 with e -> diff --git a/src/fsharp/fsi/console.fs b/src/fsharp/fsi/console.fs index a828326910f..d49807d944e 100644 --- a/src/fsharp/fsi/console.fs +++ b/src/fsharp/fsi/console.fs @@ -59,7 +59,7 @@ module internal Utils = let guard(f) = try f() with e -> - FSharp.Compiler.ErrorLogger.warning(Failure(sprintf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace)) + FSharp.Compiler.DiagnosticsLogger.warning(Failure(sprintf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace)) let rec previousWordFromIdx (line: string) (idx, isInWord) = if idx < 0 then 0 else diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index b3b8c160be8..52bdb119f83 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -44,7 +44,7 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader @@ -729,9 +729,9 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) = ignoreAllErrors (fun () -> let severity = FSharpDiagnosticSeverity.Error DoWithDiagnosticColor severity (fun () -> - errorWriter.WriteLine(); - writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err; - writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.errorStyle,severity)) err; + errorWriter.WriteLine() + writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err + writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.diagnosticStyle,severity)) err errorWriter.WriteLine() errorWriter.WriteLine() errorWriter.Flush())) @@ -762,9 +762,9 @@ type internal FsiConsoleOutput(tcConfigB, outWriter:TextWriter, errorWriter:Text member _.Error = errorWriter -/// This ErrorLogger reports all warnings, but raises StopProcessing on first error or early exit -type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStdinSyphon:FsiStdinSyphon, fsiConsoleOutput: FsiConsoleOutput) = - inherit ErrorLogger("ErrorLoggerThatStopsOnFirstError") +/// This DiagnosticsLogger reports all warnings, but raises StopProcessing on first error or early exit +type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStdinSyphon:FsiStdinSyphon, fsiConsoleOutput: FsiConsoleOutput) = + inherit DiagnosticsLogger("DiagnosticsLoggerThatStopsOnFirstError") let mutable errorCount = 0 member _.SetError() = @@ -773,32 +773,32 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd member _.ResetErrorCount() = errorCount <- 0 override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.errorSeverityOptions (err, severity) then + if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (err, severity) then fsiStdinSyphon.PrintError(tcConfigB,err) errorCount <- errorCount + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) raise StopProcessing - elif ReportDiagnosticAsWarning tcConfigB.errorSeverityOptions (err, severity) then + elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (err, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,severity)) err + writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - elif ReportDiagnosticAsInfo tcConfigB.errorSeverityOptions (err, severity) then + elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (err, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Info (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,severity)) err + writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) override x.ErrorCount = errorCount -type ErrorLogger with +type DiagnosticsLogger with member x.CheckForErrors() = (x.ErrorCount > 0) /// A helper function to check if its time to abort member x.AbortOnError(fsiConsoleOutput:FsiConsoleOutput) = @@ -1091,7 +1091,7 @@ let internal SetCurrentUICultureForThread (lcid : int option) = let internal InstallErrorLoggingOnThisThread errorLogger = if progress then dprintfn "Installing logger on id=%d name=%s" Thread.CurrentThread.ManagedThreadId Thread.CurrentThread.Name - SetThreadErrorLoggerNoUnwind(errorLogger) + SetThreadDiagnosticsLoggerNoUnwind(errorLogger) SetThreadBuildPhaseNoUnwind(BuildPhase.Interactive) /// Set the input/output encoding. The use of a thread is due to a known bug on @@ -1496,7 +1496,7 @@ type internal FsiDynamicCompiler( execs // Emit the codegen results using the assembly writer - let ProcessCodegenResults (ctok, errorLogger: ErrorLogger, istate, optEnv, tcState: TcState, tcConfig, prefixPath, showTypes: bool, isIncrementalFragment, fragName, declaredImpls, ilxGenerator: IlxAssemblyGenerator, codegenResults, m) = + let ProcessCodegenResults (ctok, errorLogger: DiagnosticsLogger, istate, optEnv, tcState: TcState, tcConfig, prefixPath, showTypes: bool, isIncrementalFragment, fragName, declaredImpls, ilxGenerator: IlxAssemblyGenerator, codegenResults, m) = let emEnv = istate.emEnv // Each input is like a small separately compiled extension to a single source file. @@ -1576,7 +1576,7 @@ type internal FsiDynamicCompiler( match exec() with | Some err -> match errorLogger with - | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> + | :? DiagnosticsLoggerThatStopsOnFirstError as errorLogger -> fprintfn fsiConsoleOutput.Error "%s" (err.ToString()) errorLogger.SetError() errorLogger.AbortOnError(fsiConsoleOutput) @@ -1621,7 +1621,7 @@ type internal FsiDynamicCompiler( // Return the new state and the environment at the end of the last input, ready for further inputs. (istate,declaredImpls) - let ProcessTypedImpl (errorLogger: ErrorLogger, optEnv, tcState: TcState, tcConfig: TcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator: IlxAssemblyGenerator) = + let ProcessTypedImpl (errorLogger: DiagnosticsLogger, optEnv, tcState: TcState, tcConfig: TcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator: IlxAssemblyGenerator) = #if DEBUG // Logging/debugging if tcConfig.printAst then @@ -1643,7 +1643,7 @@ type internal FsiDynamicCompiler( errorLogger.AbortOnError(fsiConsoleOutput) codegenResults, optEnv, fragName - let ProcessInputs (ctok, errorLogger: ErrorLogger, istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent, m) = + let ProcessInputs (ctok, errorLogger: DiagnosticsLogger, istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent, m) = let optEnv = istate.optEnv let tcState = istate.tcState let ilxGenerator = istate.ilxGenerator @@ -1801,7 +1801,7 @@ type internal FsiDynamicCompiler( istate /// Evaluate the given definitions and produce a new interactive state. - member _.EvalParsedDefinitions (ctok, errorLogger: ErrorLogger, istate, showTypes, isInteractiveItExpr, defs: SynModuleDecl list) = + member _.EvalParsedDefinitions (ctok, errorLogger: DiagnosticsLogger, istate, showTypes, isInteractiveItExpr, defs: SynModuleDecl list) = let fileName = stdinMockFileName let i = nextFragmentId() let m = match defs with [] -> rangeStdin0 | _ -> List.reduce unionRanges [for d in defs -> d.Range] @@ -1818,7 +1818,7 @@ type internal FsiDynamicCompiler( processContents newState declaredImpls /// Evaluate the given expression and produce a new interactive state. - member fsiDynamicCompiler.EvalParsedExpression (ctok, errorLogger: ErrorLogger, istate, expr: SynExpr) = + member fsiDynamicCompiler.EvalParsedExpression (ctok, errorLogger: DiagnosticsLogger, istate, expr: SynExpr) = let tcConfig = TcConfig.Create (tcConfigB, validate=false) let itName = "it" @@ -1986,7 +1986,7 @@ type internal FsiDynamicCompiler( (fun _ _ -> ())) (tcConfigB, inp, Path.GetDirectoryName sourceFile, istate)) - member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, errorLogger: ErrorLogger) = + member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, errorLogger: DiagnosticsLogger) = let tcConfig = TcConfig.Create(tcConfigB,validate=false) match sourceFiles with | [] -> istate @@ -2058,7 +2058,7 @@ type internal FsiDynamicCompiler( | _ -> None - member _.AddBoundValue (ctok, errorLogger: ErrorLogger, istate, name: string, value: obj) = + member _.AddBoundValue (ctok, errorLogger: DiagnosticsLogger, istate, name: string, value: obj) = try match value with | null -> nullArg "value" @@ -2503,7 +2503,7 @@ type FsiStdinLexerProvider CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) // Create a new lexer to read a string - member this.CreateStringLexer (sourceFileName, source, errorLogger) = + member _.CreateStringLexer (sourceFileName, source, errorLogger) = let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, source) CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) @@ -2552,11 +2552,11 @@ type FsiInteractionProcessor with _ -> (istate,Completed None) - let InteractiveCatch (errorLogger: ErrorLogger) (f:_ -> _ * FsiInteractionStepStatus) istate = + let InteractiveCatch (errorLogger: DiagnosticsLogger) (f:_ -> _ * FsiInteractionStepStatus) istate = try // reset error count match errorLogger with - | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> errorLogger.ResetErrorCount() + | :? DiagnosticsLoggerThatStopsOnFirstError as errorLogger -> errorLogger.ResetErrorCount() | _ -> () f istate @@ -2603,7 +2603,7 @@ type FsiInteractionProcessor None /// Execute a single parsed interaction. Called on the GUI/execute/main thread. - let ExecInteraction (ctok, tcConfig:TcConfig, istate, action:ParsedScriptInteraction, errorLogger: ErrorLogger) = + let ExecInteraction (ctok, tcConfig:TcConfig, istate, action:ParsedScriptInteraction, errorLogger: DiagnosticsLogger) = let packageManagerDirective directive path m = let dm = fsiOptions.DependencyProvider.TryFindDependencyManagerInPath(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError m, path) match dm with @@ -2743,7 +2743,7 @@ type FsiInteractionProcessor /// /// #directive comes through with other definitions as a SynModuleDecl.HashDirective. /// We split these out for individual processing. - let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option, cancellationToken: CancellationToken) = + let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = cancellationToken.ThrowIfCancellationRequested() let action,nextAction,istate = match action with @@ -2806,7 +2806,7 @@ type FsiInteractionProcessor /// Execute a single parsed interaction which may contain multiple items to be executed /// independently - let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option, cancellationToken: CancellationToken) = + let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = let istate, completed = execParsedInteractions (ctok, tcConfig, istate, action, errorLogger, lastResult, cancellationToken) match completed with | Completed _ -> @@ -2977,7 +2977,7 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, errorLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) @@ -2994,7 +2994,7 @@ type FsiInteractionProcessor member _.EvalExpression (ctok, sourceText, scriptFileName, errorLogger) = use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) @@ -3253,7 +3253,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let fsiStdinSyphon = FsiStdinSyphon(errorWriter) let fsiConsoleOutput = FsiConsoleOutput(tcConfigB, outWriter, errorWriter) - let errorLogger = ErrorLoggerThatStopsOnFirstError(tcConfigB, fsiStdinSyphon, fsiConsoleOutput) + let errorLogger = DiagnosticsLoggerThatStopsOnFirstError(tcConfigB, fsiStdinSyphon, fsiConsoleOutput) do InstallErrorLoggingOnThisThread errorLogger // FSI error logging on main thread. @@ -3368,7 +3368,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Choice2Of2 None -> raise (FsiCompilationException(FSIstrings.SR.fsiOperationFailed(), None)) | Choice2Of2 (Some userExn) -> raise (makeNestedException userExn) - let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationErrorLogger) res = + let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationDiagnosticLogger) res = let errs = errorLogger.GetDiagnostics() let errorInfos = DiagnosticHelpers.CreateDiagnostics (errorOptions, true, scriptFile, errs, true) let userRes = @@ -3504,8 +3504,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions - let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalExpression(ctok, code, dummyScriptFileName, errorLogger) |> commitResultNonThrowing errorOptions dummyScriptFileName errorLogger @@ -3526,8 +3526,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let ctok = AssumeCompilationThreadWithoutEvidence() let cancellationToken = defaultArg cancellationToken CancellationToken.None - let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions - let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalInteraction(ctok, code, dummyScriptFileName, errorLogger, cancellationToken) |> commitResultNonThrowing errorOptions "input.fsx" errorLogger @@ -3547,8 +3547,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let errorOptions = TcConfig.Create(tcConfigB, validate = false).errorSeverityOptions - let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB, validate = false).diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalScript(ctok, filePath, errorLogger) |> commitResultNonThrowing errorOptions filePath errorLogger |> function Choice1Of2 _, errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs diff --git a/src/fsharp/fsi/fsimain.fs b/src/fsharp/fsi/fsimain.fs index 142c5b8561c..f5975dc0282 100644 --- a/src/fsharp/fsi/fsimain.fs +++ b/src/fsharp/fsi/fsimain.fs @@ -123,11 +123,11 @@ let StartServer (fsiSession : FsiEvaluationSession) (fsiServerName) = #if FSI_SERVER let server = {new Server.Shared.FSharpInteractiveServer() with - member this.Interrupt() = + member _.Interrupt() = //printf "FSI-SERVER: received CTRL-C request...\n" try fsiSession.Interrupt() - with e -> + with _ -> // Final sanity check! - catch all exns - but not expected assert false () @@ -298,8 +298,8 @@ let evaluateSession(argv: string[]) = fsiSession.Run() 0 with - | FSharp.Compiler.ErrorLogger.StopProcessingExn _ -> 1 - | FSharp.Compiler.ErrorLogger.ReportedError _ -> 1 + | FSharp.Compiler.DiagnosticsLogger.StopProcessingExn _ -> 1 + | FSharp.Compiler.DiagnosticsLogger.ReportedError _ -> 1 | e -> eprintf "Exception by fsi.exe:\n%+A\n" e; 1 // Mark the main thread as STAThread since it is a GUI thread diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index 157cdc918fd..a40ebb591be 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -10,7 +10,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Xml @@ -58,9 +58,12 @@ type AssemblyLoader = [] type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) = let typeRefToTyconRefCache = ConcurrentDictionary() - member this.g = g - member this.assemblyLoader = assemblyLoader - member this.ILTypeRefToTyconRefCache = typeRefToTyconRefCache + + member _.g = g + + member _.assemblyLoader = assemblyLoader + + member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache let CanImportILScopeRef (env: ImportMap) m scoref = @@ -640,3 +643,15 @@ let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoad } CcuThunk.Create(nm, ccuData) + +//------------------------------------------------------------------------- +// From IL types to F# types +//------------------------------------------------------------------------- + +/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. +let RescopeAndImportILType scoref amap m importInst ilty = + ilty |> rescopeILType scoref |> ImportILType amap m importInst + +let CanRescopeAndImportILType scoref amap m ilty = + ilty |> rescopeILType scoref |> CanImportILType amap m + diff --git a/src/fsharp/import.fsi b/src/fsharp/import.fsi index 975a9d56a56..acc5869615c 100644 --- a/src/fsharp/import.fsi +++ b/src/fsharp/import.fsi @@ -65,10 +65,10 @@ val internal CanImportILType: ImportMap -> range -> ILType -> bool #if !NO_TYPEPROVIDERS /// Import a provided type as an F# type. -val internal ImportProvidedType: ImportMap -> range (* TType list -> *) -> Tainted -> TType +val internal ImportProvidedType: ImportMap -> range -> Tainted -> TType /// Import a provided type reference as an F# type TyconRef -val internal ImportProvidedNamedType: ImportMap -> range (* TType list -> *) -> Tainted -> TyconRef +val internal ImportProvidedNamedType: ImportMap -> range -> Tainted -> TyconRef /// Import a provided type as an AbstractIL type val internal ImportProvidedTypeAsILType: ImportMap -> range -> Tainted -> ILType @@ -97,3 +97,10 @@ val internal ImportILAssembly: /// Import the type forwarder table for an IL assembly val internal ImportILAssemblyTypeForwarders: (unit -> ImportMap) * range * ILExportedTypesAndForwarders -> Map> + +/// Import an IL type as an F# type, first rescoping to view the metadata from the current assembly +/// being compiled. importInst gives the context for interpreting type variables. +val RescopeAndImportILType: + scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType + +val CanRescopeAndImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> ilty: ILType -> bool diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index c8ba00a3875..de977d0681b 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -7,423 +7,23 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Import open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text -open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.TypeHierarchy +open FSharp.Compiler.Xml #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders #endif -//------------------------------------------------------------------------- -// From IL types to F# types -//------------------------------------------------------------------------- - -/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. -let ImportILType scoref amap m importInst ilty = - ilty |> rescopeILType scoref |> Import.ImportILType amap m importInst - -let CanImportILType scoref amap m ilty = - ilty |> rescopeILType scoref |> Import.CanImportILType amap m - -//------------------------------------------------------------------------- -// Fold the hierarchy. -// REVIEW: this code generalizes the iteration used below for member lookup. -//------------------------------------------------------------------------- - -/// Indicates if an F# type is the type associated with an F# exception declaration -let isExnDeclTy g ty = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> tcref.IsExceptionDecl - | _ -> false - -/// Get the base type of a type, taking into account type instantiations. Return None if the -/// type has no base type. -let GetSuperTypeOfType g amap m ty = -#if !NO_TYPEPROVIDERS - let ty = - match tryTcrefOfAppTy g ty with - | ValueSome tcref when tcref.IsProvided -> stripTyEqns g ty - | _ -> stripTyEqnsAndMeasureEqns g ty -#else - let ty = stripTyEqnsAndMeasureEqns g ty -#endif - - match metadataOfTy g ty with -#if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - let st = info.ProvidedType - let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) - match superOpt with - | None -> None - | Some super -> Some(Import.ImportProvidedType amap m super) -#endif - | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> - let tinst = argsOfAppTy g ty - match tdef.Extends with - | None -> None - | Some ilty -> Some (ImportILType scoref amap m tinst ilty) - - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - if isFSharpObjModelTy g ty || isExnDeclTy g ty then - let tcref = tcrefOfAppTy g ty - Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) - elif isArrayTy g ty then - Some g.system_Array_ty - elif isRefTy g ty && not (isObjTy g ty) then - Some g.obj_ty - elif isStructTupleTy g ty then - Some g.system_Value_ty - elif isFSharpStructOrEnumTy g ty then - if isFSharpEnumTy g ty then - Some g.system_Enum_ty - else - Some g.system_Value_ty - elif isStructAnonRecdTy g ty then - Some g.system_Value_ty - elif isAnonRecdTy g ty then - Some g.obj_ty - elif isRecdTy g ty || isUnionTy g ty then - Some g.obj_ty - else - None - -/// Make a type for System.Collections.Generic.IList -let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = - TType_app(g.tcref_System_Collections_Generic_IList, [ty], g.knownWithoutNull) - -/// Indicates whether we can skip interface types that lie outside the reference set -[] -type SkipUnrefInterfaces = Yes | No - -let GetImmediateInterfacesOfMetadataType g amap m skipUnref ty (tcref: TyconRef) tinst = - [ - match metadataOfTy g ty with -#if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - for ity in info.ProvidedType.PApplyArray((fun st -> st.GetInterfaces()), "GetInterfaces", m) do - Import.ImportProvidedType amap m ity -#endif - | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> - // ImportILType may fail for an interface if the assembly load set is incomplete and the interface - // comes from another assembly. In this case we simply skip the interface: - // if we don't skip it, then compilation will just fail here, and if type checking - // succeeds with fewer non-dereferencable interfaces reported then it would have - // succeeded with more reported. There are pathological corner cases where this - // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always - // assume those are present. - for ity in tdef.Implements do - if skipUnref = SkipUnrefInterfaces.No || CanImportILType scoref amap m ity then - ImportILType scoref amap m tinst ity - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - for ity in tcref.ImmediateInterfaceTypesOfFSharpTycon do - instType (mkInstForAppTy g ty) ity ] - -/// Collect the set of immediate declared interface types for an F# type, but do not -/// traverse the type hierarchy to collect further interfaces. -// -// NOTE: Anonymous record types are not directly considered to implement IComparable, -// IComparable or IEquatable. This is because whether they support these interfaces depend on their -// consitutent types, which may not yet be known in type inference. -let rec GetImmediateInterfacesOfType skipUnref g amap m ty = - [ - match tryAppTy g ty with - | ValueSome(tcref, tinst) -> - // Check if this is a measure-annotated type - match tcref.TypeReprInfo with - | TMeasureableRepr reprTy -> - yield! GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy - | _ -> - yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref ty tcref tinst - - | ValueNone -> - // For tuple types, func types, check if we can eliminate to a type with metadata. - let tyWithMetadata = convertToTypeWithMetadataIfPossible g ty - match tryAppTy g tyWithMetadata with - | ValueSome (tcref, tinst) -> - if isAnyTupleTy g ty then - yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref tyWithMetadata tcref tinst - | _ -> () - - // .NET array types are considered to implement IList - if isArray1DTy g ty then - mkSystemCollectionsGenericIListTy g (destArrayTy g ty) - ] - -// Report the interfaces supported by a measure-annotated type. -// -// For example, consider: -// -// [] -// type A<[] 'm> = A -// -// This measure-annotated type is considered to support the interfaces on its representation type A, -// with the exception that -// -// 1. we rewrite the IComparable and IEquatable interfaces, so that -// IComparable --> IComparable> -// IEquatable --> IEquatable> -// -// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces -// -// This rule is conservative and only applies to IComparable and IEquatable interfaces. -// -// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. -and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = - [ - // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> - for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do - if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m ity) && - not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) then - ity - - // NOTE: we should really only report the IComparable> interface for measure-annotated types - // if the original type supports IComparable somewhere in the hierarchy, likeiwse IEquatable>. - // - // However since F# 2.0 we have always reported these interfaces for all measure-annotated types. - - //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIComparable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIComparable_tcref [ty] - - //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIEquatable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIEquatable_tcref [ty] - ] - -// Check for IComparable, IEquatable and interfaces that derive from these -and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m ity = - ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m ity - -// Check for IComparable, IEquatable and interfaces that derive from these -and ExistsInInterfaceHierarchy p skipUnref g amap m ity = - match ity with - | AppTy g (tcref, tinst) -> - p ity || - (GetImmediateInterfacesOfMetadataType g amap m skipUnref ity tcref tinst - |> List.exists (ExistsInInterfaceHierarchy p skipUnref g amap m)) - | _ -> false - -/// Indicates whether we should visit multiple instantiations of the same generic interface or not -[] -type AllowMultiIntfInstantiations = Yes | No - -/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). -/// Visit base types and interfaces first. -let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = - let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = - - let seenThisTycon = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> Set.contains tcref.Stamp visitedTycon - | _ -> false - - // Do not visit the same type twice. Could only be doing this if we've seen this tycon - if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else - - // Do not visit the same tycon twice, e.g. I and I, collect I only, unless directed to allow this - if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else - - let state = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> - let visitedTycon = Set.add tcref.Stamp visitedTycon - visitedTycon, visited.Add (tcref, ty), acc - | _ -> - state - - if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else - let visitedTycon, visited, acc = - if isInterfaceTy g ty then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) - (loop ndeep g.obj_ty state) - else - match tryDestTyparTy g ty with - | ValueSome tp -> - let state = loop (ndeep+1) g.obj_ty state - List.foldBack - (fun x vacc -> - match x with - | TyparConstraint.MayResolveMember _ - | TyparConstraint.DefaultsTo _ - | TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _ - | TyparConstraint.IsEnum _ - | TyparConstraint.IsDelegate _ - | TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _ - | TyparConstraint.SimpleChoice _ - | TyparConstraint.RequiresDefaultConstructor _ -> vacc - | TyparConstraint.CoercesTo(cty, _) -> - loop (ndeep + 1) cty vacc) - tp.Constraints - state - | _ -> - let state = - if followInterfaces then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) - state - else - state - let state = - Option.foldBack - (loop (ndeep+1)) - (GetSuperTypeOfType g amap m ty) - state - state - let acc = visitor ty acc - (visitedTycon, visited, acc) - loop 0 ty (Set.empty, TyconRefMultiMap<_>.Empty, acc) |> p33 - -/// Fold, do not follow interfaces (unless the type is itself an interface) -let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = - FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc - -/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes f g amap m ty acc - -/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () - -/// Search for one element satisfying a predicate, following interfaces -let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false - -/// Search for one element where a function returns a 'Some' result, following interfaces -let SearchEntireHierarchyOfType f g amap m ty = - FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes - (fun ty acc -> - match acc with - | None -> if f ty then Some ty else None - | Some _ -> acc) - g amap m ty None - -/// Get all super types of the type, including the type itself -let AllSuperTypesOfType g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] - -/// Get all interfaces of a type, including the type itself if it is an interface -let AllInterfacesOfType g amap m allowMultiIntfInst ty = - AllSuperTypesOfType g amap m allowMultiIntfInst ty |> List.filter (isInterfaceTy g) - -/// Check if two types have the same nominal head type -let HaveSameHeadType g ty1 ty2 = - match tryTcrefOfAppTy g ty1 with - | ValueSome tcref1 -> - match tryTcrefOfAppTy g ty2 with - | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 - | _ -> false - | _ -> false - -/// Check if a type has a particular head type -let HasHeadType g tcref ty2 = - match tryTcrefOfAppTy g ty2 with - | ValueSome tcref2 -> tyconRefEq g tcref tcref2 - | ValueNone -> false - -/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) -let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = - ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - -/// Check if a type exists somewhere in the hierarchy which has the given head type. -let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = - ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - -/// Read an Abstract IL type from metadata and convert to an F# type. -let ImportILTypeFromMetadata amap m scoref tinst minst ilty = - ImportILType scoref amap m (tinst@minst) ilty - -/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. -let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilty getCattrs = - let ty = ImportILType scoref amap m (tinst@minst) ilty - // If the type is a byref and one of attributes from a return or parameter has IsReadOnly, then it's a inref. - if isByrefTy amap.g ty && TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ()) then - mkInByrefTy amap.g (destByrefTy amap.g ty) - else - ty - -/// Get the parameter type of an IL method. -let ImportParameterTypeFromMetadata amap m ilty getCattrs scoref tinst mist = - ImportILTypeFromMetadataWithAttributes amap m scoref tinst mist ilty getCattrs - -/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and -/// translating 'void' to 'None'. -let ImportReturnTypeFromMetadata amap m ilty getCattrs scoref tinst minst = - match ilty with - | ILType.Void -> None - | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy getCattrs) - - -/// Copy constraints. If the constraint comes from a type parameter associated -/// with a type constructor then we are simply renaming type variables. If it comes -/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the -/// instantiation associated with 'ty' as well as copying the type parameters associated with -/// M and instantiating their constraints -/// -/// Note: this now looks identical to constraint instantiation. - -let CopyTyparConstraints m tprefInst (tporig: Typar) = - tporig.Constraints - |> List.map (fun tpc -> - match tpc with - | TyparConstraint.CoercesTo(ty, _) -> - TyparConstraint.CoercesTo (instType tprefInst ty, m) - | TyparConstraint.DefaultsTo(priority, ty, _) -> - TyparConstraint.DefaultsTo (priority, instType tprefInst ty, m) - | TyparConstraint.SupportsNull _ -> - TyparConstraint.SupportsNull m - | TyparConstraint.IsEnum (uty, _) -> - TyparConstraint.IsEnum (instType tprefInst uty, m) - | TyparConstraint.SupportsComparison _ -> - TyparConstraint.SupportsComparison m - | TyparConstraint.SupportsEquality _ -> - TyparConstraint.SupportsEquality m - | TyparConstraint.IsDelegate(aty, bty, _) -> - TyparConstraint.IsDelegate (instType tprefInst aty, instType tprefInst bty, m) - | TyparConstraint.IsNonNullableStruct _ -> - TyparConstraint.IsNonNullableStruct m - | TyparConstraint.IsUnmanaged _ -> - TyparConstraint.IsUnmanaged m - | TyparConstraint.IsReferenceType _ -> - TyparConstraint.IsReferenceType m - | TyparConstraint.SimpleChoice (tys, _) -> - TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys, m) - | TyparConstraint.RequiresDefaultConstructor _ -> - TyparConstraint.RequiresDefaultConstructor m - | TyparConstraint.MayResolveMember(traitInfo, _) -> - TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) - -/// The constraints for each typar copied from another typar can only be fixed up once -/// we have generated all the new constraints, e.g. f List, B :> List> ... -let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = - // Checks.. These are defensive programming against early reported errors. - let n0 = formalEnclosingTypars.Length - let n1 = tinst.Length - let n2 = tpsorig.Length - let n3 = tps.Length - if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0, n1)), m)) - if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2, n3)), m)) - - // The real code.. - let renaming, tptys = mkTyparToTyparRenaming tpsorig tps - let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming - (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) - renaming, tptys - - //------------------------------------------------------------------------- // Predicates and properties on values and members @@ -475,7 +75,7 @@ let GetCompiledReturnTyOfProvidedMethodInfo amap m (mi: Tainted mi.IsConstructor), m) then mi.PApply((fun mi -> mi.DeclaringType), m) else mi.Coerce(m).PApply((fun mi -> mi.ReturnType), m) - let ty = Import.ImportProvidedType amap m returnType + let ty = ImportProvidedType amap m returnType if isVoidTy amap.g ty then None else Some ty #endif @@ -492,10 +92,12 @@ let ReparentSlotSigToUseMethodTypars g m ovByMethValRef slotsig = slotsig /// Construct the data representing a parameter in the signature of an abstract method slot -let MakeSlotParam (ty, argInfo: ArgReprInfo) = TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) +let MakeSlotParam (ty, argInfo: ArgReprInfo) = + TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) /// Construct the data representing the signature of an abstract method slot -let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = copySlotSig (TSlotSig(nm, ty, ctps, mtps, paraml, retTy)) +let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = + copySlotSig (TSlotSig(nm, ty, ctps, mtps, paraml, retTy)) /// Split the type of an F# member value into /// - the type parameters associated with method but matching those of the enclosing type @@ -537,7 +139,7 @@ let private GetInstantiationForMemberVal g isCSharpExt (ty, vref, methTyArgs: Ty let memberParentTypars, memberMethodTypars, _retTy, parentTyArgs = AnalyzeTypeOfMemberVal isCSharpExt g (ty, vref) /// In some recursive inference cases involving constraints this may need to be /// fixed up - we allow uniform generic recursion but nothing else. - /// See https://github.com/Microsoft/visualfsharp/issues/3038#issuecomment-309429410 + /// See https://github.com/dotnet/fsharp/issues/3038#issuecomment-309429410 let methTyArgsFixedUp = if methTyArgs.Length < memberMethodTypars.Length then methTyArgs @ (List.skip methTyArgs.Length memberMethodTypars |> generalizeTypars) @@ -578,7 +180,11 @@ type OptionalArgInfo = /// Note this is correctly termed caller side, even though the default value is optically specified on the callee: /// in fact the default value is read from the metadata and passed explicitly to the callee on the caller side. | CallerSide of OptionalArgCallerSideValue - member x.IsOptional = match x with CalleeSide | CallerSide _ -> true | NotOptional -> false + + member x.IsOptional = + match x with + | CalleeSide | CallerSide _ -> true + | NotOptional -> false /// Compute the OptionalArgInfo for an IL parameter /// @@ -663,6 +269,7 @@ type ParamData = #if !NO_TYPEPROVIDERS type ILFieldInit with + /// Compute the ILFieldInit for the given provided constant value for a provided enum type. static member FromProvidedObj m (v: obj) = match v with @@ -692,7 +299,7 @@ type ILFieldInit with /// This is the same logic as OptionalArgInfoOfILParameter except we do not apply the /// Visual Basic rules for IDispatchConstant and IUnknownConstant to optional /// provided parameters. -let OptionalArgInfoOfProvidedParameter (amap: Import.ImportMap) m (provParam : Tainted) = +let OptionalArgInfoOfProvidedParameter (amap: ImportMap) m (provParam : Tainted) = let g = amap.g if provParam.PUntaint((fun p -> p.IsOptional), m) then match provParam.PUntaint((fun p -> p.HasDefaultValue), m) with @@ -705,7 +312,7 @@ let OptionalArgInfoOfProvidedParameter (amap: Import.ImportMap) m (provParam : T elif isObjTy g ty then MissingValue else DefaultValue - let pty = Import.ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) + let pty = ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) CallerSide (analyze pty) | _ -> let v = provParam.PUntaint((fun p -> p.RawDefaultValue), m) @@ -952,7 +559,7 @@ type MethInfo = #if !NO_TYPEPROVIDERS /// Describes a use of a method backed by provided metadata - | ProvidedMeth of amap: Import.ImportMap * methodBase: Tainted * extensionMethodPriority: ExtensionMethodPriority option * m: range + | ProvidedMeth of amap: ImportMap * methodBase: Tainted * extensionMethodPriority: ExtensionMethodPriority option * m: range #endif /// Get the enclosing type of the method info. @@ -966,7 +573,7 @@ type MethInfo = | DefaultStructCtor(_, ty) -> ty #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) + ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -1265,7 +872,7 @@ type MethInfo = | _ -> false /// Indicates if this is an extension member (e.g. on a struct) that takes a byref arg - member x.ObjArgNeedsAddress (amap: Import.ImportMap, m) = + member x.ObjArgNeedsAddress (amap: ImportMap, m) = (x.IsStruct && not x.IsExtensionMember) || match x.GetObjArgTypes (amap, m, x.FormalMethodInst) with | [h] -> isByrefTy amap.g h @@ -1328,21 +935,21 @@ type MethInfo = /// Indicates if this method is an extension member that is read-only. /// An extension member is considered read-only if the first argument is a read-only byref (inref) type. - member x.IsReadOnlyExtensionMember (amap: Import.ImportMap, m) = + member x.IsReadOnlyExtensionMember (amap: ImportMap, m) = x.IsExtensionMember && x.TryObjArgByrefType(amap, m, x.FormalMethodInst) |> Option.exists (isInByrefTy amap.g) /// Build IL method infos. - static member CreateILMeth (amap: Import.ImportMap, m, ty: TType, md: ILMethodDef) = + static member CreateILMeth (amap: ImportMap, m, ty: TType, md: ILMethodDef) = let tinfo = ILTypeInfo.FromType amap.g ty - let mtps = Import.ImportILGenericParameters (fun () -> amap) m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata md.GenericParams + let mtps = ImportILGenericParameters (fun () -> amap) m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata md.GenericParams ILMeth (amap.g, ILMethInfo(amap.g, ty, None, md, mtps), None) /// Build IL method infos for a C#-style extension method static member CreateILExtensionMeth (amap, m, apparentTy: TType, declaringTyconRef: TyconRef, extMethPri, md: ILMethodDef) = let scoref = declaringTyconRef.CompiledRepresentationForNamedType.Scope - let mtps = Import.ImportILGenericParameters (fun () -> amap) m scoref [] md.GenericParams + let mtps = ImportILGenericParameters (fun () -> amap) m scoref [] md.GenericParams ILMeth (amap.g, ILMethInfo(amap.g, apparentTy, Some declaringTyconRef, md, mtps), extMethPri) /// Tests whether two method infos have the same underlying definition. @@ -1420,7 +1027,7 @@ type MethInfo = | ProvidedMeth(amap, mi, _, m) -> // A single group of tupled arguments [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - yield Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) ] ] + yield ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) ] ] #endif /// Get the (zero or one) 'self'/'this'/'object' arguments associated with a method. @@ -1442,7 +1049,7 @@ type MethInfo = | DefaultStructCtor _ -> [] #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - if x.IsInstance then [ Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument + if x.IsInstance then [ ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument else [] #endif @@ -1623,7 +1230,7 @@ type MethInfo = let formalParams = [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some s), m) - let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) + let paramType = ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) let isIn, isOut, isOptional = p.PUntaint((fun p -> p.IsIn, p.IsOut, p.IsOptional), m) yield TSlotParam(paramName, paramType, isIn, isOut, isOptional, []) ] ] formalRetTy, formalParams @@ -1656,7 +1263,7 @@ type MethInfo = let pty = match p.PApply((fun p -> p.ParameterType), m) with | Tainted.Null -> amap.g.unit_ty - | parameterType -> Import.ImportProvidedType amap m parameterType + | parameterType -> ImportProvidedType amap m parameterType yield ParamNameAndType(pname, pty) ] ] #endif @@ -1700,7 +1307,7 @@ type ILFieldInfo = | ILFieldInfo of ilTypeInfo: ILTypeInfo * ilFieldDef: ILFieldDef #if !NO_TYPEPROVIDERS /// Represents a single use of a field backed by provided metadata - | ProvidedField of amap: Import.ImportMap * providedField: Tainted * range: range + | ProvidedField of amap: ImportMap * providedField: Tainted * range: range #endif /// Get the enclosing ("parent"/"declaring") type of the field. @@ -1708,7 +1315,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ToType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) + | ProvidedField(amap, fi, m) -> (ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) #endif member x.ApparentEnclosingAppType = x.ApparentEnclosingType @@ -1729,7 +1336,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ILTypeRef #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef + | ProvidedField(amap, fi, m) -> (ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef #endif /// Get the scope used to interpret IL metadata @@ -1800,7 +1407,7 @@ type ILFieldInfo = match x with | ILFieldInfo (_, fdef) -> fdef.FieldType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType), m)) + | ProvidedField(amap, fi, m) -> ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Get the type of the field as an F# type @@ -1808,7 +1415,7 @@ type ILFieldInfo = match x with | ILFieldInfo (tinfo, fdef) -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] fdef.FieldType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType), m)) + | ProvidedField(amap, fi, m) -> ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Tests whether two infos have the same underlying definition. @@ -2002,7 +1609,7 @@ type PropInfo = #if !NO_TYPEPROVIDERS /// An F# use of a property backed by provided metadata - | ProvidedProp of amap: Import.ImportMap * providedProp: Tainted * range: range + | ProvidedProp of amap: ImportMap * providedProp: Tainted * range: range #endif /// Get the enclosing type of the property. @@ -2014,7 +1621,7 @@ type PropInfo = | FSProp(_, ty, _, _) -> ty #if !NO_TYPEPROVIDERS | ProvidedProp(amap, pi, m) -> - Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) + ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -2241,7 +1848,7 @@ type PropInfo = | FSProp _ -> failwith "unreachable" #if !NO_TYPEPROVIDERS | ProvidedProp(_, pi, m) -> - Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType), m)) + ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType), m)) #endif /// Get the names and types of the indexer parameters associated with the property @@ -2259,7 +1866,7 @@ type PropInfo = | ProvidedProp (_, pi, m) -> [ for p in pi.PApplyArray((fun pi -> pi.GetIndexParameters()), "GetIndexParameters", m) do let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some (mkSynId m s)), m) - let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) + let paramType = ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) yield ParamNameAndType(paramName, paramType) ] #endif @@ -2319,7 +1926,7 @@ type PropInfo = match pi with | ILProp ilpinfo -> hash ilpinfo.RawMetadata.Name | FSProp(_, _, vrefOpt1, vrefOpt2) -> - // Hash on option*option + // Hash on string option * string option let vth = (vrefOpt1 |> Option.map (fun vr -> vr.LogicalName), (vrefOpt2 |> Option.map (fun vr -> vr.LogicalName))) hash vth #if !NO_TYPEPROVIDERS @@ -2419,7 +2026,7 @@ type EventInfo = #if !NO_TYPEPROVIDERS /// An F# use of an event backed by provided metadata - | ProvidedEvent of amap: Import.ImportMap * providedEvent: Tainted * range: range + | ProvidedEvent of amap: ImportMap * providedEvent: Tainted * range: range #endif /// Get the enclosing type of the event. @@ -2430,7 +2037,7 @@ type EventInfo = | ILEvent ileinfo -> ileinfo.ApparentEnclosingType | FSEvent (_, p, _, _) -> p.ApparentEnclosingType #if !NO_TYPEPROVIDERS - | ProvidedEvent (amap, ei, m) -> Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) + | ProvidedEvent (amap, ei, m) -> ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types member x.ApparentEnclosingAppType = @@ -2553,7 +2160,7 @@ type EventInfo = FindDelegateTypeOfPropertyEvent g amap x.EventName m (p.GetPropertyType(amap, m)) #if !NO_TYPEPROVIDERS | ProvidedEvent (_, ei, _) -> - Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.EventHandlerType), m)) + ImportProvidedType amap m (ei.PApply((fun ei -> ei.EventHandlerType), m)) #endif /// Test whether two event infos have the same underlying definition. diff --git a/src/fsharp/infos.fsi b/src/fsharp/infos.fsi index 183f8ccd199..b0af49e2f60 100644 --- a/src/fsharp/infos.fsi +++ b/src/fsharp/infos.fsi @@ -16,171 +16,6 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeProviders #endif -/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. -val ImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType - -val CanImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> ilty: ILType -> bool - -/// Indicates if an F# type is the type associated with an F# exception declaration -val isExnDeclTy: g: TcGlobals -> ty: TType -> bool - -/// Get the base type of a type, taking into account type instantiations. Return None if the -/// type has no base type. -val GetSuperTypeOfType: g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option - -/// Indicates whether we can skip interface types that lie outside the reference set -[] -type SkipUnrefInterfaces = - | Yes - | No - -/// Collect the set of immediate declared interface types for an F# type, but do not -/// traverse the type hierarchy to collect further interfaces. -val GetImmediateInterfacesOfType: - skipUnref: SkipUnrefInterfaces -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType list - -/// Indicates whether we should visit multiple instantiations of the same generic interface or not -[] -type AllowMultiIntfInstantiations = - | Yes - | No - -/// Fold, do not follow interfaces (unless the type is itself an interface) -val FoldPrimaryHierarchyOfType: - f: (TType -> 'a -> 'a) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - acc: 'a -> - 'a - -/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -val FoldEntireHierarchyOfType: - f: (TType -> 'a -> 'a) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - acc: 'a -> - 'a - -/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -val IterateEntireHierarchyOfType: - f: (TType -> unit) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - unit - -/// Search for one element satisfying a predicate, following interfaces -val ExistsInEntireHierarchyOfType: - f: (TType -> bool) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - bool - -/// Search for one element where a function returns a 'Some' result, following interfaces -val SearchEntireHierarchyOfType: - f: (TType -> bool) -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option - -/// Get all super types of the type, including the type itself -val AllSuperTypesOfType: - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - TType list - -/// Get all interfaces of a type, including the type itself if it is an interface -val AllInterfacesOfType: - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - TType list - -/// Check if two types have the same nominal head type -val HaveSameHeadType: g: TcGlobals -> ty1: TType -> ty2: TType -> bool - -/// Check if a type has a particular head type -val HasHeadType: g: TcGlobals -> tcref: TyconRef -> ty2: TType -> bool - -/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) -val ExistsSameHeadTypeInHierarchy: - g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> typeToLookFor: TType -> bool - -/// Check if a type exists somewhere in the hierarchy which has the given head type. -val ExistsHeadTypeInEntireHierarchy: - g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> tcrefToLookFor: TyconRef -> bool - -/// Read an Abstract IL type from metadata and convert to an F# type. -val ImportILTypeFromMetadata: - amap: ImportMap -> m: range -> scoref: ILScopeRef -> tinst: TType list -> minst: TType list -> ilty: ILType -> TType - -/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. -val ImportILTypeFromMetadataWithAttributes: - amap: ImportMap -> - m: range -> - scoref: ILScopeRef -> - tinst: TType list -> - minst: TType list -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - TType - -/// Get the parameter type of an IL method. -val ImportParameterTypeFromMetadata: - amap: ImportMap -> - m: range -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - scoref: ILScopeRef -> - tinst: TType list -> - mist: TType list -> - TType - -/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and -/// translating 'void' to 'None'. -val ImportReturnTypeFromMetadata: - amap: ImportMap -> - m: range -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - scoref: ILScopeRef -> - tinst: TType list -> - minst: TType list -> - TType option - -/// Copy constraints. If the constraint comes from a type parameter associated -/// with a type constructor then we are simply renaming type variables. If it comes -/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the -/// instantiation associated with 'ty' as well as copying the type parameters associated with -/// M and instantiating their constraints -/// -/// Note: this now looks identical to constraint instantiation. - -val CopyTyparConstraints: m: range -> tprefInst: TyparInst -> tporig: Typar -> TyparConstraint list - -/// The constraints for each typar copied from another typar can only be fixed up once -/// we have generated all the new constraints, e.g. f List, B :> List> ... -val FixupNewTypars: - m: range -> - formalEnclosingTypars: Typars -> - tinst: TType list -> - tpsorig: Typars -> - tps: Typars -> - TyparInst * TTypes - type ValRef with /// Indicates if an F#-declared function or member value is a CLIEvent property compiled as a .NET event diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index be194d99cc2..bc06a67f684 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -21,7 +21,7 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open FSharp.Compiler.AbstractIL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index ac67680eef2..698ada21335 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -10,7 +10,7 @@ open Internal.Utilities.Library open Internal.Utilities.Text.Lexing open FSharp.Compiler.IO -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers open FSharp.Compiler.UnicodeLexing @@ -52,7 +52,7 @@ type LexArgs = { conditionalDefines: string list resourceManager: LexResourceManager - errorLogger: ErrorLogger + errorLogger: DiagnosticsLogger applyLineDirectives: bool pathMap: PathMap mutable ifdefStack: LexerIfdefStack diff --git a/src/fsharp/lexhelp.fsi b/src/fsharp/lexhelp.fsi index 7c17152fa8e..246da511506 100644 --- a/src/fsharp/lexhelp.fsi +++ b/src/fsharp/lexhelp.fsi @@ -6,7 +6,7 @@ open FSharp.Compiler.IO open Internal.Utilities open Internal.Utilities.Text -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.ParseHelpers open FSharp.Compiler.UnicodeLexing open FSharp.Compiler.Parser @@ -32,7 +32,7 @@ type LexResourceManager = type LexArgs = { conditionalDefines: string list resourceManager: LexResourceManager - errorLogger: ErrorLogger + errorLogger: DiagnosticsLogger applyLineDirectives: bool pathMap: PathMap mutable ifdefStack: LexerIfdefStack @@ -51,7 +51,7 @@ val mkLexargs: lightStatus: IndentationAwareSyntaxStatus * resourceManager: LexResourceManager * ifdefStack: LexerIfdefStack * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * pathMap: PathMap -> LexArgs diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 9ee981d30d6..a77d087f94f 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -14,7 +14,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/pplex.fsl b/src/fsharp/pplex.fsl index fdd59bc6f81..4b6da64ff55 100644 --- a/src/fsharp/pplex.fsl +++ b/src/fsharp/pplex.fsl @@ -6,7 +6,7 @@ module internal FSharp.Compiler.PPLexer open System -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Lexhelp open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/pppars.fsy b/src/fsharp/pppars.fsy index 5775c898670..53616c481e6 100644 --- a/src/fsharp/pppars.fsy +++ b/src/fsharp/pppars.fsy @@ -1,7 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. %{ -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 5e04d0cc569..7398e1d00ea 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -26,7 +26,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.EditorServices.DeclarationListHelpers -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -1115,7 +1115,7 @@ type internal TypeCheckInfo /// Determines if a long ident is resolvable at a specific point. member _.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = - ErrorScope.Protect + DiagnosticsScope.Protect range0 (fun () -> /// Find items in the best naming environment. @@ -1132,7 +1132,7 @@ type internal TypeCheckInfo /// Get the auto-complete items at a location member _.GetDeclarations (parseResultsOpt, line, lineStr, partialName, completionContextAtPos, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1159,7 +1159,7 @@ type internal TypeCheckInfo /// Get the symbols for auto-complete items at a location member _.GetDeclarationListSymbols (parseResultsOpt, line, lineStr, partialName, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1282,7 +1282,7 @@ type internal TypeCheckInfo let tip = LayoutRender.toArray tip ToolTipElement.Single(tip, FSharpXmlDoc.None)] - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 dataTipOfReferences (fun err -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetReferenceResolutionStructuredToolTipText: '%s'" err) @@ -1302,7 +1302,7 @@ type internal TypeCheckInfo // GetToolTipText: return the "pop up" (or "Quick Info") text given a certain context. member _.GetStructuredToolTipText(line, lineStr, colAtEndOfNames, names) = let Compute() = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition(None, Some names, None, None, @@ -1328,7 +1328,7 @@ type internal TypeCheckInfo res member _.GetF1Keyword (line, lineStr, colAtEndOfNames, names) : string option = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1366,7 +1366,7 @@ type internal TypeCheckInfo None) member _.GetMethods (line, lineStr, colAtEndOfNames, namesOpt) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1390,7 +1390,7 @@ type internal TypeCheckInfo MethodGroup(msg,[| |])) member _.GetMethodsAsSymbols (line, lineStr, colAtEndOfNames, names) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition (None, Some names, None, @@ -1410,7 +1410,7 @@ type internal TypeCheckInfo None) member _.GetDeclarationLocation (line, lineStr, colAtEndOfNames, names, preferFlag) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1519,7 +1519,7 @@ type internal TypeCheckInfo FindDeclResult.DeclNotFound (FindDeclFailureReason.Unknown msg)) member _.GetSymbolUseAtLocation (line, lineStr, colAtEndOfNames, names) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition (None, Some names, None, None, @@ -1605,7 +1605,7 @@ type FSharpParsingOptions = static member FromTcConfig(tcConfig: TcConfig, sourceFiles, isInteractive: bool) = { SourceFiles = sourceFiles ConditionalDefines = tcConfig.conditionalDefines - ErrorSeverityOptions = tcConfig.errorSeverityOptions + ErrorSeverityOptions = tcConfig.diagnosticsOptions LangVersionText = tcConfig.langVersion.VersionText IsInteractive = isInteractive IndentationAwareSyntax = tcConfig.indentationAwareSyntax @@ -1616,7 +1616,7 @@ type FSharpParsingOptions = { SourceFiles = sourceFiles ConditionalDefines = tcConfigB.conditionalDefines - ErrorSeverityOptions = tcConfigB.errorSeverityOptions + ErrorSeverityOptions = tcConfigB.diagnosticsOptions LangVersionText = tcConfigB.langVersion.VersionText IsInteractive = isInteractive IndentationAwareSyntax = tcConfigB.indentationAwareSyntax @@ -1627,8 +1627,8 @@ type FSharpParsingOptions = module internal ParseAndCheckFile = /// Error handler for parsing & type checking while processing a single file - type ErrorHandler(reportErrors, mainInputFileName, errorSeverityOptions: FSharpDiagnosticOptions, sourceText: ISourceText, suggestNamesForErrors: bool) = - let mutable options = errorSeverityOptions + type ErrorHandler(reportErrors, mainInputFileName, diagnosticsOptions: FSharpDiagnosticOptions, sourceText: ISourceText, suggestNamesForErrors: bool) = + let mutable options = diagnosticsOptions let errorsAndWarningsCollector = ResizeArray<_>() let mutable errorCount = 0 @@ -1659,12 +1659,12 @@ module internal ParseAndCheckFile = | e -> report e let errorLogger = - { new ErrorLogger("ErrorHandler") with + { new DiagnosticsLogger("ErrorHandler") with member x.DiagnosticSink (exn, severity) = diagnosticSink severity exn member x.ErrorCount = errorCount } // Public members - member _.ErrorLogger = errorLogger + member _.DiagnosticsLogger = errorLogger member _.CollectedDiagnostics = errorsAndWarningsCollector.ToArray() @@ -1693,7 +1693,7 @@ module internal ParseAndCheckFile = // When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives. // TODO(pathmap): expose PathMap on the service API, and thread it through here - let lexargs = mkLexargs(conditionalDefines, lightStatus, lexResourceManager, [], errHandler.ErrorLogger, PathMap.empty) + let lexargs = mkLexargs(conditionalDefines, lightStatus, lexResourceManager, [], errHandler.DiagnosticsLogger, PathMap.empty) let lexargs = { lexargs with applyLineDirectives = false } let tokenizer = LexFilter.LexFilter(lightStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf) @@ -1703,15 +1703,15 @@ module internal ParseAndCheckFile = UnicodeLexing.SourceTextAsLexbuf(true, LanguageVersion(langVersion), sourceText) let matchBraces(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = - let delayedLogger = CapturingErrorLogger("matchBraces") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + let delayedLogger = CapturingDiagnosticsLogger("matchBraces") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) - // Make sure there is an ErrorLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors - let delayedLogger = CapturingErrorLogger("matchBraces") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors + let delayedLogger = CapturingDiagnosticsLogger("matchBraces") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let matchingBraces = ResizeArray<_>() @@ -1788,7 +1788,7 @@ module internal ParseAndCheckFile = let parseFile(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) let errHandler = ErrorHandler(true, fileName, options.ErrorSeverityOptions, sourceText, suggestNamesForErrors) - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let parseResult = @@ -1801,9 +1801,9 @@ module internal ParseAndCheckFile = let isExe = options.IsExe try - ParseInput(lexfun, options.ErrorSeverityOptions, errHandler.ErrorLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) + ParseInput(lexfun, options.ErrorSeverityOptions, errHandler.DiagnosticsLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) with e -> - errHandler.ErrorLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None. + errHandler.DiagnosticsLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None. EmptyParsedInput(fileName, (isLastCompiland, isExe))) errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors @@ -1903,16 +1903,16 @@ module internal ParseAndCheckFile = let parsedMainInput = parseResults.ParseTree // Initialize the error handler - let errHandler = ErrorHandler(true, mainInputFileName, tcConfig.errorSeverityOptions, sourceText, suggestNamesForErrors) + let errHandler = ErrorHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck // Apply nowarns to tcConfig (may generate errors, so ensure errorLogger is installed) let tcConfig = ApplyNoWarnsToTcConfig (tcConfig, parsedMainInput,Path.GetDirectoryName mainInputFileName) // update the error handler with the modified tcConfig - errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions + errHandler.ErrorSeverityOptions <- tcConfig.diagnosticsOptions // Play background errors and warnings for this file. do for err, severity in backgroundDiagnostics do @@ -1939,7 +1939,7 @@ module internal ParseAndCheckFile = // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance // for the client to claim the result as obsolete and have the typecheck abort. - use _unwind = new CompilationGlobalsScope (errHandler.ErrorLogger, BuildPhase.TypeCheck) + use _unwind = new CompilationGlobalsScope (errHandler.DiagnosticsLogger, BuildPhase.TypeCheck) let! result = CheckOneInputAndFinish(checkForErrors, tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index a8e65487a28..c7fea4e9b61 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -15,7 +15,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Symbols open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs diff --git a/src/fsharp/service/FSharpParseFileResults.fs b/src/fsharp/service/FSharpParseFileResults.fs index d67044ea10d..9ee0e816b52 100644 --- a/src/fsharp/service/FSharpParseFileResults.fs +++ b/src/fsharp/service/FSharpParseFileResults.fs @@ -456,7 +456,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, /// Get declared items and the selected item at the specified location member _.GetNavigationItemsImpl() = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> match input with | ParsedInput.ImplFile _ as p -> @@ -808,7 +808,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules | _ -> [] - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let locations = findBreakPoints() diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 5aa4a2288dd..f87d4bf9ffe 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -4,6 +4,8 @@ namespace FSharp.Compiler.CodeAnalysis open System open System.Collections.Generic +open System.Collections.Immutable +open System.Diagnostics open System.IO open System.Threading open Internal.Utilities.Library @@ -22,7 +24,7 @@ open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.NameResolution @@ -55,14 +57,17 @@ module IncrementalBuilderEventTesting = let data = Array.create MAX None let mutable curIndex = 0 let mutable numAdds = 0 + // called by the product, to note when a parse/typecheck happens for a file member _.Add(fileName:'T) = numAdds <- numAdds + 1 data[curIndex] <- Some fileName curIndex <- (curIndex + 1) % MAX + member _.CurrentEventNum = numAdds // called by unit tests, returns 'n' most recent additions. - member this.MostRecentList(n: int) : list<'T> = + + member _.MostRecentList(n: int) : 'T list = if n < 0 || n > MAX then raise <| ArgumentOutOfRangeException("n", sprintf "n must be between 0 and %d, inclusive, but got %d" MAX n) let mutable remaining = n @@ -109,7 +114,7 @@ module IncrementalBuildSyntaxTree = let mutable weakCache: WeakReference<_> option = None let parse(sigNameOpt: QualifiedNameOfFile option) = - let errorLogger = CompilationErrorLogger("Parse", tcConfig.errorSeverityOptions) + let errorLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parse) @@ -180,16 +185,16 @@ type TcInfo = latestCcuSigForFile: ModuleOrNamespaceType option - /// Accumulated errors, last file first - tcErrorsRev:(PhasedDiagnostic * FSharpDiagnosticSeverity)[] list + /// Accumulated diagnostics, last file first + tcDiagnosticsRev:(PhasedDiagnostic * FSharpDiagnosticSeverity)[] list tcDependencyFiles: string list sigNameOpt: (string * QualifiedNameOfFile) option } - member x.TcErrors = - Array.concat (List.rev x.tcErrorsRev) + member x.TcDiagnostics = + Array.concat (List.rev x.tcDiagnosticsRev) /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] @@ -358,7 +363,7 @@ type BoundModel private (tcConfig: TcConfig, else this - member this.Next(syntaxTree, tcInfo) = + member _.Next(syntaxTree, tcInfo) = BoundModel( tcConfig, tcGlobals, @@ -374,10 +379,10 @@ type BoundModel private (tcConfig: TcConfig, Some syntaxTree, None) - member this.Finish(finalTcErrorsRev, finalTopAttribs) = + member _.Finish(finalTcDiagnosticsRev, finalTopAttribs) = node { let createFinish tcInfo = - { tcInfo with tcErrorsRev = finalTcErrorsRev; topAttribs = finalTopAttribs } + { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } let! finishState = node { @@ -467,14 +472,14 @@ type BoundModel private (tcConfig: TcConfig, | input, _sourceRange, fileName, parseErrors -> IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) - let capturingErrorLogger = CapturingErrorLogger("TypeCheck") - let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.errorSeverityOptions, capturingErrorLogger) + let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") + let errorLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) beforeFileChecked.Trigger fileName let prevModuleNamesDict = prevTcInfo.moduleNamesDict let prevTcState = prevTcInfo.tcState - let prevTcErrorsRev = prevTcInfo.tcErrorsRev + let prevTcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore @@ -498,7 +503,7 @@ type BoundModel private (tcConfig: TcConfig, Logger.LogBlockMessageStop fileName LogCompilerFunctionId.IncrementalBuild_TypeCheck fileChecked.Trigger fileName - let newErrors = Array.append parseErrors (capturingErrorLogger.Diagnostics |> List.toArray) + let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls let tcInfo = @@ -507,7 +512,7 @@ type BoundModel private (tcConfig: TcConfig, tcEnvAtEndOfFile = tcEnvAtEndOfFile moduleNamesDict = moduleNamesDict latestCcuSigForFile = Some ccuSigForFile - tcErrorsRev = newErrors :: prevTcErrorsRev + tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev topAttribs = Some topAttribs tcDependencyFiles = fileName :: prevTcDependencyFiles sigNameOpt = @@ -726,27 +731,28 @@ module IncrementalBuilderHelpers = // Link all the assemblies together and produce the input typecheck accumulator let CombineImportedAssembliesTask ( - assemblyName, - tcConfig: TcConfig, - tcConfigP, - tcGlobals, - frameworkTcImports, - nonFrameworkResolutions, - unresolvedReferences, - dependencyProvider, - loadClosureOpt: LoadClosure option, - niceNameGen, - basicDependencies, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - defaultPartialTypeChecking, - beforeFileChecked, - fileChecked, - importsInvalidatedByTypeProvider: Event) : NodeCode = + assemblyName, + tcConfig: TcConfig, + tcConfigP, + tcGlobals, + frameworkTcImports, + nonFrameworkResolutions, + unresolvedReferences, + dependencyProvider, + loadClosureOpt: LoadClosure option, + niceNameGen, + basicDependencies, + keepAssemblyContents, + keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + defaultPartialTypeChecking, + beforeFileChecked, + fileChecked, + importsInvalidatedByTypeProvider: Event) : NodeCode = + node { - let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) + let errorLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) let! tcImports = @@ -777,7 +783,7 @@ module IncrementalBuilderHelpers = #endif return tcImports with exn -> - System.Diagnostics.Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" exn) + Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" exn) errorLogger.Warning exn return frameworkTcImports } @@ -798,7 +804,7 @@ module IncrementalBuilderHelpers = tcEnvAtEndOfFile=tcInitial topAttribs=None latestCcuSigForFile=None - tcErrorsRev = [ initialErrors ] + tcDiagnosticsRev = [ initialErrors ] moduleNamesDict = Map.empty tcDependencyFiles = basicDependencies sigNameOpt = None @@ -837,14 +843,14 @@ module IncrementalBuilderHelpers = } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: block) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: ImmutableArray) = node { - let errorLogger = CompilationErrorLogger("FinalizeTypeCheckTask", tcConfig.errorSeverityOptions) + let errorLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) let! results = boundModels - |> Block.map (fun boundModel -> node { + |> ImmutableArray.map (fun boundModel -> node { if enablePartialTypeChecking then let! tcInfo = boundModel.GetOrComputeTcInfo() return tcInfo, None @@ -852,7 +858,7 @@ module IncrementalBuilderHelpers = let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() return tcInfo, tcInfoExtras.latestImplFile }) - |> Block.map (fun work -> + |> ImmutableArray.map (fun work -> node { let! tcInfo, latestImplFile = work return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) @@ -920,7 +926,7 @@ module IncrementalBuilderHelpers = errorRecoveryNoRange exn mkSimpleAssemblyRef assemblyName, ProjectAssemblyDataResult.Unavailable true, None - let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev + let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcDiagnosticsRev let! finalBoundModelWithErrors = finalBoundModel.Finish(diagnostics, Some topAttrs) return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } @@ -933,12 +939,12 @@ type IncrementalBuilderInitialState = { initialBoundModel: BoundModel tcGlobals: TcGlobals - referencedAssemblies: block * (TimeStampCache -> DateTime)> + referencedAssemblies: ImmutableArray * (TimeStampCache -> DateTime)> tcConfig: TcConfig outfile: string assemblyName: string lexResourceManager: Lexhelp.LexResourceManager - fileNames: block + fileNames: ImmutableArray enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event @@ -974,12 +980,12 @@ type IncrementalBuilderInitialState = { initialBoundModel = initialBoundModel tcGlobals = tcGlobals - referencedAssemblies = nonFrameworkAssemblyInputs |> Block.ofSeq + referencedAssemblies = nonFrameworkAssemblyInputs |> ImmutableArray.ofSeq tcConfig = tcConfig outfile = outfile assemblyName = assemblyName lexResourceManager = lexResourceManager - fileNames = sourceFiles |> Block.ofSeq + fileNames = sourceFiles |> ImmutableArray.ofSeq enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked @@ -1002,18 +1008,18 @@ type IncrementalBuilderState = { // stampedFileNames represent the real stamps of the files. // logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. - stampedFileNames: block - logicalStampedFileNames: block - stampedReferencedAssemblies: block + stampedFileNames: ImmutableArray + logicalStampedFileNames: ImmutableArray + stampedReferencedAssemblies: ImmutableArray initialBoundModel: GraphNode - boundModels: block> + boundModels: ImmutableArray> finalizedBoundModel: GraphNode<(ILAssemblyRef * ProjectAssemblyDataResult * TypedImplFile list option * BoundModel) * DateTime> } [] module IncrementalBuilderStateHelpers = - let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: blockbuilder>) i = + let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: ImmutableArray>.Builder) i = let fileInfo = initialState.fileNames[i] let prevBoundModelGraphNode = match i with @@ -1025,13 +1031,13 @@ module IncrementalBuilderStateHelpers = return! TypeCheckTask initialState.enablePartialTypeChecking prevBoundModel syntaxTree }) - let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: blockbuilder>) = + let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = GraphNode(node { // Compute last bound model then get all the evaluated models. let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue() let boundModels = boundModels.ToImmutable() - |> Block.map (fun x -> x.TryPeekValue().Value) + |> ImmutableArray.map (fun x -> x.TryPeekValue().Value) let! result = FinalizeTypeCheckTask @@ -1085,7 +1091,7 @@ module IncrementalBuilderStateHelpers = and computeStampedFileNames (initialState: IncrementalBuilderInitialState) state (cache: TimeStampCache) = let mutable i = 0 (state, initialState.fileNames) - ||> Block.fold (fun state fileInfo -> + ||> ImmutableArray.fold (fun state fileInfo -> let newState = computeStampedFileName initialState state cache i fileInfo i <- i + 1 newState @@ -1096,7 +1102,7 @@ module IncrementalBuilderStateHelpers = let mutable referencesUpdated = false initialState.referencedAssemblies - |> Block.iteri (fun i asmInfo -> + |> ImmutableArray.iteri (fun i asmInfo -> let currentStamp = state.stampedReferencedAssemblies[i] let stamp = StampReferencedAssemblyTask cache asmInfo @@ -1131,16 +1137,16 @@ type IncrementalBuilderState with let cache = TimeStampCache(defaultTimeStamp) let initialBoundModel = GraphNode(node.Return initialBoundModel) - let boundModels = BlockBuilder.create fileNames.Length + let boundModels = ImmutableArrayBuilder.create fileNames.Length for slot = 0 to fileNames.Length - 1 do boundModels.Add(createBoundModelGraphNode initialState initialBoundModel boundModels slot) let state = { - stampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) - logicalStampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) - stampedReferencedAssemblies = Block.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) + stampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) + logicalStampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) + stampedReferencedAssemblies = ImmutableArray.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) initialBoundModel = initialBoundModel boundModels = boundModels.ToImmutable() finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels @@ -1351,19 +1357,19 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc String.Compare(fileName, f2.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 || String.Compare(FileSystem.GetFullPathShim fileName, FileSystem.GetFullPathShim f2.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 result - match fileNames |> Block.tryFindIndex CompareFileNames with + match fileNames |> ImmutableArray.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None - member this.GetSlotOfFileName(fileName: string) = - match this.TryGetSlotOfFileName(fileName) with + member builder.GetSlotOfFileName(fileName: string) = + match builder.TryGetSlotOfFileName(fileName) with | Some slot -> slot | None -> failwith (sprintf "The file '%s' was not part of the project. Did you call InvalidateConfiguration when the list of files in the project changed?" fileName) member _.GetSlotsCount () = fileNames.Length - member this.ContainsFile(fileName: string) = - (this.TryGetSlotOfFileName fileName).IsSome + member builder.ContainsFile(fileName: string) = + (builder.TryGetSlotOfFileName fileName).IsSome member builder.GetParseResultsForFile fileName = let slotOfFile = builder.GetSlotOfFileName fileName @@ -1401,8 +1407,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc node { - // Trap and report warnings and errors from creation. - let delayedLogger = CapturingErrorLogger("IncrementalBuilderCreation") + // Trap and report diagnostics from creation. + let delayedLogger = CapturingDiagnosticsLogger("IncrementalBuilderCreation") use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) let! builderOpt = @@ -1513,8 +1519,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorOptions = tcConfig.errorSeverityOptions - let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) + let errorLogger = CompilationDiagnosticLogger("nonFrameworkAssemblyInputs", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) // Get the names and time stamps of all the non-framework referenced assemblies, which will act @@ -1524,7 +1529,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let nonFrameworkAssemblyInputs = // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) + let errorLogger = CompilationDiagnosticLogger("nonFrameworkAssemblyInputs", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) @@ -1535,10 +1540,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc for pr in projectReferences do yield Choice2Of2 pr, (fun (cache: TimeStampCache) -> cache.GetProjectReferenceTimeStamp pr) ] - // - // - // - // // Start importing let tcConfigP = TcConfigProvider.Constant tcConfig @@ -1639,13 +1640,14 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let diagnostics = match builderOpt with | Some builder -> - let errorSeverityOptions = builder.TcConfig.errorSeverityOptions - let errorLogger = CompilationErrorLogger("IncrementalBuilderCreation", errorSeverityOptions) + let diagnosticsOptions = builder.TcConfig.diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("IncrementalBuilderCreation", diagnosticsOptions) delayedLogger.CommitDelayedDiagnostics errorLogger errorLogger.GetDiagnostics() | _ -> Array.ofList delayedLogger.Diagnostics - |> Array.map (fun (d, severity) -> FSharpDiagnostic.CreateFromException(d, severity, range.Zero, suggestNamesForErrors)) + |> Array.map (fun (diag, severity) -> + FSharpDiagnostic.CreateFromException(diag, severity, range.Zero, suggestNamesForErrors)) return builderOpt, diagnostics } \ No newline at end of file diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index ac4b206eb54..d55e1dcf7f9 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -12,7 +12,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure @@ -57,13 +57,14 @@ type internal TcInfo = latestCcuSigForFile: ModuleOrNamespaceType option /// Accumulated errors, last file first - tcErrorsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] list + tcDiagnosticsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] list tcDependencyFiles: string list sigNameOpt: (string * QualifiedNameOfFile) option } - member TcErrors: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + /// Accumulated diagnostics + member TcDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 1f55a0e5c70..0cb7f19ba78 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -9,7 +9,7 @@ open Internal.Utilities.Library open FSharp.Compiler.Diagnostics open FSharp.Compiler.Import open FSharp.Compiler.Infos -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.TcGlobals @@ -17,6 +17,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy type SemanticClassificationType = | ReferenceType = 0 @@ -71,7 +72,7 @@ module TcResolutionsExtensions = type TcResolutions with member sResolutions.GetSemanticClassification(g: TcGlobals, amap: ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : SemanticClassificationItem [] = - ErrorScope.Protect range0 (fun () -> + DiagnosticsScope.Protect range0 (fun () -> let (|LegitTypeOccurence|_|) = function | ItemOccurence.UseInType | ItemOccurence.UseInAttribute @@ -341,7 +342,7 @@ module TcResolutionsExtensions = | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then add m SemanticClassificationType.Enumeration - elif tcref.IsExceptionDecl then + elif tcref.IsFSharpException then add m SemanticClassificationType.Exception elif tcref.IsFSharpDelegateTycon then add m SemanticClassificationType.Delegate diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index e65d12b8fa4..0a89eb646d2 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -247,7 +247,7 @@ module AssemblyContent = // are not triggered (see "if not entity.IsProvided") and the other data accessed is immutable or computed safely // on-demand. However a more compete review may be warranted. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() signature.TryGetEntities() |> Seq.collect (traverseEntity contentType Parent.Empty) @@ -265,7 +265,7 @@ module AssemblyContent = // concurrently with other threads. On an initial review this is not a problem since type provider computations // are not triggered (see "if not entity.IsProvided") and the other data accessed is immutable or computed safely // on-demand. However a more compete review may be warranted. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() #if !NO_TYPEPROVIDERS match assemblies |> List.filter (fun x -> not x.IsProviderGenerated), fileName with diff --git a/src/fsharp/service/ServiceCompilerDiagnostics.fs b/src/fsharp/service/ServiceCompilerDiagnostics.fs index abbedea37d2..f61b8ad9b6f 100644 --- a/src/fsharp/service/ServiceCompilerDiagnostics.fs +++ b/src/fsharp/service/ServiceCompilerDiagnostics.fs @@ -17,7 +17,7 @@ module CompilerDiagnostics = | FSharpDiagnosticKind.AddIndexerDot -> FSComp.SR.addIndexerDot() | FSharpDiagnosticKind.ReplaceWithSuggestion s -> FSComp.SR.replaceWithSuggestion(s) - let GetSuggestedNames (suggestionsF: FSharp.Compiler.ErrorLogger.Suggestions) (unresolvedIdentifier: string) = + let GetSuggestedNames (suggestionsF: FSharp.Compiler.DiagnosticsLogger.Suggestions) (unresolvedIdentifier: string) = let buffer = SuggestionBuffer(unresolvedIdentifier) if buffer.Disabled then Seq.empty diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index e0ec1e81016..cae7ebfe708 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution @@ -222,7 +222,7 @@ module DeclarationListHelpers = let remarks = toArray remarks ToolTipElement.Single (layout, xml, remarks=remarks) - | Item.RecdField rfinfo when rfinfo.TyconRef.IsExceptionDecl -> + | Item.RecdField rfinfo when rfinfo.TyconRef.IsFSharpException -> let ty, _ = PrettyTypes.PrettifyType g rfinfo.FieldType let id = rfinfo.RecdField.Id let layout = @@ -459,7 +459,7 @@ module DeclarationListHelpers = /// Format the structured version of a tooltip for an item let FormatStructuredDescriptionOfItem isDecl infoReader ad m denv item = - ErrorScope.Protect m + DiagnosticsScope.Protect m (fun () -> FormatItemDescriptionToToolTipElement isDecl infoReader ad m denv item) (fun err -> ToolTipElement.CompositionError err) @@ -857,7 +857,7 @@ module internal DescriptionListsImpl = | Item.Types _ -> FSharpGlyph.Class | Item.UnqualifiedType (tcref :: _) -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then FSharpGlyph.Enum - elif tcref.IsExceptionDecl then FSharpGlyph.Exception + elif tcref.IsFSharpException then FSharpGlyph.Exception elif tcref.IsFSharpDelegateTycon then FSharpGlyph.Delegate elif tcref.IsFSharpInterfaceTycon then FSharpGlyph.Interface elif tcref.IsFSharpStructOrEnumTycon then FSharpGlyph.Struct @@ -1183,7 +1183,7 @@ type MethodGroup( name: string, unsortedMethods: MethodGroupItem[] ) = let methods = flatItems |> Array.ofList |> Array.map (fun flatItem -> let prettyParams, prettyRetTyL = - ErrorScope.Protect m + DiagnosticsScope.Protect m (fun () -> PrettyParamsAndReturnTypeOfItem infoReader m denv { item with Item = flatItem }) (fun err -> [], wordL (tagText err)) diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index 8996aa276ee..a823215c5f3 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -11,7 +11,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Lexhelp open FSharp.Compiler.Parser @@ -334,10 +334,20 @@ module internal TestExpose = type FSharpTokenizerLexState = { PosBits: int64 OtherBits: int64 } + static member Initial = { PosBits = 0L; OtherBits = 0L } - member this.Equals (other: FSharpTokenizerLexState) = (this.PosBits = other.PosBits) && (this.OtherBits = other.OtherBits) - override this.Equals (obj: obj) = match obj with :? FSharpTokenizerLexState as other -> this.Equals other | _ -> false - override this.GetHashCode () = hash this.PosBits + hash this.OtherBits + + member this.Equals (other: FSharpTokenizerLexState) = + (this.PosBits = other.PosBits) && + (this.OtherBits = other.OtherBits) + + override this.Equals (obj: obj) = + match obj with + | :? FSharpTokenizerLexState as other -> this.Equals other + | _ -> false + + override this.GetHashCode () = + hash this.PosBits + hash this.OtherBits type FSharpTokenizerColorState = | Token = 1 @@ -822,7 +832,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, member x.ScanToken (lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) let lightStatus, lexcont = LexerStateEncoding.decodeLexInt lexState let lightStatus = IndentationAwareSyntaxStatus(lightStatus, false) @@ -1511,7 +1521,7 @@ type FSharpToken = [] module FSharpLexerImpl = - let lexWithErrorLogger (text: ISourceText) conditionalDefines (flags: FSharpLexerFlags) reportLibraryOnlyFeatures langVersion errorLogger onToken pathMap (ct: CancellationToken) = + let lexWithDiagnosticsLogger (text: ISourceText) conditionalDefines (flags: FSharpLexerFlags) reportLibraryOnlyFeatures langVersion errorLogger onToken pathMap (ct: CancellationToken) = let canSkipTrivia = (flags &&& FSharpLexerFlags.SkipTrivia) = FSharpLexerFlags.SkipTrivia let isLightSyntaxOn = (flags &&& FSharpLexerFlags.LightSyntaxOn) = FSharpLexerFlags.LightSyntaxOn let isCompiling = (flags &&& FSharpLexerFlags.Compiling) = FSharpLexerFlags.Compiling @@ -1533,7 +1543,7 @@ module FSharpLexerImpl = lexer use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) resetLexbufPos "" lexbuf while not lexbuf.IsPastEndOfStream do @@ -1541,8 +1551,8 @@ module FSharpLexerImpl = onToken (getNextToken lexbuf) lexbuf.LexemeRange let lex text conditionalDefines flags reportLibraryOnlyFeatures langVersion lexCallback pathMap ct = - let errorLogger = CompilationErrorLogger("Lexer", FSharpDiagnosticOptions.Default) - lexWithErrorLogger text conditionalDefines flags reportLibraryOnlyFeatures langVersion errorLogger lexCallback pathMap ct + let errorLogger = CompilationDiagnosticLogger("Lexer", FSharpDiagnosticOptions.Default) + lexWithDiagnosticsLogger text conditionalDefines flags reportLibraryOnlyFeatures langVersion errorLogger lexCallback pathMap ct [] type FSharpLexer = diff --git a/src/fsharp/service/ServiceNavigation.fs b/src/fsharp/service/ServiceNavigation.fs index 520587fd50d..de3b0bece2c 100755 --- a/src/fsharp/service/ServiceNavigation.fs +++ b/src/fsharp/service/ServiceNavigation.fs @@ -218,7 +218,7 @@ module NavigationImpl = | _ -> [] // Returns class-members for the right dropdown - and processMembers members enclosingEntityKind : range * list = + and processMembers members enclosingEntityKind = let members = members |> List.groupBy (fun x -> x.Range) @@ -389,7 +389,7 @@ module NavigationImpl = //| TyconCore_repr_hidden of range | _ -> [] - and processSigMembers (members: SynMemberSig list): list = + and processSigMembers (members: SynMemberSig list) = [ for memb in members do match memb with | SynMemberSig.Member(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _, _) -> @@ -399,37 +399,40 @@ module NavigationImpl = | _ -> () ] // Process declarations in a module that belong to the right drop-down (let bindings) - let processNestedSigDeclarations decls = decls |> List.collect (function - | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _) -> - [ createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) ] - | _ -> [] ) + let processNestedSigDeclarations decls = + decls |> List.collect (fun decl -> + match decl with + | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _) -> + [ createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) ] + | _ -> [] ) // Process declarations nested in a module that should be displayed in the left dropdown // (such as type declarations, nested modules etc.) let rec processNavigationTopLevelSigDeclarations(baseName, decls) = - decls - |> List.collect (function - | SynModuleSigDecl.ModuleAbbrev(id, lid, m) -> - [ createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, rangeOfLid lid, [], NavigationEntityKind.Module, false, None) ] + decls |> List.collect (fun decl -> + match decl with + | SynModuleSigDecl.ModuleAbbrev(id, lid, m) -> + [ createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, rangeOfLid lid, [], NavigationEntityKind.Module, false, None) ] - | SynModuleSigDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); moduleDecls=decls; range=m) -> - // Find let bindings (for the right dropdown) - let nested = processNestedSigDeclarations(decls) - let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) + | SynModuleSigDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); moduleDecls=decls; range=m) -> + // Find let bindings (for the right dropdown) + let nested = processNestedSigDeclarations(decls) + let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) - // Get nested modules and types (for the left dropdown) - let other = processNavigationTopLevelSigDeclarations(newBaseName, decls) - createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other), nested, NavigationEntityKind.Module, false, access) :: other + // Get nested modules and types (for the left dropdown) + let other = processNavigationTopLevelSigDeclarations(newBaseName, decls) + createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other), nested, NavigationEntityKind.Module, false, access) :: other - | SynModuleSigDecl.Types(tydefs, _) -> tydefs |> List.collect (processTycon baseName) - | SynModuleSigDecl.Exception (defn,_) -> processExnSig baseName defn - | _ -> []) + | SynModuleSigDecl.Types(tydefs, _) -> tydefs |> List.collect (processTycon baseName) + | SynModuleSigDecl.Exception (defn,_) -> processExnSig baseName defn + | _ -> []) // Collect all the items let items = // Show base name for this module only if it's not the root one let singleTopLevel = (modules.Length = 1) - modules |> List.collect (fun (SynModuleOrNamespaceSig(id, _isRec, kind, decls, _, _, access, m, _)) -> + modules |> List.collect (fun modulSig -> + let (SynModuleOrNamespaceSig(id, _isRec, kind, decls, _, _, access, m, _)) = modulSig let baseName = if (not singleTopLevel) then textOfLid id else "" // Find let bindings (for the right dropdown) let nested = processNestedSigDeclarations(decls) diff --git a/src/fsharp/service/ServiceParamInfoLocations.fs b/src/fsharp/service/ServiceParamInfoLocations.fs index f883e171430..8d1f8e93d23 100755 --- a/src/fsharp/service/ServiceParamInfoLocations.fs +++ b/src/fsharp/service/ServiceParamInfoLocations.fs @@ -34,14 +34,22 @@ type ParameterLocations // (compare to f( or f(42, where the parser injects a fake "AbrExpr" to represent the missing argument) assert(tupleEndLocations.Length = namedParamNames.Length + 1) [| yield! namedParamNames; yield None |] // None is representation of a non-named param - member this.LongId = longId - member this.LongIdStartLocation = longIdRange.Start - member this.LongIdEndLocation = longIdRange.End - member this.OpenParenLocation = openParenLocation - member this.TupleEndLocations = tupleEndLocations - member this.IsThereACloseParen = isThereACloseParen - member this.NamedParamNames = namedParamNames - member this.ArgumentLocations = argRanges |> Array.ofList + + member _.LongId = longId + + member _.LongIdStartLocation = longIdRange.Start + + member _.LongIdEndLocation = longIdRange.End + + member _.OpenParenLocation = openParenLocation + + member _.TupleEndLocations = tupleEndLocations + + member _.IsThereACloseParen = isThereACloseParen + + member _.NamedParamNames = namedParamNames + + member _.ArgumentLocations = argRanges |> Array.ofList [] module internal ParameterLocationsImpl = @@ -183,7 +191,7 @@ module internal ParameterLocationsImpl = let traverseInput(pos, parseTree) = SyntaxTraversal.Traverse(pos, parseTree, { new SyntaxVisitorBase<_>() with - member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let expr = expr // fix debug locals match expr with @@ -258,12 +266,12 @@ module internal ParameterLocationsImpl = | _ -> defaultTraverse expr - member this.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = + member _.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = match tyAbbrevRhs with | StaticParameters pos loc -> Some loc | _ -> None - member this.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = + member _.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = match defaultTraverse expr with | Some _ as r -> r | None -> diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index b98dd95378b..5e19aed8106 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -165,7 +165,7 @@ module SyntaxTraversal = let dive node range project = range,(fun() -> project node) - let pick pos (outerRange:range) (debugObj:obj) (diveResults:list) = + let pick pos (outerRange:range) (debugObj:obj) (diveResults: (range * _) list) = match diveResults with | [] -> None | _ -> diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index 0ef54b9058e..16000de1e75 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -355,7 +355,7 @@ module ParsedInput = let pick x = SyntaxTraversal.pick pos x let walker = { new SyntaxVisitorBase<_>() with - member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let pick = pick expr.Range let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars if not(rangeContainsPos expr.Range pos) then @@ -1610,7 +1610,7 @@ module ParsedInput = // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() let mutable result = None let mutable ns = None @@ -1742,7 +1742,7 @@ module ParsedInput = // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() match res with | None -> [||] | Some (scope, ns, pos) -> diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 8aa0a7e1ed4..bc9f5255c3e 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -705,7 +705,7 @@ module Structure = with the following construct. This necessitates inspecting the children of the construct and finding the end of the last child's range to use instead. - Detailed further in - https://github.com/Microsoft/visualfsharp/issues/2094 + Detailed further in - https://github.com/dotnet/fsharp/issues/2094 *) let lastMemberSigRangeElse r memberSigs = diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 0c8e892e156..9f4bb64466e 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.CompilerOptions open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure @@ -85,28 +85,33 @@ module Helpers = && FSharpProjectOptions.UseSameProject(o1,o2) module CompileHelpers = - let mkCompilationErrorHandlers() = - let errors = ResizeArray<_>() + let mkCompilationDiagnosticsHandlers() = + let diagnostics = ResizeArray<_>() - let errorSink isError exn = - let mainError, relatedErrors = SplitRelatedDiagnostics exn - let oneError e = errors.Add(FSharpDiagnostic.CreateFromException (e, isError, range0, true)) // Suggest names for errors - oneError mainError - List.iter oneError relatedErrors + let diagnosticSink isError exn = + let main, related = SplitRelatedDiagnostics exn + let oneDiagnostic e = diagnostics.Add(FSharpDiagnostic.CreateFromException (e, isError, range0, true)) // Suggest names for errors + oneDiagnostic main + List.iter oneDiagnostic related let errorLogger = - { new ErrorLogger("CompileAPI") with - member x.DiagnosticSink(exn, isError) = errorSink isError exn - member x.ErrorCount = errors |> Seq.filter (fun e -> e.Severity = FSharpDiagnosticSeverity.Error) |> Seq.length } + { new DiagnosticsLogger("CompileAPI") with + + member _.DiagnosticSink(exn, isError) = diagnosticSink isError exn + + member _.ErrorCount = + diagnostics + |> Seq.filter (fun diag -> diag.Severity = FSharpDiagnosticSeverity.Error) + |> Seq.length } let loggerProvider = - { new ErrorLoggerProvider() with - member x.CreateErrorLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } - errors, errorLogger, loggerProvider + { new DiagnosticsLoggerProvider() with + member _.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } + diagnostics, errorLogger, loggerProvider let tryCompile errorLogger f = use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + use unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let exiter = { new Exiter with member x.Exit n = raise StopProcessing } try f exiter @@ -118,25 +123,25 @@ module CompileHelpers = /// Compile using the given flags. Source files names are resolved via the FileSystem API. The output file must be given by a -o flag. let compileFromArgs (ctok, argv: string[], legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) = - let errors, errorLogger, loggerProvider = mkCompilationErrorHandlers() + let diagnostics, errorLogger, loggerProvider = mkCompilationDiagnosticsHandlers() let result = tryCompile errorLogger (fun exiter -> - mainCompile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) + CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) - errors.ToArray(), result + diagnostics.ToArray(), result let compileFromAsts (ctok, legacyReferenceResolver, asts, assemblyName, outFile, dependencies, noframework, pdbFile, executable, tcImportsCapture, dynamicAssemblyCreator) = - let errors, errorLogger, loggerProvider = mkCompilationErrorHandlers() + let diagnostics, errorLogger, loggerProvider = mkCompilationDiagnosticsHandlers() let executable = defaultArg executable true let target = if executable then CompilerTarget.ConsoleExe else CompilerTarget.Dll let result = tryCompile errorLogger (fun exiter -> - compileOfAst (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) + CompileFromSyntaxTrees (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) - errors.ToArray(), result + diagnostics.ToArray(), result let createDynamicAssembly (debugInfo: bool, tcImportsRef: TcImports option ref, execute: bool, assemblyBuilderRef: _ option ref) (tcConfig: TcConfig, tcGlobals:TcGlobals, outfile, ilxMainModule) = @@ -517,7 +522,7 @@ type BackgroundCompiler( return FSharpParseFileResults(creationDiags, parseTree, true, [| |]) | Some builder -> let parseTree,_,_,parseDiags = builder.GetParseResultsForFile fileName - let diagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.errorSeverityOptions, false, fileName, parseDiags, suggestNamesForErrors) |] + let diagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.diagnosticsOptions, false, fileName, parseDiags, suggestNamesForErrors) |] return FSharpParseFileResults(diagnostics = diagnostics, input = parseTree, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) } @@ -573,7 +578,7 @@ type BackgroundCompiler( tcInfo.tcState, tcInfo.moduleNamesDict, loadClosure, - tcInfo.TcErrors, + tcInfo.TcDiagnostics, options.IsIncompleteTypeCheckEnvironment, options, builder, @@ -725,10 +730,10 @@ type BackgroundCompiler( let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile let latestImplementationFile = tcInfoExtras.latestImplFile let tcDependencyFiles = tcInfo.tcDependencyFiles - let tcErrors = tcInfo.TcErrors - let errorOptions = builder.TcConfig.errorSeverityOptions - let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, parseDiags, suggestNamesForErrors) |] - let tcErrors = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, tcErrors, suggestNamesForErrors) |] + let tcDiagnostics = tcInfo.TcDiagnostics + let diagnosticsOptions = builder.TcConfig.diagnosticsOptions + let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, parseDiags, suggestNamesForErrors) |] + let tcDiagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, tcDiagnostics, suggestNamesForErrors) |] let parseResults = FSharpParseFileResults(diagnostics=parseDiags, input=parseTree, parseHadErrors=false, dependencyFiles=builder.AllDependenciesDeprecated) let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) let typedResults = @@ -743,7 +748,7 @@ type BackgroundCompiler( Array.ofList tcDependencyFiles, creationDiags, parseResults.Diagnostics, - tcErrors, + tcDiagnostics, keepAssemblyContents, Option.get latestCcuSigForFile, tcState.Ccu, @@ -815,7 +820,7 @@ type BackgroundCompiler( return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationDiags, None) | Some builder -> let! tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = builder.GetFullCheckResultsAndImplementationsForProject() - let errorOptions = tcProj.TcConfig.errorSeverityOptions + let diagnosticsOptions = tcProj.TcConfig.diagnosticsOptions let fileName = DummyFileNameForRangesWithoutASpecificLocation // Although we do not use 'tcInfoExtras', computing it will make sure we get an extra info. @@ -824,28 +829,32 @@ type BackgroundCompiler( let topAttribs = tcInfo.topAttribs let tcState = tcInfo.tcState let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile - let tcErrors = tcInfo.TcErrors + let tcDiagnostics = tcInfo.TcDiagnostics let tcDependencyFiles = tcInfo.tcDependencyFiles let diagnostics = [| yield! creationDiags; - yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, true, fileName, tcErrors, suggestNamesForErrors) |] + yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, true, fileName, tcDiagnostics, suggestNamesForErrors) |] let getAssemblyData() = match tcAssemblyDataOpt with | ProjectAssemblyDataResult.Available data -> Some data | _ -> None + let details = + (tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, + Choice1Of2 builder, topAttribs, getAssemblyData, ilAssemRef, + tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, + Array.ofList tcDependencyFiles, + options) + let results = - FSharpCheckProjectResults - (options.ProjectFileName, + FSharpCheckProjectResults( + options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, - diagnostics, - Some(tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, - (Choice1Of2 builder), topAttribs, getAssemblyData, ilAssemRef, - tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, - Array.ofList tcDependencyFiles, - options)) + diagnostics, + Some details + ) return results } @@ -878,7 +887,7 @@ type BackgroundCompiler( member _.GetProjectOptionsFromScript(fileName, sourceText, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib: bool option, useSdkRefs: bool option, sdkDirOverride: string option, assumeDotNetFramework: bool option, optionsStamp: int64 option, _userOpName) = cancellable { - use errors = new ErrorScope() + use diagnostics = new DiagnosticsScope() // Do we add a reference to FSharp.Compiler.Interactive.Settings by default? let useFsiAuxLib = defaultArg useFsiAuxLib true @@ -935,7 +944,7 @@ type BackgroundCompiler( } scriptClosureCache.Set(AnyCallerThread, options, loadClosure) // Save the full load closure for later correlation. let diags = loadClosure.LoadClosureRootFileDiagnostics |> List.map (fun (exn, isError) -> FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false)) - return options, (diags @ errors.Diagnostics) + return options, (diags @ diagnostics.Diagnostics) } |> Cancellable.toAsync @@ -1150,7 +1159,7 @@ type FSharpChecker(legacyReferenceResolver, let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) // Perform the compilation, given the above capturing function. - let errorsAndWarnings, result = CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) + let diagnostics, result = CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) // Retrieve and return the results let assemblyOpt = @@ -1158,7 +1167,7 @@ type FSharpChecker(legacyReferenceResolver, | None -> None | Some a -> Some (a :> Assembly) - return errorsAndWarnings, result, assemblyOpt + return diagnostics, result, assemblyOpt } member _.CompileToDynamicAssembly (ast:ParsedInput list, assemblyName:string, dependencies:string list, execute: (TextWriter * TextWriter) option, ?debug:bool, ?noframework:bool, ?userOpName: string) = @@ -1183,7 +1192,7 @@ type FSharpChecker(legacyReferenceResolver, let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) // Perform the compilation, given the above capturing function. - let errorsAndWarnings, result = + let diagnostics, result = CompileHelpers.compileFromAsts (ctok, legacyReferenceResolver, ast, assemblyName, outFile, dependencies, noframework, None, Some execute.IsSome, tcImportsCapture, dynamicAssemblyCreator) // Retrieve and return the results @@ -1192,7 +1201,7 @@ type FSharpChecker(legacyReferenceResolver, | None -> None | Some a -> Some (a :> Assembly) - return errorsAndWarnings, result, assemblyOpt + return diagnostics, result, assemblyOpt } /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation. @@ -1295,7 +1304,7 @@ type FSharpChecker(legacyReferenceResolver, member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive, ?isEditing) = let isEditing = defaultArg isEditing false let isInteractive = defaultArg isInteractive false - use errorScope = new ErrorScope() + use errorScope = new DiagnosticsScope() let tcConfigB = TcConfigBuilder.CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, @@ -1368,7 +1377,7 @@ open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.EditorServices open FSharp.Compiler.Text.Range -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger type CompilerEnvironment() = /// Source file extensions diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index b479ec8a47e..e9ccc85ddc8 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -6,7 +6,7 @@ open FSharp.Compiler open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.QuotationTranslator open FSharp.Compiler.Syntax @@ -14,6 +14,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations [] diff --git a/src/fsharp/symbols/FSharpDiagnostic.fs b/src/fsharp/symbols/FSharpDiagnostic.fs new file mode 100644 index 00000000000..09e118a3ea4 --- /dev/null +++ b/src/fsharp/symbols/FSharpDiagnostic.fs @@ -0,0 +1,207 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +//---------------------------------------------------------------------------- +// Open up the compiler as an incremental service for parsing, +// type checking and intellisense-like environment-reporting. +//-------------------------------------------------------------------------- + +namespace FSharp.Compiler.Diagnostics + +open System + +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +open FSharp.Core.Printf +open FSharp.Compiler +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Position +open FSharp.Compiler.Text.Range + +type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string) = + member _.Range = m + + member _.Severity = severity + + member _.Message = message + + member _.Subcategory = subcategory + + member _.ErrorNumber = errorNum + + member _.ErrorNumberPrefix = numberPrefix + + member _.ErrorNumberText = numberPrefix + errorNum.ToString("0000") + + member _.Start = m.Start + + member _.End = m.End + + member _.StartLine = m.Start.Line + + member _.EndLine = m.End.Line + + member _.StartColumn = m.Start.Column + + member _.EndColumn = m.End.Column + + member _.FileName = m.FileName + + member _.WithStart newStart = + let m = mkFileIndexRange m.FileIndex newStart m.End + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) + + member _.WithEnd newEnd = + let m = mkFileIndexRange m.FileIndex m.Start newEnd + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) + + override _.ToString() = + let fileName = m.FileName + let s = m.Start + let e = m.End + let severity = + match severity with + | FSharpDiagnosticSeverity.Warning -> "warning" + | FSharpDiagnosticSeverity.Error -> "error" + | FSharpDiagnosticSeverity.Info -> "info" + | FSharpDiagnosticSeverity.Hidden -> "hidden" + sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message + + /// Decompose a warning or error into parts: position, severity, message, error number + static member CreateFromException(diag, severity, fallbackRange: range, suggestNames: bool) = + let m = match GetRangeOfDiagnostic diag with Some m -> m | None -> fallbackRange + let msg = bufs (fun buf -> OutputPhasedDiagnostic buf diag false suggestNames) + let errorNum = GetDiagnosticNumber diag + FSharpDiagnostic(m, severity, msg, diag.Subcategory(), errorNum, "FS") + + /// Decompose a warning or error into parts: position, severity, message, error number + static member CreateFromExceptionAndAdjustEof(diag, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = + let diag = FSharpDiagnostic.CreateFromException(diag, severity, fallbackRange, suggestNames) + + // Adjust to make sure that errors reported at Eof are shown at the linesCount + let startline, schange = min (Line.toZ diag.Range.StartLine, false) (linesCount, true) + let endline, echange = min (Line.toZ diag.Range.EndLine, false) (linesCount, true) + + if not (schange || echange) then diag + else + let r = if schange then diag.WithStart(mkPos startline lastLength) else diag + if echange then r.WithEnd(mkPos endline (1 + lastLength)) else r + + static member NewlineifyErrorString(message) = NewlineifyErrorString(message) + + static member NormalizeErrorString(text) = NormalizeErrorString(text) + + static member Create(severity: FSharpDiagnosticSeverity, message: string, number: int, range: range, ?numberPrefix: string, ?subcategory: string) = + let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck + let numberPrefix = defaultArg numberPrefix "FS" + FSharpDiagnostic(range, severity, message, subcategory, number, numberPrefix) + +/// Use to reset error and warning handlers +[] +type DiagnosticsScope() = + let mutable diags = [] + let mutable firstError = None + let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + let unwindEL = + PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> + { new DiagnosticsLogger("DiagnosticsScope") with + member x.DiagnosticSink(exn, severity) = + let err = FSharpDiagnostic.CreateFromException(exn, severity, range.Zero, false) + diags <- err :: diags + if severity = FSharpDiagnosticSeverity.Error && firstError.IsNone then + firstError <- Some err.Message + member x.ErrorCount = diags.Length }) + + member _.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) + + member _.Diagnostics = diags + + member x.TryGetFirstErrorText() = + match x.Errors with + | error :: _ -> Some error.Message + | [] -> None + + interface IDisposable with + member _.Dispose() = + unwindEL.Dispose() (* unwind pushes when DiagnosticsScope disposes *) + unwindBP.Dispose() + + member _.FirstError with get() = firstError and set v = firstError <- v + + /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and + /// perform other operations which might expose us to either bona-fide F# error messages such + /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, + /// may hit internal compiler failures. + /// + /// In some calling cases, we get a chance to report the error as part of user text. For example + /// if there is a "missing assembly" error while formatting the text of the description of an + /// autocomplete, then the error message is shown in replacement of the text (rather than crashing Visual + /// Studio, or swallowing the exception completely) + static member Protect<'a> (m: range) (f: unit->'a) (err: string->'a): 'a = + use errorScope = new DiagnosticsScope() + let res = + try + Some (f()) + with e -> + // Here we only call errorRecovery to save the error message for later use by TryGetFirstErrorText. + try + errorRecovery e m + with _ -> + // If error recovery fails, then we have an internal compiler error. In this case, we show the whole stack + // in the extra message, should the extra message be used. + errorScope.FirstError <- Some (e.ToString()) + None + match res with + | Some res -> res + | None -> + match errorScope.TryGetFirstErrorText() with + | Some text -> err text + | None -> err "" + +/// An error logger that capture errors, filtering them according to warning levels etc. +type internal CompilationDiagnosticLogger (debugName: string, options: FSharpDiagnosticOptions) = + inherit DiagnosticsLogger("CompilationDiagnosticLogger("+debugName+")") + + let mutable errorCount = 0 + let diagnostics = ResizeArray<_>() + + override _.DiagnosticSink(err, severity) = + if ReportDiagnosticAsError options (err, severity) then + diagnostics.Add(err, FSharpDiagnosticSeverity.Error) + errorCount <- errorCount + 1 + elif ReportDiagnosticAsWarning options (err, severity) then + diagnostics.Add(err, FSharpDiagnosticSeverity.Warning) + elif ReportDiagnosticAsInfo options (err, severity) then + diagnostics.Add(err, severity) + override x.ErrorCount = errorCount + + member x.GetDiagnostics() = diagnostics.ToArray() + +module DiagnosticHelpers = + + let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) = + [ let severity = + if ReportDiagnosticAsError options (exn, severity) then FSharpDiagnosticSeverity.Error + else severity + if (severity = FSharpDiagnosticSeverity.Error || ReportDiagnosticAsWarning options (exn, severity) || ReportDiagnosticAsInfo options (exn, severity)) then + let oneError exn = + [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. + // Not ideal, but it's hard to see what else to do. + let fallbackRange = rangeN mainInputFileName 1 + let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, severity, fallbackRange, fileInfo, suggestNames) + let fileName = ei.Range.FileName + if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then + yield ei ] + + let mainError, relatedErrors = SplitRelatedDiagnostics exn + yield! oneError mainError + for e in relatedErrors do + yield! oneError e ] + + let CreateDiagnostics (options, allErrors, mainInputFileName, errors, suggestNames) = + let fileInfo = (Int32.MaxValue, Int32.MaxValue) + [| for exn, severity in errors do + yield! ReportDiagnostic (options, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) |] diff --git a/src/fsharp/symbols/FSharpDiagnostic.fsi b/src/fsharp/symbols/FSharpDiagnostic.fsi new file mode 100644 index 00000000000..2e5ea40dcf2 --- /dev/null +++ b/src/fsharp/symbols/FSharpDiagnostic.fsi @@ -0,0 +1,130 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +//---------------------------------------------------------------------------- +// Helpers for quick info and information about items +//---------------------------------------------------------------------------- + +namespace FSharp.Compiler.Diagnostics + +open System +open FSharp.Compiler.Text +open FSharp.Compiler.DiagnosticsLogger + +/// Represents a diagnostic produced by the F# compiler +[] +type public FSharpDiagnostic = + + /// Gets the file name for the diagnostic + member FileName: string + + /// Gets the start position for the diagnostic + member Start: Position + + /// Gets the end position for the diagnostic + member End: Position + + /// Gets the start column for the diagnostic + member StartColumn: int + + /// Gets the end column for the diagnostic + member EndColumn: int + + /// Gets the start line for the diagnostic + member StartLine: int + + /// Gets the end line for the diagnostic + member EndLine: int + + /// Gets the range for the diagnostic + member Range: range + + /// Gets the severity for the diagnostic + member Severity: FSharpDiagnosticSeverity + + /// Gets the message for the diagnostic + member Message: string + + /// Gets the sub-category for the diagnostic + member Subcategory: string + + /// Gets the number for the diagnostic + member ErrorNumber: int + + /// Gets the number prefix for the diagnostic, usually "FS" but may differ for analyzers + member ErrorNumberPrefix: string + + /// Gets the full error number text e.g "FS0031" + member ErrorNumberText: string + + /// Creates a diagnostic, e.g. for reporting from an analyzer + static member Create: + severity: FSharpDiagnosticSeverity * + message: string * + number: int * + range: range * + ?numberPrefix: string * + ?subcategory: string -> + FSharpDiagnostic + + static member internal CreateFromExceptionAndAdjustEof: + diag: PhasedDiagnostic * + severity: FSharpDiagnosticSeverity * + range * + lastPosInFile: (int * int) * + suggestNames: bool -> + FSharpDiagnostic + + static member internal CreateFromException: + diag: PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic + + /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), + /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo + static member NewlineifyErrorString: message: string -> string + + /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), + /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo + static member NormalizeErrorString: text: string -> string + +//---------------------------------------------------------------------------- +// Internal only + +// Implementation details used by other code in the compiler +[] +type internal DiagnosticsScope = + + interface IDisposable + + new: unit -> DiagnosticsScope + + member Diagnostics: FSharpDiagnostic list + + static member Protect<'T> : range -> (unit -> 'T) -> (string -> 'T) -> 'T + +/// An error logger that capture errors, filtering them according to warning levels etc. +type internal CompilationDiagnosticLogger = + inherit DiagnosticsLogger + + /// Create the diagnostics logger + new: debugName: string * options: FSharpDiagnosticOptions -> CompilationDiagnosticLogger + + /// Get the captured diagnostics + member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + +module internal DiagnosticHelpers = + + val ReportDiagnostic: + FSharpDiagnosticOptions * + allErrors: bool * + mainInputFileName: string * + fileInfo: (int * int) * + (PhasedDiagnostic * FSharpDiagnosticSeverity) * + suggestNames: bool -> + FSharpDiagnostic list + + val CreateDiagnostics: + FSharpDiagnosticOptions * + allErrors: bool * + mainInputFileName: string * + seq * + suggestNames: bool -> + FSharpDiagnostic [] diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 8f7962d8862..5def8ebe7be 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -1,212 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -//---------------------------------------------------------------------------- -// Open up the compiler as an incremental service for parsing, -// type checking and intellisense-like environment-reporting. -//-------------------------------------------------------------------------- - -namespace FSharp.Compiler.Diagnostics - -open System - -open Internal.Utilities.Library -open Internal.Utilities.Library.Extras - -open FSharp.Core.Printf -open FSharp.Compiler -open FSharp.Compiler.CompilerDiagnostics -open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Text -open FSharp.Compiler.Text.Position -open FSharp.Compiler.Text.Range - -type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string) = - member _.Range = m - - member _.Severity = severity - - member _.Message = message - - member _.Subcategory = subcategory - - member _.ErrorNumber = errorNum - - member _.ErrorNumberPrefix = numberPrefix - - member _.ErrorNumberText = numberPrefix + errorNum.ToString("0000") - - member _.Start = m.Start - - member _.End = m.End - - member _.StartLine = m.Start.Line - - member _.EndLine = m.End.Line - - member _.StartColumn = m.Start.Column - - member _.EndColumn = m.End.Column - - member _.FileName = m.FileName - - member _.WithStart newStart = - let m = mkFileIndexRange m.FileIndex newStart m.End - FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) - - member _.WithEnd newEnd = - let m = mkFileIndexRange m.FileIndex m.Start newEnd - FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) - - override _.ToString() = - let fileName = m.FileName - let s = m.Start - let e = m.End - let severity = - match severity with - | FSharpDiagnosticSeverity.Warning -> "warning" - | FSharpDiagnosticSeverity.Error -> "error" - | FSharpDiagnosticSeverity.Info -> "info" - | FSharpDiagnosticSeverity.Hidden -> "hidden" - sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message - - /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromException(exn, severity, fallbackRange: range, suggestNames: bool) = - let m = match GetRangeOfDiagnostic exn with Some m -> m | None -> fallbackRange - let msg = bufs (fun buf -> OutputPhasedDiagnostic buf exn false suggestNames) - let errorNum = GetDiagnosticNumber exn - FSharpDiagnostic(m, severity, msg, exn.Subcategory(), errorNum, "FS") - - /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromExceptionAndAdjustEof(exn, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = - let r = FSharpDiagnostic.CreateFromException(exn, severity, fallbackRange, suggestNames) - - // Adjust to make sure that errors reported at Eof are shown at the linesCount - let startline, schange = min (Line.toZ r.Range.StartLine, false) (linesCount, true) - let endline, echange = min (Line.toZ r.Range.EndLine, false) (linesCount, true) - - if not (schange || echange) then r - else - let r = if schange then r.WithStart(mkPos startline lastLength) else r - if echange then r.WithEnd(mkPos endline (1 + lastLength)) else r - - static member NewlineifyErrorString(message) = NewlineifyErrorString(message) - - static member NormalizeErrorString(text) = NormalizeErrorString(text) - - static member Create(severity: FSharpDiagnosticSeverity, message: string, number: int, range: range, ?numberPrefix: string, ?subcategory: string) = - let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck - let numberPrefix = defaultArg numberPrefix "FS" - FSharpDiagnostic(range, severity, message, subcategory, number, numberPrefix) - -/// Use to reset error and warning handlers -[] -type ErrorScope() = - let mutable diags = [] - let mutable firstError = None - let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck - let unwindEL = - PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> - { new ErrorLogger("ErrorScope") with - member x.DiagnosticSink(exn, severity) = - let err = FSharpDiagnostic.CreateFromException(exn, severity, range.Zero, false) - diags <- err :: diags - if severity = FSharpDiagnosticSeverity.Error && firstError.IsNone then - firstError <- Some err.Message - member x.ErrorCount = diags.Length }) - - member x.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) - - member x.Diagnostics = diags - - member x.TryGetFirstErrorText() = - match x.Errors with - | error :: _ -> Some error.Message - | [] -> None - - interface IDisposable with - member d.Dispose() = - unwindEL.Dispose() (* unwind pushes when ErrorScope disposes *) - unwindBP.Dispose() - - member x.FirstError with get() = firstError and set v = firstError <- v - - /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and - /// perform other operations which might expose us to either bona-fide F# error messages such - /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, - /// may hit internal compiler failures. - /// - /// In some calling cases, we get a chance to report the error as part of user text. For example - /// if there is a "missing assembly" error while formatting the text of the description of an - /// autocomplete, then the error message is shown in replacement of the text (rather than crashing Visual - /// Studio, or swallowing the exception completely) - static member Protect<'a> (m: range) (f: unit->'a) (err: string->'a): 'a = - use errorScope = new ErrorScope() - let res = - try - Some (f()) - with e -> - // Here we only call errorRecovery to save the error message for later use by TryGetFirstErrorText. - try - errorRecovery e m - with _ -> - // If error recovery fails, then we have an internal compiler error. In this case, we show the whole stack - // in the extra message, should the extra message be used. - errorScope.FirstError <- Some (e.ToString()) - None - match res with - | Some res -> res - | None -> - match errorScope.TryGetFirstErrorText() with - | Some text -> err text - | None -> err "" - -/// An error logger that capture errors, filtering them according to warning levels etc. -type internal CompilationErrorLogger (debugName: string, options: FSharpDiagnosticOptions) = - inherit ErrorLogger("CompilationErrorLogger("+debugName+")") - - let mutable errorCount = 0 - let diagnostics = ResizeArray<_>() - - override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError options (err, severity) then - diagnostics.Add(err, FSharpDiagnosticSeverity.Error) - errorCount <- errorCount + 1 - elif ReportDiagnosticAsWarning options (err, severity) then - diagnostics.Add(err, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo options (err, severity) then - diagnostics.Add(err, severity) - override x.ErrorCount = errorCount - - member x.GetDiagnostics() = diagnostics.ToArray() - -module DiagnosticHelpers = - - let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) = - [ let severity = - if ReportDiagnosticAsError options (exn, severity) then FSharpDiagnosticSeverity.Error - else severity - if (severity = FSharpDiagnosticSeverity.Error || ReportDiagnosticAsWarning options (exn, severity) || ReportDiagnosticAsInfo options (exn, severity)) then - let oneError exn = - [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. - // Not ideal, but it's hard to see what else to do. - let fallbackRange = rangeN mainInputFileName 1 - let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, severity, fallbackRange, fileInfo, suggestNames) - let fileName = ei.Range.FileName - if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then - yield ei ] - - let mainError, relatedErrors = SplitRelatedDiagnostics exn - yield! oneError mainError - for e in relatedErrors do - yield! oneError e ] - - let CreateDiagnostics (options, allErrors, mainInputFileName, errors, suggestNames) = - let fileInfo = (Int32.MaxValue, Int32.MaxValue) - [| for exn, severity in errors do - yield! ReportDiagnostic (options, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) |] - - namespace FSharp.Compiler.Symbols open System.IO @@ -216,7 +9,7 @@ open Internal.Utilities.Library.Extras open FSharp.Core.Printf open FSharp.Compiler open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.IO @@ -230,6 +23,7 @@ open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TcGlobals /// Describe a comment as either a block of text or a file+signature reference into an intellidoc file. @@ -759,7 +553,7 @@ module internal SymbolHelpers = let tcref = rfinfo.TyconRef let xmldoc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then - if tcref.IsExceptionDecl then + if tcref.IsFSharpException then Some tcref.XmlDoc else Some rfinfo.RecdField.XmlDoc diff --git a/src/fsharp/symbols/SymbolHelpers.fsi b/src/fsharp/symbols/SymbolHelpers.fsi index 8cb781565db..d0057c47496 100755 --- a/src/fsharp/symbols/SymbolHelpers.fsi +++ b/src/fsharp/symbols/SymbolHelpers.fsi @@ -4,122 +4,6 @@ // Helpers for quick info and information about items //---------------------------------------------------------------------------- -namespace FSharp.Compiler.Diagnostics - -open System -open FSharp.Compiler.Text -open FSharp.Compiler.ErrorLogger - -/// Represents a diagnostic produced by the F# compiler -[] -type public FSharpDiagnostic = - - /// Gets the file name for the diagnostic - member FileName: string - - /// Gets the start position for the diagnostic - member Start: Position - - /// Gets the end position for the diagnostic - member End: Position - - /// Gets the start column for the diagnostic - member StartColumn: int - - /// Gets the end column for the diagnostic - member EndColumn: int - - /// Gets the start line for the diagnostic - member StartLine: int - - /// Gets the end line for the diagnostic - member EndLine: int - - /// Gets the range for the diagnostic - member Range: range - - /// Gets the severity for the diagnostic - member Severity: FSharpDiagnosticSeverity - - /// Gets the message for the diagnostic - member Message: string - - /// Gets the sub-category for the diagnostic - member Subcategory: string - - /// Gets the number for the diagnostic - member ErrorNumber: int - - /// Gets the number prefix for the diagnostic, usually "FS" but may differ for analyzers - member ErrorNumberPrefix: string - - /// Gets the full error number text e.g "FS0031" - member ErrorNumberText: string - - /// Creates a diagnostic, e.g. for reporting from an analyzer - static member Create: - severity: FSharpDiagnosticSeverity * - message: string * - number: int * - range: range * - ?numberPrefix: string * - ?subcategory: string -> - FSharpDiagnostic - - static member internal CreateFromExceptionAndAdjustEof: - PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int * int) * suggestNames: bool -> - FSharpDiagnostic - - static member internal CreateFromException: - PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic - - /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), - /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo - static member NewlineifyErrorString: message: string -> string - - /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), - /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo - static member NormalizeErrorString: text: string -> string - -//---------------------------------------------------------------------------- -// Internal only - -// Implementation details used by other code in the compiler -[] -type internal ErrorScope = - interface IDisposable - new: unit -> ErrorScope - member Diagnostics: FSharpDiagnostic list - static member Protect<'a> : range -> (unit -> 'a) -> (string -> 'a) -> 'a - -/// An error logger that capture errors, filtering them according to warning levels etc. -type internal CompilationErrorLogger = - inherit ErrorLogger - - /// Create the diagnostics logger - new: debugName: string * options: FSharpDiagnosticOptions -> CompilationErrorLogger - - /// Get the captured diagnostics - member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity) [] - -module internal DiagnosticHelpers = - val ReportDiagnostic: - FSharpDiagnosticOptions * - allErrors: bool * - mainInputFileName: string * - fileInfo: (int * int) * - (PhasedDiagnostic * FSharpDiagnosticSeverity) * - suggestNames: bool -> - FSharpDiagnostic list - - val CreateDiagnostics: - FSharpDiagnosticOptions * - allErrors: bool * - mainInputFileName: string * - seq * - suggestNames: bool -> - FSharpDiagnostic [] - namespace FSharp.Compiler.Symbols open Internal.Utilities.Library diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 25183fd4652..292457e6e67 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -16,15 +16,16 @@ open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax +open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.Xml +open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics -open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.Syntax.PrettyNaming +open FSharp.Compiler.TypeHierarchy type FSharpAccessibility(a:Accessibility, ?isProtected) = let isProtected = defaultArg isProtected false @@ -75,7 +76,7 @@ type SymbolEnv(g: TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceTyp [] module Impl = let protect f = - ErrorLogger.protectAssemblyExplorationF + DiagnosticsLogger.protectAssemblyExplorationF (fun (asmName, path) -> invalidOp (sprintf "The entity or value '%s' does not exist or is in an unresolved assembly. You may need to add a reference to assembly '%s'" path asmName)) f @@ -546,7 +547,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = entity.IsEnumTycon member _.IsFSharpExceptionDeclaration = - isResolvedAndFSharp() && entity.IsExceptionDecl + isResolvedAndFSharp() && entity.IsFSharpException member _.IsUnresolved = isUnresolved() @@ -586,7 +587,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.DeclaredInterfaces = if isUnresolved() then makeReadOnlyCollection [] else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration [] (fun () -> + DiagnosticsLogger.protectAssemblyExploration [] (fun () -> [ for ity in GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes cenv.g cenv.amap range0 ty do yield FSharpType(cenv, ity) ]) |> makeReadOnlyCollection @@ -594,7 +595,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.AllInterfaces = if isUnresolved() then makeReadOnlyCollection [] else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration [] (fun () -> + DiagnosticsLogger.protectAssemblyExploration [] (fun () -> [ for ity in AllInterfacesOfType cenv.g cenv.amap range0 AllowMultiIntfInstantiations.Yes ty do yield FSharpType(cenv, ity) ]) |> makeReadOnlyCollection @@ -602,13 +603,13 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.IsAttributeType = if isUnresolved() then false else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration false <| fun () -> + DiagnosticsLogger.protectAssemblyExploration false <| fun () -> ExistsHeadTypeInEntireHierarchy cenv.g cenv.amap range0 ty cenv.g.tcref_System_Attribute member _.IsDisposableType = if isUnresolved() then false else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration false <| fun () -> + DiagnosticsLogger.protectAssemblyExploration false <| fun () -> ExistsHeadTypeInEntireHierarchy cenv.g cenv.amap range0 ty cenv.g.tcref_System_IDisposable member _.BaseType = @@ -2322,7 +2323,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = type FSharpType(cenv, ty:TType) = let isUnresolved() = - ErrorLogger.protectAssemblyExploration true <| fun () -> + DiagnosticsLogger.protectAssemblyExploration true <| fun () -> match stripTyparEqns ty with | TType_app (tcref, _, _) -> FSharpEntity(cenv, tcref).IsUnresolved | TType_measure (Measure.Con tcref) -> FSharpEntity(cenv, tcref).IsUnresolved diff --git a/src/fsharp/tainted.fs b/src/fsharp/tainted.fs index a50b2dd2dba..0eb274fa48b 100644 --- a/src/fsharp/tainted.fs +++ b/src/fsharp/tainted.fs @@ -107,7 +107,7 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = let errNum,_ = FSComp.SR.etProviderError("", "") raise <| TypeProviderError((errNum, e.Message), this.TypeProviderDesignation, range) - member this.TypeProvider = Tainted<_>(context, context.TypeProvider) + member _.TypeProvider = Tainted<_>(context, context.TypeProvider) member this.PApply(f,range: range) = let u = this.Protect f range @@ -148,13 +148,13 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = member this.PUntaintNoFailure f = this.PUntaint(f, range0) /// Access the target object directly. Use with extreme caution. - member this.AccessObjectDirectly = value + member _.AccessObjectDirectly = value static member CreateAll(providerSpecs: (ITypeProvider * ILScopeRef) list) = [for tp,nm in providerSpecs do yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; Lock=TypeProviderLock() },tp) ] - member this.OfType<'U> () = + member _.OfType<'U> () = match box value with | :? 'U as u -> Some (Tainted(context,u)) | _ -> None diff --git a/src/fsharp/utils/CompilerLocationUtils.fs b/src/fsharp/utils/CompilerLocationUtils.fs index d6df7915d7f..3e22c1aab0a 100644 --- a/src/fsharp/utils/CompilerLocationUtils.fs +++ b/src/fsharp/utils/CompilerLocationUtils.fs @@ -248,7 +248,7 @@ module internal FSharpEnvironment = // Specify the tooling-compatible fragments of a path such as: // typeproviders/fsharp41/net461/MyProvider.DesignTime.dll // tools/fsharp41/net461/MyProvider.DesignTime.dll - // See https://github.com/Microsoft/visualfsharp/issues/3736 + // See https://github.com/dotnet/fsharp/issues/3736 // Represents the F#-compiler <-> type provider protocol. // When the API or protocol updates, add a new version moniker to the front of the list here. diff --git a/src/fsharp/utils/prim-lexing.fs b/src/fsharp/utils/prim-lexing.fs index 4e33ef35c65..be5740f14d2 100644 --- a/src/fsharp/utils/prim-lexing.fs +++ b/src/fsharp/utils/prim-lexing.fs @@ -255,7 +255,7 @@ namespace Internal.Utilities.Text.Lexing member _.SupportsFeature featureId = langVersion.SupportsFeature featureId member _.CheckLanguageFeatureErrorRecover featureId range = - FSharp.Compiler.ErrorLogger.checkLanguageFeatureErrorRecover langVersion featureId range + FSharp.Compiler.DiagnosticsLogger.checkLanguageFeatureErrorRecover langVersion featureId range static member FromFunction (reportLibraryOnlyFeatures, langVersion, f : 'Char[] * int * int -> int) : LexBuffer<'Char> = let extension= Array.zeroCreate 4096 diff --git a/src/fsharp/utils/sformat.fs b/src/fsharp/utils/sformat.fs index c29ff687543..1ee3032b150 100644 --- a/src/fsharp/utils/sformat.fs +++ b/src/fsharp/utils/sformat.fs @@ -443,7 +443,7 @@ module ReflectUtils = let isListType ty = FSharpType.IsUnion ty && (let cases = FSharpType.GetUnionCases ty - cases.Length > 0 && equivHeadTypes typedefof> cases[0].DeclaringType) + cases.Length > 0 && equivHeadTypes typedefof<_ list> cases[0].DeclaringType) [] type TupleType = diff --git a/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs b/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs index a5d852b2625..ad3c87c24fc 100644 --- a/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs +++ b/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs @@ -14,27 +14,36 @@ type MockEngine() = member val Messages = ResizeArray() with get interface IBuildEngine with - member this.BuildProjectFile(projectFileName: string, targetNames: string [], globalProperties: System.Collections.IDictionary, targetOutputs: System.Collections.IDictionary): bool = + + member _.BuildProjectFile(projectFileName: string, targetNames: string [], globalProperties: System.Collections.IDictionary, targetOutputs: System.Collections.IDictionary): bool = failwith "Not Implemented" - member this.ColumnNumberOfTaskNode: int = 0 - member this.ContinueOnError: bool = true - member this.LineNumberOfTaskNode: int = 0 + + member _.ColumnNumberOfTaskNode: int = 0 + + member _.ContinueOnError = true + + member _.LineNumberOfTaskNode: int = 0 + member this.LogCustomEvent(e: CustomBuildEventArgs): unit = this.Custom.Add e failwith "Not Implemented" + member this.LogErrorEvent(e: BuildErrorEventArgs): unit = this.Errors.Add e + member this.LogMessageEvent(e: BuildMessageEventArgs): unit = this.Messages.Add e + member this.LogWarningEvent(e: BuildWarningEventArgs): unit = this.Warnings.Add e - member this.ProjectFileOfTaskNode: string = "" + + member _.ProjectFileOfTaskNode: string = "" type SourceRoot = SourceRoot of path: string * - props: list * - expectedProps: list + props: (string * string) list * + expectedProps: (string * string) list /// these tests are ported from https://github.com/dotnet/roslyn/blob/093ea477717001c58be6231cf2a793f4245cbf72/src/Compilers/Core/MSBuildTaskTests/MapSourceRootTests.cs @@ -71,7 +80,7 @@ type MapSourceRootsTests() = |> Array.iteri checkExpectations [] - member this.``basic deterministic scenarios`` () = + member _.``basic deterministic scenarios`` () = let items = [| SourceRoot(@"c:\packages\SourcePackage1\", [], ["MappedPath", @"/_1/"]) @@ -96,7 +105,7 @@ type MapSourceRootsTests() = [] - member this.``invalid chars`` () = + member _.``invalid chars`` () = let items = [| SourceRoot(@"!@#:;$%^&*()_+|{}\", [], ["MappedPath", @"/_1/"]) @@ -116,7 +125,7 @@ type MapSourceRootsTests() = successfulTest items [] - member this.``input paths must end with separator`` () = + member _.``input paths must end with separator`` () = let items = [| SourceRoot(@"C:\", [], []) @@ -145,7 +154,7 @@ type MapSourceRootsTests() = Assert.Fail("Expected to fail on the inputs") [] - member this.``nested roots separators`` () = + member _.``nested roots separators`` () = let items = [| SourceRoot(@"c:\MyProjects\MyProject\", [], [ @@ -174,7 +183,7 @@ type MapSourceRootsTests() = successfulTest items [] - member this.``sourceroot case sensitivity``() = + member _.``sourceroot case sensitivity``() = let items = [| SourceRoot(@"c:\packages\SourcePackage1\", [], ["MappedPath", @"/_/"]) SourceRoot(@"C:\packages\SourcePackage1\", [], ["MappedPath", @"/_1/"]) @@ -184,7 +193,7 @@ type MapSourceRootsTests() = successfulTest items [] - member this.``recursion error`` () = + member _.``recursion error`` () = let path1 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\1\" let path2 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\2\" let path3 = Utilities.FixFilePath @"c:\MyProjects\MyProject\" @@ -225,7 +234,7 @@ type MapSourceRootsTests() = [] [] [] - member this.``metadata merge 1`` (deterministic: bool) = + member _.``metadata merge 1`` (deterministic: bool) = let path1 = Utilities.FixFilePath @"c:\packages\SourcePackage1\" let path2 = Utilities.FixFilePath @"c:\packages\SourcePackage2\" let path3 = Utilities.FixFilePath @"c:\packages\SourcePackage3\" @@ -319,7 +328,7 @@ type MapSourceRootsTests() = |> Array.iteri checkExpectations [] - member this.``missing containing root`` () = + member _.``missing containing root`` () = let items = [| SourceRoot(@"c:\MyProjects\MYPROJECT\", [], []) SourceRoot(@"c:\MyProjects\MyProject\a\b\", [ @@ -352,7 +361,7 @@ type MapSourceRootsTests() = Assert.Fail("Expected to fail on the inputs") [] - member this.``no containing root`` () = + member _.``no containing root`` () = let items = [| SourceRoot(@"c:\MyProjects\MyProject\", [], []) SourceRoot(@"c:\MyProjects\MyProject\a\b\", [ @@ -385,7 +394,7 @@ type MapSourceRootsTests() = [] [] [] - member this.``no top level source root`` (deterministic: bool) = + member _.``no top level source root`` (deterministic: bool) = let path1 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\b\" let items = [| SourceRoot(path1, [ diff --git a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs index 642541c7f90..d295f60f4ee 100644 --- a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs +++ b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs @@ -18,26 +18,24 @@ type WriteCodeFragmentFSharpTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member this.``No parameters``() = + member _.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member this.``Skipped and out of order positional parameters``() = + member _.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member this.``Named parameters``() = + member _.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member this.``Named and positional parameters``() = + member _.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member this.``Escaped string parameters``() = + member _.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" - // this should look like: SomeAttribute("\"uno\"") - [] type WriteCodeFragmentCSharpTests() = @@ -50,23 +48,23 @@ type WriteCodeFragmentCSharpTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member this.``No parameters``() = + member _.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member this.``Skipped and out of order positional parameters``() = + member _.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member this.``Named parameters``() = + member _.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member this.``Named and positional parameters``() = + member _.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member this.``Escaped string parameters``() = + member _.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" // this should look like: SomeAttribute("\"uno\"") @@ -82,23 +80,23 @@ type WriteCodeFragmentVisualBasicTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member this.``No parameters``() = + member _.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member this.``Skipped and out of order positional parameters``() = + member _.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member this.``Named parameters``() = + member _.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member this.``Named and positional parameters``() = + member _.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member this.``Escaped string parameters``() = + member _.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" // this should look like: SomeAttribute("\"uno\"") diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs index 325dcc0f769..3eb8c174d29 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs @@ -12,7 +12,7 @@ let testNoOverflow op overflowArg = | :? OverflowException -> failwith "Failed: 1" type T(x : float) = - member this.Data = x + member _.Data = x static member op_Explicit (x : T) = byte x.Data static member op_Explicit (x : T) = char x.Data static member op_Explicit (x : T) = int16 x.Data diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs index 5210295c8eb..fb57826cbe9 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs @@ -1,4 +1,4 @@ -// regression test for https://github.com/Microsoft/visualfsharp/issues/420 +// regression test for https://github.com/dotnet/fsharp/issues/420 [] type X public (i : int) = diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs index b1cca3856b1..7c67a679fa9 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs @@ -10,7 +10,7 @@ let public funcA n = | _ -> Some( 22 ) // debug range should cover all of "Some( 22 )" -// Test case from https://github.com/Microsoft/visualfsharp/issues/105 +// Test case from https://github.com/dotnet/fsharp/issues/105 let OuterWithGenericInner list = let GenericInner (list: 'T list) = match list with @@ -19,7 +19,7 @@ let OuterWithGenericInner list = GenericInner list -// Test case from https://github.com/Microsoft/visualfsharp/issues/105 +// Test case from https://github.com/dotnet/fsharp/issues/105 let OuterWithNonGenericInner list = let NonGenericInner (list: int list) = match list with @@ -28,7 +28,7 @@ let OuterWithNonGenericInner list = NonGenericInner list -// Test case from https://github.com/Microsoft/visualfsharp/issues/105 +// Test case from https://github.com/dotnet/fsharp/issues/105 let OuterWithNonGenericInnerWithCapture x list = let NonGenericInnerWithCapture (list: int list) = match list with diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs index 05e33058136..c150c1b81a1 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs @@ -1,7 +1,7 @@ // #NoMono #NoMT #CodeGen #EmittedIL #Tuples type A() = class end -// A code+optimization pattern, see https://github.com/Microsoft/visualfsharp/issues/6532 +// A code+optimization pattern, see https://github.com/dotnet/fsharp/issues/6532 type C() = static member inline F (?x1: A, ?x2: A) = let count = 0 diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx b/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx index 26fc292d037..f10327acf31 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx @@ -1,5 +1,5 @@ // #Regression #NoMT #Printing -// Regression test for https://github.com/Microsoft/visualfsharp/issues/109 +// Regression test for https://github.com/dotnet/fsharp/issues/109 // pretty printing signatures with params arguments //type Heterogeneous = diff --git a/tests/FSharp.Compiler.UnitTests/BlockTests.fs b/tests/FSharp.Compiler.UnitTests/BlockTests.fs index 08a718f5244..aaa0084773e 100644 --- a/tests/FSharp.Compiler.UnitTests/BlockTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BlockTests.fs @@ -5,15 +5,15 @@ open Xunit open FSharp.Test open Internal.Utilities.Library -module BlockTests = +module ImmutableArrayTests = [] let ``Iter should work correctly``() = - let b = Block.init 5 id + let b = ImmutableArray.init 5 id let results = ResizeArray() b - |> Block.iter (fun x -> + |> ImmutableArray.iter (fun x -> results.Add(x) ) @@ -30,9 +30,9 @@ module BlockTests = [] let ``Map should work correctly``() = - let b = Block.init 5 id + let b = ImmutableArray.init 5 id - let b2 = b |> Block.map (fun x -> x + 1) + let b2 = b |> ImmutableArray.map (fun x -> x + 1) Assert.Equal( [ @@ -47,11 +47,11 @@ module BlockTests = [] let ``Fold should work correctly``() = - let b = Block.init 5 id + let b = ImmutableArray.init 5 id let result = (0, b) - ||> Block.fold (fun state n -> + ||> ImmutableArray.fold (fun state n -> state + n ) diff --git a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs index bc4b3f9f0bc..91244459fdd 100644 --- a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs +++ b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs @@ -5,5 +5,5 @@ module CompilerTestHelpers = let (|Warning|_|) (exn: System.Exception) = match exn with - | :? FSharp.Compiler.ErrorLogger.Error as e -> let n,d = e.Data0 in Some (n,d) + | :? FSharp.Compiler.DiagnosticsLogger.DiagnosticWithText as e -> Some (e.number, e.message) | _ -> None diff --git a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs index b3442017bc4..42442377a5a 100644 --- a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs +++ b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs @@ -13,37 +13,34 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open FSharp.Compiler.Diagnostics -open FSharp.Compiler.Lexer open FSharp.Compiler.Lexhelp -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers -open FSharp.Compiler.Syntax type public HashIfExpression() = - let preludes = [|"#if "; "#elif "|] - let epilogues = [|""; " // Testing"|] + let preludes = [|"#if "; "#elif "|] + let epilogues = [|""; " // Testing"|] - let ONE = IfdefId "ONE" - let TWO = IfdefId "TWO" - let THREE = IfdefId "THREE" + let ONE = IfdefId "ONE" + let TWO = IfdefId "TWO" + let THREE = IfdefId "THREE" let isSet l r = (l &&& r) <> 0 - let (!!) e = IfdefNot(e) - let (&&&) l r = IfdefAnd(l,r) - let (|||) l r = IfdefOr(l,r) - + let (!!) e = IfdefNot(e) + let (&&&) l r = IfdefAnd(l,r) + let (|||) l r = IfdefOr(l,r) let exprAsString (e : LexerIfdefExpression) : string = - let sb = StringBuilder() + let sb = StringBuilder() let append (s : string) = ignore <| sb.Append s let rec build (e : LexerIfdefExpression) : unit = match e with - | IfdefAnd (l,r)-> append "("; build l; append " && "; build r; append ")" + | IfdefAnd (l,r) -> append "("; build l; append " && "; build r; append ")" | IfdefOr (l,r) -> append "("; build l; append " || "; build r; append ")" - | IfdefNot ee -> append "!"; build ee - | IfdefId nm -> append nm + | IfdefNot ee -> append "!"; build ee + | IfdefId nm -> append nm build e @@ -55,9 +52,9 @@ type public HashIfExpression() = let errorLogger = { - new ErrorLogger("TestErrorLogger") with - member x.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e - member x.ErrorCount = errors.Count + new DiagnosticsLogger("TestDiagnosticsLogger") with + member _.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e + member _.ErrorCount = errors.Count } let lightSyntax = IndentationAwareSyntaxStatus(true, false) @@ -66,27 +63,27 @@ type public HashIfExpression() = let startPos = Position.Empty let args = mkLexargs (defines, lightSyntax, resourceManager, [], errorLogger, PathMap.empty) - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger let parser (s : string) = - let lexbuf = LexBuffer.FromChars (true, LanguageVersion.Default, s.ToCharArray ()) - lexbuf.StartPos <- startPos - lexbuf.EndPos <- startPos - let tokenStream = PPLexer.tokenstream args + let lexbuf = LexBuffer.FromChars (true, LanguageVersion.Default, s.ToCharArray ()) + lexbuf.StartPos <- startPos + lexbuf.EndPos <- startPos + let tokenStream = PPLexer.tokenstream args PPParser.start tokenStream lexbuf errors, warnings, parser do // Setup - CompileThreadStatic.BuildPhase <- BuildPhase.Compile + CompileThreadStatic.BuildPhase <- BuildPhase.Compile interface IDisposable with // Teardown member _.Dispose() = - CompileThreadStatic.BuildPhase <- BuildPhase.DefaultPhase - CompileThreadStatic.ErrorLogger <- CompileThreadStatic.ErrorLogger + CompileThreadStatic.BuildPhase <- BuildPhase.DefaultPhase + CompileThreadStatic.DiagnosticsLogger <- CompileThreadStatic.DiagnosticsLogger [] - member this.PositiveParserTestCases()= + member _.PositiveParserTestCases()= let errors, warnings, parser = createParser () @@ -117,8 +114,8 @@ type public HashIfExpression() = "false" , IfdefId "false" |] - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for test,expected in positiveTestCases do for prelude in preludes do @@ -126,12 +123,12 @@ type public HashIfExpression() = for epilogue in epilogues do let test = test + epilogue try - let expr = parser test + let expr = parser test if expected <> expr then fail <| sprintf "'%s', expected %A, actual %A" test (exprAsString expected) (exprAsString expr) - with - | e -> fail <| sprintf "'%s', expected %A, actual %s,%A" test (exprAsString expected) (e.GetType().Name) e.Message + with e -> + fail <| sprintf "'%s', expected %A, actual %s,%A" test (exprAsString expected) (e.GetType().Name) e.Message let fs = @@ -147,9 +144,9 @@ type public HashIfExpression() = () [] - member this.NegativeParserTestCases()= + member _.NegativeParserTestCases()= - let errors, warnings, parser = createParser () + let errors, _warnings, parser = createParser () let negativeTests = [| @@ -183,18 +180,18 @@ type public HashIfExpression() = "ONE )(@$&%*@^#%#!$)" |] - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for test in negativeTests do for prelude in preludes do let test = prelude + test for epilogue in epilogues do - let test = test + epilogue + let test = test + epilogue try - let bec = errors.Count - let expr = parser test - let aec = errors.Count + let bec = errors.Count + let expr = parser test + let aec = errors.Count if bec = aec then // No new errors discovered fail <| sprintf "'%s', expected 'parse error', actual %A" test (exprAsString expr) @@ -208,22 +205,22 @@ type public HashIfExpression() = Assert.shouldBe "" fails [] - member this.LexerIfdefEvalTestCases()= + member _.LexerIfdefEvalTestCases()= - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for i in 0..7 do - let one = isSet i 1 - let two = isSet i 2 - let three = isSet i 4 + let one = isSet i 1 + let two = isSet i 2 + let three = isSet i 4 let lookup s = match s with - | "ONE" -> one - | "TWO" -> two - | "THREE" -> three - | _ -> false + | "ONE" -> one + | "TWO" -> two + | "THREE" -> three + | _ -> false let testCases = [| diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs index cb74c489da0..817d1fcc473 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs @@ -1552,7 +1552,7 @@ module ComparersRegression = exception ValidationException of lhs:obj * rhs:obj * expected:obj * received:obj - let make_result_set<'a,'b when 'b : equality> (f:IOperation<'a>) (items:array<'a>) (validation_set:option>)= + let make_result_set<'a,'b when 'b : equality> (f: IOperation<'a>) (items: 'a[]) (validation_set: int[] option)= let results = Array.zeroCreate (items.Length*items.Length) for i = 0 to items.Length-1 do for j = 0 to items.Length-1 do diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 89b74783e9f..103b636c127 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -580,7 +580,7 @@ type AsyncModule() = #if IGNORED - [] + [] member _.``SleepContinuations``() = let okCount = ref 0 let errCount = ref 0 diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 30fef17666e..29d086d0f20 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -338,7 +338,7 @@ type AsyncType() = #if IGNORED [] - [] + [] member _.CancellationPropagatesToImmediateTask () = let a = async { while true do () @@ -355,7 +355,7 @@ type AsyncType() = #if IGNORED [] - [] + [] member _.CancellationPropagatesToGroupImmediate () = let ewh = new ManualResetEvent(false) let cancelled = ref false diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs index c887eb470c8..2a180783da0 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs @@ -72,7 +72,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/Microsoft/visualfsharp/issues/3337 + // https://github.com/dotnet/fsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = @@ -114,7 +114,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/Microsoft/visualfsharp/issues/3337 + // https://github.com/dotnet/fsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = @@ -156,7 +156,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/Microsoft/visualfsharp/issues/3337 + // https://github.com/dotnet/fsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs index 81429996a05..ee2b662bfe5 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs @@ -911,7 +911,7 @@ open NonStructuralComparison type NonStructuralComparisonTests() = [] - member _.CompareFloat32() = // https://github.com/Microsoft/visualfsharp/pull/4493 + member _.CompareFloat32() = // https://github.com/dotnet/fsharp/pull/4493 let x = 32 |> float32 let y = 32 |> float32 diff --git a/tests/benchmarks/TaskPerf/option.fs b/tests/benchmarks/TaskPerf/option.fs index 20003378273..2df8610880f 100644 --- a/tests/benchmarks/TaskPerf/option.fs +++ b/tests/benchmarks/TaskPerf/option.fs @@ -72,11 +72,11 @@ type OptionBuilderUsingInlineIfLambdaBase() = (fun () -> ValueSome value) - member inline this.ReturnFrom (source: option<'T>) : OptionCode<'T> = + member inline _.ReturnFrom (source: 'T option) : OptionCode<'T> = (fun () -> match source with Some x -> ValueOption.Some x | None -> ValueOption.None) - member inline this.ReturnFrom (source: voption<'T>) : OptionCode<'T> = + member inline _.ReturnFrom (source: voption<'T>) : OptionCode<'T> = (fun () -> source) type OptionBuilderUsingInlineIfLambda() = diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 4cdc2adaf89..8e7669ddc69 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -1318,7 +1318,7 @@ module CoreTests = exec cfg ("." ++ "main.exe") "" - // Repro for https://github.com/Microsoft/visualfsharp/issues/1298 + // Repro for https://github.com/dotnet/fsharp/issues/1298 [] let fileorder () = let cfg = testConfig "core/fileorder" @@ -1345,7 +1345,7 @@ module CoreTests = exec cfg ("." ++ "test2.exe") "" - // Repro for https://github.com/Microsoft/visualfsharp/issues/2679 + // Repro for https://github.com/dotnet/fsharp/issues/2679 [] let ``add files with same name from different folders`` () = let cfg = testConfig "core/samename" @@ -1390,7 +1390,7 @@ module CoreTests = [] let ``no-warn-2003-tests`` () = - // see https://github.com/Microsoft/visualfsharp/issues/3139 + // see https://github.com/dotnet/fsharp/issues/3139 let cfg = testConfig "core/versionAttributes" let stdoutPath = "out.stdout.txt" |> getfullpath cfg let stderrPath = "out.stderr.txt" |> getfullpath cfg @@ -1593,7 +1593,7 @@ module CoreTests = [] let ``patterns-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/patterns" FSC_OPTIMIZED "preview" -//BUGBUG: https://github.com/Microsoft/visualfsharp/issues/6601 +//BUGBUG: https://github.com/dotnet/fsharp/issues/6601 // [] // let ``patterns-FSI`` () = singleTestBuildAndRun' "core/patterns" FSI @@ -2105,7 +2105,7 @@ module VersionTests = [] module ToolsTests = - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let bundle () = let cfg = testConfig "tools/bundle" @@ -2265,7 +2265,7 @@ module RegressionTests = let ``321`` () = singleTestBuildAndRun "regression/321" FSC_OPTIMIZED #if !NETCOREAPP - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let ``655`` () = let cfg = testConfig "regression/655" @@ -2284,7 +2284,7 @@ module RegressionTests = testOkFile.CheckExists() - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let ``656`` () = let cfg = testConfig "regression/656" @@ -2318,7 +2318,7 @@ module RegressionTests = let ``struct-tuple-bug-1-FSI`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSI #if !NETCOREAPP - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let ``struct-measure-bug-1`` () = let cfg = testConfig "regression/struct-measure-bug-1" diff --git a/tests/service/Common.fs b/tests/service/Common.fs index d73c89e7bfb..efc7e115084 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -235,16 +235,16 @@ let tups (m: range) = (m.StartLine, m.StartColumn), (m.EndLine, m.EndColumn) /// Extract range info and convert to zero-based line - please don't use this one any more let tupsZ (m: range) = (m.StartLine-1, m.StartColumn), (m.EndLine-1, m.EndColumn) -let attribsOfSymbolUse (s:FSharpSymbolUse) = - [ if s.IsFromDefinition then yield "defn" - if s.IsFromType then yield "type" - if s.IsFromAttribute then yield "attribute" - if s.IsFromDispatchSlotImplementation then yield "override" - if s.IsFromPattern then yield "pattern" - if s.IsFromComputationExpression then yield "compexpr" ] - -let attribsOfSymbol (s:FSharpSymbol) = - [ match s with +let attribsOfSymbolUse (symbolUse: FSharpSymbolUse) = + [ if symbolUse.IsFromDefinition then yield "defn" + if symbolUse.IsFromType then yield "type" + if symbolUse.IsFromAttribute then yield "attribute" + if symbolUse.IsFromDispatchSlotImplementation then yield "override" + if symbolUse.IsFromPattern then yield "pattern" + if symbolUse.IsFromComputationExpression then yield "compexpr" ] + +let attribsOfSymbol (symbol: FSharpSymbol) = + [ match symbol with | :? FSharpField as v -> yield "field" if v.IsCompilerGenerated then yield "compgen" @@ -310,26 +310,26 @@ let attribsOfSymbol (s:FSharpSymbol) = | _ -> () ] let rec allSymbolsInEntities compGen (entities: IList) = - [ for e in entities do - yield (e :> FSharpSymbol) - for gp in e.GenericParameters do + [ for entity in entities do + yield (entity :> FSharpSymbol) + for gp in entity.GenericParameters do if compGen || not gp.IsCompilerGenerated then yield (gp :> FSharpSymbol) - for x in e.MembersFunctionsAndValues do + for x in entity.MembersFunctionsAndValues do if compGen || not x.IsCompilerGenerated then yield (x :> FSharpSymbol) for gp in x.GenericParameters do if compGen || not gp.IsCompilerGenerated then yield (gp :> FSharpSymbol) - for x in e.UnionCases do + for x in entity.UnionCases do yield (x :> FSharpSymbol) for f in x.Fields do if compGen || not f.IsCompilerGenerated then yield (f :> FSharpSymbol) - for x in e.FSharpFields do + for x in entity.FSharpFields do if compGen || not x.IsCompilerGenerated then yield (x :> FSharpSymbol) - yield! allSymbolsInEntities compGen e.NestedEntities ] + yield! allSymbolsInEntities compGen entity.NestedEntities ] let getParseResults (source: string) = @@ -351,8 +351,8 @@ let getParseAndCheckResults50 (source: string) = parseAndCheckScript50("Test.fsx", source) -let inline dumpErrors results = - (^TResults: (member Diagnostics: FSharpDiagnostic[]) results) +let inline dumpDiagnostics (results: FSharpCheckFileResults) = + results.Diagnostics |> Array.map (fun e -> let message = e.Message.Split('\n') diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 92b184d99c9..9ca4362ead7 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -14,7 +14,7 @@ match () with | x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,4): This expression was expected to have type 'unit' but here has type 'string'" ] @@ -27,7 +27,7 @@ let ``Wrong type 02 - Binding`` () = let ("": unit), (x: int) = let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(2,5--2,7): This expression was expected to have type 'unit' but here has type 'string'" "(2,41--2,43): This expression was expected to have type 'unit * int' but here has type 'unit'" "(2,4--2,24): Incomplete pattern matches on this expression." @@ -44,7 +44,7 @@ match () with | [] x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"; "CompiledNameAttribute"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,25): Attributes are not allowed within patterns" "(3,4--3,16): This attribute is not valid for use on this language element" ] @@ -60,7 +60,7 @@ match () with | ?x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,4): Optional arguments are only permitted on type members" ] @@ -75,7 +75,7 @@ match 1, 2 with | null -> let y = () in () """ assertHasSymbolUsages ["y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,6): The type '(int * int)' does not have 'null' as a proper value" "(2,6--2,10): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." ] @@ -95,7 +95,7 @@ match A with | B (x, _) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,10): This union case expects 3 arguments in tupled form" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -115,7 +115,7 @@ match A with | B (_, _, x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,5--7,12): This expression was expected to have type 'int' but here has type ''a * 'b * 'c'" "(6,6--6,7): Incomplete pattern matches on this expression." ] @@ -135,7 +135,7 @@ match A with | B (_, _, x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,11--7,12): This constructor is applied to 3 argument(s) but expects 2" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -154,7 +154,7 @@ match A with | A x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,5): This union case does not take arguments" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'B (_)' may indicate a case not covered by the pattern(s)." ] @@ -173,7 +173,7 @@ match A with | B x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -192,7 +192,7 @@ match A with | B (name = x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,5--7,9): The union case 'B' does not have a field named 'name'." "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -212,7 +212,7 @@ match A with | B (field = x; field = z) -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,16--7,21): Union case/exception field 'field' cannot be used more than once." "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -232,7 +232,7 @@ match A with | B x z -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,7): This union case expects 2 arguments in tupled form" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -246,7 +246,7 @@ match None with | Some (x, z) -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ ] @@ -262,7 +262,7 @@ match 1 with | Foo (field = x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,2--5,17): Foo is an active pattern and cannot be treated as a discriminated union case with named fields." ] @@ -279,7 +279,7 @@ match 1 with | Foo x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,2--5,7): This literal pattern does not take arguments" "(4,6--4,7): Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s)." ] @@ -297,7 +297,7 @@ match TraceLevel.Off with | TraceLevel.Off x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,2--5,18): This literal pattern does not take arguments" "(4,6--4,20): Incomplete pattern matches on this expression. For example, the value 'TraceLevel.Error' may indicate a case not covered by the pattern(s)." ] @@ -319,7 +319,7 @@ let dowork () = f (Case 1) 0 // return an integer exit code""" assertHasSymbolUsages ["DU"; "dowork"; "du"; "f"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(6,6--6,10): This constructor is applied to 0 argument(s) but expects 1" ] @@ -330,7 +330,7 @@ match 1 with | x | x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] @@ -343,7 +343,7 @@ match 1 with | x | z -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,7): The two sides of this 'or' pattern bind different sets of variables" ] @@ -362,7 +362,7 @@ match A with | B (x, y) | B (a, x) -> let z = x + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,21): The two sides of this 'or' pattern bind different sets of variables" "(7,19--7,20): This expression was expected to have type 'int' but here has type 'string'" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." @@ -381,7 +381,7 @@ match 3 with | a as b -> let c = a + b in () """ assertHasSymbolUsages ["a"; "b"; "c"; "w"; "x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] @@ -399,7 +399,7 @@ match box 1 with | :? int8 as Id i as j -> let x = i + 5y + j in () // Only the first "as" will have the derived type """ assertHasSymbolUsages (List.map string ['a'..'j']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,34--5,35): The type 'obj' does not support the operator '+'" "(5,32--5,33): The type 'obj' does not support the operator '+'" "(7,45--7,46): The type 'obj' does not match the type 'uint64'" @@ -423,7 +423,7 @@ match Unchecked.defaultof with | _ -> () """ assertHasSymbolUsages ["a"; "b"; "c"; "d"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,21--5,27): Type constraint mismatch. The type 'int' is not compatible with type 'System.Enum' " ] @@ -439,7 +439,7 @@ match Unchecked.defaultof with | g -> () """ assertHasSymbolUsages ["a"; "b"; "c"; "d"; "e"; "f"; "g"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(4,2--4,85): This rule will never be matched" ] @@ -456,7 +456,7 @@ match Unchecked.defaultof with | :? _ as z -> let _ = z in () """ assertHasSymbolUsages ["a"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(2,6--2,30): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." "(6,2--6,6): The type 'int' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." ] @@ -477,7 +477,7 @@ match Unchecked.defaultof with | k & l as (m as (false as n)) as (o as _) -> if k || l || m || n || o then () """ assertHasSymbolUsages (List.map string ['a'..'o']) checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] let ``As 07 - syntactical precedence matrix testing right - total patterns`` () = @@ -556,7 +556,7 @@ Some v |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] #if !NETCOREAPP @@ -601,7 +601,7 @@ Some w |> eq () """ assertHasSymbolUsages (List.map string ['a'..'y']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(8,4--8,18): Incomplete pattern matches on this expression. For example, the value '[]' may indicate a case not covered by the pattern(s)." "(9,4--9,14): Incomplete pattern matches on this expression." "(10,4--10,18): Incomplete pattern matches on this expression." @@ -643,7 +643,7 @@ let v as struct w = 15 let x as () = y let z as """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,9--10,10): Unexpected symbol ',' in binding" "(11,9--11,10): Unexpected symbol ':' in binding" "(12,9--12,11): Unexpected symbol '::' in binding" @@ -692,7 +692,7 @@ Some x |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] #if !NETCOREAPP @@ -737,7 +737,7 @@ Some w |> eq () """ assertHasSymbolUsages (List.map string ['a'..'y']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(8,4--8,20): Incomplete pattern matches on this expression. For example, the value '[]' may indicate a case not covered by the pattern(s)." "(9,4--9,14): Incomplete pattern matches on this expression." "(10,4--10,18): Incomplete pattern matches on this expression." @@ -779,7 +779,7 @@ let v struct as w = 15 let () as x = y let z as = """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" @@ -854,7 +854,7 @@ Some x |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(11,25--11,26): This expression was expected to have type 'int' but here has type 'obj'" "(28,6--28,24): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." "(26,6--26,12): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." @@ -930,7 +930,7 @@ Some w |> eq () """ assertHasSymbolUsages (set ['a' .. 'y'] |> Set.remove 'n' |> Set.map string |> Set.toList) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(21,2--21,8): This type test or downcast will always hold" "(34,6--34,14): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." "(32,6--32,14): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." @@ -973,7 +973,7 @@ let :? v as struct w = 15 let :? x as () = y let :? z as """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,12--10,13): Unexpected symbol ',' in binding" "(11,12--11,13): Unexpected symbol ':' in binding" "(12,12--12,14): Unexpected symbol '::' in binding" @@ -1046,7 +1046,7 @@ match box {{ aaa = 9 }} with Some "" |> eq // No more type checks after the above line? """ assertHasSymbolUsages (Set.toList validSet) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(27,2--27,14): This expression was expected to have type 'obj' but here has type 'struct ('a * 'b)'" "(52,2--52,13): This expression was expected to have type 'obj' but here has type 'AAA'" "(26,6--26,24): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." @@ -1131,7 +1131,7 @@ match box [|11|] with Some "" |> eq """ assertHasSymbolUsages (set ['a'..'y'] - set [ 'm'..'r' ] |> Set.map string |> Set.toList) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(19,2--19,4): This expression was expected to have type 'obj' but here has type 'int'" "(21,2--21,7): This expression was expected to have type 'obj' but here has type 'bool'" "(23,2--23,6): This expression was expected to have type 'obj' but here has type 'bool'" @@ -1180,7 +1180,7 @@ let v [ as :? w = 15 let () as :? x = y let as :? z = """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" @@ -1234,7 +1234,7 @@ let ?w as x = 7 let y as ?z = 8 () """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,9--7,11): Unexpected symbol '[<' in binding" "(4,4--4,12): This construct is deprecated: Character range matches have been removed in F#. Consider using a 'when' pattern guard instead." "(4,4--4,17): Incomplete pattern matches on this expression. For example, the value '' '' may indicate a case not covered by the pattern(s)." @@ -1266,6 +1266,6 @@ let f : obj -> _ = () """ assertHasSymbolUsages ["i"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,6--5,18): Feature 'non-variable patterns to the right of 'as' patterns' is not available in F# 5.0. Please use language version 6.0 or greater." ] \ No newline at end of file diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 342712caa39..00ae15bc4e1 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -5246,7 +5246,7 @@ module internal ProjectBig = [] -// Simplified repro for https://github.com/Microsoft/visualfsharp/issues/2679 +// Simplified repro for https://github.com/dotnet/fsharp/issues/2679 let ``add files with same name from different folders`` () = let fileNames = [ __SOURCE_DIRECTORY__ + "/data/samename/folder1/a.fs" @@ -5333,7 +5333,7 @@ let x = (1 = 3.0) let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) [] -let ``Test line directives in foreground analysis`` () = // see https://github.com/Microsoft/visualfsharp/issues/3317 +let ``Test line directives in foreground analysis`` () = // see https://github.com/dotnet/fsharp/issues/3317 // In background analysis and normal compiler checking, the errors are reported w.r.t. the line directives let wholeProjectResults = checker.ParseAndCheckProject(ProjectLineDirectives.options) |> Async.RunImmediate diff --git a/tests/service/data/TestTP/ProvidedTypes.fs b/tests/service/data/TestTP/ProvidedTypes.fs index 7ea2cd5ba46..2b609793233 100644 --- a/tests/service/data/TestTP/ProvidedTypes.fs +++ b/tests/service/data/TestTP/ProvidedTypes.fs @@ -8102,7 +8102,7 @@ namespace ProviderImplementation.ProvidedTypes // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, // which fortunately also correspond to element types. We just use the design-time types instead. // See convertConstExpr in the compiler, e.g. - // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // https://github.com/dotnet/fsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 // for the accepted types. match inp.Namespace, inp.Name with //| USome "System", "Void"-> typeof diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index dcdc6cd7291..3d93c28d3b8 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -33,7 +33,7 @@ type internal FSharpCompletionProvider inherit FSharpCompletionProviderBase() // Save the backing data in a cache, we need to save for at least the length of the completion session - // See https://github.com/Microsoft/visualfsharp/issues/4714 + // See https://github.com/dotnet/fsharp/issues/4714 static let mutable declarationItems: DeclarationListItem[] = [||] static let [] NameInCodePropName = "NameInCode" static let [] FullNamePropName = "FullName" diff --git a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs index d7995bcf509..689c410b5f1 100644 --- a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs +++ b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs @@ -51,7 +51,7 @@ type CodeFixesOptions = SuggestNamesForErrors: bool } static member Default = { // We have this off by default, disable until we work out how to make this low priority - // See https://github.com/Microsoft/visualfsharp/pull/3238#issue-237699595 + // See https://github.com/dotnet/fsharp/pull/3238#issue-237699595 SimplifyName = false AlwaysPlaceOpensAtTopLevel = true UnusedOpens = true diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs index 38ad605c2bc..4be4c71d300 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs @@ -1604,7 +1604,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem MSBuildProject.SetGlobalProperty(projNode.BuildProject, ProjectFileConstants.Platform, currentConfigName.MSBuildPlatform) projNode.UpdateMSBuildState() - // The following event sequences are observed in Visual Studio 2017, see https://github.com/Microsoft/visualfsharp/pull/3025#pullrequestreview-38005713 + // The following event sequences are observed in Visual Studio 2017, see https://github.com/dotnet/fsharp/pull/3025#pullrequestreview-38005713 // // Loading tests\projects\misc\TestProjectChanges.sln: // diff --git a/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs b/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs index a5e3128e872..2e6291ef3ec 100644 --- a/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs +++ b/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs @@ -13,7 +13,7 @@ open Microsoft.VisualStudio.Utilities // type internal TextBufferStream(textLines:ITextBuffer, contentTypeRegistry: IContentTypeRegistryService) = do if null = textLines then raise (new ArgumentNullException("textLines")) - // The following line causes unhandled excepiton on a background thread, see https://github.com/Microsoft/visualfsharp/issues/2318#issuecomment-279340343 + // The following line causes unhandled excepiton on a background thread, see https://github.com/dotnet/fsharp/issues/2318#issuecomment-279340343 // It seems we should provide a Quick Info Provider at the same time as uncommenting it. //do textLines.ChangeContentType(contentTypeRegistry.GetContentType Guids.fsiContentTypeName, Guid Guids.guidFsiLanguageService) diff --git a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs index a07104b2e7f..ca7f220fa73 100644 --- a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs +++ b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs @@ -7723,7 +7723,7 @@ namespace ProviderImplementation.ProvidedTypes // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, // which fortunately also correspond to element types. We just use the design-time types instead. // See convertConstExpr in the compiler, e.g. - // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // https://github.com/dotnet/fsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 // for the accepted types. match inp.Namespace, inp.Name with | USome "System", "Void"-> typeof @@ -8984,7 +8984,7 @@ namespace ProviderImplementation.ProvidedTypes let systemRuntimeContainsTypeObj = config.GetField("systemRuntimeContainsType") - // Account for https://github.com/Microsoft/visualfsharp/pull/591 + // Account for https://github.com/dotnet/fsharp/pull/591 let systemRuntimeContainsTypeObj2 = if systemRuntimeContainsTypeObj.HasField("systemRuntimeContainsTypeRef") then systemRuntimeContainsTypeObj.GetField("systemRuntimeContainsTypeRef").GetProperty("Value") diff --git a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs index c4a1d61cde8..e94163042e4 100644 --- a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs @@ -162,7 +162,7 @@ type BraceMatchingServiceTests() = [] member this.BraceMatchingAtEndOfLine_Bug1597() = - // https://github.com/Microsoft/visualfsharp/issues/1597 + // https://github.com/dotnet/fsharp/issues/1597 let code = """ [] let main argv = diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 52193afac40..381e9d0e5ec 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -457,7 +457,7 @@ let _ = new A(Setta) let notExpected = ["SettableProperty@"; "AnotherSettableProperty@"; "NonSettableProperty@"] VerifyCompletionList(fileContents, "(Setta", expected, notExpected) -[] +[] let ``Constructing a new fully qualified class with object initializer syntax without ending paren``() = let fileContents = """ module M = diff --git a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs index 2f3b76b2965..c9674a89861 100644 --- a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs @@ -392,7 +392,7 @@ let g (t : T) = t.Count() [] member public this.DocumentDiagnosticsDontReportProjectErrors_Bug1596() = - // https://github.com/Microsoft/visualfsharp/issues/1596 + // https://github.com/dotnet/fsharp/issues/1596 this.VerifyNoErrors( fileContents = """ let x = 3 diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index 68cbcec09ec..368df57ad3f 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -29,7 +29,7 @@ module StandardSettings = type UsingMSBuild() as this = inherit LanguageServiceBaseTests() - let createFile (code : list) fileKind refs otherFlags = + let createFile (code : string list) fileKind refs otherFlags = let (_, _, file) = match code with | [code] when code.IndexOfAny([|'\r'; '\n'|]) <> -1 -> @@ -38,7 +38,7 @@ type UsingMSBuild() as this = this.CreateSingleFileProject(code, fileKind = fileKind, references = refs, ?otherFlags=otherFlags) file - let DoWithAutoCompleteUsingExtraRefs refs otherFlags coffeeBreak fileKind reason (code : list) marker f = + let DoWithAutoCompleteUsingExtraRefs refs otherFlags coffeeBreak fileKind reason (code : string list) marker f = // Up to 2 untyped parse operations are OK: we do an initial parse to provide breakpoint valdiation etc. // This might be before the before the background builder is ready to process the foreground typecheck. // In this case the background builder calls us back when its ready, and we then request a foreground typecheck @@ -53,7 +53,7 @@ type UsingMSBuild() as this = gpatcc.AssertExactly(0,0) - let DoWithAutoComplete coffeeBreak fileKind reason otherFlags (code : list) marker f = + let DoWithAutoComplete coffeeBreak fileKind reason otherFlags (code : string list) marker f = DoWithAutoCompleteUsingExtraRefs [] otherFlags coffeeBreak fileKind reason code marker f let AssertAutoCompleteContainsAux coffeeBreak fileName reason otherFlags code marker should shouldnot = @@ -134,7 +134,7 @@ type UsingMSBuild() as this = // There are some dot completion tests in this type as well, in the systematic tests for queries - member private this.VerifyDotCompListContainAllAtStartOfMarker(fileContents : string, marker : string, list :string list, ?addtlRefAssy:list, ?coffeeBreak:bool) = + member private this.VerifyDotCompListContainAllAtStartOfMarker(fileContents : string, marker : string, list :string list, ?addtlRefAssy:string list, ?coffeeBreak:bool) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) //to add references @@ -143,7 +143,7 @@ type UsingMSBuild() as this = AssertCompListContainsAll(completions, list) // There are some quickinfo tests in this file as well, in the systematic tests for queries - member public this.InfoInDeclarationTestQuickInfoImpl(code : string,marker,expected,atStart, ?addtlRefAssy : list) = + member public this.InfoInDeclarationTestQuickInfoImpl(code : string,marker,expected,atStart, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(code, ?references = addtlRefAssy) let gpatcc = GlobalParseAndTypeCheckCounter.StartNew(this.VS) @@ -156,7 +156,7 @@ type UsingMSBuild() as this = AssertContains(tooltip, expected) gpatcc.AssertExactly(0,0) - member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : list) = + member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : string list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,false,?addtlRefAssy=addtlRefAssy) static member charExpectedCompletions = [ "CompareTo"; // Members defined on System.Char @@ -207,7 +207,7 @@ type UsingMSBuild() as this = [ ] // should not contain //**Help Function for checking Ctrl-Space Completion Contains the expected value ************* - member private this.AssertCtrlSpaceCompletionContains(fileContents : list, marker, expected, ?addtlRefAssy: list) = + member private this.AssertCtrlSpaceCompletionContains(fileContents : string list, marker, expected, ?addtlRefAssy: string list) = this.AssertCtrlSpaceCompletion( fileContents, marker, @@ -222,19 +222,19 @@ type UsingMSBuild() as this = ) //**Help Function for checking Ctrl-Space Completion Contains the expected value ************* - member private this.AssertCtrlSpaceCompletion(fileContents : list, marker, checkCompletion: (CompletionItem array -> unit), ?addtlRefAssy: list) = + member private this.AssertCtrlSpaceCompletion(fileContents : string list, marker, checkCompletion: (CompletionItem array -> unit), ?addtlRefAssy: string list) = let (_, _, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToEndOfMarker(file,marker) let completions = CtrlSpaceCompleteAtCursor file checkCompletion completions - member private this.AutoCompletionListNotEmpty (fileContents : list) marker = + member private this.AutoCompletionListNotEmpty (fileContents : string list) marker = let (_, _, file) = this.CreateSingleFileProject(fileContents) MoveCursorToEndOfMarker(file,marker) let completions = AutoCompleteAtCursor file Assert.AreNotEqual(0,completions.Length) - member public this.TestCompletionNotShowingWhenFastUpdate (firstSrc : list) secondSrc marker = + member public this.TestCompletionNotShowingWhenFastUpdate (firstSrc : string list) secondSrc marker = let (_, _, file) = this.CreateSingleFileProject(firstSrc) MoveCursorToEndOfMarker(file,marker) @@ -257,14 +257,14 @@ type UsingMSBuild() as this = AssertCompListContainsAll(completions, list) //DoesNotContainAny At Start Of Marker Helper Function - member private this.VerifyDotCompListDoesNotContainAnyAtStartOfMarker(fileContents : string, marker : string, list : string list, ?addtlRefAssy : list) = + member private this.VerifyDotCompListDoesNotContainAnyAtStartOfMarker(fileContents : string, marker : string, list : string list, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) let completions = DotCompletionAtStartOfMarker file marker AssertCompListDoesNotContainAny(completions, list) //DotCompList Is Empty At Start Of Marker Helper Function - member private this.VerifyDotCompListIsEmptyAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : list) = + member private this.VerifyDotCompListIsEmptyAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) let completions = DotCompletionAtStartOfMarker file marker @@ -1237,7 +1237,7 @@ for i in 0..a."] AssertCtrlSpaceCompleteContains code "? y." ["Chars"; "Length"] ["abs"] [] - [] + [] member public this.``Query.ForKeywordCanCompleteIntoIdentifier``() = let code = [ @@ -1479,7 +1479,7 @@ let x = new MyClass2(0) [] - [] + [] member public this.``AfterConstructor.5039_1``() = AssertAutoCompleteContainsNoCoffeeBreak [ "let someCall(x) = null" @@ -1489,7 +1489,7 @@ let x = new MyClass2(0) [ "LastIndexOfAny" ] // should not contain (String) [] - [] + [] member public this.``AfterConstructor.5039_1.CoffeeBreak``() = AssertAutoCompleteContains [ "let someCall(x) = null" @@ -2022,7 +2022,7 @@ let x = new MyClass2(0) [] [] - [] + [] member public this.``CurriedArguments.Regression1``() = AssertCtrlSpaceCompleteContainsNoCoffeeBreak ["let fffff x y = 1" @@ -2447,7 +2447,7 @@ let x = new MyClass2(0) [] [] [] - [] + [] member this.``QueryExpressions.QueryAndSequenceExpressionWithForYieldLoopSystematic``() = let prefix = """ @@ -2549,7 +2549,7 @@ let aaaaaa = 0 [] [] [] - [] + [] /// Incrementally enter query with a 'join' and check for availability of quick info, auto completion and dot completion member this.``QueryAndOtherExpressions.WordByWordSystematicJoinQueryOnSingleLine``() = @@ -2604,7 +2604,7 @@ let aaaaaa = 0 /// This is a sanity check that the multiple-line case is much the same as the single-line cae [] [] - [] + [] member this.``QueryAndOtherExpressions.WordByWordSystematicJoinQueryOnMultipleLine``() = let prefix = """ @@ -2771,7 +2771,7 @@ let x = query { for bbbb in abbbbc(*D0*) do (* Various parser recovery test cases -------------------------------------------------- *) //*****************Helper Function***************** - member public this.AutoCompleteRecoveryTest(source : list, marker, expected) = + member public this.AutoCompleteRecoveryTest(source : string list, marker, expected) = let (_, _, file) = this.CreateSingleFileProject(source) MoveCursorToEndOfMarker(file, marker) let completions = time1 CtrlSpaceCompleteAtCursor file "Time of first autocomplete." @@ -5064,7 +5064,7 @@ let x = query { for bbbb in abbbbc(*D0*) do Assert.IsTrue(completions.Length>0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug72561``() = let code = [ " " ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -5086,7 +5086,7 @@ let x = query { for bbbb in abbbbc(*D0*) do gpatcc.AssertExactly(0,0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug72561.Noteworthy.NowWorks``() = let code = [ "123 " ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -5109,7 +5109,7 @@ let x = query { for bbbb in abbbbc(*D0*) do gpatcc.AssertExactly(0,0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug130733.NowWorks``() = let code = [ "let someCall(x) = null" "let xe = someCall(System.IO.StringReader() "] @@ -5152,7 +5152,7 @@ let x = query { for bbbb in abbbbc(*D0*) do let completions = AutoCompleteAtCursor(file) AssertCompListContainsAll(completions, list) - member private this.VerifyCtrlSpaceListContainAllAtStartOfMarker(fileContents : string, marker : string, list : string list, ?coffeeBreak:bool, ?addtlRefAssy:list) = + member private this.VerifyCtrlSpaceListContainAllAtStartOfMarker(fileContents : string, marker : string, list : string list, ?coffeeBreak:bool, ?addtlRefAssy:string list) = let coffeeBreak = defaultArg coffeeBreak false let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker(file, marker) @@ -7067,7 +7067,7 @@ let rec f l = //Regression test for bug 65740 Fsharp: dot completion is mission after a '#' statement [] - [] + [] member this.``Identifier.In#Statement``() = this.VerifyDotCompListContainAllAtStartOfMarker( fileContents = """ diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index add5eb9cc4d..d96d3a16d61 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -94,7 +94,7 @@ type UsingMSBuild() as this = (errorTexts.ToString()) //Verify the warning list Count - member private this.VerifyWarningListCountAtOpenProject(fileContents : string, expectedNum : int, ?addtlRefAssy : list) = + member private this.VerifyWarningListCountAtOpenProject(fileContents : string, expectedNum : int, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -102,7 +102,7 @@ type UsingMSBuild() as this = Assert.AreEqual(expectedNum,warnList.Length) //verify no the error list - member private this.VerifyNoErrorListAtOpenProject(fileContents : string, ?addtlRefAssy : list) = + member private this.VerifyNoErrorListAtOpenProject(fileContents : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -113,7 +113,7 @@ type UsingMSBuild() as this = Assert.IsTrue(errorList.IsEmpty) //Verify the error list containd the expected string - member private this.VerifyErrorListContainedExpectedString(fileContents : string, expectedStr : string, ?addtlRefAssy : list) = + member private this.VerifyErrorListContainedExpectedString(fileContents : string, expectedStr : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -571,7 +571,7 @@ but here has type Assert.IsTrue(errorList.IsEmpty) [] - [] + [] member public this.``UnicodeCharacters``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs index 5a369da4093..b1049408fac 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs @@ -22,7 +22,7 @@ type UsingMSBuild() = inherit LanguageServiceBaseTests() //GoToDefinitionSuccess Helper Function - member private this.VerifyGoToDefnSuccessAtStartOfMarker(fileContents : string, marker : string, definitionCode : string,?addtlRefAssy : list) = + member private this.VerifyGoToDefnSuccessAtStartOfMarker(fileContents : string, marker : string, definitionCode : string,?addtlRefAssy : string list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) @@ -44,7 +44,7 @@ type UsingMSBuild() = Assert.AreEqual(pos, actualPos, "pos") //GoToDefinitionFail Helper Function - member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string,?addtlRefAssy : list) = + member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string,?addtlRefAssy : string list) = this.VerifyGoToDefnFailAtStartOfMarker( fileContents = fileContents, @@ -55,7 +55,7 @@ type UsingMSBuild() = //GoToDefinitionFail Helper Function - member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string, f : OpenFile * GotoDefnResult -> unit, ?addtlRefAssy : list) = + member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string, f : OpenFile * GotoDefnResult -> unit, ?addtlRefAssy : string list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) @@ -67,7 +67,7 @@ type UsingMSBuild() = //The verification result should be: // Fail at automation lab // Succeed on dev machine with enlistment installed. - member private this.VerifyGoToDefnNoErrorDialogAtStartOfMarker(fileContents : string, marker :string, definitionCode : string, ?addtlRefAssy : list) = + member private this.VerifyGoToDefnNoErrorDialogAtStartOfMarker(fileContents : string, marker :string, definitionCode : string, ?addtlRefAssy : string list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs index 9404ca301e4..0da7fce519b 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs @@ -59,7 +59,7 @@ type UsingMSBuild() = (expectedParamNames,paramDisplays) ||> List.forall2 (fun expectedParamName paramDisplay -> paramDisplay.Contains(expectedParamName)))) - member private this.GetMethodListForAMethodTip(fileContents : string, marker : string, ?addtlRefAssy : list) = + member private this.GetMethodListForAMethodTip(fileContents : string, marker : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker(file, marker) @@ -67,22 +67,22 @@ type UsingMSBuild() = GetParameterInfoAtCursor(file) //Verify all the overload method parameterInfo - member private this.VerifyParameterInfoAtStartOfMarker(fileContents : string, marker : string, expectedParamNamesSet:string list list, ?addtlRefAssy :list) = + member private this.VerifyParameterInfoAtStartOfMarker(fileContents : string, marker : string, expectedParamNamesSet:string list list, ?addtlRefAssy :string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertMethodGroup(methodstr,expectedParamNamesSet) //Verify No parameterInfo at the marker - member private this.VerifyNoParameterInfoAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : list) = + member private this.VerifyNoParameterInfoAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertEmptyMethodGroup(methodstr) //Verify one method parameterInfo if contained in parameterInfo list - member private this.VerifyParameterInfoContainedAtStartOfMarker(fileContents : string, marker : string, expectedParamNames:string list, ?addtlRefAssy : list) = + member private this.VerifyParameterInfoContainedAtStartOfMarker(fileContents : string, marker : string, expectedParamNames:string list, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertMethodGroupContain(methodstr,expectedParamNames) //Verify the parameterInfo of one of the list order - member private this.VerifyParameterInfoOverloadMethodIndex(fileContents : string, marker : string, index : int, expectedParams:string list, ?addtlRefAssy : list) = + member private this.VerifyParameterInfoOverloadMethodIndex(fileContents : string, marker : string, index : int, expectedParams:string list, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) Assert.IsTrue(methodstr.IsSome, "Expected a method group") let methodstr = methodstr.Value @@ -102,7 +102,7 @@ type UsingMSBuild() = Assert.IsTrue (methodstr.GetCount() > 0) //Verify return content after the colon - member private this.VerifyFirstParameterInfoColonContent(fileContents : string, marker : string, expectedStr : string, ?addtlRefAssy : list) = + member private this.VerifyFirstParameterInfoColonContent(fileContents : string, marker : string, expectedStr : string, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) Assert.IsTrue(methodstr.IsSome, "Expected a method group") let methodstr = methodstr.Value @@ -253,7 +253,7 @@ type UsingMSBuild() = this.VerifyHasParameterInfo(fileContent, "(*Mark*)") [] - [] + [] member public this.``Single.DotNet.StaticMethod``() = let code = ["#light" @@ -426,7 +426,7 @@ type UsingMSBuild() = [] - [] + [] member public this.``Single.InMatchClause``() = let v461 = Version(4,6,1) let fileContent = """ @@ -604,7 +604,7 @@ type UsingMSBuild() = // Test PI does not pop up after non-parameterized properties and after values [] - [] + [] member public this.``Single.Locations.EndOfFile`` () = this.TestSystematicParameterInfo("System.Console.ReadLine(", [ [] ]) @@ -640,50 +640,59 @@ type UsingMSBuild() = [] member public this.``Single.Generics.Typeof``() = - let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("typeof(", []) + [] - [] + [] member public this.``Single.Generics.MathAbs``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Math.Abs(", sevenTimes ["value"]) + [] - [] + [] member public this.``Single.Generics.ExchangeInt``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange(", sevenTimes ["location1"; "value"]) + [] - [] + [] member public this.``Single.Generics.Exchange``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange(", sevenTimes ["location1"; "value"]) + [] - [] + [] member public this.``Single.Generics.ExchangeUnder``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange<_> (", sevenTimes ["location1"; "value"]) + [] - [] + [] member public this.``Single.Generics.Dictionary``() = this.TestGenericParameterInfo("System.Collections.Generic.Dictionary<_, option>(", [ []; ["capacity"]; ["comparer"]; ["capacity"; "comparer"]; ["dictionary"]; ["dictionary"; "comparer"] ]) + [] - [] + [] member public this.``Single.Generics.List``() = this.TestGenericParameterInfo("new System.Collections.Generic.List< _ > ( ", [ []; ["capacity"]; ["collection"] ]) + [] - [] + [] member public this.``Single.Generics.ListInt``() = this.TestGenericParameterInfo("System.Collections.Generic.List(", [ []; ["capacity"]; ["collection"] ]) + [] - [] + [] member public this.``Single.Generics.EventHandler``() = this.TestGenericParameterInfo("new System.EventHandler( ", [ [""] ]) // function arg doesn't have a name + [] - [] + [] member public this.``Single.Generics.EventHandlerEventArgs``() = this.TestGenericParameterInfo("System.EventHandler(", [ [""] ]) // function arg doesn't have a name + [] - [] + [] member public this.``Single.Generics.EventHandlerEventArgsNew``() = this.TestGenericParameterInfo("new System.EventHandler ( ", [ [""] ]) // function arg doesn't have a name @@ -697,7 +706,7 @@ type UsingMSBuild() = failwith "bad unit test: did not find '$' in input to mark cursor location!" idx, lines - member public this.TestParameterInfoNegative (testLine, ?addtlRefAssy : list) = + member public this.TestParameterInfoNegative (testLine, ?addtlRefAssy : string list) = let cursorPrefix, testLines = this.ExtractLineInfo testLine let code = @@ -712,7 +721,7 @@ type UsingMSBuild() = Assert.IsTrue(info.IsNone, "expected no parameter info") gpatcc.AssertExactly(0,0) - member public this.TestParameterInfoLocation (testLine, expectedPos, ?addtlRefAssy : list) = + member public this.TestParameterInfoLocation (testLine, expectedPos, ?addtlRefAssy : string list) = let cursorPrefix, testLines = this.ExtractLineInfo testLine let code = [ "#light" @@ -756,7 +765,7 @@ type UsingMSBuild() = this.TestParameterInfoLocation("let a = Interlocked.Exchange($", 8) [] - [] + [] member public this.``Single.Locations.WithGenericArgs``() = this.TestParameterInfoLocation("Interlocked.Exchange($", 0) @@ -779,7 +788,7 @@ type UsingMSBuild() = [] [] [] - [] + [] //This test verifies that ParamInfo location on a provided type with namespace that exposes static parameter that takes >1 argument works normally. member public this.``TypeProvider.Type.ParameterInfoLocation.WithNamespace`` () = this.TestParameterInfoLocation("type boo = N1.T<$",11, @@ -788,7 +797,7 @@ type UsingMSBuild() = [] [] [] - [] + [] //This test verifies that ParamInfo location on a provided type without the namespace that exposes static parameter that takes >1 argument works normally. member public this.``TypeProvider.Type.ParameterInfoLocation.WithOutNamespace`` () = this.TestParameterInfoLocation("open N1 \n"+"type boo = T<$", @@ -881,7 +890,7 @@ type UsingMSBuild() = ("// System.Console.WriteLine($)") [] - [] + [] member this.``Regression.LocationOfParams.AfterQuicklyTyping.Bug91373``() = let code = [ "let f x = x " "let f1 y = y " @@ -906,7 +915,7 @@ type UsingMSBuild() = AssertEqual([|(2,10);(2,12);(2,13);(3,0)|], info.GetParameterLocations()) [] - [] + [] member this.``LocationOfParams.AfterQuicklyTyping.CallConstructor``() = let code = [ "type Foo() = class end" ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -1072,7 +1081,7 @@ We really need to rewrite some code paths here to use the real parse tree rather () [] - [] + [] member public this.``Regression.LocationOfParams.Bug91479``() = this.TestParameterInfoLocationOfParams("""let z = fun x -> x + ^System.Int16.Parse^(^$ """, markAtEOF=true) @@ -1198,7 +1207,7 @@ We really need to rewrite some code paths here to use the real parse tree rather ^l.Aggregate^(^$^) // was once a bug""") [] - [] + [] member public this.``LocationOfParams.BY_DESIGN.WayThatMismatchedParensFailOver.Case1``() = // when only one 'statement' after the mismatched parens after a comma, the comma swallows it and it becomes a badly-indented // continuation of the expression from the previous line @@ -1210,7 +1219,7 @@ We really need to rewrite some code paths here to use the real parse tree rather c.M(1,2,3,4)""", markAtEOF=true) [] - [] + [] member public this.``LocationOfParams.BY_DESIGN.WayThatMismatchedParensFailOver.Case2``() = // when multiple 'statements' after the mismatched parens after a comma, the parser sees a single argument to the method that // is a statement sequence, e.g. a bunch of discarded expressions. That is, @@ -1244,7 +1253,7 @@ We really need to rewrite some code paths here to use the real parse tree rather ^System.Console.WriteLine^(^ $(42,43) ^) // oops""") [] - [] + [] member public this.``LocationOfParams.Tuples.Bug123219``() = this.TestParameterInfoLocationOfParams(""" type Expr = | Num of int @@ -1385,7 +1394,7 @@ We really need to rewrite some code paths here to use the real parse tree rather [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix0``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ $ """, // missing all params, just have < @@ -1393,7 +1402,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix1``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ 42 """, // missing > @@ -1401,7 +1410,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix1Named``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored=42 """, // missing > @@ -1409,7 +1418,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ """, // missing last param @@ -1417,7 +1426,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2Named1``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored= """, // missing last param after name with equals @@ -1425,7 +1434,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2Named2``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored """, // missing last param after name sans equals @@ -1489,7 +1498,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.StaticParametersAtConstructorCallSite``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" let x = new ^N1.T^<^ "fo$o",^ 42 ^>()""", @@ -1627,7 +1636,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["string";"System.Globalization.NumberStyles"]) [] - [] + [] member public this.``Multi.DotNet.StaticMethod.WithinLambda``() = let fileContents = """let z = fun x -> x + System.Int16.Parse("",(*Mark*)""" this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["string";"System.Globalization.NumberStyles"]) @@ -1646,7 +1655,7 @@ We really need to rewrite some code paths here to use the real parse tree rather (* Common functions for multi-parameterinfo tests -------------------------------------------------- *) [] - [] + [] member public this.``Multi.DotNet.Constructor``() = let fileContents = "let _ = new System.DateTime(2010,12,(*Mark*)" this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["int";"int";"int"]) @@ -1742,7 +1751,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoAtStartOfMarker(fileContents,"(*Mark*)",[["int list"]]) [] - [] + [] member public this.``Multi.Function.WithOptionType``() = let fileContents = """ let foo( a : int option, b : string ref) = 0 @@ -1759,7 +1768,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoAtStartOfMarker(fileContents,"(*Mark*)",[["int option";"float option"]]) [] - [] + [] member public this.``Multi.Function.WithRefType``() = let fileContents = """ let foo( a : int ref, b : string ref) = 0 diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs index 388bb365fd9..d62f4274062 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs @@ -54,7 +54,7 @@ type UsingMSBuild() = AssertContains(trimnewlines tooltip, trimnewlines expected) gpatcc.AssertExactly(0,0) - member public this.CheckTooltip(code : string,marker,atStart, f, ?addtlRefAssy : list) = + member public this.CheckTooltip(code : string,marker,atStart, f, ?addtlRefAssy : string list) = let (_, _, file) = this.CreateSingleFileProject(code, ?references = addtlRefAssy) let gpatcc = GlobalParseAndTypeCheckCounter.StartNew(this.VS) @@ -67,14 +67,14 @@ type UsingMSBuild() = f (tooltip, pos) gpatcc.AssertExactly(0,0) - member public this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,atStart, ?addtlRefAssy : list) = + member public this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,atStart, ?addtlRefAssy : string list) = let check ((tooltip, _), _) = AssertContains(tooltip, expected) this.CheckTooltip(code, marker, atStart, check, ?addtlRefAssy=addtlRefAssy ) - member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : list) = + member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : string list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,false,?addtlRefAssy=addtlRefAssy) - member public this.AssertQuickInfoContainsAtStartOfMarker(code, marker, expected, ?addtlRefAssy : list) = + member public this.AssertQuickInfoContainsAtStartOfMarker(code, marker, expected, ?addtlRefAssy : string list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,true,?addtlRefAssy=addtlRefAssy) member public this.VerifyQuickInfoDoesNotContainAnyAtEndOfMarker (code : string) marker notexpected = @@ -1684,7 +1684,7 @@ let f (tp:ITypeProvider(*$$$*)) = tp.Invalidate /// Complete a member completion and confirm that its data tip contains the fragments /// in rhsContainsOrder - member public this.AssertMemberDataTipContainsInOrder(code : list,marker,completionName,rhsContainsOrder) = + member public this.AssertMemberDataTipContainsInOrder(code : string list,marker,completionName,rhsContainsOrder) = let code = code |> Seq.collect (fun s -> s.Split [|'\r'; '\n'|]) |> List.ofSeq let (_, project, file) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(this.VS) (* why needed? *) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs index ea2d28ad606..7f854cb01e3 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs @@ -24,7 +24,7 @@ type UsingMSBuild() as this = let (_, p, f) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) (p, f) - let createSingleFileFsxFromLines (code : list) = + let createSingleFileFsxFromLines (code : string list) = let (_, p, f) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) (p, f) @@ -582,7 +582,7 @@ type UsingMSBuild() as this = [] [] - [] + [] member public this.``Fsx.NoError.HashR.RelativePath1``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -619,7 +619,7 @@ type UsingMSBuild() as this = AssertNoSquiggle(ans) [] - [] + [] member public this.``Fsx.NoError.HashR.RelativePath2``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs index 34021a7dd1a..e89d828ac24 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs @@ -89,7 +89,7 @@ type UsingMSBuild() = // In this bug, the referenced project output didn't exist yet. Building dependee should cause update in dependant [] - [] + [] member public this.``Regression.NoContainedString.Timestamps.Bug3368a``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -166,7 +166,7 @@ type UsingMSBuild() = // FEATURE: When a referenced assembly's timestamp changes the reference is reread. [] - [] + [] member public this.``Timestamps.ReferenceAssemblyChangeAbsolute``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -213,7 +213,7 @@ type UsingMSBuild() = // In this bug, relative paths to referenced assemblies weren't seen. [] - [] + [] member public this.``Timestamps.ReferenceAssemblyChangeRelative``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -268,7 +268,7 @@ type UsingMSBuild() = // FEATURE: When a referenced project's assembly timestamp changes the reference is reread. [] - [] + [] member public this.``Timestamps.ProjectReferenceAssemblyChange``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs index 5f3f2f63c9a..8b56c8ae806 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs @@ -684,7 +684,7 @@ type Project() = File.Delete(absFilePath) )) - [] //ref bug https://github.com/Microsoft/visualfsharp/issues/259 + [] //ref bug https://github.com/dotnet/fsharp/issues/259 member public this.``RenameFile.InFolder``() = this.MakeProjectAndDo(["file1.fs"; @"Folder1\file2.fs"; @"Folder1\nested1.fs"], [], "", (fun project -> let absFilePath = Path.Combine(project.ProjectFolder, "Folder1", "nested1.fs") @@ -746,7 +746,7 @@ type Project() = if File.Exists(absFilePath) then File.Delete(absFilePath) )) -(* Disabled for now - see https://github.com/Microsoft/visualfsharp/pull/3071 - this is testing old project system features +(* Disabled for now - see https://github.com/dotnet/fsharp/pull/3071 - this is testing old project system features [] member public this.``RenameFile.BuildActionIsResetBasedOnFilenameExtension``() = diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs index bdedda27f09..50805ed6356 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs @@ -508,10 +508,10 @@ type References() = AssertContains contents newPropVal ) - // Disabled due to: https://github.com/Microsoft/visualfsharp/issues/1460 + // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 // On DEV 15 Preview 4 the VS IDE Test fails with : // System.InvalidOperationException : Operation is not valid due to the current state of the object. - // [] // Disabled due to: https://github.com/Microsoft/visualfsharp/issues/1460 + // [] // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 member public this.``AddReference.COM`` () = DoWithTempFile "Test.fsproj" (fun projFile -> File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [], "")) diff --git a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs index c33223c6ff0..35fe73cb680 100644 --- a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs +++ b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs @@ -32,21 +32,21 @@ type internal SourceFileKind = FS | FSI | FSX type internal ISingleFileTestRunner = abstract CreateSingleFileProject : content : string * - ?references : list * - ?defines : list * + ?references : string list * + ?defines : string list * ?fileKind : SourceFileKind * - ?disabledWarnings : list * + ?disabledWarnings : string list * ?fileName : string -> (OpenSolution * OpenProject * OpenFile) abstract CreateSingleFileProject : - content : list * - ?references : list * - ?defines : list * + content : string list * + ?references : string list * + ?defines : string list * ?fileKind : SourceFileKind * - ?disabledWarnings : list* + ?disabledWarnings : string list* ? fileName : string -> (OpenSolution * OpenProject * OpenFile) type internal Helper = - static member TrimOutExtraMscorlibs (libList:list) = + static member TrimOutExtraMscorlibs (libList:string list) = // There may be multiple copies of mscorlib referenced; but we're only allowed to use one. Pick the highest one. let allExceptMscorlib = libList |> List.filter (fun s -> not(s.Contains("mscorlib"))) let mscorlibs = libList |> List.filter (fun s -> s.Contains("mscorlib")) @@ -78,7 +78,7 @@ type internal Helper = Impl SourceFileKind.FS Impl SourceFileKind.FSX - static member AssertMemberDataTipContainsInOrder(sftr : ISingleFileTestRunner, code : list,marker,completionName,rhsContainsOrder) = + static member AssertMemberDataTipContainsInOrder(sftr : ISingleFileTestRunner, code : string list,marker,completionName,rhsContainsOrder) = let (_solution, project, file) = sftr.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(file.VS) (* why needed? *) MoveCursorToEndOfMarker(file,marker) @@ -193,7 +193,7 @@ type internal GlobalParseAndTypeCheckCounter private(initialParseCount:int, init | Some(aat) -> aat :: (expectedTypeCheckedFiles |> List.map GetNameOfOpenFile) | _ -> (expectedTypeCheckedFiles |> List.map GetNameOfOpenFile) this.AssertExactly(p.Length, t.Length, p, t, expectCreate) - member private this.AssertExactly(expectedParses, expectedTypeChecks, expectedParsedFiles : list, expectedTypeCheckedFiles : list, expectCreate : bool) = + member private this.AssertExactly(expectedParses, expectedTypeChecks, expectedParsedFiles : string list, expectedTypeCheckedFiles : string list, expectCreate : bool) = let note,ok = if expectCreate then if this.SawIBCreated() then ("The incremental builder was created, as expected",true) else ("The incremental builder was NOT deleted and recreated, even though we expected it to be",false) @@ -254,46 +254,41 @@ type LanguageServiceBaseTests() = let mutable defaultVS : VisualStudio = Unchecked.defaultof<_> let mutable currentVS : VisualStudio = Unchecked.defaultof<_> - (* VsOps is internal, but this type needs to be public *) + // VsOps is internal, but this type needs to be public let mutable ops = BuiltMSBuildTestFlavour() let testStopwatch = new Stopwatch() - (* Timings ----------------------------------------------------------------------------- *) + // Timings ----------------------------------------------------------------------------- let stopWatch = new Stopwatch() let ResetStopWatch() = stopWatch.Reset(); stopWatch.Start() - let time1 op a message = - ResetStopWatch() - let result = op a - printf "%s %d ms\n" message stopWatch.ElapsedMilliseconds - result - member internal this.VsOpts + member internal _.VsOpts with set op = ops <- op member internal this.TestRunner : ISingleFileTestRunner = SingleFileTestRunner(this) :> _ - member internal this.VS = currentVS + member internal _.VS = currentVS member internal this.CreateSingleFileProject ( content : string, - ?references : list, - ?defines : list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string, ?otherFlags: string ) = let content = content.Split( [|"\r\n"|], StringSplitOptions.None) |> List.ofArray this.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName, ?otherFlags = otherFlags) - member internal this.CreateSingleFileProject + member internal _.CreateSingleFileProject ( - content : list, - ?references : list, - ?defines : list, + content : string list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string, ?otherFlags: string ) = @@ -353,12 +348,12 @@ type LanguageServiceBaseTests() = defaultSolution, proj, file - member internal this.CreateSolution() = + member internal _.CreateSolution() = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" GlobalFunctions.CreateSolution(currentVS) - member internal this.CloseSolution(sln : OpenSolution) = + member internal _.CloseSolution(sln : OpenSolution) = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" if (box sln.VS <> box currentVS) then @@ -366,7 +361,7 @@ type LanguageServiceBaseTests() = GlobalFunctions.CloseSolution(sln) - member internal this.AddAssemblyReference(proj, ref) = + member internal _.AddAssemblyReference(proj, ref) = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" @@ -466,21 +461,21 @@ and internal SingleFileTestRunner(owner : LanguageServiceBaseTests) = member sftr.CreateSingleFileProject ( content : string, - ?references : list, - ?defines : list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string ) = owner.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName) member sftr.CreateSingleFileProject ( - content : list, - ?references : list, - ?defines : list, + content : string list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string ) = owner.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName) diff --git a/vsintegration/tests/UnitTests/Tests.Watson.fs b/vsintegration/tests/UnitTests/Tests.Watson.fs index e0e44503b47..54122e4ff71 100644 --- a/vsintegration/tests/UnitTests/Tests.Watson.fs +++ b/vsintegration/tests/UnitTests/Tests.Watson.fs @@ -31,7 +31,7 @@ type Check = |] let ctok = AssumeCompilationThreadWithoutEvidence () - let _code = mainCompile (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.ErrorLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) + let _code = CompileFromCommandLineArguments (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.DiagnosticsLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) () with | :? 'TException as e -> @@ -40,8 +40,8 @@ type Check = else printfn "%s" msg Assert.Fail("The correct callstack was not reported to watson.") - | (FSharp.Compiler.ErrorLogger.ReportedError (Some (FSharp.Compiler.ErrorLogger.InternalError (msg, range) as e))) - | (FSharp.Compiler.ErrorLogger.InternalError (msg, range) as e) -> + | (FSharp.Compiler.DiagnosticsLogger.ReportedError (Some (FSharp.Compiler.DiagnosticsLogger.InternalError (msg, range) as e))) + | (FSharp.Compiler.DiagnosticsLogger.InternalError (msg, range) as e) -> printfn "InternalError Exception: %s, range = %A, stack = %s" msg range (e.ToString()) Assert.Fail("An InternalError exception occurred.") finally diff --git a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs index f33ffbc52da..bcdcd67b66b 100644 --- a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs +++ b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs @@ -184,11 +184,11 @@ module WorkspaceTests = interface IFSharpWorkspaceProjectContext with - member this.Dispose(): unit = () + member _.Dispose(): unit = () - member this.FilePath: string = mainProj.FilePath + member _.FilePath: string = mainProj.FilePath - member this.HasProjectReference(filePath: string): bool = + member _.HasProjectReference(filePath: string): bool = mainProj.ProjectReferences |> Seq.exists (fun x -> let projRef = mainProj.Solution.GetProject(x.ProjectId) @@ -198,11 +198,11 @@ module WorkspaceTests = false ) - member this.Id: ProjectId = mainProj.Id + member _.Id: ProjectId = mainProj.Id - member this.ProjectReferenceCount: int = mainProj.ProjectReferences.Count() + member _.ProjectReferenceCount: int = mainProj.ProjectReferences.Count() - member this.SetProjectReferences(projRefs: seq): unit = + member _.SetProjectReferences(projRefs: seq): unit = let currentProj = mainProj let mutable solution = currentProj.Solution @@ -224,9 +224,9 @@ module WorkspaceTests = mainProj <- solution.GetProject(currentProj.Id) - member this.MetadataReferenceCount: int = mainProj.MetadataReferences.Count + member _.MetadataReferenceCount: int = mainProj.MetadataReferences.Count - member this.HasMetadataReference(referencePath: string): bool = + member _.HasMetadataReference(referencePath: string): bool = mainProj.MetadataReferences |> Seq.exists (fun x -> match x with @@ -235,7 +235,7 @@ module WorkspaceTests = | _ -> false) - member this.SetMetadataReferences(referencePaths: string seq): unit = + member _.SetMetadataReferences(referencePaths: string seq): unit = let currentProj = mainProj let mutable solution = currentProj.Solution @@ -263,7 +263,7 @@ module WorkspaceTests = type TestFSharpWorkspaceProjectContextFactory(workspace: Workspace, miscFilesWorkspace: Workspace) = interface IFSharpWorkspaceProjectContextFactory with - member this.CreateProjectContext(filePath: string): IFSharpWorkspaceProjectContext = + member _.CreateProjectContext(filePath: string): IFSharpWorkspaceProjectContext = match miscFilesWorkspace.CurrentSolution.GetDocumentIdsWithFilePath(filePath) |> Seq.tryExactlyOne with | Some docId -> let doc = miscFilesWorkspace.CurrentSolution.GetDocument(docId) From 7ce8b632281fdf96276214602b84a33f36104451 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 10 May 2022 10:39:03 +0200 Subject: [PATCH 03/91] Revert "Cleanup (#13113)" This reverts commit ff0deda617826cd3041198c53fe46481c2118a64. --- src/fsharp/AccessibilityLogic.fs | 3 +- src/fsharp/AttributeChecking.fs | 10 +- src/fsharp/AttributeChecking.fsi | 2 +- src/fsharp/AugmentWithHashCompare.fs | 14 +- src/fsharp/BuildGraph.fs | 20 +- src/fsharp/BuildGraph.fsi | 2 +- src/fsharp/CheckComputationExpressions.fs | 2 +- src/fsharp/CheckDeclarations.fs | 21 +- src/fsharp/CheckDeclarations.fsi | 4 +- src/fsharp/CheckExpressions.fs | 75 +-- src/fsharp/CheckExpressions.fsi | 52 +- src/fsharp/CheckFormatStrings.fs | 2 +- src/fsharp/CompilerConfig.fs | 22 +- src/fsharp/CompilerConfig.fsi | 10 +- src/fsharp/CompilerDiagnostics.fs | 98 ++-- src/fsharp/CompilerDiagnostics.fsi | 64 +-- src/fsharp/CompilerImports.fs | 12 +- src/fsharp/CompilerImports.fsi | 10 +- src/fsharp/CompilerOptions.fs | 22 +- src/fsharp/ConstraintSolver.fs | 9 +- src/fsharp/ConstraintSolver.fsi | 2 +- src/fsharp/CreateILModule.fs | 2 +- .../DependencyManager/DependencyProvider.fs | 2 +- src/fsharp/DetupleArgs.fs | 2 +- .../{DiagnosticsLogger.fs => ErrorLogger.fs} | 159 +++--- ...{DiagnosticsLogger.fsi => ErrorLogger.fsi} | 87 ++-- .../FSharp.Build/FSharpEmbedResXSource.fs | 14 +- .../FSharp.Build/FSharpEmbedResourceText.fs | 12 +- .../FSharp.Build/Microsoft.FSharp.Targets | 4 +- .../FSharp.Compiler.Service.fsproj | 56 +- src/fsharp/FSharp.Core/Query.fs | 8 +- src/fsharp/FSharp.Core/async.fs | 2 +- .../FSharp.Core/fslib-extra-pervasives.fs | 22 +- src/fsharp/FSharp.Core/list.fs | 72 ++- src/fsharp/FSharp.Core/local.fs | 2 +- src/fsharp/FSharp.Core/map.fs | 4 +- src/fsharp/FSharp.Core/option.fs | 242 ++------- src/fsharp/FSharp.Core/prim-types.fs | 4 +- src/fsharp/FSharp.Core/quotations.fs | 24 +- src/fsharp/FSharp.Core/quotations.fsi | 12 +- src/fsharp/FSharp.Core/seq.fs | 2 +- src/fsharp/FSharp.Core/string.fs | 4 +- .../FSharp.DependencyManager.fs | 2 +- src/fsharp/FindUnsolved.fs | 2 +- src/fsharp/FxResolver.fs | 2 +- src/fsharp/IlxGen.fs | 10 +- src/fsharp/ImmutableArray.fsi | 57 --- src/fsharp/InfoReader.fs | 3 +- src/fsharp/InfoReader.fsi | 1 - src/fsharp/InnerLambdasToTopLevelFuncs.fs | 2 +- src/fsharp/LegacyHostedCompilerForTesting.fs | 100 +--- src/fsharp/LexFilter.fs | 2 +- src/fsharp/LowerCalls.fs | 53 -- src/fsharp/LowerCalls.fsi | 10 - ...LowerSequences.fs => LowerCallsAndSeqs.fs} | 394 ++++++++++++++- ...werSequences.fsi => LowerCallsAndSeqs.fsi} | 16 +- src/fsharp/LowerComputedCollections.fs | 272 ---------- src/fsharp/LowerComputedCollections.fsi | 10 - src/fsharp/LowerStateMachines.fs | 10 +- src/fsharp/MethodCalls.fs | 3 +- src/fsharp/MethodCalls.fsi | 2 +- src/fsharp/MethodOverrides.fs | 3 +- src/fsharp/NameResolution.fs | 63 +-- src/fsharp/NicePrint.fs | 13 +- src/fsharp/OptimizeInputs.fs | 6 +- src/fsharp/Optimizer.fs | 14 +- src/fsharp/ParseAndCheckInputs.fs | 34 +- src/fsharp/ParseAndCheckInputs.fsi | 16 +- src/fsharp/ParseHelpers.fs | 2 +- src/fsharp/PatternMatchCompilation.fs | 50 +- src/fsharp/PostInferenceChecks.fs | 3 +- src/fsharp/QueueList.fs | 2 +- src/fsharp/QuotationTranslator.fs | 2 +- src/fsharp/ScriptClosure.fs | 20 +- src/fsharp/ScriptClosure.fsi | 2 +- src/fsharp/SignatureConformance.fs | 5 +- src/fsharp/StaticLinking.fs | 6 +- src/fsharp/SyntaxTreeOps.fs | 2 +- src/fsharp/TypeHierarchy.fs | 409 --------------- src/fsharp/TypeHierarchy.fsi | 174 ------- src/fsharp/TypeProviders.fs | 2 +- src/fsharp/TypeRelations.fs | 4 +- src/fsharp/TypedTree.fs | 12 +- src/fsharp/TypedTreeOps.fs | 97 +--- src/fsharp/TypedTreeOps.fsi | 32 +- src/fsharp/TypedTreePickle.fs | 4 +- src/fsharp/XmlDoc.fs | 2 +- src/fsharp/XmlDocFileWriter.fs | 2 +- src/fsharp/absil/il.fs | 365 +++++++------- src/fsharp/absil/il.fsi | 2 +- src/fsharp/absil/illib.fs | 2 +- src/fsharp/absil/ilmorph.fs | 2 +- src/fsharp/absil/ilread.fs | 2 +- src/fsharp/absil/ilreflect.fs | 4 +- src/fsharp/absil/ilwrite.fs | 2 +- src/fsharp/absil/ilwritepdb.fs | 2 +- .../{LowerLocalMutables.fs => autobox.fs} | 6 +- .../{LowerLocalMutables.fsi => autobox.fsi} | 2 +- src/fsharp/{ImmutableArray.fs => block.fs} | 53 +- src/fsharp/block.fsi | 63 +++ src/fsharp/fsc.fs | 130 +++-- src/fsharp/fsc.fsi | 49 +- src/fsharp/fscmain.fs | 6 +- src/fsharp/fsi/console.fs | 2 +- src/fsharp/fsi/fsi.fs | 76 +-- src/fsharp/fsi/fsimain.fs | 8 +- src/fsharp/import.fs | 23 +- src/fsharp/import.fsi | 11 +- src/fsharp/infos.fs | 477 ++++++++++++++++-- src/fsharp/infos.fsi | 165 ++++++ src/fsharp/lex.fsl | 2 +- src/fsharp/lexhelp.fs | 4 +- src/fsharp/lexhelp.fsi | 6 +- src/fsharp/pars.fsy | 2 +- src/fsharp/pplex.fsl | 2 +- src/fsharp/pppars.fsy | 2 +- src/fsharp/service/FSharpCheckerResults.fs | 60 +-- src/fsharp/service/FSharpCheckerResults.fsi | 2 +- src/fsharp/service/FSharpParseFileResults.fs | 4 +- src/fsharp/service/IncrementalBuild.fs | 154 +++--- src/fsharp/service/IncrementalBuild.fsi | 7 +- src/fsharp/service/SemanticClassification.fs | 7 +- src/fsharp/service/ServiceAssemblyContent.fs | 4 +- .../service/ServiceCompilerDiagnostics.fs | 2 +- src/fsharp/service/ServiceDeclarationLists.fs | 10 +- src/fsharp/service/ServiceLexing.fs | 28 +- src/fsharp/service/ServiceNavigation.fs | 45 +- .../service/ServiceParamInfoLocations.fs | 30 +- src/fsharp/service/ServiceParseTreeWalk.fs | 2 +- src/fsharp/service/ServiceParsedInputOps.fs | 6 +- src/fsharp/service/ServiceStructure.fs | 2 +- src/fsharp/service/service.fs | 103 ++-- src/fsharp/symbols/Exprs.fs | 3 +- src/fsharp/symbols/FSharpDiagnostic.fs | 207 -------- src/fsharp/symbols/FSharpDiagnostic.fsi | 130 ----- src/fsharp/symbols/SymbolHelpers.fs | 212 +++++++- src/fsharp/symbols/SymbolHelpers.fsi | 116 +++++ src/fsharp/symbols/Symbols.fs | 19 +- src/fsharp/tainted.fs | 6 +- src/fsharp/utils/CompilerLocationUtils.fs | 2 +- src/fsharp/utils/prim-lexing.fs | 2 +- src/fsharp/utils/sformat.fs | 2 +- .../MapSourceRootsTests.fs | 43 +- .../WriteCodeFragmentTests.fs | 32 +- .../checkedOperatorsNoOverflow.fs | 2 +- .../EmittedIL/Misc/AbstractClass.fs | 2 +- .../SteppingMatch/SteppingMatch09.fs | 6 +- .../EmittedIL/Tuples/OptionalArg01.fs | 2 +- .../Printing/ParamArrayInSignatures.fsx | 2 +- tests/FSharp.Compiler.UnitTests/BlockTests.fs | 14 +- .../CompilerTestHelpers.fs | 2 +- .../HashIfExpression.fs | 99 ++-- .../FSharp.Core/ComparersRegression.fs | 2 +- .../Microsoft.FSharp.Control/AsyncModule.fs | 2 +- .../Microsoft.FSharp.Control/AsyncType.fs | 4 +- .../MailboxProcessorType.fs | 6 +- .../FSharp.Core/PrimTypes.fs | 2 +- tests/benchmarks/TaskPerf/option.fs | 4 +- tests/fsharp/tests.fs | 16 +- tests/service/Common.fs | 38 +- tests/service/PatternMatchCompilationTests.fs | 82 +-- tests/service/ProjectAnalysisTests.fs | 4 +- tests/service/data/TestTP/ProvidedTypes.fs | 2 +- .../Completion/CompletionProvider.fs | 2 +- .../FSharp.Editor/Options/EditorOptions.fs | 2 +- .../FSharp.ProjectSystem.FSharp/Project.fs | 2 +- .../src/FSharp.VS.FSI/fsiTextBufferStream.fs | 2 +- .../ProvidedTypes.fs | 4 +- .../UnitTests/BraceMatchingServiceTests.fs | 2 +- .../UnitTests/CompletionProviderTests.fs | 2 +- .../DocumentDiagnosticAnalyzerTests.fs | 2 +- .../Tests.LanguageService.Completion.fs | 50 +- .../Tests.LanguageService.ErrorList.fs | 8 +- .../Tests.LanguageService.GotoDefinition.fs | 8 +- .../Tests.LanguageService.ParameterInfo.fs | 93 ++-- .../Tests.LanguageService.QuickInfo.fs | 10 +- .../Tests.LanguageService.Script.fs | 6 +- .../Tests.LanguageService.TimeStamp.fs | 8 +- .../Tests.ProjectSystem.Project.fs | 4 +- .../Tests.ProjectSystem.References.fs | 4 +- .../UnitTests/TestLib.LanguageService.fs | 69 +-- vsintegration/tests/UnitTests/Tests.Watson.fs | 6 +- .../UnitTests/Workspace/WorkspaceTests.fs | 20 +- 183 files changed, 2946 insertions(+), 3483 deletions(-) rename src/fsharp/{DiagnosticsLogger.fs => ErrorLogger.fs} (85%) rename src/fsharp/{DiagnosticsLogger.fsi => ErrorLogger.fsi} (83%) delete mode 100644 src/fsharp/ImmutableArray.fsi delete mode 100644 src/fsharp/LowerCalls.fs delete mode 100644 src/fsharp/LowerCalls.fsi rename src/fsharp/{LowerSequences.fs => LowerCallsAndSeqs.fs} (68%) rename src/fsharp/{LowerSequences.fsi => LowerCallsAndSeqs.fsi} (68%) delete mode 100644 src/fsharp/LowerComputedCollections.fs delete mode 100644 src/fsharp/LowerComputedCollections.fsi delete mode 100644 src/fsharp/TypeHierarchy.fs delete mode 100644 src/fsharp/TypeHierarchy.fsi rename src/fsharp/{LowerLocalMutables.fs => autobox.fs} (98%) rename src/fsharp/{LowerLocalMutables.fsi => autobox.fsi} (88%) rename src/fsharp/{ImmutableArray.fs => block.fs} (74%) create mode 100644 src/fsharp/block.fsi delete mode 100644 src/fsharp/symbols/FSharpDiagnostic.fs delete mode 100644 src/fsharp/symbols/FSharpDiagnostic.fsi diff --git a/src/fsharp/AccessibilityLogic.fs b/src/fsharp/AccessibilityLogic.fs index 4a70f268ddf..e9d917016ed 100644 --- a/src/fsharp/AccessibilityLogic.fs +++ b/src/fsharp/AccessibilityLogic.fs @@ -6,13 +6,12 @@ module internal FSharp.Compiler.AccessibilityLogic open Internal.Utilities.Library open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index 9d1cc9ac5ca..14e92c80b43 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -9,14 +9,12 @@ open System.Collections.Generic open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler -open FSharp.Compiler.DiagnosticsLogger -open FSharp.Compiler.Import +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders @@ -89,7 +87,7 @@ type AttribInfo = match x with | FSAttribInfo(_g, Attrib(tcref, _, _, _, _, _, _)) -> tcref | ILAttribInfo (g, amap, scoref, a, m) -> - let ty = RescopeAndImportILType scoref amap m [] a.Method.DeclaringType + let ty = ImportILType scoref amap m [] a.Method.DeclaringType tcrefOfAppTy g ty member x.ConstructorArguments = @@ -103,7 +101,7 @@ type AttribInfo = | ILAttribInfo (_g, amap, scoref, cattr, m) -> let parms, _args = decodeILAttribData cattr [ for argTy, arg in Seq.zip cattr.Method.FormalArgTypes parms -> - let ty = RescopeAndImportILType scoref amap m [] argTy + let ty = ImportILType scoref amap m [] argTy let obj = evalILAttribElem arg ty, obj ] @@ -118,7 +116,7 @@ type AttribInfo = | ILAttribInfo (_g, amap, scoref, cattr, m) -> let _parms, namedArgs = decodeILAttribData cattr [ for nm, argTy, isProp, arg in namedArgs -> - let ty = RescopeAndImportILType scoref amap m [] argTy + let ty = ImportILType scoref amap m [] argTy let obj = evalILAttribElem arg let isField = not isProp ty, nm, isField, obj ] diff --git a/src/fsharp/AttributeChecking.fsi b/src/fsharp/AttributeChecking.fsi index 430fe36f0db..25db0ca1679 100644 --- a/src/fsharp/AttributeChecking.fsi +++ b/src/fsharp/AttributeChecking.fsi @@ -7,7 +7,7 @@ module internal FSharp.Compiler.AttributeChecking open System.Collections.Generic open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 8e2646ada99..59869f2dfbe 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -5,7 +5,8 @@ module internal FSharp.Compiler.AugmentWithHashCompare open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Infos open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Xml @@ -13,7 +14,6 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy let mkIComparableCompareToSlotSig (g: TcGlobals) = TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [[TSlotParam(Some("obj"), g.obj_ty, false, false, false, [])]], Some g.int_ty) @@ -175,7 +175,7 @@ let mkEqualsTestConjuncts g m exprs = List.foldBack (fun e acc -> mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty e acc (mkFalse g m)) a b let mkMinimalTy (g: TcGlobals) (tcref: TyconRef) = - if tcref.Deref.IsFSharpException then [], g.exn_ty + if tcref.Deref.IsExceptionDecl then [], g.exn_ty else generalizeTyconRef g tcref // check for nulls @@ -679,7 +679,7 @@ let isTrueFSharpStructTycon _g (tycon: Tycon) = let canBeAugmentedWithEquals g (tycon: Tycon) = tycon.IsUnionTycon || tycon.IsRecordTycon || - (tycon.IsFSharpException && isNominalExnc tycon) || + (tycon.IsExceptionDecl && isNominalExnc tycon) || isTrueFSharpStructTycon g tycon let canBeAugmentedWithCompare g (tycon: Tycon) = @@ -918,7 +918,7 @@ let MakeValsForEqualsAugmentation g (tcref: TyconRef) = let tps = tcref.Typars m let objEqualsVal = mkValSpec g tcref ty vis (Some(mkEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsObjTy g ty)) unaryArg - let nocEqualsVal = mkValSpec g tcref ty vis (if tcref.Deref.IsFSharpException then None else Some(mkGenericIEquatableEqualsSlotSig g ty)) "Equals" (tps +-> (mkEqualsTy g ty)) unaryArg + let nocEqualsVal = mkValSpec g tcref ty vis (if tcref.Deref.IsExceptionDecl then None else Some(mkGenericIEquatableEqualsSlotSig g ty)) "Equals" (tps +-> (mkEqualsTy g ty)) unaryArg objEqualsVal, nocEqualsVal let MakeValsForEqualityWithComparerAugmentation g (tcref: TyconRef) = @@ -1032,7 +1032,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon (mkCompGenBind withcEqualsVal.Deref withcEqualsExpr)] if tycon.IsUnionTycon then mkStructuralEquatable mkUnionHashWithComparer mkUnionEqualityWithComparer elif (tycon.IsRecordTycon || tycon.IsStructOrEnumTycon) then mkStructuralEquatable mkRecdHashWithComparer mkRecdEqualityWithComparer - elif tycon.IsFSharpException then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer + elif tycon.IsExceptionDecl then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer else [] let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = @@ -1066,7 +1066,7 @@ let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = [ mkCompGenBind nocEqualsVal.Deref nocEqualsExpr mkCompGenBind objEqualsVal.Deref objEqualsExpr ] - if tycon.IsFSharpException then mkEquals mkExnEquality + if tycon.IsExceptionDecl then mkEquals mkExnEquality elif tycon.IsUnionTycon then mkEquals mkUnionEquality elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkEquals mkRecdEquality else [] diff --git a/src/fsharp/BuildGraph.fs b/src/fsharp/BuildGraph.fs index 2c287c11f3e..ca8409a22e6 100644 --- a/src/fsharp/BuildGraph.fs +++ b/src/fsharp/BuildGraph.fs @@ -7,7 +7,7 @@ open System.Threading open System.Threading.Tasks open System.Diagnostics open System.Globalization -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open Internal.Utilities.Library [] @@ -15,12 +15,12 @@ type NodeCode<'T> = Node of Async<'T> let wrapThreadStaticInfo computation = async { - let errorLogger = CompileThreadStatic.DiagnosticsLogger + let errorLogger = CompileThreadStatic.ErrorLogger let phase = CompileThreadStatic.BuildPhase try return! computation finally - CompileThreadStatic.DiagnosticsLogger <- errorLogger + CompileThreadStatic.ErrorLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase } @@ -72,7 +72,7 @@ type NodeCodeBuilder() = member _.Using(value: CompilationGlobalsScope, binder: CompilationGlobalsScope -> NodeCode<'U>) = Node( async { - CompileThreadStatic.DiagnosticsLogger <- value.DiagnosticsLogger + CompileThreadStatic.ErrorLogger <- value.ErrorLogger CompileThreadStatic.BuildPhase <- value.BuildPhase try return! binder value |> Async.AwaitNodeCode @@ -90,19 +90,19 @@ type NodeCode private () = Node(wrapThreadStaticInfo Async.CancellationToken) static member RunImmediate (computation: NodeCode<'T>, ct: CancellationToken) = - let errorLogger = CompileThreadStatic.DiagnosticsLogger + let errorLogger = CompileThreadStatic.ErrorLogger let phase = CompileThreadStatic.BuildPhase try try let work = async { - CompileThreadStatic.DiagnosticsLogger <- errorLogger + CompileThreadStatic.ErrorLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase return! computation |> Async.AwaitNodeCode } Async.StartImmediateAsTask(work, cancellationToken=ct).Result finally - CompileThreadStatic.DiagnosticsLogger <- errorLogger + CompileThreadStatic.ErrorLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase with | :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> @@ -112,18 +112,18 @@ type NodeCode private () = NodeCode.RunImmediate(computation, CancellationToken.None) static member StartAsTask_ForTesting (computation: NodeCode<'T>, ?ct: CancellationToken) = - let errorLogger = CompileThreadStatic.DiagnosticsLogger + let errorLogger = CompileThreadStatic.ErrorLogger let phase = CompileThreadStatic.BuildPhase try let work = async { - CompileThreadStatic.DiagnosticsLogger <- errorLogger + CompileThreadStatic.ErrorLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase return! computation |> Async.AwaitNodeCode } Async.StartAsTask(work, cancellationToken=defaultArg ct CancellationToken.None) finally - CompileThreadStatic.DiagnosticsLogger <- errorLogger + CompileThreadStatic.ErrorLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase static member CancellationToken = cancellationToken diff --git a/src/fsharp/BuildGraph.fsi b/src/fsharp/BuildGraph.fsi index 169164d6ff5..1a475c97225 100644 --- a/src/fsharp/BuildGraph.fsi +++ b/src/fsharp/BuildGraph.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.BuildGraph open System open System.Threading open System.Threading.Tasks -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open Internal.Utilities.Library /// Represents code that can be run as part of the build graph. diff --git a/src/fsharp/CheckComputationExpressions.fs b/src/fsharp/CheckComputationExpressions.fs index e27825992d9..64dde88c6d9 100644 --- a/src/fsharp/CheckComputationExpressions.fs +++ b/src/fsharp/CheckComputationExpressions.fs @@ -9,7 +9,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckExpressions open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index bebef739d09..9ce89d6306f 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.CheckExpressions open FSharp.Compiler.CheckComputationExpressions open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -35,7 +35,6 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS @@ -375,7 +374,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath (env: // Bind elements of data definitions for exceptions and types (fields, etc.) //------------------------------------------------------------------------- -exception NotUpperCaseConstructor of range: range +exception NotUpperCaseConstructor of range let CheckNamespaceModuleOrTypeName (g: TcGlobals) (id: Ident) = // type names '[]' etc. are used in fslib @@ -679,7 +678,7 @@ let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target = | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m) -exception ParameterlessStructCtor of range: range +exception ParameterlessStructCtor of range let MakeSafeInitField (g: TcGlobals) env m isStatic = let id = @@ -2291,7 +2290,7 @@ module MutRecBindingChecking = let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, m, moduleRange, openDeclsRef)) -> Some (target, m, moduleRange, openDeclsRef) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) - let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsFSharpException) + let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) // Add the type definitions, exceptions, modules and "open" declarations. // The order here is sensitive. The things added first will be resolved in an environment @@ -2476,7 +2475,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial bindsm scopem mutRecNSInfo (env let overridesOK = DeclKind.CanOverrideOrImplement declKind members |> List.collect (function | SynMemberDefn.Interface(interfaceType=intfTy; members=defnOpt) -> - let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref let m = intfTy.Range if tcref.IsTypeAbbrev then error(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveInterfaceDeclaration(), m)) if tcref.IsEnumTycon then error(Error(FSComp.SR.tcEnumerationsCannotHaveInterfaceDeclaration(), m)) @@ -2601,7 +2600,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tycon && scSet.Contains tycon.Stamp then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref let m = tycon.Range let genericIComparableTy = mkAppTy g.system_GenericIComparable_tcref [ty] @@ -2624,7 +2623,7 @@ module AddAugmentationDeclarations = PublishInterface cenv env.DisplayEnv tcref m true g.mk_IStructuralComparable_ty PublishInterface cenv env.DisplayEnv tcref m true g.mk_IComparable_ty - if not tycon.IsFSharpException && not hasExplicitGenericIComparable then + if not tycon.IsExceptionDecl && not hasExplicitGenericIComparable then PublishInterface cenv env.DisplayEnv tcref m true genericIComparableTy tcaug.SetCompare (mkLocalValRef cvspec1, mkLocalValRef cvspec2) tcaug.SetCompareWith (mkLocalValRef cvspec3) @@ -2685,7 +2684,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tycon then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref let m = tycon.Range // Note: tycon.HasOverride only gives correct results after we've done the type augmentation @@ -2702,7 +2701,7 @@ module AddAugmentationDeclarations = let vspec1, vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) - if not tycon.IsFSharpException then + if not tycon.IsExceptionDecl then PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy g.system_GenericIEquatable_tcref [ty]) PublishValueDefn cenv env ModuleOrMemberBinding vspec1 PublishValueDefn cenv env ModuleOrMemberBinding vspec2 @@ -4607,7 +4606,7 @@ module EstablishTypeDefinitionCores = (envMutRecPrelim, withAttrs) ||> MutRecShapes.extendEnvs (fun envForDecls decls -> let tycons = decls |> List.choose (function MutRecShape.Tycon (_, Some (tycon, _)) -> Some tycon | _ -> None) - let exns = tycons |> List.filter (fun tycon -> tycon.IsFSharpException) + let exns = tycons |> List.filter (fun tycon -> tycon.IsExceptionDecl) let envForDecls = (envForDecls, exns) ||> List.fold (AddLocalExnDefnAndReport cenv.tcSink scopem) envForDecls) diff --git a/src/fsharp/CheckDeclarations.fsi b/src/fsharp/CheckDeclarations.fsi index 40b485d060c..4d31b04abdf 100644 --- a/src/fsharp/CheckDeclarations.fsi +++ b/src/fsharp/CheckDeclarations.fsi @@ -74,6 +74,6 @@ val CheckOneSigFile: ParsedSigFileInput -> Cancellable -exception ParameterlessStructCtor of range: range +exception ParameterlessStructCtor of range -exception NotUpperCaseConstructor of range: range +exception NotUpperCaseConstructor of range diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 44a40d21c55..a1adff7d4b8 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -38,7 +38,6 @@ open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS @@ -64,94 +63,50 @@ let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 80 //------------------------------------------------------------------------- exception BakedInMemberConstraintName of string * range - exception FunctionExpected of DisplayEnv * TType * range - exception NotAFunction of DisplayEnv * TType * range * range - exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range * bool - exception Recursion of DisplayEnv * Ident * TType * TType * range - exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range - exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range - exception LetRecCheckedAtRuntime of range - exception LetRecUnsound of DisplayEnv * ValRef list * range - exception TyconBadArgs of DisplayEnv * TyconRef * int * range - exception UnionCaseWrongArguments of DisplayEnv * int * int * range - exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range - exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range - exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range - exception MissingFields of string list * range - exception FunctionValueUnexpected of DisplayEnv * TType * range - exception UnitTypeExpected of DisplayEnv * TType * range - exception UnitTypeExpectedWithEquality of DisplayEnv * TType * range - exception UnitTypeExpectedWithPossibleAssignment of DisplayEnv * TType * bool * string * range - exception UnitTypeExpectedWithPossiblePropertySetter of DisplayEnv * TType * string * string * range - exception UnionPatternsBindDifferentNames of range - exception VarBoundTwice of Ident - exception ValueRestriction of DisplayEnv * InfoReader * bool * Val * Typar * range - exception ValNotMutable of DisplayEnv * ValRef * range - exception ValNotLocal of DisplayEnv * ValRef * range - exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range - exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range - exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range - exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range - exception CoercionTargetSealed of DisplayEnv * TType * range - exception UpcastUnnecessary of range - exception TypeTestUnnecessary of range - exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range - exception SelfRefObjCtor of bool * range - exception VirtualAugmentationOnNullValuedType of range - exception NonVirtualAugmentationOnNullValuedType of range - exception UseOfAddressOfOperator of range - exception DeprecatedThreadStaticBindingWarning of range - exception IntfImplInIntrinsicAugmentation of range - exception IntfImplInExtrinsicAugmentation of range - exception OverrideInIntrinsicAugmentation of range - exception OverrideInExtrinsicAugmentation of range - exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range - exception StandardOperatorRedefinitionWarning of string * range - -exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option +exception InvalidInternalsVisibleToAssemblyName of (*badName*)string * (*fileName option*) string option /// Represents information about the initialization field used to check that object constructors /// have completed before fields are accessed. @@ -1863,19 +1818,19 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> let values, vspecMap = let sink = { new ITypecheckResultsSink with - member _.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports + member this.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports - member _.NotifyNameResolution(pos, item, itemTyparInst, occurence, nenv, ad, m, replacing) = + member this.NotifyNameResolution(pos, item, itemTyparInst, occurence, nenv, ad, m, replacing) = notifyNameResolution (pos, item, item, itemTyparInst, occurence, nenv, ad, m, replacing) - member _.NotifyMethodGroupNameResolution(pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) = + member this.NotifyMethodGroupNameResolution(pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) = notifyNameResolution (pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) - member _.NotifyExprHasType(_, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals - member _.NotifyFormatSpecifierLocation(_, _) = () - member _.NotifyOpenDeclaration _ = () - member _.CurrentSourceText = None - member _.FormatStringCheckContext = None } + member this.NotifyExprHasType(_, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals + member this.NotifyFormatSpecifierLocation(_, _) = () + member this.NotifyOpenDeclaration _ = () + member this.CurrentSourceText = None + member this.FormatStringCheckContext = None } use _h = WithNewTypecheckResultsSink(sink, cenv.tcSink) MakeAndPublishSimpleVals cenv env names @@ -8664,11 +8619,9 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen cenv overallTy env item tp let SEEN_NAMED_ARGUMENT = -1 - // Dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: - // regular notation for named parameters Some(Value = 5) can mean either - // 1) create "bool option" with value - result of equality operation or - // 2) create "int option" using named arg syntax. - // So far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. + // dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: + // regular notation for named parameters Some(Value = 5) can mean either 1) create option with value - result of equality operation or 2) create option using named arg syntax. + // so far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. for _, id, arg in namedCallerArgs do match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with @@ -11386,7 +11339,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl CheckMemberFlags None newslotsOK overridesOK memberFlags id.idRange CheckForNonAbstractInterface declKind tcref memberFlags id.idRange - if memberFlags.MemberKind = SynMemberKind.Constructor && tcref.Deref.IsFSharpException then + if memberFlags.MemberKind = SynMemberKind.Constructor && tcref.Deref.IsExceptionDecl then error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(), id.idRange)) let isExtrinsic = (declKind = ExtrinsicExtensionBinding) diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index d2513565511..badd1b17da0 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -11,7 +11,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -107,105 +107,59 @@ type TcEnv = eIsControlFlow: bool } member DisplayEnv: DisplayEnv - member NameEnv: NameResolutionEnv - member AccessRights: AccessorDomain //------------------------------------------------------------------------- // Some of the exceptions arising from type checking. These should be moved to -// use DiagnosticsLogger. +// use ErrorLogger. //------------------------------------------------------------------------- exception BakedInMemberConstraintName of string * range - exception FunctionExpected of DisplayEnv * TType * range - exception NotAFunction of DisplayEnv * TType * range * range - exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range * bool - exception Recursion of DisplayEnv * Ident * TType * TType * range - exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range - exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range - exception LetRecCheckedAtRuntime of range - exception LetRecUnsound of DisplayEnv * ValRef list * range - exception TyconBadArgs of DisplayEnv * TyconRef * int * range - exception UnionCaseWrongArguments of DisplayEnv * int * int * range - exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range - exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range - exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range - exception MissingFields of string list * range - exception UnitTypeExpected of DisplayEnv * TType * range - exception UnitTypeExpectedWithEquality of DisplayEnv * TType * range - exception UnitTypeExpectedWithPossiblePropertySetter of DisplayEnv * TType * string * string * range - exception UnitTypeExpectedWithPossibleAssignment of DisplayEnv * TType * bool * string * range - exception FunctionValueUnexpected of DisplayEnv * TType * range - exception UnionPatternsBindDifferentNames of range - exception VarBoundTwice of Ident - exception ValueRestriction of DisplayEnv * InfoReader * bool * Val * Typar * range - exception ValNotMutable of DisplayEnv * ValRef * range - exception ValNotLocal of DisplayEnv * ValRef * range - exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range - exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range - exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range - exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range - exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range - exception CoercionTargetSealed of DisplayEnv * TType * range - exception UpcastUnnecessary of range - exception TypeTestUnnecessary of range - exception SelfRefObjCtor of bool * range - exception VirtualAugmentationOnNullValuedType of range - exception NonVirtualAugmentationOnNullValuedType of range - exception UseOfAddressOfOperator of range - exception DeprecatedThreadStaticBindingWarning of range - exception IntfImplInIntrinsicAugmentation of range - exception IntfImplInExtrinsicAugmentation of range - exception OverrideInIntrinsicAugmentation of range - exception OverrideInExtrinsicAugmentation of range - exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range - exception StandardOperatorRedefinitionWarning of string * range - -exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option +exception InvalidInternalsVisibleToAssemblyName of string (*fileName option*) * string option (*badName*) val TcFieldInit: range -> ILFieldInit -> Const diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs index 5d24e1050d9..10f91b62498 100644 --- a/src/fsharp/CheckFormatStrings.fs +++ b/src/fsharp/CheckFormatStrings.fs @@ -367,7 +367,7 @@ let parseFormatStringInternal (m: range) (fragRanges: range list) (g: TcGlobals) parseLoop acc (i+1, fragLine, fragCol+1) fragments | 'd' | 'i' | 'u' | 'B' | 'o' | 'x' | 'X' -> - if ch = 'B' then DiagnosticsLogger.checkLanguageFeatureError g.langVersion Features.LanguageFeature.PrintfBinaryFormat m + if ch = 'B' then ErrorLogger.checkLanguageFeatureError g.langVersion Features.LanguageFeature.PrintfBinaryFormat m if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString()) collectSpecifierLocation fragLine fragCol 1 let i = skipPossibleInterpolationHole (i+1) diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index 7027e682d8e..835cf68894d 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis @@ -368,7 +368,7 @@ type TcConfigBuilder = mutable useHighEntropyVA: bool mutable inputCodePage: int option mutable embedResources: string list - mutable diagnosticsOptions: FSharpDiagnosticOptions + mutable errorSeverityOptions: FSharpDiagnosticOptions mutable mlCompatibility: bool mutable checkOverflow: bool mutable showReferenceResolutions: bool @@ -430,7 +430,7 @@ type TcConfigBuilder = mutable legacyReferenceResolver: LegacyReferenceResolver mutable showFullPaths: bool - mutable diagnosticStyle: DiagnosticStyle + mutable errorStyle: ErrorStyle mutable utf8output: bool mutable flatErrors: bool @@ -579,7 +579,7 @@ type TcConfigBuilder = projectReferences = [] knownUnresolvedReferences = [] loadedSources = [] - diagnosticsOptions = FSharpDiagnosticOptions.Default + errorSeverityOptions = FSharpDiagnosticOptions.Default embedResources = [] inputCodePage = None subsystemVersion = 4, 0 // per spec for 357994 @@ -646,7 +646,7 @@ type TcConfigBuilder = includewin32manifest = true linkResources = [] showFullPaths = false - diagnosticStyle = DiagnosticStyle.Default + errorStyle = ErrorStyle.DefaultErrors utf8output = false flatErrors = false @@ -770,8 +770,8 @@ type TcConfigBuilder = | Some n -> // nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- true - tcConfigB.diagnosticsOptions <- - { tcConfigB.diagnosticsOptions with WarnOff = ListSet.insert (=) n tcConfigB.diagnosticsOptions.WarnOff } + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with WarnOff = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOff } member tcConfigB.TurnWarningOn(m, s: string) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter @@ -780,8 +780,8 @@ type TcConfigBuilder = | Some n -> // warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- false - tcConfigB.diagnosticsOptions <- - { tcConfigB.diagnosticsOptions with WarnOn = ListSet.insert (=) n tcConfigB.diagnosticsOptions.WarnOn } + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with WarnOn = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOn } member tcConfigB.AddIncludePath (m, path, pathIncludedFrom) = let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path @@ -1062,7 +1062,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.useHighEntropyVA = data.useHighEntropyVA member _.inputCodePage = data.inputCodePage member _.embedResources = data.embedResources - member _.diagnosticsOptions = data.diagnosticsOptions + member _.errorSeverityOptions = data.errorSeverityOptions member _.mlCompatibility = data.mlCompatibility member _.checkOverflow = data.checkOverflow member _.showReferenceResolutions = data.showReferenceResolutions @@ -1118,7 +1118,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.includewin32manifest = data.includewin32manifest member _.linkResources = data.linkResources member _.showFullPaths = data.showFullPaths - member _.diagnosticStyle = data.diagnosticStyle + member _.errorStyle = data.errorStyle member _.utf8output = data.utf8output member _.flatErrors = data.flatErrors member _.maxErrors = data.maxErrors diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index 99c2684caae..8caa6028a6a 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Text @@ -256,7 +256,7 @@ type TcConfigBuilder = mutable embedResources: string list - mutable diagnosticsOptions: FSharpDiagnosticOptions + mutable errorSeverityOptions: FSharpDiagnosticOptions mutable mlCompatibility: bool @@ -366,7 +366,7 @@ type TcConfigBuilder = mutable showFullPaths: bool - mutable diagnosticStyle: DiagnosticStyle + mutable errorStyle: ErrorStyle mutable utf8output: bool @@ -566,7 +566,7 @@ type TcConfig = member embedResources: string list - member diagnosticsOptions: FSharpDiagnosticOptions + member errorSeverityOptions: FSharpDiagnosticOptions member mlCompatibility: bool @@ -674,7 +674,7 @@ type TcConfig = member showFullPaths: bool - member diagnosticStyle: DiagnosticStyle + member errorStyle: ErrorStyle member utf8output: bool diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index 38cdc428e77..a5b4bfc37a9 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticMessage open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp @@ -125,8 +125,8 @@ let GetRangeOfDiagnostic(diag: PhasedDiagnostic) = | NotUpperCaseConstructor m | RecursiveUseCheckedAtRuntime (_, _, m) | LetRecEvaluatedOutOfOrder (_, _, _, m) - | DiagnosticWithText (_, _, m) - | DiagnosticWithSuggestions (_, _, m, _, _) + | Error (_, m) + | ErrorWithSuggestions (_, m, _, _) | SyntaxError (_, m) | InternalError (_, m) | InterfaceNotRevealed(_, _, m) @@ -340,8 +340,8 @@ let GetDiagnosticNumber(diag: PhasedDiagnostic) = | WrappedError(e, _) -> GetFromException e - | DiagnosticWithText (n, _, _) -> n - | DiagnosticWithSuggestions (n, _, _, _, _) -> n + | Error ((n, _), _) -> n + | ErrorWithSuggestions ((n, _), _, _, _) -> n | Failure _ -> 192 | IllegalFileNameChar(fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar)) #if !NO_TYPEPROVIDERS @@ -358,8 +358,8 @@ let GetWarningLevel diag = | LetRecEvaluatedOutOfOrder _ | DefensiveCopyWarning _ -> 5 - | DiagnosticWithText(n, _, _) - | DiagnosticWithSuggestions(n, _, _, _, _) -> + | Error((n, _), _) + | ErrorWithSuggestions((n, _), _, _, _) -> // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint..." // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...." // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint..." @@ -1356,7 +1356,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diag: PhasedDiagnostic) (canSuggestN | None -> os.AppendString(OverrideDoesntOverride1E().Format sig1) | Some minfoVirt -> - // https://github.com/dotnet/fsharp/issues/35 + // https://github.com/Microsoft/visualfsharp/issues/35 // Improve error message when attempting to override generic return type with unit: // we need to check if unit was used as a type argument let hasUnitTType_app (types: TType list) = @@ -1480,9 +1480,9 @@ let OutputPhasedErrorR (os: StringBuilder) (diag: PhasedDiagnostic) (canSuggestN os.AppendString(NonUniqueInferredAbstractSlot3E().Format ty1 ty2) os.AppendString(NonUniqueInferredAbstractSlot4E().Format) - | DiagnosticWithText (_, s, _) -> os.AppendString s + | Error ((_, s), _) -> os.AppendString s - | DiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> + | ErrorWithSuggestions ((_, s), _, idText, suggestionF) -> os.AppendString(DecompileOpName s) suggestNames suggestionF idText @@ -1740,32 +1740,32 @@ let SanitizeFileName fileName implicitIncludeDir = fileName [] -type FormattedDiagnosticLocation = +type DiagnosticLocation = { Range: range File: string TextRepresentation: string IsEmpty: bool } [] -type FormattedDiagnosticCanonicalInformation = +type DiagnosticCanonicalInformation = { ErrorNumber: int Subcategory: string TextRepresentation: string } [] -type FormattedDiagnosticDetailedInfo = - { Location: FormattedDiagnosticLocation option - Canonical: FormattedDiagnosticCanonicalInformation +type DiagnosticDetailedInfo = + { Location: DiagnosticLocation option + Canonical: DiagnosticCanonicalInformation Message: string } [] -type FormattedDiagnostic = +type Diagnostic = | Short of FSharpDiagnosticSeverity * string - | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo + | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = - let outputWhere (showFullPaths, diagnosticStyle) m: FormattedDiagnosticLocation = +let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = + let outputWhere (showFullPaths, errorStyle) m: DiagnosticLocation = if equals m rangeStartup || equals m rangeCmdArgs then { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" } else @@ -1775,30 +1775,30 @@ let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenError else SanitizeFileName file implicitIncludeDir let text, m, file = - match diagnosticStyle with - | DiagnosticStyle.Emacs -> + match errorStyle with + | ErrorStyle.EmacsErrors -> let file = file.Replace("\\", "/") (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output - | DiagnosticStyle.Default -> + | ErrorStyle.DefaultErrors -> let file = file.Replace('/', Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file - // We may also want to change Test to be 1-based - | DiagnosticStyle.Test -> + // We may also want to change TestErrors to be 1-based + | ErrorStyle.TestErrors -> let file = file.Replace("/", "\\") let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - | DiagnosticStyle.Gcc -> + | ErrorStyle.GccErrors -> let file = file.Replace('/', Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file // Here, we want the complete range information so Project Systems can generate proper squiggles - | DiagnosticStyle.VisualStudio -> + | ErrorStyle.VSErrors -> // Show prefix only for real files. Otherwise, we just want a truncated error like: // parse error FS0031: blah blah if not (equals m range0) && not (equals m rangeStartup) && not (equals m rangeCmdArgs) then @@ -1812,19 +1812,19 @@ let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenError match diag.Exception with | ReportedError _ -> assert ("" = "Unexpected ReportedError") // this should never happen - [| |] + Seq.empty | StopProcessing -> assert ("" = "Unexpected StopProcessing") // this should never happen - [| |] + Seq.empty | _ -> let errors = ResizeArray() let report diag = let OutputWhere diag = match GetRangeOfDiagnostic diag with - | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) + | Some m -> Some(outputWhere (showFullPaths, errorStyle) m) | None -> None - let OutputCanonicalInformation(subcategory, errorNumber) : FormattedDiagnosticCanonicalInformation = + let OutputCanonicalInformation(subcategory, errorNumber) : DiagnosticCanonicalInformation = let message = match severity with | FSharpDiagnosticSeverity.Error -> "error" @@ -1832,9 +1832,9 @@ let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenError | FSharpDiagnosticSeverity.Info | FSharpDiagnosticSeverity.Hidden -> "info" let text = - match diagnosticStyle with + match errorStyle with // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. - | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber + | ErrorStyle.VSErrors -> sprintf "%s %s FS%04d: " subcategory message errorNumber | _ -> sprintf "%s FS%04d: " message errorNumber { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} @@ -1846,14 +1846,14 @@ let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenError OutputPhasedDiagnostic os mainError flattenErrors suggestNames os.ToString() - let entry: FormattedDiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message } + let entry: DiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message } - errors.Add (FormattedDiagnostic.Long(severity, entry)) + errors.Add (Diagnostic.Long(severity, entry)) let OutputRelatedError(diag: PhasedDiagnostic) = - match diagnosticStyle with + match errorStyle with // Give a canonical string when --vserror. - | DiagnosticStyle.VisualStudio -> + | ErrorStyle.VSErrors -> let relWhere = OutputWhere mainError // mainError? let relCanonical = OutputCanonicalInformation(diag.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code let relMessage = @@ -1861,13 +1861,13 @@ let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenError OutputPhasedDiagnostic os diag flattenErrors suggestNames os.ToString() - let entry: FormattedDiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} - errors.Add (FormattedDiagnostic.Long (severity, entry) ) + let entry: DiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} + errors.Add( Diagnostic.Long (severity, entry) ) | _ -> let os = StringBuilder() OutputPhasedDiagnostic os diag flattenErrors suggestNames - errors.Add (FormattedDiagnostic.Short(severity, os.ToString()) ) + errors.Add( Diagnostic.Short(severity, os.ToString()) ) relatedErrors |> List.iter OutputRelatedError @@ -1881,20 +1881,20 @@ let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenError #endif | x -> report x - errors.ToArray() + errors:> seq<_> /// used by fsc.exe and fsi.exe, but not by VS /// prints error and related errors to the specified StringBuilder -let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity) os (diag: PhasedDiagnostic) = +let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity) os (diag: PhasedDiagnostic) = // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage. - let errors = CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity, diag, true) + let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity, diag, true) for e in errors do Printf.bprintf os "\n" match e with - | FormattedDiagnostic.Short(_, txt) -> + | Diagnostic.Short(_, txt) -> os.AppendString txt |> ignore - | FormattedDiagnostic.Long(_, details) -> + | Diagnostic.Long(_, details) -> match details.Location with | Some l when not l.IsEmpty -> os.AppendString l.TextRepresentation | _ -> () @@ -1960,7 +1960,7 @@ let ReportDiagnosticAsError options (diag, severity) = // Scoped #nowarn pragmas -/// Build an DiagnosticsLogger that delegates to another DiagnosticsLogger but filters warnings turned off by the given pragma declarations +/// Build an ErrorLogger that delegates to another ErrorLogger but filters warnings turned off by the given pragma declarations // // NOTE: we allow a flag to turn of strict file checking. This is because file names sometimes don't match due to use of // #line directives, e.g. for pars.fs/pars.fsy. In this case we just test by line number - in most cases this is sufficient @@ -1968,8 +1968,8 @@ let ReportDiagnosticAsError options (diag, severity) = // However this is indicative of a more systematic problem where source-line // sensitive operations (lexfilter and warning filtering) do not always // interact well with #line directives. -type DiagnosticsLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: DiagnosticsLogger) = - inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedPragmas") +type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: ErrorLogger) = + inherit ErrorLogger("ErrorLoggerFilteringByScopedPragmas") override x.DiagnosticSink (phasedError, severity) = if severity = FSharpDiagnosticSeverity.Error then @@ -1998,5 +1998,5 @@ type DiagnosticsLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagno override _.ErrorCount = errorLogger.ErrorCount -let GetDiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) = - DiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) :> DiagnosticsLogger +let GetErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) = + ErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) :> ErrorLogger diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index 46e8644ba24..79f2de1ce4c 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.CompilerDiagnostics open System.Text open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -64,7 +64,7 @@ val OutputDiagnostic: implicitIncludeDir: string * showFullPaths: bool * flattenErrors: bool * - diagnosticStyle: DiagnosticStyle * + errorStyle: ErrorStyle * severity: FSharpDiagnosticSeverity -> StringBuilder -> PhasedDiagnostic -> @@ -74,56 +74,56 @@ val OutputDiagnostic: val OutputDiagnosticContext: prefix: string -> fileLineFunction: (string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit -/// Get an error logger that filters the reporting of warnings based on scoped pragma information -val GetDiagnosticsLoggerFilteringByScopedPragmas: - checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * DiagnosticsLogger -> DiagnosticsLogger - -val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string - -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a warning as an error -val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Used internally and in LegacyHostedCompilerForTesting +/// Part of LegacyHostedCompilerForTesting [] -type FormattedDiagnosticLocation = +type DiagnosticLocation = { Range: range File: string TextRepresentation: string IsEmpty: bool } -/// Used internally and in LegacyHostedCompilerForTesting +/// Part of LegacyHostedCompilerForTesting [] -type FormattedDiagnosticCanonicalInformation = +type DiagnosticCanonicalInformation = { ErrorNumber: int Subcategory: string TextRepresentation: string } -/// Used internally and in LegacyHostedCompilerForTesting +/// Part of LegacyHostedCompilerForTesting [] -type FormattedDiagnosticDetailedInfo = - { Location: FormattedDiagnosticLocation option - Canonical: FormattedDiagnosticCanonicalInformation +type DiagnosticDetailedInfo = + { Location: DiagnosticLocation option + Canonical: DiagnosticCanonicalInformation Message: string } -/// Used internally and in LegacyHostedCompilerForTesting +/// Part of LegacyHostedCompilerForTesting [] -type FormattedDiagnostic = +type Diagnostic = | Short of FSharpDiagnosticSeverity * string - | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo + | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo -/// Used internally and in LegacyHostedCompilerForTesting -val CollectFormattedDiagnostics: +/// Part of LegacyHostedCompilerForTesting +val CollectDiagnostic: implicitIncludeDir: string * showFullPaths: bool * flattenErrors: bool * - diagnosticStyle: DiagnosticStyle * + errorStyle: ErrorStyle * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> - FormattedDiagnostic [] + seq + +/// Get an error logger that filters the reporting of warnings based on scoped pragma information +val GetErrorLoggerFilteringByScopedPragmas: + checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * ErrorLogger -> ErrorLogger + +val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string + +/// Indicates if we should report a diagnostic as a warning +val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Indicates if we should report a diagnostic as a warning +val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Indicates if we should report a warning as an error +val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index bafd28ed504..4353f5ec4ef 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -23,7 +23,7 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig open FSharp.Compiler.DependencyManager -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Import open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis @@ -172,11 +172,11 @@ let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemappi else [ ] -exception AssemblyNotResolved of originalName: string * range: range +exception AssemblyNotResolved of (*originalName*) string * range -exception MSBuildReferenceResolutionWarning of message: string * warningCode: string * range: range +exception MSBuildReferenceResolutionWarning of (*MSBuild warning code*)string * (*Message*)string * range -exception MSBuildReferenceResolutionError of message: string * warningCode: string * range: range +exception MSBuildReferenceResolutionError of (*MSBuild warning code*)string * (*Message*)string * range let OpenILBinary(fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, tryGetMetadataSnapshot) = let opts: ILReaderOptions = @@ -1327,7 +1327,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse runtimeAssemblyAttributes: ILAttribute list, entityToInjectInto, invalidateCcu: Event<_>, m) = - let startingErrorCount = CompileThreadStatic.DiagnosticsLogger.ErrorCount + let startingErrorCount = CompileThreadStatic.ErrorLogger.ErrorCount // Find assembly level TypeProviderAssemblyAttributes. These will point to the assemblies that // have class which implement ITypeProvider and which have TypeProviderAttribute on them. @@ -1454,7 +1454,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse with e -> errorRecovery e m - if startingErrorCount bool @@ -156,7 +156,7 @@ type TcImports = member FindDllInfo: CompilationThreadToken * range * string -> ImportedBinary - member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> ImportedBinary option + member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> option member FindCcuFromAssemblyRef: CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index 4df98259688..78fa1a59808 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -19,7 +19,7 @@ open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open FSharp.Compiler.Text open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open Internal.Utilities @@ -613,15 +613,15 @@ let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = | false, _ -> None [ CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> - tcConfigB.diagnosticsOptions <- - { tcConfigB.diagnosticsOptions with + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with GlobalWarnAsError = switch <> OptionSwitch.Off }), None, Some (FSComp.SR.optsWarnaserrorPM())) CompilerOption("warnaserror", tagWarnList, OptionStringListSwitch (fun n switch -> match trimFStoInt n with | Some n -> - let options = tcConfigB.diagnosticsOptions - tcConfigB.diagnosticsOptions <- + let options = tcConfigB.errorSeverityOptions + tcConfigB.errorSeverityOptions <- if switch = OptionSwitch.Off then { options with WarnAsError = ListSet.remove (=) n options.WarnAsError @@ -633,8 +633,8 @@ let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = | None -> ()), None, Some (FSComp.SR.optsWarnaserror())) CompilerOption("warn", tagInt, OptionInt (fun n -> - tcConfigB.diagnosticsOptions <- - { tcConfigB.diagnosticsOptions with + tcConfigB.errorSeverityOptions <- + { tcConfigB.errorSeverityOptions with WarnLevel = if (n >= 0 && n <= 5) then n else error(Error (FSComp.SR.optsInvalidWarningLevel n, rangeCmdArgs)) } ), None, Some (FSComp.SR.optsWarn())) @@ -1057,7 +1057,7 @@ let testFlag tcConfigB = OptionString (fun s -> match s with | "StackSpan" -> tcConfigB.internalTestSpanStackReferring <- true - | "ErrorRanges" -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Test + | "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors | "Tracking" -> tracking <- true (* general purpose on/off diagnostics flag *) | "NoNeedToTailcall" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportNoNeedToTailcall = true } | "FunctionSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportFunctionSizes = true } @@ -1077,12 +1077,12 @@ let testFlag tcConfigB = // Not shown in fsc.exe help, no warning on use, motivation is for use from tooling. let editorSpecificFlags (tcConfigB: TcConfigBuilder) = - [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.VisualStudio), None, None) + [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None) CompilerOption("validate-type-providers", tagNone, OptionUnit id, None, None) // preserved for compatibility's sake, no longer has any effect CompilerOption("LCID", tagInt, OptionInt ignore, None, None) CompilerOption("flaterrors", tagNone, OptionUnit (fun () -> tcConfigB.flatErrors <- true), None, None) CompilerOption("sqmsessionguid", tagNone, OptionString ignore, None, None) - CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Gcc), None, None) + CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None) CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some s), None, None) CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) CompilerOption("noconditionalerasure", tagNone, OptionUnit (fun () -> tcConfigB.noConditionalErasure <- true), None, None) @@ -1314,7 +1314,7 @@ let mlKeywordsFlag = let gnuStyleErrorsFlag tcConfigB = CompilerOption ("gnu-style-errors", tagNone, - OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Emacs), + OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.EmacsErrors), Some(DeprecatedCommandLineOptionNoDescription("--gnu-style-errors", rangeCmdArgs)), None) let deprecatedFlagsBoth tcConfigB = diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 293ce77491e..4a91626e7d3 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -51,7 +51,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Import open FSharp.Compiler.InfoReader @@ -66,7 +66,6 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //------------------------------------------------------------------------- @@ -355,7 +354,7 @@ let MakeConstraintSolverEnv contextInfo css m denv = /// Check whether a type variable occurs in the r.h.s. of a type, e.g. to catch /// infinite equations such as -/// 'a = 'a list +/// 'a = list<'a> let rec occursCheck g un ty = match stripTyEqns g ty with | TType_ucase(_, l) @@ -976,7 +975,7 @@ let CheckWarnIfRigid (csenv: ConstraintSolverEnv) ty1 (r: Typar) ty = let rec SolveTyparEqualsTypePart1 (csenv: ConstraintSolverEnv) m2 (trace: OptionalTrace) ty1 r ty = trackErrors { // The types may still be equivalent due to abbreviations, which we are trying not to eliminate if typeEquiv csenv.g ty1 ty then () else - // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/dotnet/fsharp/issues/1170 + // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/Microsoft/visualfsharp/issues/1170 if occursCheck csenv.g r ty then return! ErrorD (ConstraintSolverInfiniteTypes(csenv.DisplayEnv, csenv.eContextInfo, ty1, ty, csenv.m, m2)) else // Note: warn _and_ continue! do! CheckWarnIfRigid csenv ty1 r ty @@ -1903,7 +1902,7 @@ and GetSupportOfMemberConstraint (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = tys |> List.forall (isAnyParTy csenv.g >> not) -// This may be relevant to future bug fixes, see https://github.com/dotnet/fsharp/issues/3814 +// This may be relevant to future bug fixes, see https://github.com/Microsoft/visualfsharp/issues/3814 // /// Check if some part of the support is solved. // and SupportOfMemberConstraintIsPartiallySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = // tys |> List.exists (isAnyParTy csenv.g >> not) diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 353f0aab107..8a305067831 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -4,7 +4,7 @@ module internal FSharp.Compiler.ConstraintSolver open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader diff --git a/src/fsharp/CreateILModule.fs b/src/fsharp/CreateILModule.fs index c510fcca310..ea2bf785a11 100644 --- a/src/fsharp/CreateILModule.fs +++ b/src/fsharp/CreateILModule.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.IO open FSharp.Compiler.OptimizeInputs diff --git a/src/fsharp/DependencyManager/DependencyProvider.fs b/src/fsharp/DependencyManager/DependencyProvider.fs index aeb5f43f3e8..f3c99e6186f 100644 --- a/src/fsharp/DependencyManager/DependencyProvider.fs +++ b/src/fsharp/DependencyManager/DependencyProvider.fs @@ -238,7 +238,7 @@ type ReflectionDependencyManagerProvider(theType: Type, member _.HelpMessages = instance |> helpMessagesProperty /// Resolve the dependencies for the given arguments - member _.ResolveDependencies(scriptDir, mainScriptName, scriptName, scriptExt, packageManagerTextLines, tfm, rid, timeout): IResolveDependenciesResult = + member this.ResolveDependencies(scriptDir, mainScriptName, scriptName, scriptExt, packageManagerTextLines, tfm, rid, timeout): IResolveDependenciesResult = // The ResolveDependencies method, has two signatures, the original signaature in the variable resolveDeps and the updated signature resolveDepsEx // the resolve method can return values in two different tuples: // (bool * string list * string list * string list) diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index 718cc21e87a..e7aac1ac894 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -5,7 +5,7 @@ module internal FSharp.Compiler.Detuple open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text diff --git a/src/fsharp/DiagnosticsLogger.fs b/src/fsharp/ErrorLogger.fs similarity index 85% rename from src/fsharp/DiagnosticsLogger.fs rename to src/fsharp/ErrorLogger.fs index 6dd5ee7aef7..776c91519bc 100644 --- a/src/fsharp/DiagnosticsLogger.fs +++ b/src/fsharp/ErrorLogger.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module FSharp.Compiler.DiagnosticsLogger +module FSharp.Compiler.ErrorLogger open FSharp.Compiler.Diagnostics open FSharp.Compiler.Features @@ -14,12 +14,12 @@ open Internal.Utilities.Library.Extras /// Represents the style being used to format errors [] -type DiagnosticStyle = - | Default - | Emacs - | Test - | VisualStudio - | Gcc +type ErrorStyle = + | DefaultErrors + | EmacsErrors + | TestErrors + | VSErrors + | GccErrors /// Thrown when we want to add some range information to a .NET exception exception WrappedError of exn * range with @@ -66,60 +66,46 @@ let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ let StopProcessing<'T> = StopProcessingExn None -// int is e.g. 191 in FS0191 -exception DiagnosticWithText of number: int * message: string * range: range with +exception Error of (int * string) * range with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | DiagnosticWithText(_, msg, _) -> msg + | Error((_, msg), _) -> msg | _ -> "impossible" -exception InternalError of message: string * range: range with +exception InternalError of msg: string * range with override this.Message = match this :> exn with | InternalError(msg, m) -> msg + m.ToString() | _ -> "impossible" -exception UserCompilerMessage of message: string * number: int * range: range +exception UserCompilerMessage of string * int * range -exception LibraryUseOnly of range: range +exception LibraryUseOnly of range -exception Deprecated of message: string * range: range +exception Deprecated of string * range -exception Experimental of message: string * range: range +exception Experimental of string * range -exception PossibleUnverifiableCode of range: range +exception PossibleUnverifiableCode of range -exception UnresolvedReferenceNoRange of assemblyName: string +exception UnresolvedReferenceNoRange of (*assemblyName*) string -exception UnresolvedReferenceError of assemblyName: string * range: range +exception UnresolvedReferenceError of (*assemblyName*) string * range -exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string with +exception UnresolvedPathReferenceNoRange of (*assemblyName*) string * (*path*) string with override this.Message = match this :> exn with | UnresolvedPathReferenceNoRange(assemblyName, path) -> sprintf "Assembly: %s, full path: %s" assemblyName path | _ -> "impossible" -exception UnresolvedPathReference of assemblyName: string * path: string * range: range +exception UnresolvedPathReference of (*assemblyName*) string * (*path*) string * range -exception DiagnosticWithSuggestions of number: int * message: string * range: range * identifier: string * suggestions: Suggestions with // int is e.g. 191 in FS0191 +exception ErrorWithSuggestions of (int * string) * range * string * Suggestions with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | DiagnosticWithSuggestions(_, msg, _, _, _) -> msg + | ErrorWithSuggestions((_, msg), _, _, _) -> msg | _ -> "impossible" -/// The F# compiler code currently uses 'Error(...)' in many places to create -/// an DiagnosticWithText as an exception even if it's a warning. -/// -/// We will eventually rename this to remove this use of "Error" -let Error ((n, text), m) = - DiagnosticWithText (n, text, m) - -/// The F# compiler code currently uses 'ErrorWithSuggestions(...)' in many places to create -/// an DiagnosticWithText as an exception even if it's a warning. -/// -/// We will eventually rename this to remove this use of "Error" -let ErrorWithSuggestions ((n, message), m, id, suggestions) = - DiagnosticWithSuggestions (n, message, m, id, suggestions) let inline protectAssemblyExploration dflt f = try @@ -182,44 +168,32 @@ type BuildPhase = module BuildPhaseSubcategory = [] let DefaultPhase = "" - [] let Compile = "compile" - [] let Parameter = "parameter" - [] let Parse = "parse" - [] let TypeCheck = "typecheck" - [] let CodeGen = "codegen" - [] let Optimize = "optimize" - [] let IlxGen = "ilxgen" - [] let IlGen = "ilgen" - [] let Output = "output" - [] let Interactive = "interactive" - [] let Internal = "internal" // Compiler ICE [] type PhasedDiagnostic = - { Exception:exn - Phase:BuildPhase } + { Exception:exn; Phase:BuildPhase } /// Construct a phased error static member Create(exn:exn, phase:BuildPhase) : PhasedDiagnostic = @@ -292,30 +266,27 @@ type PhasedDiagnostic = [] [] -type DiagnosticsLogger(nameForDebugging:string) = +type ErrorLogger(nameForDebugging:string) = abstract ErrorCount: int - // The 'Impl' factoring enables a developer to place a breakpoint at the non-Impl // code just below and get a breakpoint for all error logger implementations. abstract DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - - member _.DebugDisplay() = sprintf "DiagnosticsLogger(%s)" nameForDebugging + member _.DebugDisplay() = sprintf "ErrorLogger(%s)" nameForDebugging let DiscardErrorsLogger = - { new DiagnosticsLogger("DiscardErrorsLogger") with - member _.DiagnosticSink(phasedError, severity) = () - member _.ErrorCount = 0 - } - -let AssertFalseDiagnosticsLogger = - { new DiagnosticsLogger("AssertFalseDiagnosticsLogger") with - // TODO: reenable these asserts in the compiler service - member _.DiagnosticSink(phasedError, severity) = (* assert false; *) () - member _.ErrorCount = (* assert false; *) 0 + { new ErrorLogger("DiscardErrorsLogger") with + member x.DiagnosticSink(phasedError, severity) = () + member x.ErrorCount = 0 } + +let AssertFalseErrorLogger = + { new ErrorLogger("AssertFalseErrorLogger") with + // TODO: reenable these asserts in the compiler service + member x.DiagnosticSink(phasedError, severity) = (* assert false; *) () + member x.ErrorCount = (* assert false; *) 0 } -type CapturingDiagnosticsLogger(nm) = - inherit DiagnosticsLogger(nm) +type CapturingErrorLogger(nm) = + inherit ErrorLogger(nm) let mutable errorCount = 0 let diagnostics = ResizeArray() @@ -327,7 +298,7 @@ type CapturingDiagnosticsLogger(nm) = member _.Diagnostics = diagnostics |> Seq.toList - member _.CommitDelayedDiagnostics(errorLogger:DiagnosticsLogger) = + member _.CommitDelayedDiagnostics(errorLogger:ErrorLogger) = // Eagerly grab all the errors and warnings from the mutable collection let errors = diagnostics.ToArray() errors |> Array.iter errorLogger.DiagnosticSink @@ -335,12 +306,12 @@ type CapturingDiagnosticsLogger(nm) = /// Type holds thread-static globals for use by the compile. type internal CompileThreadStatic = [] - static val mutable private buildPhase: BuildPhase + static val mutable private buildPhase : BuildPhase [] - static val mutable private errorLogger: DiagnosticsLogger + static val mutable private errorLogger : ErrorLogger - static member BuildPhaseUnchecked = CompileThreadStatic.buildPhase + static member BuildPhaseUnchecked = CompileThreadStatic.buildPhase (* This can be a null value *) static member BuildPhase with get() = @@ -349,16 +320,16 @@ type internal CompileThreadStatic = | _ -> CompileThreadStatic.buildPhase and set v = CompileThreadStatic.buildPhase <- v - static member DiagnosticsLogger + static member ErrorLogger with get() = match box CompileThreadStatic.errorLogger with - | Null -> AssertFalseDiagnosticsLogger + | Null -> AssertFalseErrorLogger | _ -> CompileThreadStatic.errorLogger and set v = CompileThreadStatic.errorLogger <- v [] -module DiagnosticsLoggerExtensions = +module ErrorLoggerExtensions = open System.Reflection // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV @@ -394,7 +365,7 @@ module DiagnosticsLoggerExtensions = raise exn | _ -> () - type DiagnosticsLogger with + type ErrorLogger with member x.EmitDiagnostic (exn, severity) = match exn with @@ -468,25 +439,25 @@ let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) = member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase } /// NOTE: The change will be undone when the returned "unwind" object disposes -let PushDiagnosticsLoggerPhaseUntilUnwind(errorLoggerTransformer: DiagnosticsLogger -> #DiagnosticsLogger) = - let oldDiagnosticsLogger = CompileThreadStatic.DiagnosticsLogger - CompileThreadStatic.DiagnosticsLogger <- errorLoggerTransformer oldDiagnosticsLogger +let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer: ErrorLogger -> #ErrorLogger) = + let oldErrorLogger = CompileThreadStatic.ErrorLogger + CompileThreadStatic.ErrorLogger <- errorLoggerTransformer oldErrorLogger { new IDisposable with member _.Dispose() = - CompileThreadStatic.DiagnosticsLogger <- oldDiagnosticsLogger } + CompileThreadStatic.ErrorLogger <- oldErrorLogger } let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase -let SetThreadDiagnosticsLoggerNoUnwind errorLogger = CompileThreadStatic.DiagnosticsLogger <- errorLogger +let SetThreadErrorLoggerNoUnwind errorLogger = CompileThreadStatic.ErrorLogger <- errorLogger /// This represents the thread-local state established as each task function runs as part of the build. /// /// Use to reset error and warning handlers. -type CompilationGlobalsScope(errorLogger: DiagnosticsLogger, buildPhase: BuildPhase) = - let unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) +type CompilationGlobalsScope(errorLogger: ErrorLogger, buildPhase: BuildPhase) = + let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase - member _.DiagnosticsLogger = errorLogger + member _.ErrorLogger = errorLogger member _.BuildPhase = buildPhase // Return the disposable object that cleans up @@ -498,31 +469,31 @@ type CompilationGlobalsScope(errorLogger: DiagnosticsLogger, buildPhase: BuildPh // Global functions are still used by parser and TAST ops. /// Raises an exception with error recovery and returns unit. -let errorR exn = CompileThreadStatic.DiagnosticsLogger.ErrorR exn +let errorR exn = CompileThreadStatic.ErrorLogger.ErrorR exn /// Raises a warning with error recovery and returns unit. -let warning exn = CompileThreadStatic.DiagnosticsLogger.Warning exn +let warning exn = CompileThreadStatic.ErrorLogger.Warning exn /// Raises a warning with error recovery and returns unit. -let informationalWarning exn = CompileThreadStatic.DiagnosticsLogger.InformationalWarning exn +let informationalWarning exn = CompileThreadStatic.ErrorLogger.InformationalWarning exn /// Raises a special exception and returns 'T - can be caught later at an errorRecovery point. -let error exn = CompileThreadStatic.DiagnosticsLogger.Error exn +let error exn = CompileThreadStatic.ErrorLogger.Error exn /// Simulates an error. For test purposes only. -let simulateError (p : PhasedDiagnostic) = CompileThreadStatic.DiagnosticsLogger.SimulateError p +let simulateError (p : PhasedDiagnostic) = CompileThreadStatic.ErrorLogger.SimulateError p -let diagnosticSink (phasedError, severity) = CompileThreadStatic.DiagnosticsLogger.DiagnosticSink (phasedError, severity) +let diagnosticSink (phasedError, severity) = CompileThreadStatic.ErrorLogger.DiagnosticSink (phasedError, severity) let errorSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Error) let warnSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Warning) -let errorRecovery exn m = CompileThreadStatic.DiagnosticsLogger.ErrorRecovery exn m +let errorRecovery exn m = CompileThreadStatic.ErrorLogger.ErrorRecovery exn m -let stopProcessingRecovery exn m = CompileThreadStatic.DiagnosticsLogger.StopProcessingRecovery exn m +let stopProcessingRecovery exn m = CompileThreadStatic.ErrorLogger.StopProcessingRecovery exn m -let errorRecoveryNoRange exn = CompileThreadStatic.DiagnosticsLogger.ErrorRecoveryNoRange exn +let errorRecoveryNoRange exn = CompileThreadStatic.ErrorLogger.ErrorRecoveryNoRange exn let report f = f() @@ -540,16 +511,16 @@ let mlCompatWarning s m = warning(UserCompilerMessage(FSComp.SR.mlCompatMessage let mlCompatError s m = errorR(UserCompilerMessage(FSComp.SR.mlCompatError s, 62, m)) let suppressErrorReporting f = - let errorLogger = CompileThreadStatic.DiagnosticsLogger + let errorLogger = CompileThreadStatic.ErrorLogger try let errorLogger = - { new DiagnosticsLogger("suppressErrorReporting") with + { new ErrorLogger("suppressErrorReporting") with member _.DiagnosticSink(_phasedError, _isError) = () member _.ErrorCount = 0 } - SetThreadDiagnosticsLoggerNoUnwind errorLogger + SetThreadErrorLoggerNoUnwind errorLogger f() finally - SetThreadDiagnosticsLoggerNoUnwind errorLogger + SetThreadErrorLoggerNoUnwind errorLogger let conditionallySuppressErrorReporting cond f = if cond then suppressErrorReporting f else f() @@ -742,7 +713,7 @@ type StackGuard(maxDepth: int) = depth <- depth + 1 try if depth % maxDepth = 0 then - let errorLogger = CompileThreadStatic.DiagnosticsLogger + let errorLogger = CompileThreadStatic.ErrorLogger let buildPhase = CompileThreadStatic.BuildPhase async { do! Async.SwitchToNewThread() diff --git a/src/fsharp/DiagnosticsLogger.fsi b/src/fsharp/ErrorLogger.fsi similarity index 83% rename from src/fsharp/DiagnosticsLogger.fsi rename to src/fsharp/ErrorLogger.fsi index b003fac96dd..eb36563e984 100644 --- a/src/fsharp/DiagnosticsLogger.fsi +++ b/src/fsharp/ErrorLogger.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.DiagnosticsLogger +module internal FSharp.Compiler.ErrorLogger open System open FSharp.Compiler.Diagnostics @@ -9,12 +9,12 @@ open FSharp.Compiler.Text /// Represents the style being used to format errors [] -type DiagnosticStyle = - | Default - | Emacs - | Test - | VisualStudio - | Gcc +type ErrorStyle = + | DefaultErrors + | EmacsErrors + | TestErrors + | VSErrors + | GccErrors /// Thrown when we want to add some range information to a .NET exception exception WrappedError of exn * range @@ -41,41 +41,29 @@ val (|StopProcessing|_|): exn: exn -> unit option val StopProcessing<'T> : exn -/// Represents a diagnostic exeption whose text comes via SR.* -exception DiagnosticWithText of number: int * message: string * range: range +exception Error of (int * string) * range -/// Creates a diagnostic exeption whose text comes via SR.* -val Error: (int * string) * range -> exn +exception InternalError of msg: string * range -exception InternalError of message: string * range: range +exception UserCompilerMessage of string * int * range -exception UserCompilerMessage of message: string * number: int * range: range +exception LibraryUseOnly of range -exception LibraryUseOnly of range: range +exception Deprecated of string * range -exception Deprecated of message: string * range: range +exception Experimental of string * range -exception Experimental of message: string * range: range +exception PossibleUnverifiableCode of range -exception PossibleUnverifiableCode of range: range +exception UnresolvedReferenceNoRange of string -exception UnresolvedReferenceNoRange of assemblyName: string +exception UnresolvedReferenceError of string * range -exception UnresolvedReferenceError of assemblyName: string * range: range +exception UnresolvedPathReferenceNoRange of string * string -exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string +exception UnresolvedPathReference of string * string * range -exception UnresolvedPathReference of assemblyName: string * path: string * range: range - -exception DiagnosticWithSuggestions of - number: int * - message: string * - range: range * - identifier: string * - suggestions: Suggestions - -/// Creates a DiagnosticWithSuggestions whose text comes via SR.* -val ErrorWithSuggestions: (int * string) * range * string * Suggestions -> exn +exception ErrorWithSuggestions of (int * string) * range * string * Suggestions val inline protectAssemblyExploration: dflt: 'a -> f: (unit -> 'a) -> 'a @@ -167,9 +155,9 @@ type PhasedDiagnostic = member Subcategory: unit -> string [] -type DiagnosticsLogger = +type ErrorLogger = - new: nameForDebugging: string -> DiagnosticsLogger + new: nameForDebugging: string -> ErrorLogger member DebugDisplay: unit -> string @@ -177,16 +165,16 @@ type DiagnosticsLogger = abstract member ErrorCount: int -val DiscardErrorsLogger: DiagnosticsLogger +val DiscardErrorsLogger: ErrorLogger -val AssertFalseDiagnosticsLogger: DiagnosticsLogger +val AssertFalseErrorLogger: ErrorLogger -type CapturingDiagnosticsLogger = - inherit DiagnosticsLogger +type CapturingErrorLogger = + inherit ErrorLogger - new: nm: string -> CapturingDiagnosticsLogger + new: nm: string -> CapturingErrorLogger - member CommitDelayedDiagnostics: errorLogger: DiagnosticsLogger -> unit + member CommitDelayedDiagnostics: errorLogger: ErrorLogger -> unit override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit @@ -201,10 +189,10 @@ type CompileThreadStatic = static member BuildPhaseUnchecked: BuildPhase - static member DiagnosticsLogger: DiagnosticsLogger with get, set + static member ErrorLogger: ErrorLogger with get, set [] -module DiagnosticsLoggerExtensions = +module ErrorLoggerExtensions = val tryAndDetectDev15: bool @@ -214,32 +202,25 @@ module DiagnosticsLoggerExtensions = /// Reraise an exception if it is one we want to report to Watson. val ReraiseIfWatsonable: exn: exn -> unit - type DiagnosticsLogger with + type ErrorLogger with member ErrorR: exn: exn -> unit - member Warning: exn: exn -> unit - member Error: exn: exn -> 'b - member SimulateError: ph: PhasedDiagnostic -> 'a - member ErrorRecovery: exn: exn -> m: range -> unit - member StopProcessingRecovery: exn: exn -> m: range -> unit - member ErrorRecoveryNoRange: exn: exn -> unit /// NOTE: The change will be undone when the returned "unwind" object disposes val PushThreadBuildPhaseUntilUnwind: phase: BuildPhase -> IDisposable /// NOTE: The change will be undone when the returned "unwind" object disposes -val PushDiagnosticsLoggerPhaseUntilUnwind: - errorLoggerTransformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable +val PushErrorLoggerPhaseUntilUnwind: errorLoggerTransformer: (ErrorLogger -> #ErrorLogger) -> IDisposable val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit -val SetThreadDiagnosticsLoggerNoUnwind: errorLogger: DiagnosticsLogger -> unit +val SetThreadErrorLoggerNoUnwind: errorLogger: ErrorLogger -> unit /// Reports an error diagnostic and continues val errorR: exn: exn -> unit @@ -403,10 +384,10 @@ type StackGuard = /// /// Use to reset error and warning handlers. type CompilationGlobalsScope = - new: errorLogger: DiagnosticsLogger * buildPhase: BuildPhase -> CompilationGlobalsScope + new: errorLogger: ErrorLogger * buildPhase: BuildPhase -> CompilationGlobalsScope interface IDisposable - member DiagnosticsLogger: DiagnosticsLogger + member ErrorLogger: ErrorLogger member BuildPhase: BuildPhase diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs index fc8b9167d38..b24e0fc1a77 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs @@ -93,32 +93,30 @@ module internal {1} = None [] - member _.EmbeddedResource + member this.EmbeddedResource with get() = _embeddedText and set(value) = _embeddedText <- value [] - member _.IntermediateOutputPath + member this.IntermediateOutputPath with get() = _outputPath and set(value) = _outputPath <- value - member _.TargetFramework + member this.TargetFramework with get() = _targetFramework and set(value) = _targetFramework <- value [] - member _.GeneratedSource + member this.GeneratedSource with get() = _generatedSource interface ITask with - member _.BuildEngine + member this.BuildEngine with get() = _buildEngine and set(value) = _buildEngine <- value - - member _.HostObject + member this.HostObject with get() = _hostObject and set(value) = _hostObject <- value - member this.Execute() = let getBooleanMetadata (metadataName:string) (defaultValue:bool) (item:ITaskItem) = match item.GetMetadata(metadataName) with diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs index f43fef77a43..7081761e2c5 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs @@ -452,28 +452,28 @@ open Printf None [] - member _.EmbeddedText + member this.EmbeddedText with get() = _embeddedText and set(value) = _embeddedText <- value [] - member _.IntermediateOutputPath + member this.IntermediateOutputPath with get() = _outputPath and set(value) = _outputPath <- value [] - member _.GeneratedSource + member this.GeneratedSource with get() = _generatedSource [] - member _.GeneratedResx + member this.GeneratedResx with get() = _generatedResx interface ITask with - member _.BuildEngine + member this.BuildEngine with get() = _buildEngine and set(value) = _buildEngine <- value - member _.HostObject + member this.HostObject with get() = _hostObject and set(value) = _hostObject <- value member this.Execute() = diff --git a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets index 3ba06c1e4bf..e200ed8a7b0 100644 --- a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets +++ b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets @@ -288,8 +288,8 @@ this file. correct list of resources based on the build system being used. This could be a bit simpler, but xbuild doesn't seem to support msbuild 4.0 'item functions' like Distinct(). - Reference: https://github.com/dotnet/fsharp/pull/2595 - https://github.com/dotnet/fsharp/pull/2605 + Reference: https://github.com/Microsoft/visualfsharp/pull/2595 + https://github.com/Microsoft/visualfsharp/pull/2605 --> Utilities\lib.fs - - Utilities\ImmutableArray.fsi + + Utilities\block.fsi - - Utilities\ImmutableArray.fs + + Utilities\block.fs Utilities\rational.fsi @@ -241,11 +241,11 @@ ErrorLogging\TextLayoutRender.fs - - ErrorLogging\DiagnosticsLogger.fsi + + ErrorLogging\ErrorLogger.fsi - - ErrorLogging\DiagnosticsLogger.fs + + ErrorLogging\ErrorLogger.fs ErrorLogging\ErrorResolutionHints.fsi @@ -549,12 +549,6 @@ Logic\import.fs - - Logic\TypeHierarchy.fsi - - - Logic\TypeHierarchy.fs - Logic\infos.fsi @@ -693,23 +687,11 @@ Optimize\InnerLambdasToTopLevelFuncs.fs - - Optimize\LowerCalls.fsi - - - Optimize\LowerCalls.fs - - - Optimize\LowerSequences.fsi + + Optimize\LowerCallsAndSeqs.fsi - - Optimize\LowerSequences.fs - - - Optimize\LowerComputedCollections.fsi - - - Optimize\LowerComputedCollections.fs + + Optimize\LowerCallsAndSeqs.fs Optimize\LowerStateMachines.fsi @@ -717,11 +699,11 @@ Optimize\LowerStateMachines.fs - - Optimize\LowerLocalMutables.fsi + + Optimize\autobox.fsi - - Optimize\LowerLocalMutables.fs + + Optimize\autobox.fs CodeGen\IlxGen.fsi @@ -830,12 +812,6 @@ - - Symbols/FSharpDiagnostic.fsi - - - Symbols/FSharpDiagnostic.fs - Symbols/SymbolHelpers.fsi diff --git a/src/fsharp/FSharp.Core/Query.fs b/src/fsharp/FSharp.Core/Query.fs index 18fec9dfef8..8d54ff85228 100644 --- a/src/fsharp/FSharp.Core/Query.fs +++ b/src/fsharp/FSharp.Core/Query.fs @@ -45,8 +45,8 @@ module ForwardDeclarations = let mutable Query = { new IQueryMethods with - member _.Execute(_) = failwith "IQueryMethods.Execute should never be called" - member _.EliminateNestedQueries(_) = failwith "IQueryMethods.EliminateNestedQueries should never be called" + member this.Execute(_) = failwith "IQueryMethods.Execute should never be called" + member this.EliminateNestedQueries(_) = failwith "IQueryMethods.EliminateNestedQueries should never be called" } type QueryBuilder() = @@ -1925,8 +1925,8 @@ module Query = do ForwardDeclarations.Query <- { new ForwardDeclarations.IQueryMethods with - member _.Execute q = QueryExecute q - member _.EliminateNestedQueries e = EliminateNestedQueries e + member this.Execute q = QueryExecute q + member this.EliminateNestedQueries e = EliminateNestedQueries e } diff --git a/src/fsharp/FSharp.Core/async.fs b/src/fsharp/FSharp.Core/async.fs index 0620810dac8..ccfb8dd75db 100644 --- a/src/fsharp/FSharp.Core/async.fs +++ b/src/fsharp/FSharp.Core/async.fs @@ -865,7 +865,7 @@ namespace Microsoft.FSharp.Control let mutable result = None // The continuations for the result - let mutable savedConts: SuspendedAsync<'T> list = [] + let mutable savedConts: list> = [] // The WaitHandle event for the result. Only created if needed, and set to null when disposed. let mutable resEvent = null diff --git a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs index 789533419b0..534ae14958c 100644 --- a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs +++ b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs @@ -328,9 +328,9 @@ namespace Microsoft.FSharp.Core.CompilerServices let mutable filePath : string = null let mutable line : int = 0 let mutable column : int = 0 - member _.FilePath with get() = filePath and set v = filePath <- v - member _.Line with get() = line and set v = line <- v - member _.Column with get() = column and set v = column <- v + member this.FilePath with get() = filePath and set v = filePath <- v + member this.Line with get() = line and set v = line <- v + member this.Column with get() = column and set v = column <- v [] type TypeProviderEditorHideMethodsAttribute() = @@ -349,14 +349,14 @@ namespace Microsoft.FSharp.Core.CompilerServices let mutable isInvalidationSupported : bool = false let mutable useResolutionFolderAtRuntime : bool = false let mutable systemRuntimeAssemblyVersion : System.Version = null - member _.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v - member _.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v - member _.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v - member _.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v - member _.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v - member _.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v - member _.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v - member _.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName + member this.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v + member this.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v + member this.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v + member this.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v + member this.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v + member this.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v + member this.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v + member this.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName type IProvidedNamespace = abstract NamespaceName : string diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index d0eeda4e854..cd22fb65be3 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -42,7 +42,7 @@ namespace Microsoft.FSharp.Collections [] let concat lists = Microsoft.FSharp.Primitives.Basics.List.concat lists - let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection: 'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list: 'T list) = + let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection:'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list:'T list) = let dict = Dictionary comparer let rec loop srcList = match srcList with @@ -56,13 +56,13 @@ namespace Microsoft.FSharp.Collections Microsoft.FSharp.Primitives.Basics.List.countBy dict getKey // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let countByValueType (projection: 'T->'Key) (list: 'T list) = countByImpl HashIdentity.Structural<'Key> projection id list + let countByValueType (projection:'T->'Key) (list:'T list) = countByImpl HashIdentity.Structural<'Key> projection id list // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let countByRefType (projection: 'T->'Key) (list: 'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list + let countByRefType (projection:'T->'Key) (list:'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list [] - let countBy (projection: 'T->'Key) (list: 'T list) = + let countBy (projection:'T->'Key) (list:'T list) = match list with | [] -> [] | _ -> @@ -84,7 +84,7 @@ namespace Microsoft.FSharp.Collections Microsoft.FSharp.Primitives.Basics.List.mapFold mapping state list [] - let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) list state = + let mapFoldBack<'T, 'State, 'Result> (mapping:'T -> 'State -> 'Result * 'State) list state = match list with | [] -> [], state | [h] -> let h', s' = mapping h state in [h'], s' @@ -99,19 +99,19 @@ namespace Microsoft.FSharp.Collections loop ([], state) (rev list) [] - let inline iter ([] action) (list: 'T list) = for x in list do action x + let inline iter ([] action) (list:'T list) = for x in list do action x [] - let distinct (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list + let distinct (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list [] - let distinctBy projection (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list + let distinctBy projection (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list [] - let ofArray (array: 'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array + let ofArray (array:'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array [] - let toArray (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list + let toArray (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list [] let empty<'T> = ([ ] : 'T list) @@ -154,7 +154,7 @@ namespace Microsoft.FSharp.Collections let choose chooser list = Microsoft.FSharp.Primitives.Basics.List.choose chooser list [] - let splitAt index (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list + let splitAt index (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list [] let take count (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.take count list @@ -233,14 +233,14 @@ namespace Microsoft.FSharp.Collections | h :: t -> fold reduction h t [] - let scan<'T, 'State> folder (state:'State) (list: 'T list) = + let scan<'T, 'State> folder (state:'State) (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.scan folder state list [] let inline singleton value = [value] [] - let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:'T1 list) (list2:'T2 list) = + let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:list<'T1>) (list2:list<'T2>) = let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder) let rec loop acc list1 list2 = match list1, list2 with @@ -258,7 +258,7 @@ namespace Microsoft.FSharp.Collections // this version doesn't causes stack overflow - it uses a private stack [] - let foldBack<'T, 'State> folder (list: 'T list) (state:'State) = + let foldBack<'T, 'State> folder (list:'T list) (state:'State) = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) match list with | [] -> state @@ -283,7 +283,7 @@ namespace Microsoft.FSharp.Collections let arrn = arr.Length foldArraySubRight f arr 0 (arrn - 2) arr.[arrn - 1] - let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr: _[]) start fin initState = + let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr:_[]) start fin initState = let mutable state = initState let mutable res = [state] for i = fin downto start do @@ -292,7 +292,7 @@ namespace Microsoft.FSharp.Collections res [] - let scanBack<'T, 'State> folder (list: 'T list) (state:'State) = + let scanBack<'T, 'State> folder (list:'T list) (state:'State) = match list with | [] -> [state] | [h] -> @@ -428,17 +428,17 @@ namespace Microsoft.FSharp.Collections [] let where predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list - let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf: 'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = + let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf:'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.groupBy comparer keyf getKey list // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let groupByValueType (keyf: 'T->'Key) (list: 'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list + let groupByValueType (keyf:'T->'Key) (list:'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let groupByRefType (keyf: 'T->'Key) (list: 'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list + let groupByRefType (keyf:'T->'Key) (list:'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list [] - let groupBy (projection: 'T->'Key) (list: 'T list) = + let groupBy (projection:'T->'Key) (list:'T list) = match list with | [] -> [] | _ -> @@ -548,19 +548,13 @@ namespace Microsoft.FSharp.Collections loop 0 list [] - let findIndexBack predicate list = - list - |> toArray - |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate + let findIndexBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate [] - let tryFindIndexBack predicate list = - list - |> toArray - |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate + let tryFindIndexBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate [] - let inline sum (list: 'T list) = + let inline sum (list:list<'T>) = match list with | [] -> LanguagePrimitives.GenericZero<'T> | t -> @@ -570,7 +564,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline sumBy ([] projection: 'T -> 'U) (list: 'T list) = + let inline sumBy ([] projection: 'T -> 'U) (list:list<'T>) = match list with | [] -> LanguagePrimitives.GenericZero<'U> | t -> @@ -580,7 +574,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline max (list: _ list) = + let inline max (list:list<_>) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -591,7 +585,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline maxBy projection (list: _ list) = + let inline maxBy projection (list:list<_>) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -605,7 +599,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline min (list: _ list) = + let inline min (list:list<_>) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -616,7 +610,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline minBy projection (list: _ list) = + let inline minBy projection (list:list<_>) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -630,7 +624,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline average (list: 'T list) = + let inline average (list:list<'T>) = match list with | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | xs -> @@ -642,7 +636,7 @@ namespace Microsoft.FSharp.Collections LanguagePrimitives.DivideByInt sum count [] - let inline averageBy ([] projection: 'T -> 'U) (list: 'T list) = + let inline averageBy ([] projection: 'T -> 'U) (list:list<'T>) = match list with | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | xs -> @@ -660,7 +654,7 @@ namespace Microsoft.FSharp.Collections let allPairs list1 list2 = Microsoft.FSharp.Primitives.Basics.List.allPairs list1 list2 [] - let inline compareWith ([] comparer: 'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = + let inline compareWith ([] comparer:'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = let rec loop list1 list2 = match list1, list2 with | head1 :: tail1, head2 :: tail2 -> @@ -676,14 +670,14 @@ namespace Microsoft.FSharp.Collections let permute indexMap list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.permute indexMap |> ofArray [] - let exactlyOne (list: _ list) = + let exactlyOne (list: list<_>) = match list with | [x] -> x | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | _ -> invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) [] - let tryExactlyOne (list: _ list) = + let tryExactlyOne (list: list<_>) = match list with | [x] -> Some x | _ -> None diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 16c7c77e63e..99de5a7b172 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -531,7 +531,7 @@ module internal List = let inline ofSeq (e : IEnumerable<'T>) = match e with - | :? ('T list) as l -> l + | :? list<'T> as l -> l | :? ('T[]) as arr -> ofArray arr | _ -> use ie = e.GetEnumerator() diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 8a4c0b64fb0..31458e94db3 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -453,8 +453,8 @@ module MapTree = let ofSeq comparer (c : seq<'Key * 'T>) = match c with - | :? (('Key * 'T)[]) as xs -> ofArray comparer xs - | :? (('Key * 'T) list) as xs -> ofList comparer xs + | :? array<'Key * 'T> as xs -> ofArray comparer xs + | :? list<'Key * 'T> as xs -> ofList comparer xs | _ -> use ie = c.GetEnumerator() mkFromEnumerator comparer empty ie diff --git a/src/fsharp/FSharp.Core/option.fs b/src/fsharp/FSharp.Core/option.fs index 8b28af7531d..552d1c9231f 100644 --- a/src/fsharp/FSharp.Core/option.fs +++ b/src/fsharp/FSharp.Core/option.fs @@ -8,94 +8,49 @@ open Microsoft.FSharp.Core.Operators module Option = [] - let get option = - match option with - | None -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) - | Some x -> x + let get option = match option with None -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) | Some x -> x [] - let inline isSome option = - match option with - | None -> false - | Some _ -> true + let inline isSome option = match option with None -> false | Some _ -> true [] - let inline isNone option = - match option with - | None -> true - | Some _ -> false + let inline isNone option = match option with None -> true | Some _ -> false [] - let defaultValue value option = - match option with - | None -> value - | Some v -> v + let defaultValue value option = match option with None -> value | Some v -> v [] - let defaultWith defThunk option = - match option with - | None -> defThunk () - | Some v -> v + let defaultWith defThunk option = match option with None -> defThunk () | Some v -> v [] - let orElse ifNone option = - match option with - | None -> ifNone - | Some _ -> option + let orElse ifNone option = match option with None -> ifNone | Some _ -> option [] - let orElseWith ifNoneThunk option = - match option with - | None -> ifNoneThunk () - | Some _ -> option + let orElseWith ifNoneThunk option = match option with None -> ifNoneThunk () | Some _ -> option [] - let count option = - match option with - | None -> 0 - | Some _ -> 1 + let count option = match option with None -> 0 | Some _ -> 1 [] - let fold<'T,'State> folder (state:'State) (option: 'T option) = - match option with - | None -> state - | Some x -> folder state x + let fold<'T,'State> folder (state:'State) (option: option<'T>) = match option with None -> state | Some x -> folder state x [] - let foldBack<'T,'State> folder (option: option<'T>) (state:'State) = - match option with - | None -> state - | Some x -> folder x state + let foldBack<'T,'State> folder (option: option<'T>) (state:'State) = match option with None -> state | Some x -> folder x state [] - let exists predicate option = - match option with - | None -> false - | Some x -> predicate x + let exists predicate option = match option with None -> false | Some x -> predicate x [] - let forall predicate option = - match option with - | None -> true - | Some x -> predicate x + let forall predicate option = match option with None -> true | Some x -> predicate x [] - let inline contains value option = - match option with - | None -> false - | Some v -> v = value + let inline contains value option = match option with None -> false | Some v -> v = value [] - let iter action option = - match option with - | None -> () - | Some x -> action x + let iter action option = match option with None -> () | Some x -> action x [] - let map mapping option = - match option with - | None -> None - | Some x -> Some (mapping x) + let map mapping option = match option with None -> None | Some x -> Some (mapping x) [] let map2 mapping option1 option2 = @@ -110,151 +65,78 @@ module Option = | _ -> None [] - let bind binder option = - match option with - | None -> None - | Some x -> binder x + let bind binder option = match option with None -> None | Some x -> binder x [] - let flatten option = - match option with - | None -> None - | Some x -> x + let flatten option = match option with None -> None | Some x -> x [] - let filter predicate option = - match option with - | None -> None - | Some x -> if predicate x then Some x else None + let filter predicate option = match option with None -> None | Some x -> if predicate x then Some x else None [] - let toArray option = - match option with - | None -> [| |] - | Some x -> [| x |] + let toArray option = match option with None -> [| |] | Some x -> [| x |] [] - let toList option = - match option with - | None -> [ ] - | Some x -> [ x ] + let toList option = match option with None -> [ ] | Some x -> [ x ] [] - let toNullable option = - match option with - | None -> System.Nullable() - | Some v -> System.Nullable(v) + let toNullable option = match option with None -> System.Nullable() | Some v -> System.Nullable(v) [] - let ofNullable (value:System.Nullable<'T>) = - if value.HasValue then - Some value.Value - else - None + let ofNullable (value:System.Nullable<'T>) = if value.HasValue then Some value.Value else None [] - let ofObj value = - match value with - | null -> None - | _ -> Some value + let ofObj value = match value with null -> None | _ -> Some value [] - let toObj value = - match value with - | None -> null - | Some x -> x + let toObj value = match value with None -> null | Some x -> x module ValueOption = [] - let get voption = - match voption with - | ValueNone -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) - | ValueSome x -> x + let get voption = match voption with ValueNone -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) | ValueSome x -> x [] - let inline isSome voption = - match voption with - | ValueNone -> false - | ValueSome _ -> true + let inline isSome voption = match voption with ValueNone -> false | ValueSome _ -> true [] - let inline isNone voption = - match voption with - | ValueNone -> true - | ValueSome _ -> false + let inline isNone voption = match voption with ValueNone -> true | ValueSome _ -> false [] - let defaultValue value voption = - match voption with - | ValueNone -> value - | ValueSome v -> v + let defaultValue value voption = match voption with ValueNone -> value | ValueSome v -> v [] - let defaultWith defThunk voption = - match voption with - | ValueNone -> defThunk () - | ValueSome v -> v + let defaultWith defThunk voption = match voption with ValueNone -> defThunk () | ValueSome v -> v [] - let orElse ifNone voption = - match voption with - | ValueNone -> ifNone - | ValueSome _ -> voption + let orElse ifNone voption = match voption with ValueNone -> ifNone | ValueSome _ -> voption [] - let orElseWith ifNoneThunk voption = - match voption with - | ValueNone -> ifNoneThunk () - | ValueSome _ -> voption + let orElseWith ifNoneThunk voption = match voption with ValueNone -> ifNoneThunk () | ValueSome _ -> voption [] - let count voption = - match voption with - | ValueNone -> 0 - | ValueSome _ -> 1 + let count voption = match voption with ValueNone -> 0 | ValueSome _ -> 1 [] - let fold<'T,'State> folder (state:'State) (voption: voption<'T>) = - match voption with - | ValueNone -> state - | ValueSome x -> folder state x + let fold<'T,'State> folder (state:'State) (voption: voption<'T>) = match voption with ValueNone -> state | ValueSome x -> folder state x [] - let foldBack<'T,'State> folder (voption: voption<'T>) (state:'State) = - match voption with - | ValueNone -> state - | ValueSome x -> folder x state + let foldBack<'T,'State> folder (voption: voption<'T>) (state:'State) = match voption with ValueNone -> state | ValueSome x -> folder x state [] - let exists predicate voption = - match voption with - | ValueNone -> false - | ValueSome x -> predicate x + let exists predicate voption = match voption with ValueNone -> false | ValueSome x -> predicate x [] - let forall predicate voption = - match voption with - | ValueNone -> true - | ValueSome x -> predicate x + let forall predicate voption = match voption with ValueNone -> true | ValueSome x -> predicate x [] - let inline contains value voption = - match voption with - | ValueNone -> false - | ValueSome v -> v = value + let inline contains value voption = match voption with ValueNone -> false | ValueSome v -> v = value [] - let iter action voption = - match voption with - | ValueNone -> () - | ValueSome x -> action x + let iter action voption = match voption with ValueNone -> () | ValueSome x -> action x [] - let map mapping voption = - match voption with - | ValueNone -> ValueNone - | ValueSome x -> ValueSome (mapping x) + let map mapping voption = match voption with ValueNone -> ValueNone | ValueSome x -> ValueSome (mapping x) [] let map2 mapping voption1 voption2 = @@ -269,56 +151,28 @@ module ValueOption = | _ -> ValueNone [] - let bind binder voption = - match voption with - | ValueNone -> ValueNone - | ValueSome x -> binder x + let bind binder voption = match voption with ValueNone -> ValueNone | ValueSome x -> binder x [] - let flatten voption = - match voption with - | ValueNone -> ValueNone - | ValueSome x -> x + let flatten voption = match voption with ValueNone -> ValueNone | ValueSome x -> x [] - let filter predicate voption = - match voption with - | ValueNone -> ValueNone - | ValueSome x -> if predicate x then ValueSome x else ValueNone + let filter predicate voption = match voption with ValueNone -> ValueNone | ValueSome x -> if predicate x then ValueSome x else ValueNone [] - let toArray voption = - match voption with - | ValueNone -> [| |] - | ValueSome x -> [| x |] + let toArray voption = match voption with ValueNone -> [| |] | ValueSome x -> [| x |] [] - let toList voption = - match voption with - | ValueNone -> [ ] - | ValueSome x -> [ x ] + let toList voption = match voption with ValueNone -> [ ] | ValueSome x -> [ x ] [] - let toNullable voption = - match voption with - | ValueNone -> System.Nullable() - | ValueSome v -> System.Nullable(v) + let toNullable voption = match voption with ValueNone -> System.Nullable() | ValueSome v -> System.Nullable(v) [] - let ofNullable (value:System.Nullable<'T>) = - if value.HasValue then - ValueSome value.Value - else - ValueNone + let ofNullable (value:System.Nullable<'T>) = if value.HasValue then ValueSome value.Value else ValueNone [] - let ofObj value = - match value with - | null -> ValueNone - | _ -> ValueSome value + let ofObj value = match value with null -> ValueNone | _ -> ValueSome value [] - let toObj value = - match value with - | ValueNone -> null - | ValueSome x -> x + let toObj value = match value with ValueNone -> null | ValueSome x -> x diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index baa7fd5cb0b..bef9923e35b 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -3625,7 +3625,7 @@ namespace Microsoft.FSharp.Collections //------------------------------------------------------------------------- and - ListDebugView<'T>(l: 'T list) = + ListDebugView<'T>(l:list<'T>) = let ListDebugViewMaxLength = 50 // default displayed Max Length let ListDebugViewMaxFullLength = 5000 // display only when FullList opened (5000 is a super big display used to cut-off an infinite list or undebuggably huge one) @@ -5395,7 +5395,7 @@ namespace Microsoft.FSharp.Core member _.GetEnumerator () = variableStepRangeEnumerator () interface IEnumerable with - member _.GetEnumerator () = (variableStepRangeEnumerator ()) :> IEnumerator } + member this.GetEnumerator () = (variableStepRangeEnumerator ()) :> IEnumerator } let inline simpleIntegralRange minValue maxValue n step m = if step <> LanguagePrimitives.GenericOne || n > m || n = minValue || m = maxValue then diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 81d02f40a54..03ca84a5667 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -377,7 +377,7 @@ module Patterns = let ES ts = List.map E ts let (|E|) (e: Expr) = e.Tree - let (|ES|) (es: Expr list) = es |> List.map (fun e -> e.Tree) + let (|ES|) (es: list) = es |> List.map (fun e -> e.Tree) let (|FrontAndBack|_|) es = let rec loop acc xs = match xs with [] -> None | [h] -> Some (List.rev acc, h) | h :: t -> loop (h :: acc) t loop [] es @@ -742,7 +742,7 @@ module Patterns = if (not (assignableFrom expectedType receivedType)) then invalidArg "receivedType" (String.Format(threeHoleSR, name, expectedType, receivedType)) - let checkArgs (paramInfos: ParameterInfo[]) (args: Expr list) = + let checkArgs (paramInfos: ParameterInfo[]) (args:list) = if (paramInfos.Length <> args.Length) then invalidArg "args" (SR.GetString(SR.QincorrectNumArgs)) List.iter2 ( fun (p:ParameterInfo) a -> checkTypesWeakSR p.ParameterType (typeOf a) "args" (SR.GetString(SR.QtmmInvalidParam))) @@ -837,7 +837,7 @@ module Patterns = mkFE1 (TupleGetOp (ty, n)) x // Records - let mkNewRecord (ty, args: Expr list) = + let mkNewRecord (ty, args:list) = let mems = FSharpType.GetRecordFields(ty, publicOrPrivateBindingFlags) if (args.Length <> mems.Length) then invalidArg "args" (SR.GetString(SR.QincompatibleRecordLength)) List.iter2 (fun (minfo: PropertyInfo) a -> checkTypesSR minfo.PropertyType (typeOf a) "recd" (SR.GetString(SR.QtmmIncorrectArgForRecord))) (Array.toList mems) args @@ -845,7 +845,7 @@ module Patterns = // Discriminated unions - let mkNewUnionCase (unionCase:UnionCaseInfo, args: Expr list) = + let mkNewUnionCase (unionCase:UnionCaseInfo, args:list) = if Unchecked.defaultof = unionCase then raise (new ArgumentNullException()) let sargs = unionCase.GetFields() if (args.Length <> sargs.Length) then invalidArg "args" (SR.GetString(SR.QunionNeedsDiffNumArgs)) @@ -897,7 +897,7 @@ module Patterns = mkFE2 (InstanceFieldSetOp finfo) (obj, value) | true -> invalidArg "finfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkCtorCall (ci:ConstructorInfo, args: Expr list) = + let mkCtorCall (ci:ConstructorInfo, args:list) = if Unchecked.defaultof = ci then raise (new ArgumentNullException()) checkArgs (ci.GetParameters()) args mkFEN (NewObjectOp ci) args @@ -905,7 +905,7 @@ module Patterns = let mkDefaultValue (ty: Type) = mkFE0 (DefaultValueOp ty) - let mkStaticPropGet (pinfo: PropertyInfo, args: Expr list) = + let mkStaticPropGet (pinfo: PropertyInfo, args:list) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanRead) then invalidArg "pinfo" (SR.GetString(SR.QreadingSetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -913,7 +913,7 @@ module Patterns = | true -> mkFEN (StaticPropGetOp pinfo) args | false -> invalidArg "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) - let mkInstancePropGet (obj, pinfo: PropertyInfo, args: Expr list) = + let mkInstancePropGet (obj, pinfo: PropertyInfo, args:list) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanRead) then invalidArg "pinfo" (SR.GetString(SR.QreadingSetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -923,7 +923,7 @@ module Patterns = mkFEN (InstancePropGetOp pinfo) (obj :: args) | true -> invalidArg "pinfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkStaticPropSet (pinfo: PropertyInfo, args: Expr list, value: Expr) = + let mkStaticPropSet (pinfo: PropertyInfo, args:list, value: Expr) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanWrite) then invalidArg "pinfo" (SR.GetString(SR.QwritingGetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -931,7 +931,7 @@ module Patterns = | true -> mkFEN (StaticPropSetOp pinfo) (args@[value]) | false -> invalidArg "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) - let mkInstancePropSet (obj, pinfo: PropertyInfo, args: Expr list, value: Expr) = + let mkInstancePropSet (obj, pinfo: PropertyInfo, args:list, value: Expr) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanWrite) then invalidArg "pinfo" (SR.GetString(SR.QwritingGetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -941,7 +941,7 @@ module Patterns = mkFEN (InstancePropSetOp pinfo) (obj :: (args@[value])) | true -> invalidArg "pinfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkInstanceMethodCall (obj, minfo:MethodInfo, args: Expr list) = + let mkInstanceMethodCall (obj, minfo:MethodInfo, args:list) = if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) checkArgs (minfo.GetParameters()) args match minfo.IsStatic with @@ -959,7 +959,7 @@ module Patterns = mkFEN (InstanceMethodCallWOp (minfo, minfoW, nWitnesses)) (obj::args) | true -> invalidArg "minfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkStaticMethodCall (minfo:MethodInfo, args: Expr list) = + let mkStaticMethodCall (minfo:MethodInfo, args:list) = if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) checkArgs (minfo.GetParameters()) args match minfo.IsStatic with @@ -1002,7 +1002,7 @@ module Patterns = | [x] -> mkApplication (f, x) | _ -> mkApplication (f, mkNewTuple args) - let mkApplications(f: Expr, es: Expr list list) = mkLLinear mkTupledApplication (f, es) + let mkApplications(f: Expr, es:list>) = mkLLinear mkTupledApplication (f, es) let mkIteratedLambdas(vs, b) = mkRLinear mkLambda (vs, b) diff --git a/src/fsharp/FSharp.Core/quotations.fsi b/src/fsharp/FSharp.Core/quotations.fsi index 42946640323..32728b76f74 100644 --- a/src/fsharp/FSharp.Core/quotations.fsi +++ b/src/fsharp/FSharp.Core/quotations.fsi @@ -266,7 +266,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ (fun (x, y) z -> x + y + z) (1,2) 3 @>. /// - static member Applications: functionExpr: Expr * arguments: Expr list list -> Expr + static member Applications: functionExpr: Expr * arguments: list> -> Expr /// Builds an expression that represents a call to an static method or module-bound function /// @@ -292,7 +292,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ Console.WriteLine("Hello World") @>. /// - static member Call: methodInfo: MethodInfo * arguments: Expr list -> Expr + static member Call: methodInfo: MethodInfo * arguments: list -> Expr /// Builds an expression that represents a call to an instance method associated with an object /// @@ -319,7 +319,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ Console.Out.WriteLine("Hello World") @>. /// - static member Call: obj: Expr * methodInfo: MethodInfo * arguments: Expr list -> Expr + static member Call: obj: Expr * methodInfo: MethodInfo * arguments: list -> Expr /// Builds an expression that represents a call to an static method or module-bound function, potentially passing additional witness arguments /// @@ -1253,7 +1253,7 @@ type Expr = /// /// The resulting expression. static member Deserialize: - qualifyingType: Type * spliceTypes: Type list * spliceExprs: Expr list * bytes: byte [] -> Expr + qualifyingType: System.Type * spliceTypes: list * spliceExprs: list * bytes: byte [] -> Expr /// This function is called automatically when quotation syntax (<@ @>) and other sources of /// quotations are used. @@ -2248,7 +2248,7 @@ module ExprShape = /// /// [] - val (|ShapeVar|ShapeLambda|ShapeCombination|): input: Expr -> Choice + val (|ShapeVar|ShapeLambda|ShapeCombination|): input: Expr -> Choice)> /// Re-build combination expressions. The first parameter should be an object /// returned by the ShapeCombination case of the active pattern in this module. @@ -2259,4 +2259,4 @@ module ExprShape = /// The rebuilt expression. /// /// - val RebuildShapeCombination: shape: obj * arguments: Expr list -> Expr + val RebuildShapeCombination: shape: obj * arguments: list -> Expr diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index fb6fd554ff7..7020fd084df 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -695,7 +695,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source match source with | :? ('T[]) as a -> a.Length = 0 - | :? ('T list) as a -> a.IsEmpty + | :? list<'T> as a -> a.IsEmpty | :? ICollection<'T> as a -> a.Count = 0 | _ -> use ie = source.GetEnumerator() diff --git a/src/fsharp/FSharp.Core/string.fs b/src/fsharp/FSharp.Core/string.fs index a653cbf20b7..4ed8b4e9183 100644 --- a/src/fsharp/FSharp.Core/string.fs +++ b/src/fsharp/FSharp.Core/string.fs @@ -32,10 +32,10 @@ namespace Microsoft.FSharp.Core | _ -> String.Join(sep, strings, 0, strings.Length) match strings with - | :? (string[]) as arr -> + | :? array as arr -> concatArray sep arr - | :? (string list) as lst -> + | :? list as lst -> lst |> List.toArray |> concatArray sep diff --git a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs index 38cff9c84b2..43332d53373 100644 --- a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs +++ b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs @@ -269,7 +269,7 @@ type FSharpDependencyManager (outputDirectory:string option) = sprintf """ #r "nuget:FSharp.Data";; // %s 'FSharp.Data' %s""" (SR.loadNugetPackage()) (SR.highestVersion()) |] - member _.ResolveDependencies(scriptDirectory: string, scriptName: string, scriptExt: string, packageManagerTextLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int) : obj = + member this.ResolveDependencies(scriptDirectory: string, scriptName: string, scriptExt: string, packageManagerTextLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int) : obj = ignore scriptName let poundRprefix = match scriptExt with diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 508ef4d9e3f..725cb437ea1 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -7,7 +7,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps diff --git a/src/fsharp/FxResolver.fs b/src/fsharp/FxResolver.fs index ff75963c159..79a37c5b486 100644 --- a/src/fsharp/FxResolver.fs +++ b/src/fsharp/FxResolver.fs @@ -14,7 +14,7 @@ open System.Runtime.InteropServices open Internal.Utilities.FSharpEnvironment open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.ILBinaryReader -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Text open FSharp.Compiler.IO diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index da750053eba..effc65e80cd 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -20,10 +20,11 @@ open FSharp.Compiler.AbstractIL.ILX open FSharp.Compiler.AbstractIL.ILX.Types open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Import +open FSharp.Compiler.LowerCallsAndSeqs open FSharp.Compiler.LowerStateMachines open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -37,7 +38,6 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations let IlxGenStackGuardDepth = StackGuard.GetDepthOption "IlxGen" @@ -2368,13 +2368,13 @@ and GenExprPreSteps (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr sequel = //ProcessDebugPointForExpr cenv cgbuf expr - match (if compileSequenceExpressions then LowerComputedCollectionExpressions.LowerComputedListOrArrayExpr cenv.tcVal g cenv.amap expr else None) with + match (if compileSequenceExpressions then LowerComputedListOrArrayExpr cenv.tcVal g cenv.amap expr else None) with | Some altExpr -> GenExpr cenv cgbuf eenv altExpr sequel true | None -> - match (if compileSequenceExpressions then LowerSequenceExpressions.ConvertSequenceExprToObject g cenv.amap expr else None) with + match (if compileSequenceExpressions then ConvertSequenceExprToObject g cenv.amap expr else None) with | Some info -> GenSequenceExpr cenv cgbuf eenv info sequel true @@ -7442,7 +7442,7 @@ and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = | TMDefRec(_isRec, opens, tycons, mbinds, m) -> let eenvinner = AddDebugImportsToEnv cenv eenv opens for tc in tycons do - if tc.IsFSharpException then + if tc.IsExceptionDecl then GenExnDef cenv cgbuf.mgbuf eenvinner m tc else GenTypeDef cenv cgbuf.mgbuf lazyInitInfo eenvinner m tc diff --git a/src/fsharp/ImmutableArray.fsi b/src/fsharp/ImmutableArray.fsi deleted file mode 100644 index a1cd577350e..00000000000 --- a/src/fsharp/ImmutableArray.fsi +++ /dev/null @@ -1,57 +0,0 @@ -[] -module internal Internal.Utilities.Library.Block - -open System.Collections.Immutable - -[] -module ImmutableArrayBuilder = - - val create: size: int -> ImmutableArray<'T>.Builder - -[] -module ImmutableArray = - - [] - val empty<'T> : ImmutableArray<'T> - - val init: n: int -> f: (int -> 'T) -> ImmutableArray<'T> - - val iter: f: ('T -> unit) -> ImmutableArray<'T> -> unit - - val iteri: f: (int -> 'T -> unit) -> ImmutableArray<'T> -> unit - - val iter2: f: ('T1 -> 'T2 -> unit) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> unit - - val iteri2: f: (int -> 'T1 -> 'T2 -> unit) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> unit - - val map: mapper: ('T1 -> 'T2) -> ImmutableArray<'T1> -> ImmutableArray<'T2> - - val mapi: mapper: (int -> 'T1 -> 'T2) -> ImmutableArray<'T1> -> ImmutableArray<'T2> - - val concat: ImmutableArray> -> ImmutableArray<'T> - - val forall: predicate: ('T -> bool) -> ImmutableArray<'T> -> bool - - val forall2: predicate: ('T1 -> 'T2 -> bool) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> bool - - val tryFind: predicate: ('T -> bool) -> ImmutableArray<'T> -> 'T option - - val tryFindIndex: predicate: ('T -> bool) -> ImmutableArray<'T> -> int option - - val tryPick: chooser: ('T1 -> 'T2 option) -> ImmutableArray<'T1> -> 'T2 option - - val ofSeq: seq<'T> -> ImmutableArray<'T> - - val append: ImmutableArray<'T> -> ImmutableArray<'T> -> ImmutableArray<'T> - - val createOne: 'T -> ImmutableArray<'T> - - val filter: predicate: ('T -> bool) -> ImmutableArray<'T> -> ImmutableArray<'T> - - val exists: predicate: ('T -> bool) -> ImmutableArray<'T> -> bool - - val choose: chooser: ('T -> 'U option) -> ImmutableArray<'T> -> ImmutableArray<'U> - - val isEmpty: ImmutableArray<'T> -> bool - - val fold: folder: ('State -> 'T -> 'State) -> 'State -> ImmutableArray<'T> -> 'State diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index da69bbbbc0a..0cfdaa825e7 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -10,7 +10,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Syntax @@ -20,7 +20,6 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeBasics -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations /// Use the given function to select some of the member values from the members of an F# type diff --git a/src/fsharp/InfoReader.fsi b/src/fsharp/InfoReader.fsi index c7e375d5042..487e0de771d 100644 --- a/src/fsharp/InfoReader.fsi +++ b/src/fsharp/InfoReader.fsi @@ -12,7 +12,6 @@ open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.Xml -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypedTree /// Try to select an F# value when querying members, and if so return a MethInfo that wraps the F# value. diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index edc81950c2f..578201a3601 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Detuple.GlobalUsageAnalysis -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Text.Layout diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index 26b43155830..5408af60981 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -10,54 +10,19 @@ open System.IO open System.Text.RegularExpressions open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.AbstractIL.ILBinaryReader open Internal.Utilities.Library -/// Part of LegacyHostedCompilerForTesting -/// -/// Yet another DiagnosticsLogger implementation, capturing the messages but only up to the maxerrors maximum -type internal InProcDiagnosticsLoggerProvider() = - let errors = ResizeArray() - let warnings = ResizeArray() - - member _.Provider = - { new DiagnosticsLoggerProvider() with - - member _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = - - { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with - - member _.HandleTooManyErrors text = - warnings.Add(FormattedDiagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - - member _.HandleIssue(tcConfigBuilder, err, severity) = - // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf - let diagnostics = - CollectFormattedDiagnostics - (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, - tcConfigBuilder.flatErrors, tcConfigBuilder.diagnosticStyle, severity, err, true) - match severity with - | FSharpDiagnosticSeverity.Error -> - errors.AddRange(diagnostics) - | FSharpDiagnosticSeverity.Warning -> - warnings.AddRange(diagnostics) - | _ -> ()} - :> DiagnosticsLogger } - - member _.CapturedErrors = errors.ToArray() - - member _.CapturedWarnings = warnings.ToArray() - /// build issue location type internal Location = { - StartLine: int - StartColumn: int - EndLine: int - EndColumn: int + StartLine : int + StartColumn : int + EndLine : int + EndColumn : int } type internal CompilationIssueType = Warning | Error @@ -65,19 +30,19 @@ type internal CompilationIssueType = Warning | Error /// build issue details type internal CompilationIssue = { - Location: Location - Subcategory: string - Code: string - File: string - Text: string - Type: CompilationIssueType + Location : Location + Subcategory : string + Code : string + File : string + Text : string + Type : CompilationIssueType } /// combined warning and error details type internal FailureDetails = { - Warnings: CompilationIssue list - Errors: CompilationIssue list + Warnings : CompilationIssue list + Errors : CompilationIssue list } type internal CompilationResult = @@ -86,38 +51,29 @@ type internal CompilationResult = [] type internal CompilationOutput = - { Errors: FormattedDiagnostic[] - Warnings: FormattedDiagnostic[] } + { Errors : Diagnostic[] + Warnings : Diagnostic[] } type internal InProcCompiler(legacyReferenceResolver) = - member _.Compile(argv) = + member this.Compile(argv) = // Explanation: Compilation happens on whichever thread calls this function. let ctok = AssumeCompilationThreadWithoutEvidence () - let loggerProvider = InProcDiagnosticsLoggerProvider() + let loggerProvider = InProcErrorLoggerProvider() let mutable exitCode = 0 let exiter = { new Exiter with - member _.Exit n = exitCode <- n; raise StopProcessing } + member this.Exit n = exitCode <- n; raise StopProcessing } try - CompileFromCommandLineArguments ( - ctok, argv, legacyReferenceResolver, - false, ReduceMemoryFlag.Yes, - CopyFSharpCoreFlag.Yes, exiter, - loggerProvider.Provider, None, None - ) + mainCompile(ctok, argv, legacyReferenceResolver, false, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.Yes, exiter, loggerProvider.Provider, None, None) with | StopProcessing -> () - | ReportedError _ - | WrappedError(ReportedError _,_) -> + | ReportedError _ | WrappedError(ReportedError _,_) -> exitCode <- 1 () - let output: CompilationOutput = - { Warnings = loggerProvider.CapturedWarnings - Errors = loggerProvider.CapturedErrors } - + let output : CompilationOutput = { Warnings = loggerProvider.CapturedWarnings; Errors = loggerProvider.CapturedErrors } exitCode = 0, output /// in-proc version of fsc.exe @@ -132,10 +88,10 @@ type internal FscCompiler(legacyReferenceResolver) = EndLine = 0 } - /// Converts short and long issue types to the same CompilationIssue representation - let convert issue = + /// converts short and long issue types to the same CompilationIssue representation + let convert issue : CompilationIssue = match issue with - | FormattedDiagnostic.Short(severity, text) -> + | Diagnostic.Short(severity, text) -> { Location = emptyLocation Code = "" @@ -144,7 +100,7 @@ type internal FscCompiler(legacyReferenceResolver) = Text = text Type = if (severity = FSharpDiagnosticSeverity.Error) then CompilationIssueType.Error else CompilationIssueType.Warning } - | FormattedDiagnostic.Long(severity, details) -> + | Diagnostic.Long(severity, details) -> let loc, file = match details.Location with | Some l when not l.IsEmpty -> @@ -180,7 +136,7 @@ type internal FscCompiler(legacyReferenceResolver) = fun arg -> regex.IsMatch(arg) /// do compilation as if args was argv to fsc.exe - member _.Compile(args: string[]) = + member this.Compile(args : string array) = // args.[0] is later discarded, assuming it is just the path to fsc. // compensate for this in case caller didn't know let args = @@ -221,8 +177,8 @@ module internal CompilerHelpers = /// splits a provided command line string into argv array /// currently handles quotes, but not escaped quotes - let parseCommandLine (commandLine: string) = - let folder (inQuote: bool, currArg: string, argLst: string list) ch = + let parseCommandLine (commandLine : string) = + let folder (inQuote : bool, currArg : string, argLst : string list) ch = match (ch, inQuote) with | '"', _ -> (not inQuote, currArg, argLst) diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 5396ffdaabd..323347b78eb 100644 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Lexhelp open FSharp.Compiler.ParseHelpers diff --git a/src/fsharp/LowerCalls.fs b/src/fsharp/LowerCalls.fs deleted file mode 100644 index 5e58eea4911..00000000000 --- a/src/fsharp/LowerCalls.fs +++ /dev/null @@ -1,53 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal FSharp.Compiler.LowerCalls - -open Internal.Utilities.Library -open FSharp.Compiler.DiagnosticsLogger -open FSharp.Compiler.TypedTree -open FSharp.Compiler.TypedTreeOps - -let LowerCallsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsRewrite" - -//---------------------------------------------------------------------------- -// Expansion of calls to methods with statically known arity - -let InterceptExpr g cont expr = - - match expr with - | Expr.Val (vref, flags, m) -> - match vref.ValReprInfo with - | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) - | None -> None - - // App (Val v, tys, args) - | Expr.App (Expr.Val (vref, flags, _) as f0, f0ty, tyargsl, argsl, m) -> - // Only transform if necessary, i.e. there are not enough arguments - match vref.ValReprInfo with - | Some(topValInfo) -> - let argsl = List.map cont argsl - let f0 = - if topValInfo.AritiesOfArgs.Length > argsl.Length - then fst(AdjustValForExpectedArity g m vref flags topValInfo) - else f0 - - Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) - | None -> None - - | Expr.App (f0, f0ty, tyargsl, argsl, m) -> - Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) - - | _ -> None - -/// An "expr -> expr" pass that eta-expands under-applied values of -/// known arity to lambda expressions and beta-var-reduces to bind -/// any known arguments. The results are later optimized by the peephole -/// optimizer in opt.fs -let LowerImplFile g assembly = - let rwenv = - { PreIntercept = Some(InterceptExpr g) - PreInterceptBinding=None - PostTransform= (fun _ -> None) - RewriteQuotations=false - StackGuard = StackGuard(LowerCallsRewriteStackGuardDepth) } - assembly |> RewriteImplFile rwenv diff --git a/src/fsharp/LowerCalls.fsi b/src/fsharp/LowerCalls.fsi deleted file mode 100644 index aecb0ff3f9e..00000000000 --- a/src/fsharp/LowerCalls.fsi +++ /dev/null @@ -1,10 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal FSharp.Compiler.LowerCalls - -open FSharp.Compiler.TcGlobals -open FSharp.Compiler.TypedTree - -/// Expands under-applied values of known arity to lambda expressions, and then reduce to bind -/// any known arguments. The results are later optimized by Optimizer.fs -val LowerImplFile: g: TcGlobals -> assembly: TypedImplFile -> TypedImplFile diff --git a/src/fsharp/LowerSequences.fs b/src/fsharp/LowerCallsAndSeqs.fs similarity index 68% rename from src/fsharp/LowerSequences.fs rename to src/fsharp/LowerCallsAndSeqs.fs index b82947b11ff..1d014f7d0b4 100644 --- a/src/fsharp/LowerSequences.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -1,23 +1,68 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerSequenceExpressions +module internal FSharp.Compiler.LowerCallsAndSeqs +open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text +open FSharp.Compiler.TypeRelations open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy -let LowerSequenceExpressionsStackGuardDepth = StackGuard.GetDepthOption "LowerSequenceExpressions" +let LowerCallsAndSeqsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsAndSeqsRewrite" + +//---------------------------------------------------------------------------- +// Eta-expansion of calls to top-level-methods + +let InterceptExpr g cont expr = + + match expr with + | Expr.Val (vref, flags, m) -> + match vref.ValReprInfo with + | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) + | None -> None + + // App (Val v, tys, args) + | Expr.App (Expr.Val (vref, flags, _) as f0, f0ty, tyargsl, argsl, m) -> + // Only transform if necessary, i.e. there are not enough arguments + match vref.ValReprInfo with + | Some(topValInfo) -> + let argsl = List.map cont argsl + let f0 = + if topValInfo.AritiesOfArgs.Length > argsl.Length + then fst(AdjustValForExpectedArity g m vref flags topValInfo) + else f0 + + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) + | None -> None + + | Expr.App (f0, f0ty, tyargsl, argsl, m) -> + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) + + | _ -> None + +/// An "expr -> expr" pass that eta-expands under-applied values of +/// known arity to lambda expressions and beta-var-reduces to bind +/// any known arguments. The results are later optimized by the peephole +/// optimizer in opt.fs +let LowerImplFile g assembly = + let rwenv = + { PreIntercept = Some(InterceptExpr g) + PreInterceptBinding=None + PostTransform= (fun _ -> None) + RewriteQuotations=false + StackGuard = StackGuard(LowerCallsAndSeqsRewriteStackGuardDepth) } + assembly |> RewriteImplFile rwenv //---------------------------------------------------------------------------- // General helpers @@ -67,9 +112,107 @@ type LoweredSeqFirstPhaseResult = asyncVars: FreeVars } +let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals + +let (|Seq|_|) g expr = + match expr with + // use 'seq { ... }' as an indicator + | ValApp g g.seq_vref ([elemTy], [e], _m) -> Some (e, elemTy) + | _ -> None + let IsPossibleSequenceExpr g overallExpr = match overallExpr with Seq g _ -> true | _ -> false +/// Detect a 'yield x' within a 'seq { ... }' +let (|SeqYield|_|) g expr = + match expr with + | ValApp g g.seq_singleton_vref (_, [arg], m) -> Some (arg, m) + | _ -> None + +/// Detect a 'expr; expr' within a 'seq { ... }' +let (|SeqAppend|_|) g expr = + match expr with + | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> Some (arg1, arg2, m) + | _ -> None + +/// Detect a 'while gd do expr' within a 'seq { ... }' +let (|SeqWhile|_|) g expr = + match expr with + | ValApp g g.seq_generated_vref (_, [Expr.Lambda (_, _, _, [dummyv], guardExpr, _, _);innerExpr], m) + when not (isVarFreeInExpr dummyv guardExpr) -> + + // The debug point for 'while' is attached to the innerExpr, see TcSequenceExpression + let mWhile = innerExpr.Range + let spWhile = match mWhile.NotedSourceConstruct with NotedSourceConstruct.While -> DebugPointAtWhile.Yes mWhile | _ -> DebugPointAtWhile.No + Some (guardExpr, innerExpr, spWhile, m) + + | _ -> + None + +let (|SeqTryFinally|_|) g expr = + match expr with + | ValApp g g.seq_finally_vref (_, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _) as arg2], m) + when not (isVarFreeInExpr dummyv compensation) -> + + // The debug point for 'try' and 'finally' are attached to the first and second arguments + // respectively, see TcSequenceExpression + let mTry = arg1.Range + let mFinally = arg2.Range + let spTry = match mTry.NotedSourceConstruct with NotedSourceConstruct.Try -> DebugPointAtTry.Yes mTry | _ -> DebugPointAtTry.No + let spFinally = match mFinally.NotedSourceConstruct with NotedSourceConstruct.Finally -> DebugPointAtFinally.Yes mFinally | _ -> DebugPointAtFinally.No + + Some (arg1, compensation, spTry, spFinally, m) + + | _ -> + None + +let (|SeqUsing|_|) g expr = + match expr with + | ValApp g g.seq_using_vref ([_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, mBind, _)], m) -> + // The debug point mFor at the 'use x = ... ' gets attached to the lambda + let spBind = match mBind.NotedSourceConstruct with NotedSourceConstruct.Binding -> DebugPointAtBinding.Yes mBind | _ -> DebugPointAtBinding.NoneAtInvisible + Some (resource, v, body, elemTy, spBind, m) + | _ -> + None + +let (|SeqForEach|_|) g expr = + match expr with + // Nested for loops are represented by calls to Seq.collect + | ValApp g g.seq_collect_vref ([_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> + // The debug point mIn at the 'in' gets attached to the first argument, see TcSequenceExpression + let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No + Some (inp, v, body, genElemTy, mFor, mIn, spIn) + + // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. + | ValApp g g.seq_map_vref ([_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> + let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No + // The debug point mFor at the 'for' gets attached to the first argument, see TcSequenceExpression + Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) + + | _ -> None + +let (|SeqDelay|_|) g expr = + match expr with + | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) + when not (isVarFreeInExpr v e) -> + Some (e, elemTy) + | _ -> None + +let (|SeqEmpty|_|) g expr = + match expr with + | ValApp g g.seq_empty_vref (_, [], m) -> Some m + | _ -> None + +let (|SeqToList|_|) g expr = + match expr with + | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m) + | _ -> None + +let (|SeqToArray|_|) g expr = + match expr with + | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m) + | _ -> None + let tyConfirmsToSeq g ty = match tryTcrefOfAppTy g ty with | ValueSome tcref -> @@ -723,3 +866,246 @@ let ConvertSequenceExprToObject g amap overallExpr = None | _ -> None +/// Build the 'test and dispose' part of a 'use' statement +let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = + let disposeMethod = + match GetIntrinsicMethInfosOfType infoReader (Some "Dispose") AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m g.system_IDisposable_ty with + | [x] -> x + | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) + // For struct types the test is simpler + if isStructTy g v.Type then + assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) + // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive + // copy of it. + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] + + disposeExpr + else + let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let inpe = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) + mkIsInstConditional g m g.system_IDisposable_ty inpe disposeObjVar disposeExpr (mkUnit g m) + +let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = + let listCollectorTy = tyOfExpr g collExpr + let addMethod = + match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with + | [x] -> x + | _ -> error(InternalError("no " + name + " method found on Collector", m)) + let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args + expr + +let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "Add" collExpr [arg] + +let mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "AddMany" collExpr [arg] + +let mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "AddManyAndClose" collExpr [arg] + +let mkCallCollectorClose tcVal (g: TcGlobals) infoReader m collExpr = + mkCallCollectorMethod tcVal g infoReader m "Close" collExpr [] + +let LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr = + let infoReader = InfoReader(g, amap) + let collVal, collExpr = mkMutableCompGenLocal m "@collector" collectorTy + //let collExpr = mkValAddr m false (mkLocalValRef collVal) + let rec ConvertSeqExprCode isUninteresting isTailcall expr = + match expr with + | SeqYield g (e, m) -> + let exprR = mkCallCollectorAdd tcVal g infoReader m collExpr e + Result.Ok (false, exprR) + + | SeqDelay g (delayedExpr, _elemTy) -> + ConvertSeqExprCode isUninteresting isTailcall delayedExpr + + | SeqAppend g (e1, e2, m) -> + let res1 = ConvertSeqExprCode false false e1 + let res2 = ConvertSeqExprCode false isTailcall e2 + match res1, res2 with + | Result.Ok (_, e1R), Result.Ok (closed2, e2R) -> + let exprR = mkSequential m e1R e2R + Result.Ok (closed2, exprR) + | Result.Error msg, _ | _, Result.Error msg -> Result.Error msg + + | SeqWhile g (guardExpr, bodyExpr, spWhile, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + let exprR = mkWhile g (spWhile, NoSpecialWhileLoopMarker, guardExpr, bodyExprR, m) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqUsing g (resource, v, bodyExpr, _elemTy, spBind, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + // printfn "found Seq.using" + let cleanupE = BuildDisposableCleanup tcVal g infoReader m v + let exprR = + mkLet spBind m v resource + (mkTryFinally g (bodyExprR, cleanupE, m, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqForEach g (inp, v, bodyExpr, _genElemTy, mFor, mIn, spIn) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + // printfn "found Seq.for" + let inpElemTy = v.Type + let inpEnumTy = mkIEnumeratorTy g inpElemTy + let enumv, enumve = mkCompGenLocal m "enum" inpEnumTy + let guardExpr = callNonOverloadedILMethod g amap m "MoveNext" inpEnumTy [enumve] + let cleanupE = BuildDisposableCleanup tcVal g infoReader m enumv + + // A debug point should get emitted prior to both the evaluation of 'inp' and the call to GetEnumerator + let addForDebugPoint e = Expr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, e) + + let spInAsWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No + + let exprR = + mkInvisibleLet mFor enumv (callNonOverloadedILMethod g amap mFor "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) + (mkTryFinally g + (mkWhile g (spInAsWhile, NoSpecialWhileLoopMarker, guardExpr, + (mkInvisibleLet mIn v + (callNonOverloadedILMethod g amap mIn "get_Current" inpEnumTy [enumve])) + bodyExprR, mIn), + cleanupE, + mFor, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) + |> addForDebugPoint + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqTryFinally g (bodyExpr, compensation, spTry, spFinally, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + let exprR = + mkTryFinally g (bodyExprR, compensation, m, tyOfExpr g bodyExpr, spTry, spFinally) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqEmpty g m -> + let exprR = mkUnit g m + Result.Ok(false, exprR) + + | Expr.Sequential (x1, bodyExpr, NormalSeq, m) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = Expr.Sequential (x1, bodyExprR, NormalSeq, m) + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.Let (bind, bodyExpr, m, _) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = mkLetBind m bind bodyExprR + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.LetRec (binds, bodyExpr, m, _) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = mkLetRecBinds m binds bodyExprR + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.Match (spBind, exprm, pt, targets, m, ty) -> + // lower all the targets. abandon if any fail to lower + let resTargets = + targets |> Array.map (fun (TTarget(vs, targetExpr, flags)) -> + match ConvertSeqExprCode false false targetExpr with + | Result.Ok (_, targetExprR) -> + Result.Ok (TTarget(vs, targetExprR, flags)) + | Result.Error msg -> Result.Error msg ) + + if resTargets |> Array.forall (function Result.Ok _ -> true | _ -> false) then + let tglArray = Array.map (function Result.Ok v -> v | _ -> failwith "unreachable") resTargets + + let exprR = primMkMatch (spBind, exprm, pt, tglArray, m, ty) + Result.Ok(false, exprR) + else + resTargets |> Array.pick (function Result.Error msg -> Some (Result.Error msg) | _ -> None) + + | Expr.DebugPoint(dp, innerExpr) -> + let resInnerExpr = ConvertSeqExprCode isUninteresting isTailcall innerExpr + match resInnerExpr with + | Result.Ok (flag, innerExprR) -> + let exprR = Expr.DebugPoint(dp, innerExprR) + Result.Ok (flag, exprR) + | Result.Error msg -> Result.Error msg + + // yield! e ---> (for x in e -> x) + + | arbitrarySeqExpr -> + let m = arbitrarySeqExpr.Range + if isUninteresting then + // printfn "FAILED - not worth compiling an unrecognized Seq.toList at %s " (stringOfRange m) + Result.Error () + else + // If we're the final in a sequential chain then we can AddMany, Close and return + if isTailcall then + let exprR = mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr + // Return 'true' to indicate the collector was closed and the overall result of the expression is the result + Result.Ok(true, exprR) + else + let exprR = mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr + Result.Ok(false, exprR) + + + // Perform conversion + match ConvertSeqExprCode true true overallSeqExpr with + | Result.Ok (closed, overallSeqExprR) -> + mkInvisibleLet m collVal (mkDefault (m, collectorTy)) + (if closed then + // If we ended with AddManyAndClose then we're done + overallSeqExprR + else + mkSequential m + overallSeqExprR + (mkCallCollectorClose tcVal g infoReader m collExpr)) + |> Some + | Result.Error () -> + None + +let (|OptionalCoerce|) expr = + match expr with + | Expr.Op (TOp.Coerce, _, [arg], _) -> arg + | _ -> expr + +// Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression +// which only adds a 'seq' call outside of FSharp.Core +let (|OptionalSeq|_|) g amap expr = + match expr with + // use 'seq { ... }' as an indicator + | Seq g (e, elemTy) -> + Some (e, elemTy) + | _ -> + // search for the relevant element type + match tyOfExpr g expr with + | SeqElemTy g amap expr.Range elemTy -> + Some (expr, elemTy) + | _ -> None + +let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = + // If ListCollector is in FSharp.Core then this optimization kicks in + if g.ListCollector_tcr.CanDeref then + + match overallExpr with + | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> + let collectorTy = g.mk_ListCollector_ty overallElemTy + LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr + + | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> + let collectorTy = g.mk_ArrayCollector_ty overallElemTy + LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr + + | _ -> None + else + None diff --git a/src/fsharp/LowerSequences.fsi b/src/fsharp/LowerCallsAndSeqs.fsi similarity index 68% rename from src/fsharp/LowerSequences.fsi rename to src/fsharp/LowerCallsAndSeqs.fsi index aa675cda5c0..ae761a19700 100644 --- a/src/fsharp/LowerSequences.fsi +++ b/src/fsharp/LowerCallsAndSeqs.fsi @@ -1,18 +1,17 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerSequenceExpressions +module internal FSharp.Compiler.LowerCallsAndSeqs open FSharp.Compiler.Import -open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.Text -/// Detect a 'seq' type -val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType option - -val callNonOverloadedILMethod: - g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr +/// An "expr -> expr" pass that eta-expands under-applied values of +/// known arity to lambda expressions and beta-var-reduces to bind +/// any known arguments. The results are later optimized by the peephole +/// optimizer in opt.fs +val LowerImplFile: g: TcGlobals -> assembly: TypedImplFile -> TypedImplFile /// Analyze a TAST expression to detect the elaborated form of a sequence expression. /// Then compile it to a state machine represented as a TAST containing goto, return and label nodes. @@ -27,3 +26,6 @@ val ConvertSequenceExprToObject: (ValRef * ValRef * ValRef * ValRef list * Expr * Expr * Expr * TType * range) option val IsPossibleSequenceExpr: g: TcGlobals -> overallExpr: Expr -> bool + +val LowerComputedListOrArrayExpr: + tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr option diff --git a/src/fsharp/LowerComputedCollections.fs b/src/fsharp/LowerComputedCollections.fs deleted file mode 100644 index 054a6d9f559..00000000000 --- a/src/fsharp/LowerComputedCollections.fs +++ /dev/null @@ -1,272 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal FSharp.Compiler.LowerComputedCollectionExpressions - -open Internal.Utilities.Library -open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.DiagnosticsLogger -open FSharp.Compiler.InfoReader -open FSharp.Compiler.LowerSequenceExpressions -open FSharp.Compiler.MethodCalls -open FSharp.Compiler.Syntax -open FSharp.Compiler.TcGlobals -open FSharp.Compiler.TypeRelations -open FSharp.Compiler.TypedTree -open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy - -let LowerComputedCollectionsStackGuardDepth = StackGuard.GetDepthOption "LowerComputedCollections" - -/// Build the 'test and dispose' part of a 'use' statement -let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = - let disposeMethod = - match GetIntrinsicMethInfosOfType infoReader (Some "Dispose") AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m g.system_IDisposable_ty with - | [x] -> x - | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) - // For struct types the test is simpler - if isStructTy g v.Type then - assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) - // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive - // copy of it. - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] - //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] - - disposeExpr - else - let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] - let inpe = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) - mkIsInstConditional g m g.system_IDisposable_ty inpe disposeObjVar disposeExpr (mkUnit g m) - -let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = - let listCollectorTy = tyOfExpr g collExpr - let addMethod = - match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with - | [x] -> x - | _ -> error(InternalError("no " + name + " method found on Collector", m)) - let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args - expr - -let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "Add" collExpr [arg] - -let mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "AddMany" collExpr [arg] - -let mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "AddManyAndClose" collExpr [arg] - -let mkCallCollectorClose tcVal (g: TcGlobals) infoReader m collExpr = - mkCallCollectorMethod tcVal g infoReader m "Close" collExpr [] - -let LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr = - let infoReader = InfoReader(g, amap) - let collVal, collExpr = mkMutableCompGenLocal m "@collector" collectorTy - //let collExpr = mkValAddr m false (mkLocalValRef collVal) - let rec ConvertSeqExprCode isUninteresting isTailcall expr = - match expr with - | SeqYield g (e, m) -> - let exprR = mkCallCollectorAdd tcVal g infoReader m collExpr e - Result.Ok (false, exprR) - - | SeqDelay g (delayedExpr, _elemTy) -> - ConvertSeqExprCode isUninteresting isTailcall delayedExpr - - | SeqAppend g (e1, e2, m) -> - let res1 = ConvertSeqExprCode false false e1 - let res2 = ConvertSeqExprCode false isTailcall e2 - match res1, res2 with - | Result.Ok (_, e1R), Result.Ok (closed2, e2R) -> - let exprR = mkSequential m e1R e2R - Result.Ok (closed2, exprR) - | Result.Error msg, _ | _, Result.Error msg -> Result.Error msg - - | SeqWhile g (guardExpr, bodyExpr, spWhile, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - let exprR = mkWhile g (spWhile, NoSpecialWhileLoopMarker, guardExpr, bodyExprR, m) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqUsing g (resource, v, bodyExpr, _elemTy, spBind, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - // printfn "found Seq.using" - let cleanupE = BuildDisposableCleanup tcVal g infoReader m v - let exprR = - mkLet spBind m v resource - (mkTryFinally g (bodyExprR, cleanupE, m, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqForEach g (inp, v, bodyExpr, _genElemTy, mFor, mIn, spIn) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - // printfn "found Seq.for" - let inpElemTy = v.Type - let inpEnumTy = mkIEnumeratorTy g inpElemTy - let enumv, enumve = mkCompGenLocal m "enum" inpEnumTy - let guardExpr = callNonOverloadedILMethod g amap m "MoveNext" inpEnumTy [enumve] - let cleanupE = BuildDisposableCleanup tcVal g infoReader m enumv - - // A debug point should get emitted prior to both the evaluation of 'inp' and the call to GetEnumerator - let addForDebugPoint e = Expr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, e) - - let spInAsWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No - - let exprR = - mkInvisibleLet mFor enumv (callNonOverloadedILMethod g amap mFor "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) - (mkTryFinally g - (mkWhile g (spInAsWhile, NoSpecialWhileLoopMarker, guardExpr, - (mkInvisibleLet mIn v - (callNonOverloadedILMethod g amap mIn "get_Current" inpEnumTy [enumve])) - bodyExprR, mIn), - cleanupE, - mFor, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) - |> addForDebugPoint - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqTryFinally g (bodyExpr, compensation, spTry, spFinally, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - let exprR = - mkTryFinally g (bodyExprR, compensation, m, tyOfExpr g bodyExpr, spTry, spFinally) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqEmpty g m -> - let exprR = mkUnit g m - Result.Ok(false, exprR) - - | Expr.Sequential (x1, bodyExpr, NormalSeq, m) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = Expr.Sequential (x1, bodyExprR, NormalSeq, m) - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.Let (bind, bodyExpr, m, _) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = mkLetBind m bind bodyExprR - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.LetRec (binds, bodyExpr, m, _) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = mkLetRecBinds m binds bodyExprR - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.Match (spBind, exprm, pt, targets, m, ty) -> - // lower all the targets. abandon if any fail to lower - let resTargets = - targets |> Array.map (fun (TTarget(vs, targetExpr, flags)) -> - match ConvertSeqExprCode false false targetExpr with - | Result.Ok (_, targetExprR) -> - Result.Ok (TTarget(vs, targetExprR, flags)) - | Result.Error msg -> Result.Error msg ) - - if resTargets |> Array.forall (function Result.Ok _ -> true | _ -> false) then - let tglArray = Array.map (function Result.Ok v -> v | _ -> failwith "unreachable") resTargets - - let exprR = primMkMatch (spBind, exprm, pt, tglArray, m, ty) - Result.Ok(false, exprR) - else - resTargets |> Array.pick (function Result.Error msg -> Some (Result.Error msg) | _ -> None) - - | Expr.DebugPoint(dp, innerExpr) -> - let resInnerExpr = ConvertSeqExprCode isUninteresting isTailcall innerExpr - match resInnerExpr with - | Result.Ok (flag, innerExprR) -> - let exprR = Expr.DebugPoint(dp, innerExprR) - Result.Ok (flag, exprR) - | Result.Error msg -> Result.Error msg - - // yield! e ---> (for x in e -> x) - - | arbitrarySeqExpr -> - let m = arbitrarySeqExpr.Range - if isUninteresting then - // printfn "FAILED - not worth compiling an unrecognized Seq.toList at %s " (stringOfRange m) - Result.Error () - else - // If we're the final in a sequential chain then we can AddMany, Close and return - if isTailcall then - let exprR = mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr - // Return 'true' to indicate the collector was closed and the overall result of the expression is the result - Result.Ok(true, exprR) - else - let exprR = mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr - Result.Ok(false, exprR) - - - // Perform conversion - match ConvertSeqExprCode true true overallSeqExpr with - | Result.Ok (closed, overallSeqExprR) -> - mkInvisibleLet m collVal (mkDefault (m, collectorTy)) - (if closed then - // If we ended with AddManyAndClose then we're done - overallSeqExprR - else - mkSequential m - overallSeqExprR - (mkCallCollectorClose tcVal g infoReader m collExpr)) - |> Some - | Result.Error () -> - None - -let (|OptionalCoerce|) expr = - match expr with - | Expr.Op (TOp.Coerce, _, [arg], _) -> arg - | _ -> expr - -// Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression -// which only adds a 'seq' call outside of FSharp.Core -let (|OptionalSeq|_|) g amap expr = - match expr with - // use 'seq { ... }' as an indicator - | Seq g (e, elemTy) -> - Some (e, elemTy) - | _ -> - // search for the relevant element type - match tyOfExpr g expr with - | SeqElemTy g amap expr.Range elemTy -> - Some (expr, elemTy) - | _ -> None - -let (|SeqToList|_|) g expr = - match expr with - | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None - -let (|SeqToArray|_|) g expr = - match expr with - | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None - -let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = - // If ListCollector is in FSharp.Core then this optimization kicks in - if g.ListCollector_tcr.CanDeref then - - match overallExpr with - | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> - let collectorTy = g.mk_ListCollector_ty overallElemTy - LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - - | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> - let collectorTy = g.mk_ArrayCollector_ty overallElemTy - LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - - | _ -> None - else - None diff --git a/src/fsharp/LowerComputedCollections.fsi b/src/fsharp/LowerComputedCollections.fsi deleted file mode 100644 index a1656361776..00000000000 --- a/src/fsharp/LowerComputedCollections.fsi +++ /dev/null @@ -1,10 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal FSharp.Compiler.LowerComputedCollectionExpressions - -open FSharp.Compiler.Import -open FSharp.Compiler.TcGlobals -open FSharp.Compiler.TypedTree - -val LowerComputedListOrArrayExpr: - tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr option diff --git a/src/fsharp/LowerStateMachines.fs b/src/fsharp/LowerStateMachines.fs index c0530768877..65798f93ade 100644 --- a/src/fsharp/LowerStateMachines.fs +++ b/src/fsharp/LowerStateMachines.fs @@ -2,19 +2,23 @@ module internal FSharp.Compiler.LowerStateMachines +open System.Collections.Generic open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming +open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -let LowerStateMachineStackGuardDepth = StackGuard.GetDepthOption "LowerStateMachines" +let LowerStateMachineStackGuardDepth = GetEnvInteger "FSHARP_LowerStateMachine" 50 + +let mkLabelled m l e = mkCompGenSequential m (Expr.Op (TOp.Label l, [], [], m)) e type StateMachineConversionFirstPhaseResult = { @@ -121,11 +125,13 @@ type env = { ResumableCodeDefns: ValMap TemplateStructTy: TType option + //MachineAddrExpr: Expr option } static member Empty = { ResumableCodeDefns = ValMap.Empty TemplateStructTy = None + //MachineAddrExpr = None } /// Detect prefix of expanded, optimized state machine expressions diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index e4b4251178d..8ae36bc1d28 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -10,7 +10,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -26,7 +26,6 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS diff --git a/src/fsharp/MethodCalls.fsi b/src/fsharp/MethodCalls.fsi index b8fe0a53560..e6b94be5b3f 100644 --- a/src/fsharp/MethodCalls.fsi +++ b/src/fsharp/MethodCalls.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.MethodCalls open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 9da0e71f765..5e5e040d76d 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -7,7 +7,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.Features @@ -20,7 +20,6 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //------------------------------------------------------------------------- diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 6e927ff49c8..1ed0a835f9e 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -32,7 +32,6 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders @@ -1316,7 +1315,7 @@ and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs /// Add an F# exception definition to the name resolution environment let AddExceptionDeclsToNameEnv bulkAddMode nenv (ecref: TyconRef) = - assert ecref.IsFSharpException + assert ecref.IsExceptionDecl let item = Item.ExnCase ecref {nenv with eUnqualifiedItems = @@ -1525,8 +1524,8 @@ let AddResults res1 res2 = | Exception (UndefinedName(n1, _, _, _) as e1), Exception (UndefinedName(n2, _, _, _) as e2) -> if n1 < n2 then Exception e2 else Exception e1 // Prefer more concrete errors about things being undefined - | Exception (UndefinedName _ as e1), Exception (DiagnosticWithText _) -> Exception e1 - | Exception (DiagnosticWithText _), Exception (UndefinedName _ as e2) -> Exception e2 + | Exception (UndefinedName _ as e1), Exception (Error _) -> Exception e1 + | Exception (Error _), Exception (UndefinedName _ as e2) -> Exception e2 | Exception e1, Exception _ -> Exception e1 let NoResultsOrUsefulErrors = Result [] @@ -1841,23 +1840,14 @@ let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = [] type CapturedNameResolution(i: Item, tpinst, io: ItemOccurence, nre: NameResolutionEnv, ad: AccessorDomain, m: range) = - - member _.Pos = m.End - - member _.Item = i - - member _.ItemWithInst = ({ Item = i; TyparInst = tpinst } : ItemWithInst) - - member _.ItemOccurence = io - - member _.DisplayEnv = nre.DisplayEnv - - member _.NameResolutionEnv = nre - - member _.AccessorDomain = ad - - member _.Range = m - + member this.Pos = m.End + member this.Item = i + member this.ItemWithInst = ({ Item = i; TyparInst = tpinst } : ItemWithInst) + member this.ItemOccurence = io + member this.DisplayEnv = nre.DisplayEnv + member this.NameResolutionEnv = nre + member this.AccessorDomain = ad + member this.Range = m member this.DebugToString() = sprintf "%A: %+A" (this.Pos.Line, this.Pos.Column) i @@ -1870,13 +1860,10 @@ type TcResolutions static let empty = TcResolutions(ResizeArray 0, ResizeArray 0, ResizeArray 0, ResizeArray 0) - member _.CapturedEnvs = capturedEnvs - - member _.CapturedExpressionTypings = capturedExprTypes - - member _.CapturedNameResolutions = capturedNameResolutions - - member _.CapturedMethodGroupResolutions = capturedMethodGroupResolutions + member this.CapturedEnvs = capturedEnvs + member this.CapturedExpressionTypings = capturedExprTypes + member this.CapturedNameResolutions = capturedNameResolutions + member this.CapturedMethodGroupResolutions = capturedMethodGroupResolutions static member Empty = empty @@ -1902,7 +1889,7 @@ type TcSymbolUses(g, capturedNameResolutions: ResizeArray ItemsAreEffectivelyEqual g item symbolUse.ItemWithInst.Item) then yield symbolUse |] - member _.AllUsesOfSymbols = allUsesOfSymbols + member this.AllUsesOfSymbols = allUsesOfSymbols - member _.GetFormatSpecifierLocationsAndArity() = formatSpecifierLocations + member this.GetFormatSpecifierLocationsAndArity() = formatSpecifierLocations static member Empty = TcSymbolUses(Unchecked.defaultof<_>, ResizeArray(), Array.empty) @@ -1981,16 +1968,16 @@ type TcResultsSinkImpl(tcGlobals, ?sourceText: ISourceText) = { SourceText = sourceText LineStartPositions = positions }) - member _.GetResolutions() = + member this.GetResolutions() = TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions) - member _.GetSymbolUses() = + member this.GetSymbolUses() = TcSymbolUses(tcGlobals, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray()) - member _.GetOpenDeclarations() = + member this.GetOpenDeclarations() = capturedOpenDeclarations |> Seq.distinctBy (fun x -> x.Range, x.AppliedScope, x.IsOwnNamespace) |> Seq.toArray - member _.GetFormatSpecifierLocations() = + member this.GetFormatSpecifierLocations() = capturedFormatSpecifierLocations.ToArray() interface ITypecheckResultsSink with @@ -4360,7 +4347,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE nenv.TyconsByDemangledNameAndArity(fullyQualified).Values |> Seq.filter (fun tcref -> not (tcref.LogicalName.Contains ",") && - not tcref.IsFSharpException && + not tcref.IsExceptionDecl && not (IsTyconUnseen ad g ncenv.amap m tcref)) |> Seq.map (ItemOfTyconRef ncenv m) |> Seq.toList @@ -4958,7 +4945,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a | Item.Types _ -> for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do - if not tcref.IsFSharpException + if not tcref.IsExceptionDecl && not (tcref.LogicalName.Contains ",") && not (IsTyconUnseen ad g ncenv.amap m tcref) then yield ItemOfTyconRef ncenv m tcref diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 7a2312dff16..ac03dbc080c 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -12,9 +12,8 @@ open Internal.Utilities.Library.Extras open Internal.Utilities.Rational open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax @@ -24,11 +23,11 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Layout open FSharp.Compiler.Text.LayoutRender open FSharp.Compiler.Text.TaggedText +open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy -open FSharp.Compiler.Xml +open FSharp.Compiler.AccessibilityLogic open FSharp.Core.Printf @@ -2064,7 +2063,7 @@ module TastDefinitionPrinting = let layoutTyconDefns denv infoReader ad m (tycons: Tycon list) = match tycons with | [] -> emptyL - | [h] when h.IsFSharpException -> layoutExnDefn denv infoReader (mkLocalEntityRef h) + | [h] when h.IsExceptionDecl -> layoutExnDefn denv infoReader (mkLocalEntityRef h) | h :: t -> let x = layoutTyconDefn denv infoReader ad m false WordL.keywordType (mkLocalEntityRef h) let xs = List.map (mkLocalEntityRef >> layoutTyconDefn denv infoReader ad m false (wordL (tagKeyword "and"))) t @@ -2175,7 +2174,7 @@ module TastDefinitionPrinting = if eref.IsModuleOrNamespace then layoutModuleOrNamespace denv infoReader ad m false eref.Deref |> layoutXmlDocOfEntity denv infoReader eref - elif eref.IsFSharpException then + elif eref.IsExceptionDecl then layoutExnDefn denv infoReader eref else layoutTyconDefn denv infoReader ad m true WordL.keywordType eref @@ -2505,7 +2504,7 @@ let minimalStringsOfTwoTypes denv t1 t2= match attempt4 with | Some res -> res | None -> - // https://github.com/dotnet/fsharp/issues/2561 + // https://github.com/Microsoft/visualfsharp/issues/2561 // still identical, we better (try to) show assembly qualified name to disambiguate let denv = denv.SetOpenPaths [] let denv = { denv with includeStaticParametersInTypeNames=true } diff --git a/src/fsharp/OptimizeInputs.fs b/src/fsharp/OptimizeInputs.fs index 97cfd577807..c40f7c3569f 100644 --- a/src/fsharp/OptimizeInputs.fs +++ b/src/fsharp/OptimizeInputs.fs @@ -1,5 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// # FSComp.SR.opts + module internal FSharp.Compiler.OptimizeInputs open System.IO @@ -78,7 +80,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM optEnvFirstLoop, isIncrementalFragment, tcConfig.fsiMultiAssemblyEmit, tcConfig.emitTailcalls, hidden, implFile) - let implFile = LowerLocalMutables.TransformImplFile tcGlobals importMap implFile + let implFile = AutoBox.TransformImplFile tcGlobals importMap implFile // Only do this on the first pass! let optSettings = { optSettings with abstractBigTargets = false; reportingPhase = false } @@ -116,7 +118,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM else implFile let implFile = - LowerCalls.LowerImplFile tcGlobals implFile + LowerCallsAndSeqs.LowerImplFile tcGlobals implFile let implFile, optEnvFinalSimplify = if tcConfig.doFinalSimplify then diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index b4ebb0838c8..e58d6d3a5ec 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -13,7 +13,8 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Infos open FSharp.Compiler.Text.Range open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.Syntax @@ -28,7 +29,6 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypedTreePickle -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations open System.Collections.Generic @@ -379,12 +379,12 @@ type OptimizationSettings = /// Determines if we should eliminate for-loops around an expr if it has no effect /// - /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/dotnet/fsharp/pull/376 + /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 member x.EliminateForLoop = x.LocalOptimizationsEnabled /// Determines if we should eliminate try/with or try/finally around an expr if it has no effect /// - /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/dotnet/fsharp/pull/376 + /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 member _.EliminateTryWithAndTryFinally = false /// Determines if we should eliminate first part of sequential expression if it has no effect @@ -1110,7 +1110,7 @@ let OrTailcalls l = List.exists (fun x -> x.MightMakeCriticalTailcall) l let OptimizeList f l = l |> List.map f |> List.unzip -let NoExprs : Expr list * Summary list = [], [] +let NoExprs : Expr list * list> = [], [] /// Common ways of building new value infos let CombineValueInfos einfos res = @@ -1386,7 +1386,7 @@ let IsKnownOnlyMutableBeforeUse (vref: ValRef) = // | SingleUnion of int // member x.Next = let (SingleUnion i) = x in SingleUnion (i+1) // -// See https://github.com/dotnet/fsharp/issues/5136 +// See https://github.com/Microsoft/visualfsharp/issues/5136 // // // note: allocating an object with observable identity (i.e. a name) @@ -1643,7 +1643,7 @@ let rec RewriteBoolLogicTree (targets: DecisionTreeTarget[], outerCaseTree, oute and RewriteBoolLogicCase data (TCase(test, tree)) = TCase(test, RewriteBoolLogicTree data tree) -/// Repeatedly combine switch-over-match decision trees, see https://github.com/dotnet/fsharp/issues/635. +/// Repeatedly combine switch-over-match decision trees, see https://github.com/Microsoft/visualfsharp/issues/635. /// The outer decision tree is doing a switch over a boolean result, the inner match is producing only /// constant boolean results in its targets. let rec CombineBoolLogic expr = diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 66f55246223..2f533c7ff1c 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -20,7 +20,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp @@ -266,7 +266,7 @@ let DeduplicateParsedInputModuleName (moduleNamesDict: ModuleNamesDict) input = let inputT = ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput (fileName, qualNameOfFileT, scopedPragmas, hashDirectives, modules, trivia)) inputT, moduleNamesDictT -let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: DiagnosticsLogger, lexbuf: UnicodeLexing.Lexbuf, defaultNamespace, fileName, isLastCompiland) = +let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, defaultNamespace, fileName, isLastCompiland) = // The assert below is almost ok, but it fires in two cases: // - fsi.exe sometimes passes "stdin" as a dummy file name // - if you have a #line directive, e.g. @@ -275,8 +275,8 @@ let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: D // Delay sending errors and warnings until after the file is parsed. This gives us a chance to scrape the // #nowarn declarations for the file - let delayLogger = CapturingDiagnosticsLogger("Parsing") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayLogger) + let delayLogger = CapturingErrorLogger("Parsing") + use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayLogger) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let mutable scopedPragmas = [] @@ -308,8 +308,8 @@ let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: D input finally // OK, now commit the errors, since the ScopedPragmas will (hopefully) have been scraped - let filteringDiagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, scopedPragmas, diagnosticOptions, errorLogger) - delayLogger.CommitDelayedDiagnostics filteringDiagnosticsLogger + let filteringErrorLogger = GetErrorLoggerFilteringByScopedPragmas(false, scopedPragmas, diagnosticOptions, errorLogger) + delayLogger.CommitDelayedDiagnostics filteringErrorLogger type Tokenizer = unit -> Parser.token @@ -412,7 +412,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileNam TestInteractionParserAndExit (tokenizer, lexbuf) // Parse the input - let res = ParseInput((fun _ -> tokenizer ()), tcConfig.diagnosticsOptions, errorLogger, lexbuf, None, fileName, isLastCompiland) + let res = ParseInput((fun _ -> tokenizer ()), tcConfig.errorSeverityOptions, errorLogger, lexbuf, None, fileName, isLastCompiland) // Report the statistics for testing purposes if tcConfig.reportNumDecls then @@ -488,7 +488,7 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, fileName, isLastC EmptyParsedInput(fileName, isLastCompiland) /// Parse multiple input files from disk -let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorLogger: DiagnosticsLogger, exiter: Exiter, createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, retryLocked) = +let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorLogger: ErrorLogger, exiter: Exiter, createErrorLogger: Exiter -> CapturingErrorLogger, retryLocked) = try let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofList @@ -497,14 +497,14 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorL let mutable exitCode = 0 let delayedExiter = { new Exiter with - member _.Exit n = exitCode <- n; raise StopProcessing } + member this.Exit n = exitCode <- n; raise StopProcessing } // Check input files and create delayed error loggers before we try to parallel parse. - let delayedDiagnosticsLoggers = + let delayedErrorLoggers = sourceFiles |> Array.map (fun (fileName, _) -> checkInputFile tcConfig fileName - createDiagnosticsLogger(delayedExiter) + createErrorLogger(delayedExiter) ) let results = @@ -512,16 +512,16 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorL try sourceFiles |> ArrayParallel.mapi (fun i (fileName, isLastCompiland) -> - let delayedDiagnosticsLogger = delayedDiagnosticsLoggers[i] + let delayedErrorLogger = delayedErrorLoggers[i] let directoryName = Path.GetDirectoryName fileName - let input = parseInputFileAux(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayedDiagnosticsLogger, retryLocked) + let input = parseInputFileAux(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayedErrorLogger, retryLocked) (input, directoryName) ) finally - delayedDiagnosticsLoggers - |> Array.iter (fun delayedDiagnosticsLogger -> - delayedDiagnosticsLogger.CommitDelayedDiagnostics errorLogger + delayedErrorLoggers + |> Array.iter (fun delayedErrorLogger -> + delayedErrorLogger.CommitDelayedDiagnostics errorLogger ) with | StopProcessing -> @@ -968,7 +968,7 @@ let CheckOneInput /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig:TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = // 'use' ensures that the warning handler is restored at the end - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun oldLogger -> GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.diagnosticsOptions, oldLogger) ) + use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.errorSeverityOptions, oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck RequireCompilationThread ctok diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 95406e74a72..2b438899ad7 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -12,7 +12,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.DependencyManager -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text @@ -35,7 +35,7 @@ val DeduplicateParsedInputModuleName: ModuleNamesDict -> ParsedInput -> ParsedIn val ParseInput: lexer: (Lexbuf -> Parser.token) * diagnosticOptions: FSharpDiagnosticOptions * - errorLogger: DiagnosticsLogger * + errorLogger: ErrorLogger * lexbuf: Lexbuf * defaultNamespace: string option * fileName: string * @@ -62,7 +62,7 @@ val ParseOneInputStream: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: DiagnosticsLogger * + errorLogger: ErrorLogger * retryLocked: bool * stream: Stream -> ParsedInput @@ -73,7 +73,7 @@ val ParseOneInputSourceText: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: DiagnosticsLogger * + errorLogger: ErrorLogger * sourceText: ISourceText -> ParsedInput @@ -83,7 +83,7 @@ val ParseOneInputFile: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: DiagnosticsLogger * + errorLogger: ErrorLogger * retryLocked: bool -> ParsedInput @@ -93,7 +93,7 @@ val ParseOneInputLexbuf: lexbuf: Lexbuf * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: DiagnosticsLogger -> + errorLogger: ErrorLogger -> ParsedInput val EmptyParsedInput: fileName: string * isLastCompiland: (bool * bool) -> ParsedInput @@ -103,9 +103,9 @@ val ParseInputFiles: tcConfig: TcConfig * lexResourceManager: Lexhelp.LexResourceManager * sourceFiles: string list * - errorLogger: DiagnosticsLogger * + errorLogger: ErrorLogger * exiter: Exiter * - createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) * + createErrorLogger: (Exiter -> CapturingErrorLogger) * retryLocked: bool -> (ParsedInput * string) list diff --git a/src/fsharp/ParseHelpers.fs b/src/fsharp/ParseHelpers.fs index aafb8174345..63b99d61a17 100644 --- a/src/fsharp/ParseHelpers.fs +++ b/src/fsharp/ParseHelpers.fs @@ -3,7 +3,7 @@ module FSharp.Compiler.ParseHelpers open FSharp.Compiler.AbstractIL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 5c60efab813..94d930751f6 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -10,7 +10,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax @@ -55,21 +55,21 @@ type Pattern = member this.Range = match this with - | TPat_const(_, m) -> m - | TPat_wild m -> m - | TPat_as(_, _, m) -> m - | TPat_disjs(_, m) -> m - | TPat_conjs(_, m) -> m - | TPat_query(_, _, m) -> m - | TPat_unioncase(_, _, _, m) -> m - | TPat_exnconstr(_, _, m) -> m - | TPat_tuple(_, _, _, m) -> m - | TPat_array(_, _, m) -> m - | TPat_recd(_, _, _, m) -> m - | TPat_range(_, _, m) -> m - | TPat_null m -> m - | TPat_isinst(_, _, _, m) -> m - | TPat_error m -> m + | TPat_const(_, m) -> m + | TPat_wild m -> m + | TPat_as(_, _, m) -> m + | TPat_disjs(_, m) -> m + | TPat_conjs(_, m) -> m + | TPat_query(_, _, m) -> m + | TPat_unioncase(_, _, _, m) -> m + | TPat_exnconstr(_, _, m) -> m + | TPat_tuple(_, _, _, m) -> m + | TPat_array(_, _, m) -> m + | TPat_recd(_, _, _, m) -> m + | TPat_range(_, _, m) -> m + | TPat_null m -> m + | TPat_isinst(_, _, _, m) -> m + | TPat_error m -> m and PatternValBinding = PBind of Val * TypeScheme @@ -430,9 +430,9 @@ type Implication = /// /// Example: /// match x with -/// | :? (int option) -> ... +/// | :? option -> ... /// | null -> ... -/// Nothing can be learned. If ':? (int option)' succeeds, 'null' may still have to be run. +/// Nothing can be learned. If ':? option' succeeds, 'null' may still have to be run. let computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 = if TypeNullIsTrueValue g tgtTy1 then Implication.Nothing @@ -443,9 +443,9 @@ let computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 = /// /// Example: /// match x with -/// | :? (int option) -> ... +/// | :? option -> ... /// | null -> ... -/// If ':? (int option)' fails then 'null' will fail +/// If ':? option' fails then 'null' will fail let computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = if TypeNullIsTrueValue g tgtTy1 then Implication.Fails @@ -463,8 +463,8 @@ let computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = /// Example: /// match x with /// | null -> ... -/// | :? (int option) -> ... -/// For any inputs where 'null' succeeds, ':? (int option)' will succeed +/// | :? option -> ... +/// For any inputs where 'null' succeeds, ':? option' will succeed let computeWhatSuccessfulNullTestImpliesAboutTypeTest g tgtTy2 = if TypeNullIsTrueValue g tgtTy2 then Implication.Succeeds @@ -518,8 +518,8 @@ let computeWhatSuccessfulTypeTestImpliesAboutTypeTest g amap m tgtTy1 tgtTy2 = // // This doesn't apply to types with null as true value: // match x with - // | :? (int option) -> ... - // | :? (string option) -> ... + // | :? option -> ... + // | :? option -> ... // // Here on 'null' input the first pattern succeeds, and the second pattern will also succeed elif isSealedTy g tgtTy1 && @@ -859,7 +859,7 @@ let rec BuildSwitch inpExprOpt g expr edges dflt m = compactify (Some (h :: prev :: moreprev)) t | Const.Char cprev, Const.Char cnext when (int32 cprev + 1 = int32 cnext) -> compactify (Some (h :: prev :: moreprev)) t - | _ -> (List.rev (prev :: moreprev)) :: compactify None edges + | _ -> (List.rev (prev :: moreprev)) :: compactify None edges | _ -> failwith "internal error: compactify" let edgeGroups = compactify None edges' diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 5d2179339fc..1a053ff5334 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -13,7 +13,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -26,7 +26,6 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //-------------------------------------------------------------------------- diff --git a/src/fsharp/QueueList.fs b/src/fsharp/QueueList.fs index 19591b66c8b..cb823d0bd87 100644 --- a/src/fsharp/QueueList.fs +++ b/src/fsharp/QueueList.fs @@ -68,7 +68,7 @@ module internal QueueList = let forall f (x:QueueList<_>) = Seq.forall f x - let ofList (x:_ list) = QueueList(x) + let ofList (x:list<_>) = QueueList(x) let toList (x:QueueList<_>) = Seq.toList x diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 050c7601157..1c91fe606a0 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -9,7 +9,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.QuotationPickler open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming diff --git a/src/fsharp/ScriptClosure.fs b/src/fsharp/ScriptClosure.fs index 03e1910ecef..56846ed8510 100644 --- a/src/fsharp/ScriptClosure.fs +++ b/src/fsharp/ScriptClosure.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.ParseAndCheckInputs @@ -117,7 +117,7 @@ module ScriptPreprocessClosure = tcConfig: TcConfig, codeContext, lexResourceManager: Lexhelp.LexResourceManager, - errorLogger: DiagnosticsLogger + errorLogger: ErrorLogger ) = // fsc.exe -- COMPILED\!INTERACTIVE @@ -185,8 +185,8 @@ module ScriptPreprocessClosure = match basicReferences with | None -> - let errorLogger = CapturingDiagnosticsLogger("ScriptDefaultReferences") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingErrorLogger("ScriptDefaultReferences") + use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) let references, useDotNetFramework = tcConfigB.FxResolver.GetDefaultReferences useFsiAuxLib // If the user requested .NET Core scripting but something went wrong and we reverted to @@ -357,13 +357,13 @@ module ScriptPreprocessClosure = //printfn "visiting %s" fileName if IsScript fileName || parseRequired then let parseResult, parseDiagnostics = - let errorLogger = CapturingDiagnosticsLogger("FindClosureParse") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingErrorLogger("FindClosureParse") + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) let result = ParseScriptClosureInput (fileName, sourceText, tcConfig, codeContext, lexResourceManager, errorLogger) result, errorLogger.Diagnostics - let errorLogger = CapturingDiagnosticsLogger("FindClosureMetaCommands") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingErrorLogger("FindClosureMetaCommands") + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) let pathOfMetaCommandSource = Path.GetDirectoryName fileName let preSources = tcConfig.GetAvailableLoadedSources() @@ -429,9 +429,9 @@ module ScriptPreprocessClosure = // Resolve all references. let references, unresolvedReferences, resolutionDiagnostics = - let errorLogger = CapturingDiagnosticsLogger("GetLoadClosure") + let errorLogger = CapturingErrorLogger("GetLoadClosure") - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) + use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) let references, unresolvedReferences = TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig) let references = references |> List.map (fun ar -> ar.resolvedPath, ar) references, unresolvedReferences, errorLogger.Diagnostics diff --git a/src/fsharp/ScriptClosure.fsi b/src/fsharp/ScriptClosure.fsi index dfdc34f9dcd..b6b80c8b60f 100644 --- a/src/fsharp/ScriptClosure.fsi +++ b/src/fsharp/ScriptClosure.fsi @@ -9,7 +9,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.Text diff --git a/src/fsharp/SignatureConformance.fs b/src/fsharp/SignatureConformance.fs index 8e31f63b248..22dea30b046 100644 --- a/src/fsharp/SignatureConformance.fs +++ b/src/fsharp/SignatureConformance.fs @@ -10,16 +10,15 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos -open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy +open FSharp.Compiler.InfoReader #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders diff --git a/src/fsharp/StaticLinking.fs b/src/fsharp/StaticLinking.fs index 94d3c7f3f33..09e48552ef0 100644 --- a/src/fsharp/StaticLinking.fs +++ b/src/fsharp/StaticLinking.fs @@ -13,7 +13,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.OptimizeInputs open FSharp.Compiler.Text.Range @@ -197,9 +197,9 @@ let StaticLinkILModules (tcConfig:TcConfig, ilGlobals, tcImports, ilxMainModule, type Node = { name: string data: ILModuleDef - ccu: CcuThunk option + ccu: option refs: ILReferences - mutable edges: Node list + mutable edges: list mutable visited: bool } // Find all IL modules that are to be statically linked given the static linking roots. diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs index 6c9bfee5163..b1141eb9b8a 100644 --- a/src/fsharp/SyntaxTreeOps.fs +++ b/src/fsharp/SyntaxTreeOps.fs @@ -3,7 +3,7 @@ module FSharp.Compiler.SyntaxTreeOps open Internal.Utilities.Library -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Syntax.PrettyNaming diff --git a/src/fsharp/TypeHierarchy.fs b/src/fsharp/TypeHierarchy.fs deleted file mode 100644 index 2eec1c57ec6..00000000000 --- a/src/fsharp/TypeHierarchy.fs +++ /dev/null @@ -1,409 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal FSharp.Compiler.TypeHierarchy - -open System -open Internal.Utilities.Library -open Internal.Utilities.Library.Extras -open FSharp.Compiler -open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger -open FSharp.Compiler.Import -open FSharp.Compiler.Syntax -open FSharp.Compiler.SyntaxTreeOps -open FSharp.Compiler.TcGlobals -open FSharp.Compiler.Text -open FSharp.Compiler.TypedTree -open FSharp.Compiler.TypedTreeBasics -open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypedTreeOps.DebugPrint -open FSharp.Compiler.Xml - -#if !NO_TYPEPROVIDERS -open FSharp.Compiler.TypeProviders -#endif - -//------------------------------------------------------------------------- -// Fold the hierarchy. -// REVIEW: this code generalizes the iteration used below for member lookup. -//------------------------------------------------------------------------- - -/// Get the base type of a type, taking into account type instantiations. Return None if the -/// type has no base type. -let GetSuperTypeOfType g amap m ty = -#if !NO_TYPEPROVIDERS - let ty = - match tryTcrefOfAppTy g ty with - | ValueSome tcref when tcref.IsProvided -> stripTyEqns g ty - | _ -> stripTyEqnsAndMeasureEqns g ty -#else - let ty = stripTyEqnsAndMeasureEqns g ty -#endif - - match metadataOfTy g ty with -#if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - let st = info.ProvidedType - let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) - match superOpt with - | None -> None - | Some super -> Some(ImportProvidedType amap m super) -#endif - | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> - let tinst = argsOfAppTy g ty - match tdef.Extends with - | None -> None - | Some ilty -> Some (RescopeAndImportILType scoref amap m tinst ilty) - - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - if isFSharpObjModelTy g ty || isFSharpExceptionTy g ty then - let tcref = tcrefOfAppTy g ty - Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) - elif isArrayTy g ty then - Some g.system_Array_ty - elif isRefTy g ty && not (isObjTy g ty) then - Some g.obj_ty - elif isStructTupleTy g ty then - Some g.system_Value_ty - elif isFSharpStructOrEnumTy g ty then - if isFSharpEnumTy g ty then - Some g.system_Enum_ty - else - Some g.system_Value_ty - elif isStructAnonRecdTy g ty then - Some g.system_Value_ty - elif isAnonRecdTy g ty then - Some g.obj_ty - elif isRecdTy g ty || isUnionTy g ty then - Some g.obj_ty - else - None - -/// Make a type for System.Collections.Generic.IList -let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = - TType_app(g.tcref_System_Collections_Generic_IList, [ty], g.knownWithoutNull) - -/// Indicates whether we can skip interface types that lie outside the reference set -[] -type SkipUnrefInterfaces = Yes | No - -let GetImmediateInterfacesOfMetadataType g amap m skipUnref ty (tcref: TyconRef) tinst = - [ - match metadataOfTy g ty with -#if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - for ity in info.ProvidedType.PApplyArray((fun st -> st.GetInterfaces()), "GetInterfaces", m) do - ImportProvidedType amap m ity -#endif - | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> - // ImportILType may fail for an interface if the assembly load set is incomplete and the interface - // comes from another assembly. In this case we simply skip the interface: - // if we don't skip it, then compilation will just fail here, and if type checking - // succeeds with fewer non-dereferencable interfaces reported then it would have - // succeeded with more reported. There are pathological corner cases where this - // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always - // assume those are present. - for ity in tdef.Implements do - if skipUnref = SkipUnrefInterfaces.No || CanRescopeAndImportILType scoref amap m ity then - RescopeAndImportILType scoref amap m tinst ity - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - for ity in tcref.ImmediateInterfaceTypesOfFSharpTycon do - instType (mkInstForAppTy g ty) ity ] - -/// Collect the set of immediate declared interface types for an F# type, but do not -/// traverse the type hierarchy to collect further interfaces. -// -// NOTE: Anonymous record types are not directly considered to implement IComparable, -// IComparable or IEquatable. This is because whether they support these interfaces depend on their -// consitutent types, which may not yet be known in type inference. -let rec GetImmediateInterfacesOfType skipUnref g amap m ty = - [ - match tryAppTy g ty with - | ValueSome(tcref, tinst) -> - // Check if this is a measure-annotated type - match tcref.TypeReprInfo with - | TMeasureableRepr reprTy -> - yield! GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy - | _ -> - yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref ty tcref tinst - - | ValueNone -> - // For tuple types, func types, check if we can eliminate to a type with metadata. - let tyWithMetadata = convertToTypeWithMetadataIfPossible g ty - match tryAppTy g tyWithMetadata with - | ValueSome (tcref, tinst) -> - if isAnyTupleTy g ty then - yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref tyWithMetadata tcref tinst - | _ -> () - - // .NET array types are considered to implement IList - if isArray1DTy g ty then - mkSystemCollectionsGenericIListTy g (destArrayTy g ty) - ] - -// Report the interfaces supported by a measure-annotated type. -// -// For example, consider: -// -// [] -// type A<[] 'm> = A -// -// This measure-annotated type is considered to support the interfaces on its representation type A, -// with the exception that -// -// 1. we rewrite the IComparable and IEquatable interfaces, so that -// IComparable --> IComparable> -// IEquatable --> IEquatable> -// -// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces -// -// This rule is conservative and only applies to IComparable and IEquatable interfaces. -// -// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. -and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = - [ - // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> - for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do - if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m ity) && - not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) then - ity - - // NOTE: we should really only report the IComparable> interface for measure-annotated types - // if the original type supports IComparable somewhere in the hierarchy, likeiwse IEquatable>. - // - // However since F# 2.0 we have always reported these interfaces for all measure-annotated types. - - //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIComparable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIComparable_tcref [ty] - - //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIEquatable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIEquatable_tcref [ty] - ] - -// Check for IComparable, IEquatable and interfaces that derive from these -and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m ity = - ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m ity - -// Check for IComparable, IEquatable and interfaces that derive from these -and ExistsInInterfaceHierarchy p skipUnref g amap m ity = - match ity with - | AppTy g (tcref, tinst) -> - p ity || - (GetImmediateInterfacesOfMetadataType g amap m skipUnref ity tcref tinst - |> List.exists (ExistsInInterfaceHierarchy p skipUnref g amap m)) - | _ -> false - -/// Indicates whether we should visit multiple instantiations of the same generic interface or not -[] -type AllowMultiIntfInstantiations = Yes | No - -/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). -/// Visit base types and interfaces first. -let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = - let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = - - let seenThisTycon = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> Set.contains tcref.Stamp visitedTycon - | _ -> false - - // Do not visit the same type twice. Could only be doing this if we've seen this tycon - if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else - - // Do not visit the same tycon twice, e.g. I and I, collect I only, unless directed to allow this - if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else - - let state = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> - let visitedTycon = Set.add tcref.Stamp visitedTycon - visitedTycon, visited.Add (tcref, ty), acc - | _ -> - state - - if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else - let visitedTycon, visited, acc = - if isInterfaceTy g ty then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) - (loop ndeep g.obj_ty state) - else - match tryDestTyparTy g ty with - | ValueSome tp -> - let state = loop (ndeep+1) g.obj_ty state - List.foldBack - (fun x vacc -> - match x with - | TyparConstraint.MayResolveMember _ - | TyparConstraint.DefaultsTo _ - | TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _ - | TyparConstraint.IsEnum _ - | TyparConstraint.IsDelegate _ - | TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _ - | TyparConstraint.SimpleChoice _ - | TyparConstraint.RequiresDefaultConstructor _ -> vacc - | TyparConstraint.CoercesTo(cty, _) -> - loop (ndeep + 1) cty vacc) - tp.Constraints - state - | _ -> - let state = - if followInterfaces then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) - state - else - state - let state = - Option.foldBack - (loop (ndeep+1)) - (GetSuperTypeOfType g amap m ty) - state - state - let acc = visitor ty acc - (visitedTycon, visited, acc) - loop 0 ty (Set.empty, TyconRefMultiMap<_>.Empty, acc) |> p33 - -/// Fold, do not follow interfaces (unless the type is itself an interface) -let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = - FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc - -/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes f g amap m ty acc - -/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () - -/// Search for one element satisfying a predicate, following interfaces -let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false - -/// Search for one element where a function returns a 'Some' result, following interfaces -let SearchEntireHierarchyOfType f g amap m ty = - FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes - (fun ty acc -> - match acc with - | None -> if f ty then Some ty else None - | Some _ -> acc) - g amap m ty None - -/// Get all super types of the type, including the type itself -let AllSuperTypesOfType g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] - -/// Get all interfaces of a type, including the type itself if it is an interface -let AllInterfacesOfType g amap m allowMultiIntfInst ty = - AllSuperTypesOfType g amap m allowMultiIntfInst ty |> List.filter (isInterfaceTy g) - -/// Check if two types have the same nominal head type -let HaveSameHeadType g ty1 ty2 = - match tryTcrefOfAppTy g ty1 with - | ValueSome tcref1 -> - match tryTcrefOfAppTy g ty2 with - | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 - | _ -> false - | _ -> false - -/// Check if a type has a particular head type -let HasHeadType g tcref ty2 = - match tryTcrefOfAppTy g ty2 with - | ValueSome tcref2 -> tyconRefEq g tcref tcref2 - | ValueNone -> false - -/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) -let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = - ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - -/// Check if a type exists somewhere in the hierarchy which has the given head type. -let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = - ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - -/// Read an Abstract IL type from metadata and convert to an F# type. -let ImportILTypeFromMetadata amap m scoref tinst minst ilty = - RescopeAndImportILType scoref amap m (tinst@minst) ilty - -/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. -let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilty getCattrs = - let ty = RescopeAndImportILType scoref amap m (tinst@minst) ilty - // If the type is a byref and one of attributes from a return or parameter has IsReadOnly, then it's a inref. - if isByrefTy amap.g ty && TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ()) then - mkInByrefTy amap.g (destByrefTy amap.g ty) - else - ty - -/// Get the parameter type of an IL method. -let ImportParameterTypeFromMetadata amap m ilty getCattrs scoref tinst mist = - ImportILTypeFromMetadataWithAttributes amap m scoref tinst mist ilty getCattrs - -/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and -/// translating 'void' to 'None'. -let ImportReturnTypeFromMetadata amap m ilty getCattrs scoref tinst minst = - match ilty with - | ILType.Void -> None - | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy getCattrs) - - -/// Copy constraints. If the constraint comes from a type parameter associated -/// with a type constructor then we are simply renaming type variables. If it comes -/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the -/// instantiation associated with 'ty' as well as copying the type parameters associated with -/// M and instantiating their constraints -/// -/// Note: this now looks identical to constraint instantiation. - -let CopyTyparConstraints m tprefInst (tporig: Typar) = - tporig.Constraints - |> List.map (fun tpc -> - match tpc with - | TyparConstraint.CoercesTo(ty, _) -> - TyparConstraint.CoercesTo (instType tprefInst ty, m) - | TyparConstraint.DefaultsTo(priority, ty, _) -> - TyparConstraint.DefaultsTo (priority, instType tprefInst ty, m) - | TyparConstraint.SupportsNull _ -> - TyparConstraint.SupportsNull m - | TyparConstraint.IsEnum (uty, _) -> - TyparConstraint.IsEnum (instType tprefInst uty, m) - | TyparConstraint.SupportsComparison _ -> - TyparConstraint.SupportsComparison m - | TyparConstraint.SupportsEquality _ -> - TyparConstraint.SupportsEquality m - | TyparConstraint.IsDelegate(aty, bty, _) -> - TyparConstraint.IsDelegate (instType tprefInst aty, instType tprefInst bty, m) - | TyparConstraint.IsNonNullableStruct _ -> - TyparConstraint.IsNonNullableStruct m - | TyparConstraint.IsUnmanaged _ -> - TyparConstraint.IsUnmanaged m - | TyparConstraint.IsReferenceType _ -> - TyparConstraint.IsReferenceType m - | TyparConstraint.SimpleChoice (tys, _) -> - TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys, m) - | TyparConstraint.RequiresDefaultConstructor _ -> - TyparConstraint.RequiresDefaultConstructor m - | TyparConstraint.MayResolveMember(traitInfo, _) -> - TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) - -/// The constraints for each typar copied from another typar can only be fixed up once -/// we have generated all the new constraints, e.g. f List, B :> List> ... -let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = - // Checks.. These are defensive programming against early reported errors. - let n0 = formalEnclosingTypars.Length - let n1 = tinst.Length - let n2 = tpsorig.Length - let n3 = tps.Length - if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0, n1)), m)) - if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2, n3)), m)) - - // The real code.. - let renaming, tptys = mkTyparToTyparRenaming tpsorig tps - let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming - (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) - renaming, tptys - diff --git a/src/fsharp/TypeHierarchy.fsi b/src/fsharp/TypeHierarchy.fsi deleted file mode 100644 index 4e840f765bb..00000000000 --- a/src/fsharp/TypeHierarchy.fsi +++ /dev/null @@ -1,174 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal FSharp.Compiler.TypeHierarchy - -open FSharp.Compiler -open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.Syntax -open FSharp.Compiler.Import -open FSharp.Compiler.TcGlobals -open FSharp.Compiler.Text -open FSharp.Compiler.Xml -open FSharp.Compiler.TypedTree -open FSharp.Compiler.TypedTreeOps - -#if !NO_TYPEPROVIDERS -open FSharp.Compiler.TypeProviders -#endif - -/// Get the base type of a type, taking into account type instantiations. Return None if the -/// type has no base type. -val GetSuperTypeOfType: g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option - -/// Indicates whether we can skip interface types that lie outside the reference set -[] -type SkipUnrefInterfaces = - | Yes - | No - -/// Collect the set of immediate declared interface types for an F# type, but do not -/// traverse the type hierarchy to collect further interfaces. -val GetImmediateInterfacesOfType: - skipUnref: SkipUnrefInterfaces -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType list - -/// Indicates whether we should visit multiple instantiations of the same generic interface or not -[] -type AllowMultiIntfInstantiations = - | Yes - | No - -/// Fold, do not follow interfaces (unless the type is itself an interface) -val FoldPrimaryHierarchyOfType: - f: (TType -> 'a -> 'a) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - acc: 'a -> - 'a - -/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -val FoldEntireHierarchyOfType: - f: (TType -> 'a -> 'a) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - acc: 'a -> - 'a - -/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -val IterateEntireHierarchyOfType: - f: (TType -> unit) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - unit - -/// Search for one element satisfying a predicate, following interfaces -val ExistsInEntireHierarchyOfType: - f: (TType -> bool) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - bool - -/// Search for one element where a function returns a 'Some' result, following interfaces -val SearchEntireHierarchyOfType: - f: (TType -> bool) -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option - -/// Get all super types of the type, including the type itself -val AllSuperTypesOfType: - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - TType list - -/// Get all interfaces of a type, including the type itself if it is an interface -val AllInterfacesOfType: - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - TType list - -/// Check if two types have the same nominal head type -val HaveSameHeadType: g: TcGlobals -> ty1: TType -> ty2: TType -> bool - -/// Check if a type has a particular head type -val HasHeadType: g: TcGlobals -> tcref: TyconRef -> ty2: TType -> bool - -/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) -val ExistsSameHeadTypeInHierarchy: - g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> typeToLookFor: TType -> bool - -/// Check if a type exists somewhere in the hierarchy which has the given head type. -val ExistsHeadTypeInEntireHierarchy: - g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> tcrefToLookFor: TyconRef -> bool - -/// Read an Abstract IL type from metadata and convert to an F# type. -val ImportILTypeFromMetadata: - amap: ImportMap -> m: range -> scoref: ILScopeRef -> tinst: TType list -> minst: TType list -> ilty: ILType -> TType - -/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. -val ImportILTypeFromMetadataWithAttributes: - amap: ImportMap -> - m: range -> - scoref: ILScopeRef -> - tinst: TType list -> - minst: TType list -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - TType - -/// Get the parameter type of an IL method. -val ImportParameterTypeFromMetadata: - amap: ImportMap -> - m: range -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - scoref: ILScopeRef -> - tinst: TType list -> - mist: TType list -> - TType - -/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and -/// translating 'void' to 'None'. -val ImportReturnTypeFromMetadata: - amap: ImportMap -> - m: range -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - scoref: ILScopeRef -> - tinst: TType list -> - minst: TType list -> - TType option - -/// Copy constraints. If the constraint comes from a type parameter associated -/// with a type constructor then we are simply renaming type variables. If it comes -/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the -/// instantiation associated with 'ty' as well as copying the type parameters associated with -/// M and instantiating their constraints -/// -/// Note: this now looks identical to constraint instantiation. - -val CopyTyparConstraints: m: range -> tprefInst: TyparInst -> tporig: Typar -> TyparConstraint list - -/// The constraints for each typar copied from another typar can only be fixed up once -/// we have generated all the new constraints, e.g. f List, B :> List> ... -val FixupNewTypars: - m: range -> - formalEnclosingTypars: Typars -> - tinst: TType list -> - tpsorig: Typars -> - tps: Typars -> - TyparInst * TTypes diff --git a/src/fsharp/TypeProviders.fs b/src/fsharp/TypeProviders.fs index dd29a44d36d..f7c9e752ac6 100644 --- a/src/fsharp/TypeProviders.fs +++ b/src/fsharp/TypeProviders.fs @@ -16,7 +16,7 @@ open Internal.Utilities.FSharpEnvironment open FSharp.Core.CompilerServices open FSharp.Quotations open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Text.Range diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index 6cbb7547f30..ea8d5b5dd33 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -6,12 +6,12 @@ module internal FSharp.Compiler.TypeRelations open Internal.Utilities.Collections open Internal.Utilities.Library -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy /// Implements a :> b without coercion based on finalized (no type variable) types // Note: This relation is approximate and not part of the language specification. diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 975b28ef1c5..42dddef98b8 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -17,7 +17,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILX.Types open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.QuotationPickler @@ -812,7 +812,7 @@ type Entity = | _ -> x.entity_opt_data <- Some { Entity.NewEmptyEntityOptData() with entity_exn_info = exn_info } /// Indicates if the entity represents an F# exception declaration. - member x.IsFSharpException = match x.ExceptionInfo with TExnNone -> false | _ -> true + member x.IsExceptionDecl = match x.ExceptionInfo with TExnNone -> false | _ -> true /// Demangle the module name, if FSharpModuleWithSuffix is used member x.DemangledModuleOrNamespaceName = @@ -1933,10 +1933,10 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en member _.ActivePatternElemRefLookupTable = activePatternElemRefCache /// Get a list of types defined within this module, namespace or type. - member _.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsFSharpException && not x.IsModuleOrNamespace) |> Seq.toList + member _.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList /// Get a list of F# exception definitions defined within this module, namespace or type. - member _.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsFSharpException) |> Seq.toList + member _.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList /// Get a list of module and namespace definitions defined within this module, namespace or type. member _.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList @@ -3434,7 +3434,7 @@ type EntityRef = member x.ExceptionInfo = x.Deref.ExceptionInfo /// Indicates if the entity represents an F# exception declaration. - member x.IsFSharpException = x.Deref.IsFSharpException + member x.IsExceptionDecl = x.Deref.IsExceptionDecl /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. /// @@ -4062,7 +4062,7 @@ type TType = | TType_measure of measure: Measure /// For now, used only as a discriminant in error message. - /// See https://github.com/dotnet/fsharp/issues/2561 + /// See https://github.com/Microsoft/visualfsharp/issues/2561 member x.GetAssemblyName() = match x with | TType_forall (_tps, ty) -> ty.GetAssemblyName() diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 868da58b6f3..deecf4724db 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -14,7 +14,7 @@ open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -6217,7 +6217,7 @@ let isRecdOrUnionOrStructTyconRefDefinitelyMutable (tcref: TyconRef) = tycon.UnionCasesArray |> Array.exists isUnionCaseDefinitelyMutable elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then // Note: This only looks at the F# fields, causing oddities. - // See https://github.com/dotnet/fsharp/pull/4576 + // See https://github.com/Microsoft/visualfsharp/pull/4576 tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldDefinitelyMutable else false @@ -10085,96 +10085,3 @@ let ComputeUseMethodImpl g (v: Val) = (tcref.GeneratedHashAndEqualsWithComparerValues.IsSome && typeEquiv g oty g.mk_IStructuralEquatable_ty) not isStructural)) - -let (|Seq|_|) g expr = - match expr with - // use 'seq { ... }' as an indicator - | ValApp g g.seq_vref ([elemTy], [e], _m) -> Some (e, elemTy) - | _ -> None - -/// Detect a 'yield x' within a 'seq { ... }' -let (|SeqYield|_|) g expr = - match expr with - | ValApp g g.seq_singleton_vref (_, [arg], m) -> Some (arg, m) - | _ -> None - -/// Detect a 'expr; expr' within a 'seq { ... }' -let (|SeqAppend|_|) g expr = - match expr with - | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> Some (arg1, arg2, m) - | _ -> None - -let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals - -/// Detect a 'while gd do expr' within a 'seq { ... }' -let (|SeqWhile|_|) g expr = - match expr with - | ValApp g g.seq_generated_vref (_, [Expr.Lambda (_, _, _, [dummyv], guardExpr, _, _);innerExpr], m) - when not (isVarFreeInExpr dummyv guardExpr) -> - - // The debug point for 'while' is attached to the innerExpr, see TcSequenceExpression - let mWhile = innerExpr.Range - let spWhile = match mWhile.NotedSourceConstruct with NotedSourceConstruct.While -> DebugPointAtWhile.Yes mWhile | _ -> DebugPointAtWhile.No - Some (guardExpr, innerExpr, spWhile, m) - - | _ -> - None - -let (|SeqTryFinally|_|) g expr = - match expr with - | ValApp g g.seq_finally_vref (_, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _) as arg2], m) - when not (isVarFreeInExpr dummyv compensation) -> - - // The debug point for 'try' and 'finally' are attached to the first and second arguments - // respectively, see TcSequenceExpression - let mTry = arg1.Range - let mFinally = arg2.Range - let spTry = match mTry.NotedSourceConstruct with NotedSourceConstruct.Try -> DebugPointAtTry.Yes mTry | _ -> DebugPointAtTry.No - let spFinally = match mFinally.NotedSourceConstruct with NotedSourceConstruct.Finally -> DebugPointAtFinally.Yes mFinally | _ -> DebugPointAtFinally.No - - Some (arg1, compensation, spTry, spFinally, m) - - | _ -> - None - -let (|SeqUsing|_|) g expr = - match expr with - | ValApp g g.seq_using_vref ([_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, mBind, _)], m) -> - // The debug point mFor at the 'use x = ... ' gets attached to the lambda - let spBind = match mBind.NotedSourceConstruct with NotedSourceConstruct.Binding -> DebugPointAtBinding.Yes mBind | _ -> DebugPointAtBinding.NoneAtInvisible - Some (resource, v, body, elemTy, spBind, m) - | _ -> - None - -let (|SeqForEach|_|) g expr = - match expr with - // Nested for loops are represented by calls to Seq.collect - | ValApp g g.seq_collect_vref ([_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> - // The debug point mIn at the 'in' gets attached to the first argument, see TcSequenceExpression - let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No - Some (inp, v, body, genElemTy, mFor, mIn, spIn) - - // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. - | ValApp g g.seq_map_vref ([_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> - let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No - // The debug point mFor at the 'for' gets attached to the first argument, see TcSequenceExpression - Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) - - | _ -> None - -let (|SeqDelay|_|) g expr = - match expr with - | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) - when not (isVarFreeInExpr v e) -> - Some (e, elemTy) - | _ -> None - -let (|SeqEmpty|_|) g expr = - match expr with - | ValApp g g.seq_empty_vref (_, [], m) -> Some m - | _ -> None - -let isFSharpExceptionTy g ty = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> tcref.IsFSharpException - | _ -> false diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 045425f3513..76819d6d2fd 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -2609,33 +2609,3 @@ val (|IfThenElseExpr|_|): expr: Expr -> (Expr * Expr * Expr) option /// Determine if a value is a method implementing an interface dispatch slot using a private method impl val ComputeUseMethodImpl: g: TcGlobals -> v: Val -> bool - -/// Detect the de-sugared form of a 'yield x' within a 'seq { ... }' -val (|SeqYield|_|): TcGlobals -> Expr -> (Expr * range) option - -/// Detect the de-sugared form of a 'expr; expr' within a 'seq { ... }' -val (|SeqAppend|_|): TcGlobals -> Expr -> (Expr * Expr * range) option - -/// Detect the de-sugared form of a 'while gd do expr' within a 'seq { ... }' -val (|SeqWhile|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtWhile * range) option - -/// Detect the de-sugared form of a 'try .. finally .. ' within a 'seq { ... }' -val (|SeqTryFinally|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtTry * DebugPointAtFinally * range) option - -/// Detect the de-sugared form of a 'use x = ..' within a 'seq { ... }' -val (|SeqUsing|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * DebugPointAtBinding * range) option - -/// Detect the de-sugared form of a 'for x in collection do ..' within a 'seq { ... }' -val (|SeqForEach|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * range * range * DebugPointAtInOrTo) option - -/// Detect the outer 'Seq.delay' added for a construct 'seq { ... }' -val (|SeqDelay|_|): TcGlobals -> Expr -> (Expr * TType) option - -/// Detect a 'Seq.empty' implicit in the implied 'else' branch of an 'if .. then' in a seq { ... } -val (|SeqEmpty|_|): TcGlobals -> Expr -> range option - -/// Detect a 'seq { ... }' expression -val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option - -/// Indicates if an F# type is the type associated with an F# exception declaration -val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 010e2939431..34edb759454 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -17,7 +17,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.Syntax @@ -1616,7 +1616,7 @@ let rec p_normalized_measure unt st = // numerator and denominator) is used only when absolutely necessary, maintaining // compatibility of formats with versions prior to F# 4.0. // -// See https://github.com/dotnet/fsharp/issues/69 +// See https://github.com/Microsoft/visualfsharp/issues/69 let p_measure_expr unt st = p_normalized_measure (normalizeMeasure st.oglobals unt) st let u_rational st = diff --git a/src/fsharp/XmlDoc.fs b/src/fsharp/XmlDoc.fs index 81caa767298..8f0618ba0a2 100644 --- a/src/fsharp/XmlDoc.fs +++ b/src/fsharp/XmlDoc.fs @@ -9,7 +9,7 @@ open System.Xml open System.Xml.Linq open Internal.Utilities.Library open Internal.Utilities.Collections -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.Text open FSharp.Compiler.Text.Range diff --git a/src/fsharp/XmlDocFileWriter.fs b/src/fsharp/XmlDocFileWriter.fs index 813dad3163c..882b31c4000 100644 --- a/src/fsharp/XmlDocFileWriter.fs +++ b/src/fsharp/XmlDocFileWriter.fs @@ -5,7 +5,7 @@ module internal FSharp.Compiler.XmlDocFileWriter open System.IO open System.Reflection open Internal.Utilities.Library -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.Text open FSharp.Compiler.Xml diff --git a/src/fsharp/absil/il.fs b/src/fsharp/absil/il.fs index a972c7cd4b1..5966811ff21 100644 --- a/src/fsharp/absil/il.fs +++ b/src/fsharp/absil/il.fs @@ -1269,7 +1269,7 @@ type ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } -type ILLocals = ILLocal list +type ILLocals = list [] type ILDebugImport = @@ -1547,7 +1547,7 @@ type ILParameter = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex -type ILParameters = ILParameter list +type ILParameters = list [] type ILReturn = @@ -2564,9 +2564,9 @@ let mkILSimpleTypar nm = CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs MetadataIndex = NoMetadataIdx } -let genericParamOfGenericActual (_ga: ILType) = mkILSimpleTypar "T" +let gparam_of_gactual (_ga: ILType) = mkILSimpleTypar "T" -let mkILFormalTypars (x: ILGenericArgsList) = List.map genericParamOfGenericActual x +let mkILFormalTypars (x: ILGenericArgsList) = List.map gparam_of_gactual x let mkILFormalGenericArgs numtypars (gparams: ILGenericParameterDefs) = List.mapi (fun n _gf -> mkILTyvarTy (uint16 (numtypars + n))) gparams @@ -3192,10 +3192,10 @@ let cdef_cctorCode2CodeOrCreate tag imports f (cd: ILTypeDef) = cd.With(methods = methods) -let codeOfMethodDef (md: ILMethodDef) = +let code_of_mdef (md: ILMethodDef) = match md.Code with | Some x -> x - | None -> failwith "codeOfmdef: not IL" + | None -> failwith "code_of_mdef: not IL" let mkRefToILMethod (tref, md: ILMethodDef) = mkILMethRef (tref, md.CallingConv, md.Name, md.GenericParams.Length, md.ParameterTypes, md.Return.Type) @@ -3244,19 +3244,19 @@ type ILLocalsAllocator (preAlloc: int) = member tmps.Close() = ResizeArray.toList newLocals -let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap ((fun (fdef: ILFieldDef) -> fdef.Name), l)) +let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap ((fun (f: ILFieldDef) -> f.Name), l)) let mkILFields l = mkILFieldsLazy (notlazy l) let emptyILFields = mkILFields [] -let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap ((fun (edef: ILEventDef) -> edef.Name), l)) +let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap ((fun (e: ILEventDef) -> e.Name), l)) let mkILEvents l = mkILEventsLazy (notlazy l) let emptyILEvents = mkILEvents [] -let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap ((fun (pdef: ILPropertyDef) -> pdef.Name), l) ) +let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap ((fun (p: ILPropertyDef) -> p.Name), l) ) let mkILProperties l = mkILPropertiesLazy (notlazy l) @@ -3486,9 +3486,9 @@ let computeILEnumInfo (mdName, mdFields: ILFieldDefs) = match (List.partition (fun (fd: ILFieldDef) -> fd.IsStatic) (mdFields.AsList())) with | staticFields, [vfd] -> { enumType = vfd.FieldType - enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": static field does not have an default value"))) } - | _, [] -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": no non-static field found") - | _, _ -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": more than one non-static field found") + enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": static field does not have an default value"))) } + | _, [] -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": no non-static field found") + | _, _ -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": more than one non-static field found") //--------------------------------------------------------------------- // Primitives to help read signatures. These do not use the file cursor, but @@ -3547,17 +3547,17 @@ let sigptr_get_u64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr uint64 u, sigptr -let float32OfBits (x: int32) = BitConverter.ToSingle (BitConverter.GetBytes x, 0) +let float32_of_bits (x: int32) = BitConverter.ToSingle (BitConverter.GetBytes x, 0) -let floatOfBits (x: int64) = BitConverter.Int64BitsToDouble x +let float_of_bits (x: int64) = BitConverter.Int64BitsToDouble x let sigptr_get_ieee32 bytes sigptr = let u, sigptr = sigptr_get_i32 bytes sigptr - float32OfBits u, sigptr + float32_of_bits u, sigptr let sigptr_get_ieee64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr - floatOfBits u, sigptr + float_of_bits u, sigptr let sigptr_get_intarray n (bytes: byte[]) sigptr = let res = Bytes.zeroCreate n @@ -3651,13 +3651,13 @@ let u32AsBytes (i: uint32) = i32AsBytes (int32 i) let u64AsBytes (i: uint64) = i64AsBytes (int64 i) -let bitsOfSingle (x: float32) = BitConverter.ToInt32 (BitConverter.GetBytes x, 0) +let bits_of_float32 (x: float32) = BitConverter.ToInt32 (BitConverter.GetBytes x, 0) -let bitsOfDouble (x: float) = BitConverter.DoubleToInt64Bits x +let bits_of_float (x: float) = BitConverter.DoubleToInt64Bits x -let ieee32AsBytes i = i32AsBytes (bitsOfSingle i) +let ieee32AsBytes i = i32AsBytes (bits_of_float32 i) -let ieee64AsBytes i = i64AsBytes (bitsOfDouble i) +let ieee64AsBytes i = i64AsBytes (bits_of_float i) let et_END = 0x00uy let et_VOID = 0x01uy @@ -3859,7 +3859,7 @@ let encodeCustomAttrNamedArg (nm, ty, prop, elem) = yield! encodeCustomAttrString nm yield! encodeCustomAttrValue ty elem |] -let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: _ list) (namedArgs: _ list) = +let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: list<_>) (namedArgs: list<_>) = let argTys = mspec.MethodRef.ArgTypes [| yield! [| 0x01uy; 0x00uy; |] for argTy, fixedArg in Seq.zip argTys fixedArgs do @@ -3868,11 +3868,11 @@ let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: _ list) (namedArgs: _ for namedArg in namedArgs do yield! encodeCustomAttrNamedArg namedArg |] -let encodeCustomAttr (mspec: ILMethodSpec, fixedArgs, namedArgs) = +let encodeCustomAttr (mspec: ILMethodSpec, fixedArgs: list<_>, namedArgs: list<_>) = let args = encodeCustomAttrArgs mspec fixedArgs namedArgs ILAttribute.Encoded (mspec, args, fixedArgs @ (namedArgs |> List.map (fun (_, _, _, e) -> e))) -let mkILCustomAttribMethRef (mspec: ILMethodSpec, fixedArgs, namedArgs) = +let mkILCustomAttribMethRef (mspec: ILMethodSpec, fixedArgs: list<_>, namedArgs: list<_>) = encodeCustomAttr (mspec, fixedArgs, namedArgs) let mkILCustomAttribute (tref, argTys, argvs, propvs) = @@ -3892,7 +3892,7 @@ let getCustomAttrData cattr = // as a compressed int to indicate the size followed by an array of UTF8 characters.) // - A set of properties, encoded as the named arguments to a custom attribute would be (as // in §23.3, beginning with NumNamed). -let mkPermissionSet (action, attributes: (ILTypeRef * (string * ILType * ILAttribElem) list) list) = +let mkPermissionSet (action, attributes: list) = let bytes = [| yield (byte '.') yield! z_unsigned_int attributes.Length @@ -4104,8 +4104,8 @@ let decodeILAttribData (ca: ILAttribute) = try let parser = ILTypeSigParser n parser.ParseTypeSpec(), sigptr - with exn -> - failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" exn.Message) + with e -> + failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" e.Message) | ILType.Boxed tspec when tspec.Name = "System.Object" -> let et, sigptr = sigptr_get_u8 bytes sigptr if et = 0xFFuy then @@ -4197,119 +4197,116 @@ let emptyILRefs = MethodReferences = [||] FieldReferences = [||] } -let refsOfILAssemblyRef (s: ILReferencesAccumulator) x = - s.refsA.Add x |> ignore +(* Now find references. *) +let refs_of_assemblyRef (s: ILReferencesAccumulator) x = s.refsA.Add x |> ignore -let refsOfILModuleRef (s: ILReferencesAccumulator) x = - s.refsM.Add x |> ignore +let refs_of_modref (s: ILReferencesAccumulator) x = s.refsM.Add x |> ignore -let refsOfScopeRef s x = +let refs_of_scoref s x = match x with | ILScopeRef.Local -> () - | ILScopeRef.Assembly assemblyRef -> refsOfILAssemblyRef s assemblyRef - | ILScopeRef.Module modref -> refsOfILModuleRef s modref - | ILScopeRef.PrimaryAssembly -> refsOfILAssemblyRef s s.ilg.primaryAssemblyRef + | ILScopeRef.Assembly assemblyRef -> refs_of_assemblyRef s assemblyRef + | ILScopeRef.Module modref -> refs_of_modref s modref + | ILScopeRef.PrimaryAssembly -> refs_of_assemblyRef s s.ilg.primaryAssemblyRef -let refsOfILTypeRef s (x: ILTypeRef) = refsOfScopeRef s x.Scope +let refs_of_tref s (x: ILTypeRef) = refs_of_scoref s x.Scope -let rec refsOfILType s x = +let rec refs_of_typ s x = match x with | ILType.Void | ILType.TypeVar _ -> () - | ILType.Modified (_, ty1, ty2) -> refsOfILTypeRef s ty1; refsOfILType s ty2 + | ILType.Modified (_, ty1, ty2) -> refs_of_tref s ty1; refs_of_typ s ty2 | ILType.Array (_, ty) - | ILType.Ptr ty | ILType.Byref ty -> refsOfILType s ty - | ILType.Value tr | ILType.Boxed tr -> refsOfILTypeSpec s tr - | ILType.FunctionPointer mref -> refsOfILCallsig s mref + | ILType.Ptr ty | ILType.Byref ty -> refs_of_typ s ty + | ILType.Value tr | ILType.Boxed tr -> refs_of_tspec s tr + | ILType.FunctionPointer mref -> refs_of_callsig s mref -and refsOfILTypeSpec s (x: ILTypeSpec) = - refsOfILTypeRef s x.TypeRef - refsOfILTypes s x.GenericArgs +and refs_of_inst s i = refs_of_tys s i -and refsOfILCallsig s csig = - refsOfILTypes s csig.ArgTypes - refsOfILType s csig.ReturnType +and refs_of_tspec s (x: ILTypeSpec) = refs_of_tref s x.TypeRef; refs_of_inst s x.GenericArgs -and refsOfILGenericParam s x = - refsOfILTypes s x.Constraints +and refs_of_callsig s csig = refs_of_tys s csig.ArgTypes; refs_of_typ s csig.ReturnType -and refsOfILGenericParams s b = - List.iter (refsOfILGenericParam s) b +and refs_of_genparam s x = refs_of_tys s x.Constraints -and refsOfILMethodRef s (x: ILMethodRef) = - refsOfILTypeRef s x.DeclaringTypeRef - refsOfILTypes s x.mrefArgs - refsOfILType s x.mrefReturn +and refs_of_genparams s b = List.iter (refs_of_genparam s) b + +and refs_of_dloc s ts = refs_of_tref s ts + +and refs_of_mref s (x: ILMethodRef) = + refs_of_dloc s x.DeclaringTypeRef + refs_of_tys s x.mrefArgs + refs_of_typ s x.mrefReturn s.refsMs.Add x |> ignore -and refsOfILFieldRef s x = - refsOfILTypeRef s x.DeclaringTypeRef - refsOfILType s x.Type +and refs_of_fref s x = + refs_of_tref s x.DeclaringTypeRef + refs_of_typ s x.Type s.refsFs.Add x |> ignore -and refsOfILOverridesSpec s (OverridesSpec (mref, ty)) = - refsOfILMethodRef s mref - refsOfILType s ty +and refs_of_ospec s (OverridesSpec (mref, ty)) = + refs_of_mref s mref + refs_of_typ s ty -and refsOfILMethodSpec s (x: ILMethodSpec) = - refsOfILMethodRef s x.MethodRef - refsOfILType s x.DeclaringType - refsOfILTypes s x.GenericArgs +and refs_of_mspec s (x: ILMethodSpec) = + refs_of_mref s x.MethodRef + refs_of_typ s x.DeclaringType + refs_of_inst s x.GenericArgs -and refsOfILFieldSpec s x = - refsOfILFieldRef s x.FieldRef - refsOfILType s x.DeclaringType +and refs_of_fspec s x = + refs_of_fref s x.FieldRef + refs_of_typ s x.DeclaringType -and refsOfILTypes s l = List.iter (refsOfILType s) l +and refs_of_tys s l = List.iter (refs_of_typ s) l -and refsOfILToken s x = +and refs_of_token s x = match x with - | ILToken.ILType ty -> refsOfILType s ty - | ILToken.ILMethod mr -> refsOfILMethodSpec s mr - | ILToken.ILField fr -> refsOfILFieldSpec s fr - -and refsOfILCustomAttrElem s (elem: ILAttribElem) = - match elem with - | Type (Some ty) -> refsOfILType s ty - | TypeRef (Some tref) -> refsOfILTypeRef s tref + | ILToken.ILType ty -> refs_of_typ s ty + | ILToken.ILMethod mr -> refs_of_mspec s mr + | ILToken.ILField fr -> refs_of_fspec s fr + +and refs_of_attrib_elem s (e: ILAttribElem) = + match e with + | Type (Some ty) -> refs_of_typ s ty + | TypeRef (Some tref) -> refs_of_tref s tref | Array (ty, els) -> - refsOfILType s ty - refsOfILCustomAttrElems s els + refs_of_typ s ty + refs_of_attrib_elems s els | _ -> () -and refsOfILCustomAttrElems s els = - els |> List.iter (refsOfILCustomAttrElem s) +and refs_of_attrib_elems s els = + els |> List.iter (refs_of_attrib_elem s) -and refsOfILCustomAttr s (cattr: ILAttribute) = - refsOfILMethodSpec s cattr.Method - refsOfILCustomAttrElems s cattr.Elements +and refs_of_custom_attr s (cattr: ILAttribute) = + refs_of_mspec s cattr.Method + refs_of_attrib_elems s cattr.Elements -and refsOfILCustomAttrs s (cas : ILAttributes) = - cas.AsArray() |> Array.iter (refsOfILCustomAttr s) +and refs_of_custom_attrs s (cas : ILAttributes) = + cas.AsArray() |> Array.iter (refs_of_custom_attr s) -and refsOfILVarArgs s tyso = - Option.iter (refsOfILTypes s) tyso +and refs_of_varargs s tyso = + Option.iter (refs_of_tys s) tyso -and refsOfILInstr s x = +and refs_of_instr s x = match x with | I_call (_, mr, varargs) | I_newobj (mr, varargs) | I_callvirt (_, mr, varargs) -> - refsOfILMethodSpec s mr - refsOfILVarArgs s varargs + refs_of_mspec s mr + refs_of_varargs s varargs | I_callconstraint (_, tr, mr, varargs) -> - refsOfILType s tr - refsOfILMethodSpec s mr - refsOfILVarArgs s varargs + refs_of_typ s tr + refs_of_mspec s mr + refs_of_varargs s varargs | I_calli (_, callsig, varargs) -> - refsOfILCallsig s callsig; refsOfILVarArgs s varargs + refs_of_callsig s callsig; refs_of_varargs s varargs | I_jmp mr | I_ldftn mr | I_ldvirtftn mr -> - refsOfILMethodSpec s mr + refs_of_mspec s mr | I_ldsfld (_, fr) | I_ldfld (_, _, fr) | I_ldsflda fr | I_ldflda fr | I_stsfld (_, fr) | I_stfld (_, _, fr) -> - refsOfILFieldSpec s fr + refs_of_fspec s fr | I_isinst ty | I_castclass ty | I_cpobj ty | I_initobj ty | I_ldobj (_, _, ty) | I_stobj (_, _, ty) | I_box ty |I_unbox ty | I_unbox_any ty | I_sizeof ty | I_ldelem_any (_, ty) | I_ldelema (_, _, _, ty) |I_stelem_any (_, ty) | I_newarr (_, ty) | I_mkrefany ty | I_refanyval ty - | EI_ilzero ty -> refsOfILType s ty - | I_ldtoken token -> refsOfILToken s token + | EI_ilzero ty -> refs_of_typ s ty + | I_ldtoken token -> refs_of_token s token | I_stelem _|I_ldelem _|I_ldstr _|I_switch _|I_stloc _|I_stind _ | I_starg _|I_ldloca _|I_ldloc _|I_ldind _ | I_ldarga _|I_ldarg _|I_leave _|I_br _ @@ -4322,117 +4319,119 @@ and refsOfILInstr s x = | AI_ldnull | AI_dup | AI_pop | AI_ckfinite | AI_nop | AI_ldc _ | I_seqpoint _ | EI_ldlen_multi _ -> () -and refsOfILCode s (c: ILCode) = - for i in c.Instrs do - refsOfILInstr s i - - for exnClause in c.Exceptions do - match exnClause.Clause with - | ILExceptionClause.TypeCatch (ilty, _) -> refsOfILType s ilty - | _ -> () +and refs_of_il_code s (c: ILCode) = + c.Instrs |> Array.iter (refs_of_instr s) + c.Exceptions |> List.iter (fun e -> e.Clause |> (function + | ILExceptionClause.TypeCatch (ilty, _) -> refs_of_typ s ilty + | _ -> ())) -and refsOfILMethodBody s (il: ILMethodBody) = - List.iter (refsOfILLocal s) il.Locals - refsOfILCode s il.Code +and refs_of_ilmbody s (il: ILMethodBody) = + List.iter (refs_of_local s) il.Locals + refs_of_il_code s il.Code -and refsOfILLocal s loc = refsOfILType s loc.Type +and refs_of_local s loc = refs_of_typ s loc.Type -and refsOfMethodBody s x = +and refs_of_mbody s x = match x with - | MethodBody.IL il -> refsOfILMethodBody s il.Value - | MethodBody.PInvoke attr -> refsOfILModuleRef s attr.Value.Where + | MethodBody.IL il -> refs_of_ilmbody s il.Value + | MethodBody.PInvoke attr -> refs_of_modref s attr.Value.Where | _ -> () -and refsOfILMethodDef s (md: ILMethodDef) = - List.iter (refsOfILParam s) md.Parameters - refsOfILReturn s md.Return - refsOfMethodBody s md.Body - refsOfILCustomAttrs s md.CustomAttrs - refsOfILGenericParams s md.GenericParams +and refs_of_mdef s (md: ILMethodDef) = + List.iter (refs_of_param s) md.Parameters + refs_of_return s md.Return + refs_of_mbody s md.Body + refs_of_custom_attrs s md.CustomAttrs + refs_of_genparams s md.GenericParams + +and refs_of_param s p = refs_of_typ s p.Type + +and refs_of_return s (rt: ILReturn) = refs_of_typ s rt.Type -and refsOfILParam s p = refsOfILType s p.Type +and refs_of_mdefs s x = Seq.iter (refs_of_mdef s) x -and refsOfILReturn s (rt: ILReturn) = refsOfILType s rt.Type +and refs_of_event_def s (ed: ILEventDef) = + Option.iter (refs_of_typ s) ed.EventType + refs_of_mref s ed.AddMethod + refs_of_mref s ed.RemoveMethod + Option.iter (refs_of_mref s) ed.FireMethod + List.iter (refs_of_mref s) ed.OtherMethods + refs_of_custom_attrs s ed.CustomAttrs -and refsOfILMethodDefs s x = Seq.iter (refsOfILMethodDef s) x +and refs_of_events s (x: ILEventDefs) = + List.iter (refs_of_event_def s) (x.AsList()) -and refsOfILEventDef s (ed: ILEventDef) = - Option.iter (refsOfILType s) ed.EventType - refsOfILMethodRef s ed.AddMethod - refsOfILMethodRef s ed.RemoveMethod - Option.iter (refsOfILMethodRef s) ed.FireMethod - List.iter (refsOfILMethodRef s) ed.OtherMethods - refsOfILCustomAttrs s ed.CustomAttrs +and refs_of_property_def s (pd: ILPropertyDef) = + Option.iter (refs_of_mref s) pd.SetMethod + Option.iter (refs_of_mref s) pd.GetMethod + refs_of_typ s pd.PropertyType + refs_of_tys s pd.Args + refs_of_custom_attrs s pd.CustomAttrs -and refsOfILEventDefs s (x: ILEventDefs) = - List.iter (refsOfILEventDef s) (x.AsList()) +and refs_of_properties s (x: ILPropertyDefs) = + List.iter (refs_of_property_def s) (x.AsList()) -and refsOfILPropertyDef s (pd: ILPropertyDef) = - Option.iter (refsOfILMethodRef s) pd.SetMethod - Option.iter (refsOfILMethodRef s) pd.GetMethod - refsOfILType s pd.PropertyType - refsOfILTypes s pd.Args - refsOfILCustomAttrs s pd.CustomAttrs +and refs_of_fdef s (fd: ILFieldDef) = + refs_of_typ s fd.FieldType + refs_of_custom_attrs s fd.CustomAttrs -and refsOfILPropertyDefs s (x: ILPropertyDefs) = - List.iter (refsOfILPropertyDef s) (x.AsList()) +and refs_of_fields s fields = + List.iter (refs_of_fdef s) fields -and refsOfILFieldDef s (fd: ILFieldDef) = - refsOfILType s fd.FieldType - refsOfILCustomAttrs s fd.CustomAttrs +and refs_of_method_impls s mimpls = + List.iter (refs_of_method_impl s) mimpls -and refsOfILFieldDefs s fields = - List.iter (refsOfILFieldDef s) fields +and refs_of_method_impl s m = + refs_of_ospec s m.Overrides + refs_of_mspec s m.OverrideBy -and refsOfILMethodImpls s mimpls = - List.iter (refsOfILMethodImpl s) mimpls +and refs_of_tdef_kind _s _k = () -and refsOfILMethodImpl s m = - refsOfILOverridesSpec s m.Overrides - refsOfILMethodSpec s m.OverrideBy +and refs_of_tdef s (td : ILTypeDef) = + refs_of_types s td.NestedTypes + refs_of_genparams s td.GenericParams + refs_of_tys s td.Implements + Option.iter (refs_of_typ s) td.Extends + refs_of_mdefs s td.Methods + refs_of_fields s (td.Fields.AsList()) + refs_of_method_impls s (td.MethodImpls.AsList()) + refs_of_events s td.Events + refs_of_tdef_kind s td + refs_of_custom_attrs s td.CustomAttrs + refs_of_properties s td.Properties -and refsOfILTypeDef s (td : ILTypeDef) = - refsOfILTypeDefs s td.NestedTypes - refsOfILGenericParams s td.GenericParams - refsOfILTypes s td.Implements - Option.iter (refsOfILType s) td.Extends - refsOfILMethodDefs s td.Methods - refsOfILFieldDefs s (td.Fields.AsList()) - refsOfILMethodImpls s (td.MethodImpls.AsList()) - refsOfILEventDefs s td.Events - refsOfILCustomAttrs s td.CustomAttrs - refsOfILPropertyDefs s td.Properties +and refs_of_string _s _ = () -and refsOfILTypeDefs s (types: ILTypeDefs) = Seq.iter (refsOfILTypeDef s) types +and refs_of_types s (types: ILTypeDefs) = Seq.iter (refs_of_tdef s) types -and refsOfILExportedType s (c: ILExportedTypeOrForwarder) = - refsOfILCustomAttrs s c.CustomAttrs +and refs_of_exported_type s (c: ILExportedTypeOrForwarder) = + refs_of_custom_attrs s c.CustomAttrs -and refsOfILExportedTypes s (tab: ILExportedTypesAndForwarders) = - List.iter (refsOfILExportedType s) (tab.AsList()) +and refs_of_exported_types s (tab: ILExportedTypesAndForwarders) = + List.iter (refs_of_exported_type s) (tab.AsList()) -and refsOfILResourceLocation s x = +and refs_of_resource_where s x = match x with | ILResourceLocation.Local _ -> () - | ILResourceLocation.File (mref, _) -> refsOfILModuleRef s mref - | ILResourceLocation.Assembly aref -> refsOfILAssemblyRef s aref + | ILResourceLocation.File (mref, _) -> refs_of_modref s mref + | ILResourceLocation.Assembly aref -> refs_of_assemblyRef s aref -and refsOfILResource s x = - refsOfILResourceLocation s x.Location - refsOfILCustomAttrs s x.CustomAttrs +and refs_of_resource s x = + refs_of_resource_where s x.Location + refs_of_custom_attrs s x.CustomAttrs -and refsOfILResources s (tab: ILResources) = - List.iter (refsOfILResource s) (tab.AsList()) +and refs_of_resources s (tab: ILResources) = + List.iter (refs_of_resource s) (tab.AsList()) -and refsOfILModule s m = - refsOfILTypeDefs s m.TypeDefs - refsOfILResources s m.Resources - refsOfILCustomAttrs s m.CustomAttrs - Option.iter (refsOfILManifest s) m.Manifest +and refs_of_modul s m = + refs_of_types s m.TypeDefs + refs_of_resources s m.Resources + refs_of_custom_attrs s m.CustomAttrs + Option.iter (refs_of_manifest s) m.Manifest -and refsOfILManifest s (m: ILAssemblyManifest) = - refsOfILCustomAttrs s m.CustomAttrs - refsOfILExportedTypes s m.ExportedTypes +and refs_of_manifest s (m: ILAssemblyManifest) = + refs_of_custom_attrs s m.CustomAttrs + refs_of_exported_types s m.ExportedTypes let computeILRefs ilg modul = let s = @@ -4443,7 +4442,7 @@ let computeILRefs ilg modul = refsMs = HashSet<_>(HashIdentity.Structural) refsFs = HashSet<_>(HashIdentity.Structural) } - refsOfILModule s modul + refs_of_modul s modul { AssemblyReferences = s.refsA.ToArray() ModuleReferences = s.refsM.ToArray() TypeReferences = s.refsTs.ToArray() diff --git a/src/fsharp/absil/il.fsi b/src/fsharp/absil/il.fsi index c3d784a77e5..e8dba23f758 100644 --- a/src/fsharp/absil/il.fsi +++ b/src/fsharp/absil/il.fsi @@ -753,7 +753,7 @@ type internal ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } -type internal ILLocals = ILLocal list +type internal ILLocals = list /// Defines an opened namespace, type relevant to a code location. /// diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index ac837cd6a81..7fce4b83fcc 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -393,7 +393,7 @@ module List = loop [] l let order (eltOrder: IComparer<'T>) = - { new IComparer<'T list> with + { new IComparer> with member _.Compare(xs, ys) = let rec loop xs ys = match xs, ys with diff --git a/src/fsharp/absil/ilmorph.fs b/src/fsharp/absil/ilmorph.fs index 9ddcdf7df89..f26844c6e92 100644 --- a/src/fsharp/absil/ilmorph.fs +++ b/src/fsharp/absil/ilmorph.fs @@ -25,7 +25,7 @@ let code_instr2instrs f (code: ILCode) = let mutable nw = 0 for instr in instrs do adjust[old] <- nw - let instrs : _ list = f instr + let instrs : list<_> = f instr for instr2 in instrs do codebuf.Add instr2 nw <- nw + 1 diff --git a/src/fsharp/absil/ilread.fs b/src/fsharp/absil/ilread.fs index 32ad2e8ca88..6f2ff19cef2 100644 --- a/src/fsharp/absil/ilread.fs +++ b/src/fsharp/absil/ilread.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.BinaryConstants open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Support -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open System.Reflection diff --git a/src/fsharp/absil/ilreflect.fs b/src/fsharp/absil/ilreflect.fs index 35339c31abf..0710fb71442 100644 --- a/src/fsharp/absil/ilreflect.fs +++ b/src/fsharp/absil/ilreflect.fs @@ -13,7 +13,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open FSharp.Core.Printf @@ -718,7 +718,7 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = // we should reject methods which don't satisfy parameter types by also checking // type parameters which can be contravariant for delegates for example - // see https://github.com/dotnet/fsharp/issues/2411 + // see https://github.com/Microsoft/visualfsharp/issues/2411 // without this check, subsequent call to convTypes would fail because it // constructs generic type without checking constraints if not (satisfiesAllParameters mrefParameterTypes haveArgTs) then false else diff --git a/src/fsharp/absil/ilwrite.fs b/src/fsharp/absil/ilwrite.fs index b0e77e253f7..8ea0727798f 100644 --- a/src/fsharp/absil/ilwrite.fs +++ b/src/fsharp/absil/ilwrite.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.Support open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.StrongNameSign open FSharp.Compiler.AbstractIL.ILPdbWriter -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index a6a5bb8afb0..5f809518f4f 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -16,7 +16,7 @@ open Internal.Utilities open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Support open Internal.Utilities.Library -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range diff --git a/src/fsharp/LowerLocalMutables.fs b/src/fsharp/autobox.fs similarity index 98% rename from src/fsharp/LowerLocalMutables.fs rename to src/fsharp/autobox.fs index 08b46d70727..84a2756d6d5 100644 --- a/src/fsharp/LowerLocalMutables.fs +++ b/src/fsharp/autobox.fs @@ -1,11 +1,11 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerLocalMutables +module internal FSharp.Compiler.AutoBox open Internal.Utilities.Collections open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps @@ -21,7 +21,7 @@ type cenv = { g: TcGlobals amap: Import.ImportMap } - override _.ToString() = "" + override x.ToString() = "" /// Find all the mutable locals that escape a method, function or lambda expression let DecideEscapes syntacticArgs body = diff --git a/src/fsharp/LowerLocalMutables.fsi b/src/fsharp/autobox.fsi similarity index 88% rename from src/fsharp/LowerLocalMutables.fsi rename to src/fsharp/autobox.fsi index 614bdda7164..1c2f32b13a6 100644 --- a/src/fsharp/LowerLocalMutables.fsi +++ b/src/fsharp/autobox.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerLocalMutables +module internal FSharp.Compiler.AutoBox open FSharp.Compiler.Import open FSharp.Compiler.TcGlobals diff --git a/src/fsharp/ImmutableArray.fs b/src/fsharp/block.fs similarity index 74% rename from src/fsharp/ImmutableArray.fs rename to src/fsharp/block.fs index d2c4f424615..91cec44bd12 100644 --- a/src/fsharp/ImmutableArray.fs +++ b/src/fsharp/block.fs @@ -2,19 +2,22 @@ module Internal.Utilities.Library.Block open System.Collections.Immutable +type block<'T> = ImmutableArray<'T> +type blockbuilder<'T> = ImmutableArray<'T>.Builder + [] -module ImmutableArrayBuilder = +module BlockBuilder = - let create size : ImmutableArray<'T>.Builder = + let create size : blockbuilder<'T> = ImmutableArray.CreateBuilder(size) [] -module ImmutableArray = +module Block = [] let empty<'T> = ImmutableArray<'T>.Empty - let init n (f: int -> 'T) : ImmutableArray<_> = + let init n (f: int -> 'T) : block<_> = match n with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(f 0) @@ -27,29 +30,29 @@ module ImmutableArray = builder.Add(f i) builder.MoveToImmutable() - let iter f (arr: ImmutableArray<'T>) = + let iter f (arr: block<'T>) = for i = 0 to arr.Length - 1 do f arr[i] - let iteri f (arr: ImmutableArray<'T>) = + let iteri f (arr: block<'T>) = for i = 0 to arr.Length - 1 do f i arr[i] - let iter2 f (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = + let iter2 f (arr1: block<'T1>) (arr2: block<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." for i = 0 to arr1.Length - 1 do f arr1[i] arr2[i] - let iteri2 f (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = + let iteri2 f (arr1: block<'T1>) (arr2: block<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." for i = 0 to arr1.Length - 1 do f i arr1[i] arr2[i] - let map (mapper: 'T -> 'U) (arr: ImmutableArray<'T>) : ImmutableArray<_> = + let map (mapper: 'T -> 'U) (arr: block<'T>) : block<_> = match arr.Length with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper arr[0]) @@ -59,7 +62,7 @@ module ImmutableArray = builder.Add(mapper arr[i]) builder.MoveToImmutable() - let mapi (mapper: int -> 'T -> 'U) (arr: ImmutableArray<'T>) : ImmutableArray<_> = + let mapi (mapper: int -> 'T -> 'U) (arr: block<'T>) : block<_> = match arr.Length with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper 0 arr[0]) @@ -69,7 +72,7 @@ module ImmutableArray = builder.Add(mapper i arr[i]) builder.MoveToImmutable() - let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) : ImmutableArray<_> = + let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -82,7 +85,7 @@ module ImmutableArray = builder.Add(mapper arr1[i] arr2[i]) builder.MoveToImmutable() - let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) : ImmutableArray<_> = + let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -95,7 +98,7 @@ module ImmutableArray = builder.Add(mapper i arr1[i] arr2[i]) builder.MoveToImmutable() - let concat (arrs: ImmutableArray>) : ImmutableArray<'T> = + let concat (arrs: block>) : block<'T> = match arrs.Length with | 0 -> ImmutableArray.Empty | 1 -> arrs[0] @@ -110,12 +113,12 @@ module ImmutableArray = builder.AddRange(arrs[i]) builder.MoveToImmutable() - let forall predicate (arr: ImmutableArray<'T>) = + let forall predicate (arr: block<'T>) = let len = arr.Length let rec loop i = i >= len || (predicate arr[i] && loop (i+1)) loop 0 - let forall2 predicate (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = + let forall2 predicate (arr1: block<'T1>) (arr2: block<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -124,18 +127,18 @@ module ImmutableArray = let rec loop i = i >= len1 || (f.Invoke(arr1[i], arr2[i]) && loop (i+1)) loop 0 - let tryFind predicate (arr: ImmutableArray<'T>) = + let tryFind predicate (arr: block<'T>) = let rec loop i = if i >= arr.Length then None else if predicate arr[i] then Some arr[i] else loop (i+1) loop 0 - let tryFindIndex predicate (arr: ImmutableArray<'T>) = + let tryFindIndex predicate (arr: block<'T>) = let len = arr.Length let rec go n = if n >= len then None elif predicate arr[n] then Some n else go (n+1) go 0 - let tryPick chooser (arr: ImmutableArray<'T>) = + let tryPick chooser (arr: block<'T>) = let rec loop i = if i >= arr.Length then None else match chooser arr[i] with @@ -146,13 +149,13 @@ module ImmutableArray = let ofSeq (xs: 'T seq) = ImmutableArray.CreateRange(xs) - let append (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T1>) : ImmutableArray<_> = + let append (arr1: block<'T1>) (arr2: block<'T1>) : block<_> = arr1.AddRange(arr2) - let createOne (item: 'T) : ImmutableArray<_> = + let createOne (item: 'T) : block<_> = ImmutableArray.Create(item) - let filter predicate (arr: ImmutableArray<'T>) : ImmutableArray<'T> = + let filter predicate (arr: block<'T>) : block<'T> = let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do if predicate arr[i] then @@ -160,12 +163,12 @@ module ImmutableArray = builder.Capacity <- builder.Count builder.MoveToImmutable() - let exists predicate (arr: ImmutableArray<'T>) = + let exists predicate (arr: block<'T>) = let len = arr.Length let rec loop i = i < len && (predicate arr[i] || loop (i+1)) len > 0 && loop 0 - let choose (chooser: 'T -> 'U option) (arr: ImmutableArray<'T>) : ImmutableArray<'U> = + let choose (chooser: 'T -> 'U option) (arr: block<'T>) : block<'U> = let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do let result = chooser arr[i] @@ -174,9 +177,9 @@ module ImmutableArray = builder.Capacity <- builder.Count builder.MoveToImmutable() - let isEmpty (arr: ImmutableArray<_>) = arr.IsEmpty + let isEmpty (arr: block<_>) = arr.IsEmpty - let fold folder state (arr: ImmutableArray<_>) = + let fold folder state (arr: block<_>) = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) let mutable state = state for i = 0 to arr.Length - 1 do diff --git a/src/fsharp/block.fsi b/src/fsharp/block.fsi new file mode 100644 index 00000000000..13f53ee479b --- /dev/null +++ b/src/fsharp/block.fsi @@ -0,0 +1,63 @@ +[] +module internal Internal.Utilities.Library.Block + +open System.Collections.Immutable + +/// Type alias for System.Collections.Immutable.ImmutableArray<'T> +type block<'T> = ImmutableArray<'T> + +/// Type alias for System.Collections.Immutable.ImmutableArray<'T>.Builder +type blockbuilder<'T> = ImmutableArray<'T>.Builder + +[] +module BlockBuilder = + + val create: size: int -> blockbuilder<'T> + +[] +module Block = + + [] + val empty<'T> : block<'T> + + val init: n: int -> f: (int -> 'T) -> block<'T> + + val iter: f: ('T -> unit) -> block<'T> -> unit + + val iteri: f: (int -> 'T -> unit) -> block<'T> -> unit + + val iter2: f: ('T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit + + val iteri2: f: (int -> 'T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit + + val map: mapper: ('T1 -> 'T2) -> block<'T1> -> block<'T2> + + val mapi: mapper: (int -> 'T1 -> 'T2) -> block<'T1> -> block<'T2> + + val concat: block> -> block<'T> + + val forall: predicate: ('T -> bool) -> block<'T> -> bool + + val forall2: predicate: ('T1 -> 'T2 -> bool) -> block<'T1> -> block<'T2> -> bool + + val tryFind: predicate: ('T -> bool) -> block<'T> -> 'T option + + val tryFindIndex: predicate: ('T -> bool) -> block<'T> -> int option + + val tryPick: chooser: ('T1 -> 'T2 option) -> block<'T1> -> 'T2 option + + val ofSeq: seq<'T> -> block<'T> + + val append: block<'T> -> block<'T> -> block<'T> + + val createOne: 'T -> block<'T> + + val filter: predicate: ('T -> bool) -> block<'T> -> block<'T> + + val exists: predicate: ('T -> bool) -> block<'T> -> bool + + val choose: chooser: ('T -> 'U option) -> block<'T> -> block<'U> + + val isEmpty: block<'T> -> bool + + val fold: folder: ('State -> 'T -> 'State) -> 'State -> block<'T> -> 'State diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index c18802e084a..719394dcd26 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -39,7 +39,7 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader open FSharp.Compiler.IO @@ -62,8 +62,8 @@ open FSharp.Compiler.BuildGraph /// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached [] -type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameForDebugging) = - inherit DiagnosticsLogger(nameForDebugging) +type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameForDebugging) = + inherit ErrorLogger(nameForDebugging) let mutable errors = 0 @@ -73,76 +73,110 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit - override _.ErrorCount = errors + override x.ErrorCount = errors - override x.DiagnosticSink(phasedError, severity) = - if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (phasedError, severity) then + override x.DiagnosticSink(err, severity) = + if ReportDiagnosticAsError tcConfigB.errorSeverityOptions (err, severity) then if errors >= tcConfigB.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) exiter.Exit 1 - x.HandleIssue(tcConfigB, phasedError, FSharpDiagnosticSeverity.Error) + x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Error) errors <- errors + 1 - match phasedError.Exception, tcConfigB.simulateException with + match err.Exception, tcConfigB.simulateException with | InternalError (msg, _), None - | Failure msg, None -> Debug.Assert(false, sprintf "Bug in compiler: %s\n%s" msg (phasedError.Exception.ToString())) - | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (phasedError.Exception.ToString())) + | Failure msg, None -> Debug.Assert(false, sprintf "Bug in compiler: %s\n%s" msg (err.Exception.ToString())) + | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (err.Exception.ToString())) | _ -> () - elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (phasedError, severity) then - x.HandleIssue(tcConfigB, phasedError, FSharpDiagnosticSeverity.Warning) + elif ReportDiagnosticAsWarning tcConfigB.errorSeverityOptions (err, severity) then + x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (phasedError, severity) then - x.HandleIssue(tcConfigB, phasedError, severity) + elif ReportDiagnosticAsInfo tcConfigB.errorSeverityOptions (err, severity) then + x.HandleIssue(tcConfigB, err, severity) /// Create an error logger that counts and prints errors -let ConsoleDiagnosticsLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter) = - { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleDiagnosticsLoggerUpToMaxErrors") with +let ConsoleErrorLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter) = + { new ErrorLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleErrorLoggerUpToMaxErrors") with member _.HandleTooManyErrors(text : string) = DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> Printf.eprintfn "%s" text) member _.HandleIssue(tcConfigB, err, severity) = DoWithDiagnosticColor severity (fun () -> - let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.diagnosticStyle, severity) + let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.errorStyle, severity) writeViaBuffer stderr diag err stderr.WriteLine()) - } :> DiagnosticsLogger + } :> ErrorLogger /// This error logger delays the messages it receives. At the end, call ForwardDelayedDiagnostics /// to send the held messages. -type DelayAndForwardDiagnosticsLogger(exiter: Exiter, errorLoggerProvider: DiagnosticsLoggerProvider) = - inherit CapturingDiagnosticsLogger("DelayAndForwardDiagnosticsLogger") +type DelayAndForwardErrorLogger(exiter: Exiter, errorLoggerProvider: ErrorLoggerProvider) = + inherit CapturingErrorLogger("DelayAndForwardErrorLogger") member x.ForwardDelayedDiagnostics(tcConfigB: TcConfigBuilder) = - let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) x.CommitDelayedDiagnostics errorLogger and [] - DiagnosticsLoggerProvider() = + ErrorLoggerProvider() = - member this.CreateDelayAndForwardLogger exiter = DelayAndForwardDiagnosticsLogger(exiter, this) + member this.CreateDelayAndForwardLogger exiter = DelayAndForwardErrorLogger(exiter, this) - abstract CreateDiagnosticsLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> DiagnosticsLogger + abstract CreateErrorLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> ErrorLogger -/// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum +/// Part of LegacyHostedCompilerForTesting +/// +/// Yet another ErrorLogger implementation, capturing the messages but only up to the maxerrors maximum +type InProcErrorLoggerProvider() = + let errors = ResizeArray() + let warnings = ResizeArray() + + member _.Provider = + { new ErrorLoggerProvider() with + + member log.CreateErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + + { new ErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerErrorLoggerUpToMaxErrors") with + + member this.HandleTooManyErrors text = + warnings.Add(Diagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) + + member this.HandleIssue(tcConfigBuilder, err, severity) = + // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf + let diagnostics = + CollectDiagnostic + (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, + tcConfigBuilder.flatErrors, tcConfigBuilder.errorStyle, severity, err, true) + match severity with + | FSharpDiagnosticSeverity.Error -> + errors.AddRange(diagnostics) + | FSharpDiagnosticSeverity.Warning -> + warnings.AddRange(diagnostics) + | _ -> ()} + :> ErrorLogger } + + member _.CapturedErrors = errors.ToArray() + + member _.CapturedWarnings = warnings.ToArray() + +/// The default ErrorLogger implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider() = - inherit DiagnosticsLoggerProvider() + inherit ErrorLoggerProvider() - override _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = - ConsoleDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) + override this.CreateErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) = ConsoleErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) /// Notify the exiter if any error has occurred -let AbortOnError (errorLogger: DiagnosticsLogger, exiter : Exiter) = +let AbortOnError (errorLogger: ErrorLogger, exiter : Exiter) = if errorLogger.ErrorCount > 0 then exiter.Exit 1 -let TypeCheck (ctok, tcConfig, tcImports, tcGlobals, errorLogger: DiagnosticsLogger, assemblyName, niceNameGen, tcEnv0, openDecls0, inputs, exiter: Exiter) = +let TypeCheck (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, assemblyName, niceNameGen, tcEnv0, openDecls0, inputs, exiter: Exiter) = try if isNil inputs then error(Error(FSComp.SR.fscNoImplementationFiles(), rangeStartup)) let ccuName = assemblyName @@ -382,7 +416,7 @@ type Args<'T> = Args of 'T /// - Check the inputs let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, reduceMemoryUsage: ReduceMemoryFlag, defaultCopyFSharpCore: CopyFSharpCoreFlag, - exiter: Exiter, errorLoggerProvider: DiagnosticsLoggerProvider, disposables: DisposablesTracker) = + exiter: Exiter, errorLoggerProvider: ErrorLoggerProvider, disposables: DisposablesTracker) = // See Bug 735819 let lcidFromCodePage = @@ -420,7 +454,7 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) + let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) // Share intern'd strings across all lexing/parsing let lexResourceManager = Lexhelp.LexResourceManager() @@ -469,10 +503,10 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 - let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics errorLogger @@ -498,9 +532,9 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, ReportTime tcConfig "Parse inputs" use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - let createDiagnosticsLogger = (fun exiter -> errorLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) + let createErrorLogger = (fun exiter -> errorLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingErrorLogger) - let inputs = ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, errorLogger, exiter, createDiagnosticsLogger, (*retryLocked*)false) + let inputs = ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, errorLogger, exiter, createErrorLogger, (*retryLocked*)false) let inputs, _ = (Map.empty, inputs) ||> List.mapFold (fun state (input, x) -> @@ -566,7 +600,7 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outfile, pdbFile, dllReferences, noframework, exiter: Exiter, - errorLoggerProvider: DiagnosticsLoggerProvider, + errorLoggerProvider: ErrorLoggerProvider, disposables: DisposablesTracker, inputs: ParsedInput list) = @@ -612,7 +646,7 @@ let main1OfAst // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) + let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines @@ -628,10 +662,10 @@ let main1OfAst exiter.Exit 1 let dependencyProvider = new DependencyProvider() - let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics errorLogger @@ -697,9 +731,9 @@ let main2(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener let oldLogger = errorLogger let errorLogger = let scopedPragmas = [ for TImplFile (pragmas=pragmas) in typedImplFiles do yield! pragmas ] - GetDiagnosticsLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.diagnosticsOptions, oldLogger) + GetErrorLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.errorSeverityOptions, oldLogger) - let _unwindEL_3 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) + let _unwindEL_3 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) // Try to find an AssemblyVersion attribute let assemVerFromAttrib = @@ -736,7 +770,7 @@ let main2(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener /// - optimize /// - encode optimization data let main3(Args (ctok, tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, - errorLogger: DiagnosticsLogger, generatedCcu: CcuThunk, outfile, typedImplFiles, + errorLogger: ErrorLogger, generatedCcu: CcuThunk, outfile, typedImplFiles, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter: Exiter)) = // Encode the signature data @@ -835,7 +869,7 @@ let main4 /// Fifth phase of compilation. /// - static linking -let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: DiagnosticsLogger, staticLinker, outfile, pdbfile, ilxMainModule, signingInfo, exiter: Exiter)) = +let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, staticLinker, outfile, pdbfile, ilxMainModule, signingInfo, exiter: Exiter)) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output @@ -854,7 +888,7 @@ let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: DiagnosticsLo /// Sixth phase of compilation. /// - write the binaries let main6 dynamicAssemblyCreator (Args (ctok, tcConfig, tcImports: TcImports, tcGlobals: TcGlobals, - errorLogger: DiagnosticsLogger, ilxMainModule, outfile, pdbfile, + errorLogger: ErrorLogger, ilxMainModule, outfile, pdbfile, signingInfo, exiter: Exiter)) = ReportTime tcConfig "Write .NET Binary" @@ -956,13 +990,13 @@ let main6 dynamicAssemblyCreator (Args (ctok, tcConfig, tcImports: TcImports, t ReportTime tcConfig "Exiting" /// The main (non-incremental) compilation entry point used by fsc.exe -let CompileFromCommandLineArguments +let mainCompile (ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, reduceMemoryUsage, defaultCopyFSharpCore, exiter: Exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) = use disposables = new DisposablesTracker() let savedOut = Console.Out - use _ = + use __ = { new IDisposable with member _.Dispose() = try @@ -977,7 +1011,7 @@ let CompileFromCommandLineArguments |> main6 dynamicAssemblyCreator /// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -let CompileFromSyntaxTrees +let compileOfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, targetDll, targetPdb, dependencies, noframework, exiter, loggerProvider, inputs, tcImportsCapture, dynamicAssemblyCreator) = diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 8a8ba8e91bc..51593c20689 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -6,45 +6,25 @@ open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig -open FSharp.Compiler.Diagnostics +open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals [] -type DiagnosticsLoggerProvider = - new: unit -> DiagnosticsLoggerProvider - abstract CreateDiagnosticsLoggerUpToMaxErrors: - tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger +type ErrorLoggerProvider = + new: unit -> ErrorLoggerProvider + abstract CreateErrorLoggerUpToMaxErrors: tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> ErrorLogger -/// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum +/// The default ErrorLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider - inherit DiagnosticsLoggerProvider - -/// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached -/// -/// Used only in LegacyHostedCompilerForTesting -[] -type DiagnosticsLoggerUpToMaxErrors = - inherit DiagnosticsLogger - new: tcConfigB: TcConfigBuilder * exiter: Exiter * nameForDebugging: string -> DiagnosticsLoggerUpToMaxErrors - - /// Called when an error or warning occurs - abstract HandleIssue: - tcConfigB: TcConfigBuilder * error: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - - /// Called when 'too many errors' has occurred - abstract HandleTooManyErrors: text: string -> unit - - override ErrorCount: int - - override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + inherit ErrorLoggerProvider /// The main (non-incremental) compilation entry point used by fsc.exe -val CompileFromCommandLineArguments: +val mainCompile: ctok: CompilationThreadToken * argv: string [] * legacyReferenceResolver: LegacyReferenceResolver * @@ -52,13 +32,13 @@ val CompileFromCommandLineArguments: reduceMemoryUsage: ReduceMemoryFlag * defaultCopyFSharpCore: CopyFSharpCoreFlag * exiter: Exiter * - loggerProvider: DiagnosticsLoggerProvider * + loggerProvider: ErrorLoggerProvider * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit /// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -val CompileFromSyntaxTrees: +val compileOfAst: ctok: CompilationThreadToken * legacyReferenceResolver: LegacyReferenceResolver * reduceMemoryUsage: ReduceMemoryFlag * @@ -69,8 +49,15 @@ val CompileFromSyntaxTrees: dependencies: string list * noframework: bool * exiter: Exiter * - loggerProvider: DiagnosticsLoggerProvider * + loggerProvider: ErrorLoggerProvider * inputs: ParsedInput list * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit + +/// Part of LegacyHostedCompilerForTesting +type InProcErrorLoggerProvider = + new: unit -> InProcErrorLoggerProvider + member Provider: ErrorLoggerProvider + member CapturedWarnings: Diagnostic [] + member CapturedErrors: Diagnostic [] diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index b75934ac783..42458640fd6 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Driver -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Text @@ -73,7 +73,7 @@ let main(argv) = // has been reached (e.g. type checking failed, so don't proceed to optimization). let quitProcessExiter = { new Exiter with - member _.Exit(n) = + member x.Exit(n) = try exit n with _ -> @@ -95,7 +95,7 @@ let main(argv) = // thus we can use file-locking memory mapped files. // // This is also one of only two places where CopyFSharpCoreFlag.Yes is set. The other is in LegacyHostedCompilerForTesting. - CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) + mainCompile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) 0 with e -> diff --git a/src/fsharp/fsi/console.fs b/src/fsharp/fsi/console.fs index d49807d944e..a828326910f 100644 --- a/src/fsharp/fsi/console.fs +++ b/src/fsharp/fsi/console.fs @@ -59,7 +59,7 @@ module internal Utils = let guard(f) = try f() with e -> - FSharp.Compiler.DiagnosticsLogger.warning(Failure(sprintf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace)) + FSharp.Compiler.ErrorLogger.warning(Failure(sprintf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace)) let rec previousWordFromIdx (line: string) (idx, isInWord) = if idx < 0 then 0 else diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 52bdb119f83..b3b8c160be8 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -44,7 +44,7 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader @@ -729,9 +729,9 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) = ignoreAllErrors (fun () -> let severity = FSharpDiagnosticSeverity.Error DoWithDiagnosticColor severity (fun () -> - errorWriter.WriteLine() - writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err - writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.diagnosticStyle,severity)) err + errorWriter.WriteLine(); + writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err; + writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.errorStyle,severity)) err; errorWriter.WriteLine() errorWriter.WriteLine() errorWriter.Flush())) @@ -762,9 +762,9 @@ type internal FsiConsoleOutput(tcConfigB, outWriter:TextWriter, errorWriter:Text member _.Error = errorWriter -/// This DiagnosticsLogger reports all warnings, but raises StopProcessing on first error or early exit -type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStdinSyphon:FsiStdinSyphon, fsiConsoleOutput: FsiConsoleOutput) = - inherit DiagnosticsLogger("DiagnosticsLoggerThatStopsOnFirstError") +/// This ErrorLogger reports all warnings, but raises StopProcessing on first error or early exit +type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStdinSyphon:FsiStdinSyphon, fsiConsoleOutput: FsiConsoleOutput) = + inherit ErrorLogger("ErrorLoggerThatStopsOnFirstError") let mutable errorCount = 0 member _.SetError() = @@ -773,32 +773,32 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, member _.ResetErrorCount() = errorCount <- 0 override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (err, severity) then + if ReportDiagnosticAsError tcConfigB.errorSeverityOptions (err, severity) then fsiStdinSyphon.PrintError(tcConfigB,err) errorCount <- errorCount + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) raise StopProcessing - elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (err, severity) then + elif ReportDiagnosticAsWarning tcConfigB.errorSeverityOptions (err, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err + writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,severity)) err fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (err, severity) then + elif ReportDiagnosticAsInfo tcConfigB.errorSeverityOptions (err, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Info (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err + writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,severity)) err fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) override x.ErrorCount = errorCount -type DiagnosticsLogger with +type ErrorLogger with member x.CheckForErrors() = (x.ErrorCount > 0) /// A helper function to check if its time to abort member x.AbortOnError(fsiConsoleOutput:FsiConsoleOutput) = @@ -1091,7 +1091,7 @@ let internal SetCurrentUICultureForThread (lcid : int option) = let internal InstallErrorLoggingOnThisThread errorLogger = if progress then dprintfn "Installing logger on id=%d name=%s" Thread.CurrentThread.ManagedThreadId Thread.CurrentThread.Name - SetThreadDiagnosticsLoggerNoUnwind(errorLogger) + SetThreadErrorLoggerNoUnwind(errorLogger) SetThreadBuildPhaseNoUnwind(BuildPhase.Interactive) /// Set the input/output encoding. The use of a thread is due to a known bug on @@ -1496,7 +1496,7 @@ type internal FsiDynamicCompiler( execs // Emit the codegen results using the assembly writer - let ProcessCodegenResults (ctok, errorLogger: DiagnosticsLogger, istate, optEnv, tcState: TcState, tcConfig, prefixPath, showTypes: bool, isIncrementalFragment, fragName, declaredImpls, ilxGenerator: IlxAssemblyGenerator, codegenResults, m) = + let ProcessCodegenResults (ctok, errorLogger: ErrorLogger, istate, optEnv, tcState: TcState, tcConfig, prefixPath, showTypes: bool, isIncrementalFragment, fragName, declaredImpls, ilxGenerator: IlxAssemblyGenerator, codegenResults, m) = let emEnv = istate.emEnv // Each input is like a small separately compiled extension to a single source file. @@ -1576,7 +1576,7 @@ type internal FsiDynamicCompiler( match exec() with | Some err -> match errorLogger with - | :? DiagnosticsLoggerThatStopsOnFirstError as errorLogger -> + | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> fprintfn fsiConsoleOutput.Error "%s" (err.ToString()) errorLogger.SetError() errorLogger.AbortOnError(fsiConsoleOutput) @@ -1621,7 +1621,7 @@ type internal FsiDynamicCompiler( // Return the new state and the environment at the end of the last input, ready for further inputs. (istate,declaredImpls) - let ProcessTypedImpl (errorLogger: DiagnosticsLogger, optEnv, tcState: TcState, tcConfig: TcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator: IlxAssemblyGenerator) = + let ProcessTypedImpl (errorLogger: ErrorLogger, optEnv, tcState: TcState, tcConfig: TcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator: IlxAssemblyGenerator) = #if DEBUG // Logging/debugging if tcConfig.printAst then @@ -1643,7 +1643,7 @@ type internal FsiDynamicCompiler( errorLogger.AbortOnError(fsiConsoleOutput) codegenResults, optEnv, fragName - let ProcessInputs (ctok, errorLogger: DiagnosticsLogger, istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent, m) = + let ProcessInputs (ctok, errorLogger: ErrorLogger, istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent, m) = let optEnv = istate.optEnv let tcState = istate.tcState let ilxGenerator = istate.ilxGenerator @@ -1801,7 +1801,7 @@ type internal FsiDynamicCompiler( istate /// Evaluate the given definitions and produce a new interactive state. - member _.EvalParsedDefinitions (ctok, errorLogger: DiagnosticsLogger, istate, showTypes, isInteractiveItExpr, defs: SynModuleDecl list) = + member _.EvalParsedDefinitions (ctok, errorLogger: ErrorLogger, istate, showTypes, isInteractiveItExpr, defs: SynModuleDecl list) = let fileName = stdinMockFileName let i = nextFragmentId() let m = match defs with [] -> rangeStdin0 | _ -> List.reduce unionRanges [for d in defs -> d.Range] @@ -1818,7 +1818,7 @@ type internal FsiDynamicCompiler( processContents newState declaredImpls /// Evaluate the given expression and produce a new interactive state. - member fsiDynamicCompiler.EvalParsedExpression (ctok, errorLogger: DiagnosticsLogger, istate, expr: SynExpr) = + member fsiDynamicCompiler.EvalParsedExpression (ctok, errorLogger: ErrorLogger, istate, expr: SynExpr) = let tcConfig = TcConfig.Create (tcConfigB, validate=false) let itName = "it" @@ -1986,7 +1986,7 @@ type internal FsiDynamicCompiler( (fun _ _ -> ())) (tcConfigB, inp, Path.GetDirectoryName sourceFile, istate)) - member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, errorLogger: DiagnosticsLogger) = + member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, errorLogger: ErrorLogger) = let tcConfig = TcConfig.Create(tcConfigB,validate=false) match sourceFiles with | [] -> istate @@ -2058,7 +2058,7 @@ type internal FsiDynamicCompiler( | _ -> None - member _.AddBoundValue (ctok, errorLogger: DiagnosticsLogger, istate, name: string, value: obj) = + member _.AddBoundValue (ctok, errorLogger: ErrorLogger, istate, name: string, value: obj) = try match value with | null -> nullArg "value" @@ -2503,7 +2503,7 @@ type FsiStdinLexerProvider CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) // Create a new lexer to read a string - member _.CreateStringLexer (sourceFileName, source, errorLogger) = + member this.CreateStringLexer (sourceFileName, source, errorLogger) = let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, source) CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) @@ -2552,11 +2552,11 @@ type FsiInteractionProcessor with _ -> (istate,Completed None) - let InteractiveCatch (errorLogger: DiagnosticsLogger) (f:_ -> _ * FsiInteractionStepStatus) istate = + let InteractiveCatch (errorLogger: ErrorLogger) (f:_ -> _ * FsiInteractionStepStatus) istate = try // reset error count match errorLogger with - | :? DiagnosticsLoggerThatStopsOnFirstError as errorLogger -> errorLogger.ResetErrorCount() + | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> errorLogger.ResetErrorCount() | _ -> () f istate @@ -2603,7 +2603,7 @@ type FsiInteractionProcessor None /// Execute a single parsed interaction. Called on the GUI/execute/main thread. - let ExecInteraction (ctok, tcConfig:TcConfig, istate, action:ParsedScriptInteraction, errorLogger: DiagnosticsLogger) = + let ExecInteraction (ctok, tcConfig:TcConfig, istate, action:ParsedScriptInteraction, errorLogger: ErrorLogger) = let packageManagerDirective directive path m = let dm = fsiOptions.DependencyProvider.TryFindDependencyManagerInPath(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError m, path) match dm with @@ -2743,7 +2743,7 @@ type FsiInteractionProcessor /// /// #directive comes through with other definitions as a SynModuleDecl.HashDirective. /// We split these out for individual processing. - let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = + let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option, cancellationToken: CancellationToken) = cancellationToken.ThrowIfCancellationRequested() let action,nextAction,istate = match action with @@ -2806,7 +2806,7 @@ type FsiInteractionProcessor /// Execute a single parsed interaction which may contain multiple items to be executed /// independently - let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = + let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option, cancellationToken: CancellationToken) = let istate, completed = execParsedInteractions (ctok, tcConfig, istate, action, errorLogger, lastResult, cancellationToken) match completed with | Completed _ -> @@ -2977,7 +2977,7 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, errorLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) + use _unwind2 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) @@ -2994,7 +2994,7 @@ type FsiInteractionProcessor member _.EvalExpression (ctok, sourceText, scriptFileName, errorLogger) = use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) + use _unwind2 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) @@ -3253,7 +3253,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let fsiStdinSyphon = FsiStdinSyphon(errorWriter) let fsiConsoleOutput = FsiConsoleOutput(tcConfigB, outWriter, errorWriter) - let errorLogger = DiagnosticsLoggerThatStopsOnFirstError(tcConfigB, fsiStdinSyphon, fsiConsoleOutput) + let errorLogger = ErrorLoggerThatStopsOnFirstError(tcConfigB, fsiStdinSyphon, fsiConsoleOutput) do InstallErrorLoggingOnThisThread errorLogger // FSI error logging on main thread. @@ -3368,7 +3368,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Choice2Of2 None -> raise (FsiCompilationException(FSIstrings.SR.fsiOperationFailed(), None)) | Choice2Of2 (Some userExn) -> raise (makeNestedException userExn) - let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationDiagnosticLogger) res = + let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationErrorLogger) res = let errs = errorLogger.GetDiagnostics() let errorInfos = DiagnosticHelpers.CreateDiagnostics (errorOptions, true, scriptFile, errs, true) let userRes = @@ -3504,8 +3504,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions - let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions + let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalExpression(ctok, code, dummyScriptFileName, errorLogger) |> commitResultNonThrowing errorOptions dummyScriptFileName errorLogger @@ -3526,8 +3526,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let ctok = AssumeCompilationThreadWithoutEvidence() let cancellationToken = defaultArg cancellationToken CancellationToken.None - let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions - let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions + let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalInteraction(ctok, code, dummyScriptFileName, errorLogger, cancellationToken) |> commitResultNonThrowing errorOptions "input.fsx" errorLogger @@ -3547,8 +3547,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let errorOptions = TcConfig.Create(tcConfigB, validate = false).diagnosticsOptions - let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB, validate = false).errorSeverityOptions + let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalScript(ctok, filePath, errorLogger) |> commitResultNonThrowing errorOptions filePath errorLogger |> function Choice1Of2 _, errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs diff --git a/src/fsharp/fsi/fsimain.fs b/src/fsharp/fsi/fsimain.fs index f5975dc0282..142c5b8561c 100644 --- a/src/fsharp/fsi/fsimain.fs +++ b/src/fsharp/fsi/fsimain.fs @@ -123,11 +123,11 @@ let StartServer (fsiSession : FsiEvaluationSession) (fsiServerName) = #if FSI_SERVER let server = {new Server.Shared.FSharpInteractiveServer() with - member _.Interrupt() = + member this.Interrupt() = //printf "FSI-SERVER: received CTRL-C request...\n" try fsiSession.Interrupt() - with _ -> + with e -> // Final sanity check! - catch all exns - but not expected assert false () @@ -298,8 +298,8 @@ let evaluateSession(argv: string[]) = fsiSession.Run() 0 with - | FSharp.Compiler.DiagnosticsLogger.StopProcessingExn _ -> 1 - | FSharp.Compiler.DiagnosticsLogger.ReportedError _ -> 1 + | FSharp.Compiler.ErrorLogger.StopProcessingExn _ -> 1 + | FSharp.Compiler.ErrorLogger.ReportedError _ -> 1 | e -> eprintf "Exception by fsi.exe:\n%+A\n" e; 1 // Mark the main thread as STAThread since it is a GUI thread diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index a40ebb591be..157cdc918fd 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -10,7 +10,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Xml @@ -58,12 +58,9 @@ type AssemblyLoader = [] type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) = let typeRefToTyconRefCache = ConcurrentDictionary() - - member _.g = g - - member _.assemblyLoader = assemblyLoader - - member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache + member this.g = g + member this.assemblyLoader = assemblyLoader + member this.ILTypeRefToTyconRefCache = typeRefToTyconRefCache let CanImportILScopeRef (env: ImportMap) m scoref = @@ -643,15 +640,3 @@ let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoad } CcuThunk.Create(nm, ccuData) - -//------------------------------------------------------------------------- -// From IL types to F# types -//------------------------------------------------------------------------- - -/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. -let RescopeAndImportILType scoref amap m importInst ilty = - ilty |> rescopeILType scoref |> ImportILType amap m importInst - -let CanRescopeAndImportILType scoref amap m ilty = - ilty |> rescopeILType scoref |> CanImportILType amap m - diff --git a/src/fsharp/import.fsi b/src/fsharp/import.fsi index acc5869615c..975a9d56a56 100644 --- a/src/fsharp/import.fsi +++ b/src/fsharp/import.fsi @@ -65,10 +65,10 @@ val internal CanImportILType: ImportMap -> range -> ILType -> bool #if !NO_TYPEPROVIDERS /// Import a provided type as an F# type. -val internal ImportProvidedType: ImportMap -> range -> Tainted -> TType +val internal ImportProvidedType: ImportMap -> range (* TType list -> *) -> Tainted -> TType /// Import a provided type reference as an F# type TyconRef -val internal ImportProvidedNamedType: ImportMap -> range -> Tainted -> TyconRef +val internal ImportProvidedNamedType: ImportMap -> range (* TType list -> *) -> Tainted -> TyconRef /// Import a provided type as an AbstractIL type val internal ImportProvidedTypeAsILType: ImportMap -> range -> Tainted -> ILType @@ -97,10 +97,3 @@ val internal ImportILAssembly: /// Import the type forwarder table for an IL assembly val internal ImportILAssemblyTypeForwarders: (unit -> ImportMap) * range * ILExportedTypesAndForwarders -> Map> - -/// Import an IL type as an F# type, first rescoping to view the metadata from the current assembly -/// being compiled. importInst gives the context for interpreting type variables. -val RescopeAndImportILType: - scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType - -val CanRescopeAndImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> ilty: ILType -> bool diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index de977d0681b..c8ba00a3875 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -7,23 +7,423 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger -open FSharp.Compiler.Import +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text +open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint -open FSharp.Compiler.TypeHierarchy -open FSharp.Compiler.Xml #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders #endif +//------------------------------------------------------------------------- +// From IL types to F# types +//------------------------------------------------------------------------- + +/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. +let ImportILType scoref amap m importInst ilty = + ilty |> rescopeILType scoref |> Import.ImportILType amap m importInst + +let CanImportILType scoref amap m ilty = + ilty |> rescopeILType scoref |> Import.CanImportILType amap m + +//------------------------------------------------------------------------- +// Fold the hierarchy. +// REVIEW: this code generalizes the iteration used below for member lookup. +//------------------------------------------------------------------------- + +/// Indicates if an F# type is the type associated with an F# exception declaration +let isExnDeclTy g ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> tcref.IsExceptionDecl + | _ -> false + +/// Get the base type of a type, taking into account type instantiations. Return None if the +/// type has no base type. +let GetSuperTypeOfType g amap m ty = +#if !NO_TYPEPROVIDERS + let ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref when tcref.IsProvided -> stripTyEqns g ty + | _ -> stripTyEqnsAndMeasureEqns g ty +#else + let ty = stripTyEqnsAndMeasureEqns g ty +#endif + + match metadataOfTy g ty with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata info -> + let st = info.ProvidedType + let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) + match superOpt with + | None -> None + | Some super -> Some(Import.ImportProvidedType amap m super) +#endif + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> + let tinst = argsOfAppTy g ty + match tdef.Extends with + | None -> None + | Some ilty -> Some (ImportILType scoref amap m tinst ilty) + + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + if isFSharpObjModelTy g ty || isExnDeclTy g ty then + let tcref = tcrefOfAppTy g ty + Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) + elif isArrayTy g ty then + Some g.system_Array_ty + elif isRefTy g ty && not (isObjTy g ty) then + Some g.obj_ty + elif isStructTupleTy g ty then + Some g.system_Value_ty + elif isFSharpStructOrEnumTy g ty then + if isFSharpEnumTy g ty then + Some g.system_Enum_ty + else + Some g.system_Value_ty + elif isStructAnonRecdTy g ty then + Some g.system_Value_ty + elif isAnonRecdTy g ty then + Some g.obj_ty + elif isRecdTy g ty || isUnionTy g ty then + Some g.obj_ty + else + None + +/// Make a type for System.Collections.Generic.IList +let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = + TType_app(g.tcref_System_Collections_Generic_IList, [ty], g.knownWithoutNull) + +/// Indicates whether we can skip interface types that lie outside the reference set +[] +type SkipUnrefInterfaces = Yes | No + +let GetImmediateInterfacesOfMetadataType g amap m skipUnref ty (tcref: TyconRef) tinst = + [ + match metadataOfTy g ty with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata info -> + for ity in info.ProvidedType.PApplyArray((fun st -> st.GetInterfaces()), "GetInterfaces", m) do + Import.ImportProvidedType amap m ity +#endif + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> + // ImportILType may fail for an interface if the assembly load set is incomplete and the interface + // comes from another assembly. In this case we simply skip the interface: + // if we don't skip it, then compilation will just fail here, and if type checking + // succeeds with fewer non-dereferencable interfaces reported then it would have + // succeeded with more reported. There are pathological corner cases where this + // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always + // assume those are present. + for ity in tdef.Implements do + if skipUnref = SkipUnrefInterfaces.No || CanImportILType scoref amap m ity then + ImportILType scoref amap m tinst ity + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + for ity in tcref.ImmediateInterfaceTypesOfFSharpTycon do + instType (mkInstForAppTy g ty) ity ] + +/// Collect the set of immediate declared interface types for an F# type, but do not +/// traverse the type hierarchy to collect further interfaces. +// +// NOTE: Anonymous record types are not directly considered to implement IComparable, +// IComparable or IEquatable. This is because whether they support these interfaces depend on their +// consitutent types, which may not yet be known in type inference. +let rec GetImmediateInterfacesOfType skipUnref g amap m ty = + [ + match tryAppTy g ty with + | ValueSome(tcref, tinst) -> + // Check if this is a measure-annotated type + match tcref.TypeReprInfo with + | TMeasureableRepr reprTy -> + yield! GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy + | _ -> + yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref ty tcref tinst + + | ValueNone -> + // For tuple types, func types, check if we can eliminate to a type with metadata. + let tyWithMetadata = convertToTypeWithMetadataIfPossible g ty + match tryAppTy g tyWithMetadata with + | ValueSome (tcref, tinst) -> + if isAnyTupleTy g ty then + yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref tyWithMetadata tcref tinst + | _ -> () + + // .NET array types are considered to implement IList + if isArray1DTy g ty then + mkSystemCollectionsGenericIListTy g (destArrayTy g ty) + ] + +// Report the interfaces supported by a measure-annotated type. +// +// For example, consider: +// +// [] +// type A<[] 'm> = A +// +// This measure-annotated type is considered to support the interfaces on its representation type A, +// with the exception that +// +// 1. we rewrite the IComparable and IEquatable interfaces, so that +// IComparable --> IComparable> +// IEquatable --> IEquatable> +// +// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces +// +// This rule is conservative and only applies to IComparable and IEquatable interfaces. +// +// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. +and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = + [ + // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> + for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do + if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m ity) && + not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) then + ity + + // NOTE: we should really only report the IComparable> interface for measure-annotated types + // if the original type supports IComparable somewhere in the hierarchy, likeiwse IEquatable>. + // + // However since F# 2.0 we have always reported these interfaces for all measure-annotated types. + + //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIComparable_tcref [reprTy])) skipUnref g amap m ty then + mkAppTy g.system_GenericIComparable_tcref [ty] + + //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIEquatable_tcref [reprTy])) skipUnref g amap m ty then + mkAppTy g.system_GenericIEquatable_tcref [ty] + ] + +// Check for IComparable, IEquatable and interfaces that derive from these +and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m ity = + ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m ity + +// Check for IComparable, IEquatable and interfaces that derive from these +and ExistsInInterfaceHierarchy p skipUnref g amap m ity = + match ity with + | AppTy g (tcref, tinst) -> + p ity || + (GetImmediateInterfacesOfMetadataType g amap m skipUnref ity tcref tinst + |> List.exists (ExistsInInterfaceHierarchy p skipUnref g amap m)) + | _ -> false + +/// Indicates whether we should visit multiple instantiations of the same generic interface or not +[] +type AllowMultiIntfInstantiations = Yes | No + +/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). +/// Visit base types and interfaces first. +let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = + let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = + + let seenThisTycon = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> Set.contains tcref.Stamp visitedTycon + | _ -> false + + // Do not visit the same type twice. Could only be doing this if we've seen this tycon + if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else + + // Do not visit the same tycon twice, e.g. I and I, collect I only, unless directed to allow this + if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else + + let state = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> + let visitedTycon = Set.add tcref.Stamp visitedTycon + visitedTycon, visited.Add (tcref, ty), acc + | _ -> + state + + if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else + let visitedTycon, visited, acc = + if isInterfaceTy g ty then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) + (loop ndeep g.obj_ty state) + else + match tryDestTyparTy g ty with + | ValueSome tp -> + let state = loop (ndeep+1) g.obj_ty state + List.foldBack + (fun x vacc -> + match x with + | TyparConstraint.MayResolveMember _ + | TyparConstraint.DefaultsTo _ + | TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _ + | TyparConstraint.IsEnum _ + | TyparConstraint.IsDelegate _ + | TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _ + | TyparConstraint.SimpleChoice _ + | TyparConstraint.RequiresDefaultConstructor _ -> vacc + | TyparConstraint.CoercesTo(cty, _) -> + loop (ndeep + 1) cty vacc) + tp.Constraints + state + | _ -> + let state = + if followInterfaces then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) + state + else + state + let state = + Option.foldBack + (loop (ndeep+1)) + (GetSuperTypeOfType g amap m ty) + state + state + let acc = visitor ty acc + (visitedTycon, visited, acc) + loop 0 ty (Set.empty, TyconRefMultiMap<_>.Empty, acc) |> p33 + +/// Fold, do not follow interfaces (unless the type is itself an interface) +let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = + FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc + +/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes f g amap m ty acc + +/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () + +/// Search for one element satisfying a predicate, following interfaces +let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false + +/// Search for one element where a function returns a 'Some' result, following interfaces +let SearchEntireHierarchyOfType f g amap m ty = + FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes + (fun ty acc -> + match acc with + | None -> if f ty then Some ty else None + | Some _ -> acc) + g amap m ty None + +/// Get all super types of the type, including the type itself +let AllSuperTypesOfType g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] + +/// Get all interfaces of a type, including the type itself if it is an interface +let AllInterfacesOfType g amap m allowMultiIntfInst ty = + AllSuperTypesOfType g amap m allowMultiIntfInst ty |> List.filter (isInterfaceTy g) + +/// Check if two types have the same nominal head type +let HaveSameHeadType g ty1 ty2 = + match tryTcrefOfAppTy g ty1 with + | ValueSome tcref1 -> + match tryTcrefOfAppTy g ty2 with + | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 + | _ -> false + | _ -> false + +/// Check if a type has a particular head type +let HasHeadType g tcref ty2 = + match tryTcrefOfAppTy g ty2 with + | ValueSome tcref2 -> tyconRefEq g tcref tcref2 + | ValueNone -> false + +/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) +let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = + ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom + +/// Check if a type exists somewhere in the hierarchy which has the given head type. +let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = + ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom + +/// Read an Abstract IL type from metadata and convert to an F# type. +let ImportILTypeFromMetadata amap m scoref tinst minst ilty = + ImportILType scoref amap m (tinst@minst) ilty + +/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. +let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilty getCattrs = + let ty = ImportILType scoref amap m (tinst@minst) ilty + // If the type is a byref and one of attributes from a return or parameter has IsReadOnly, then it's a inref. + if isByrefTy amap.g ty && TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ()) then + mkInByrefTy amap.g (destByrefTy amap.g ty) + else + ty + +/// Get the parameter type of an IL method. +let ImportParameterTypeFromMetadata amap m ilty getCattrs scoref tinst mist = + ImportILTypeFromMetadataWithAttributes amap m scoref tinst mist ilty getCattrs + +/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and +/// translating 'void' to 'None'. +let ImportReturnTypeFromMetadata amap m ilty getCattrs scoref tinst minst = + match ilty with + | ILType.Void -> None + | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy getCattrs) + + +/// Copy constraints. If the constraint comes from a type parameter associated +/// with a type constructor then we are simply renaming type variables. If it comes +/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the +/// instantiation associated with 'ty' as well as copying the type parameters associated with +/// M and instantiating their constraints +/// +/// Note: this now looks identical to constraint instantiation. + +let CopyTyparConstraints m tprefInst (tporig: Typar) = + tporig.Constraints + |> List.map (fun tpc -> + match tpc with + | TyparConstraint.CoercesTo(ty, _) -> + TyparConstraint.CoercesTo (instType tprefInst ty, m) + | TyparConstraint.DefaultsTo(priority, ty, _) -> + TyparConstraint.DefaultsTo (priority, instType tprefInst ty, m) + | TyparConstraint.SupportsNull _ -> + TyparConstraint.SupportsNull m + | TyparConstraint.IsEnum (uty, _) -> + TyparConstraint.IsEnum (instType tprefInst uty, m) + | TyparConstraint.SupportsComparison _ -> + TyparConstraint.SupportsComparison m + | TyparConstraint.SupportsEquality _ -> + TyparConstraint.SupportsEquality m + | TyparConstraint.IsDelegate(aty, bty, _) -> + TyparConstraint.IsDelegate (instType tprefInst aty, instType tprefInst bty, m) + | TyparConstraint.IsNonNullableStruct _ -> + TyparConstraint.IsNonNullableStruct m + | TyparConstraint.IsUnmanaged _ -> + TyparConstraint.IsUnmanaged m + | TyparConstraint.IsReferenceType _ -> + TyparConstraint.IsReferenceType m + | TyparConstraint.SimpleChoice (tys, _) -> + TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys, m) + | TyparConstraint.RequiresDefaultConstructor _ -> + TyparConstraint.RequiresDefaultConstructor m + | TyparConstraint.MayResolveMember(traitInfo, _) -> + TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) + +/// The constraints for each typar copied from another typar can only be fixed up once +/// we have generated all the new constraints, e.g. f List, B :> List> ... +let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = + // Checks.. These are defensive programming against early reported errors. + let n0 = formalEnclosingTypars.Length + let n1 = tinst.Length + let n2 = tpsorig.Length + let n3 = tps.Length + if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0, n1)), m)) + if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2, n3)), m)) + + // The real code.. + let renaming, tptys = mkTyparToTyparRenaming tpsorig tps + let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming + (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) + renaming, tptys + + //------------------------------------------------------------------------- // Predicates and properties on values and members @@ -75,7 +475,7 @@ let GetCompiledReturnTyOfProvidedMethodInfo amap m (mi: Tainted mi.IsConstructor), m) then mi.PApply((fun mi -> mi.DeclaringType), m) else mi.Coerce(m).PApply((fun mi -> mi.ReturnType), m) - let ty = ImportProvidedType amap m returnType + let ty = Import.ImportProvidedType amap m returnType if isVoidTy amap.g ty then None else Some ty #endif @@ -92,12 +492,10 @@ let ReparentSlotSigToUseMethodTypars g m ovByMethValRef slotsig = slotsig /// Construct the data representing a parameter in the signature of an abstract method slot -let MakeSlotParam (ty, argInfo: ArgReprInfo) = - TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) +let MakeSlotParam (ty, argInfo: ArgReprInfo) = TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) /// Construct the data representing the signature of an abstract method slot -let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = - copySlotSig (TSlotSig(nm, ty, ctps, mtps, paraml, retTy)) +let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = copySlotSig (TSlotSig(nm, ty, ctps, mtps, paraml, retTy)) /// Split the type of an F# member value into /// - the type parameters associated with method but matching those of the enclosing type @@ -139,7 +537,7 @@ let private GetInstantiationForMemberVal g isCSharpExt (ty, vref, methTyArgs: Ty let memberParentTypars, memberMethodTypars, _retTy, parentTyArgs = AnalyzeTypeOfMemberVal isCSharpExt g (ty, vref) /// In some recursive inference cases involving constraints this may need to be /// fixed up - we allow uniform generic recursion but nothing else. - /// See https://github.com/dotnet/fsharp/issues/3038#issuecomment-309429410 + /// See https://github.com/Microsoft/visualfsharp/issues/3038#issuecomment-309429410 let methTyArgsFixedUp = if methTyArgs.Length < memberMethodTypars.Length then methTyArgs @ (List.skip methTyArgs.Length memberMethodTypars |> generalizeTypars) @@ -180,11 +578,7 @@ type OptionalArgInfo = /// Note this is correctly termed caller side, even though the default value is optically specified on the callee: /// in fact the default value is read from the metadata and passed explicitly to the callee on the caller side. | CallerSide of OptionalArgCallerSideValue - - member x.IsOptional = - match x with - | CalleeSide | CallerSide _ -> true - | NotOptional -> false + member x.IsOptional = match x with CalleeSide | CallerSide _ -> true | NotOptional -> false /// Compute the OptionalArgInfo for an IL parameter /// @@ -269,7 +663,6 @@ type ParamData = #if !NO_TYPEPROVIDERS type ILFieldInit with - /// Compute the ILFieldInit for the given provided constant value for a provided enum type. static member FromProvidedObj m (v: obj) = match v with @@ -299,7 +692,7 @@ type ILFieldInit with /// This is the same logic as OptionalArgInfoOfILParameter except we do not apply the /// Visual Basic rules for IDispatchConstant and IUnknownConstant to optional /// provided parameters. -let OptionalArgInfoOfProvidedParameter (amap: ImportMap) m (provParam : Tainted) = +let OptionalArgInfoOfProvidedParameter (amap: Import.ImportMap) m (provParam : Tainted) = let g = amap.g if provParam.PUntaint((fun p -> p.IsOptional), m) then match provParam.PUntaint((fun p -> p.HasDefaultValue), m) with @@ -312,7 +705,7 @@ let OptionalArgInfoOfProvidedParameter (amap: ImportMap) m (provParam : Tainted< elif isObjTy g ty then MissingValue else DefaultValue - let pty = ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) + let pty = Import.ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) CallerSide (analyze pty) | _ -> let v = provParam.PUntaint((fun p -> p.RawDefaultValue), m) @@ -559,7 +952,7 @@ type MethInfo = #if !NO_TYPEPROVIDERS /// Describes a use of a method backed by provided metadata - | ProvidedMeth of amap: ImportMap * methodBase: Tainted * extensionMethodPriority: ExtensionMethodPriority option * m: range + | ProvidedMeth of amap: Import.ImportMap * methodBase: Tainted * extensionMethodPriority: ExtensionMethodPriority option * m: range #endif /// Get the enclosing type of the method info. @@ -573,7 +966,7 @@ type MethInfo = | DefaultStructCtor(_, ty) -> ty #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) + Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -872,7 +1265,7 @@ type MethInfo = | _ -> false /// Indicates if this is an extension member (e.g. on a struct) that takes a byref arg - member x.ObjArgNeedsAddress (amap: ImportMap, m) = + member x.ObjArgNeedsAddress (amap: Import.ImportMap, m) = (x.IsStruct && not x.IsExtensionMember) || match x.GetObjArgTypes (amap, m, x.FormalMethodInst) with | [h] -> isByrefTy amap.g h @@ -935,21 +1328,21 @@ type MethInfo = /// Indicates if this method is an extension member that is read-only. /// An extension member is considered read-only if the first argument is a read-only byref (inref) type. - member x.IsReadOnlyExtensionMember (amap: ImportMap, m) = + member x.IsReadOnlyExtensionMember (amap: Import.ImportMap, m) = x.IsExtensionMember && x.TryObjArgByrefType(amap, m, x.FormalMethodInst) |> Option.exists (isInByrefTy amap.g) /// Build IL method infos. - static member CreateILMeth (amap: ImportMap, m, ty: TType, md: ILMethodDef) = + static member CreateILMeth (amap: Import.ImportMap, m, ty: TType, md: ILMethodDef) = let tinfo = ILTypeInfo.FromType amap.g ty - let mtps = ImportILGenericParameters (fun () -> amap) m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata md.GenericParams + let mtps = Import.ImportILGenericParameters (fun () -> amap) m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata md.GenericParams ILMeth (amap.g, ILMethInfo(amap.g, ty, None, md, mtps), None) /// Build IL method infos for a C#-style extension method static member CreateILExtensionMeth (amap, m, apparentTy: TType, declaringTyconRef: TyconRef, extMethPri, md: ILMethodDef) = let scoref = declaringTyconRef.CompiledRepresentationForNamedType.Scope - let mtps = ImportILGenericParameters (fun () -> amap) m scoref [] md.GenericParams + let mtps = Import.ImportILGenericParameters (fun () -> amap) m scoref [] md.GenericParams ILMeth (amap.g, ILMethInfo(amap.g, apparentTy, Some declaringTyconRef, md, mtps), extMethPri) /// Tests whether two method infos have the same underlying definition. @@ -1027,7 +1420,7 @@ type MethInfo = | ProvidedMeth(amap, mi, _, m) -> // A single group of tupled arguments [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - yield ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) ] ] + yield Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) ] ] #endif /// Get the (zero or one) 'self'/'this'/'object' arguments associated with a method. @@ -1049,7 +1442,7 @@ type MethInfo = | DefaultStructCtor _ -> [] #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - if x.IsInstance then [ ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument + if x.IsInstance then [ Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument else [] #endif @@ -1230,7 +1623,7 @@ type MethInfo = let formalParams = [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some s), m) - let paramType = ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) + let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) let isIn, isOut, isOptional = p.PUntaint((fun p -> p.IsIn, p.IsOut, p.IsOptional), m) yield TSlotParam(paramName, paramType, isIn, isOut, isOptional, []) ] ] formalRetTy, formalParams @@ -1263,7 +1656,7 @@ type MethInfo = let pty = match p.PApply((fun p -> p.ParameterType), m) with | Tainted.Null -> amap.g.unit_ty - | parameterType -> ImportProvidedType amap m parameterType + | parameterType -> Import.ImportProvidedType amap m parameterType yield ParamNameAndType(pname, pty) ] ] #endif @@ -1307,7 +1700,7 @@ type ILFieldInfo = | ILFieldInfo of ilTypeInfo: ILTypeInfo * ilFieldDef: ILFieldDef #if !NO_TYPEPROVIDERS /// Represents a single use of a field backed by provided metadata - | ProvidedField of amap: ImportMap * providedField: Tainted * range: range + | ProvidedField of amap: Import.ImportMap * providedField: Tainted * range: range #endif /// Get the enclosing ("parent"/"declaring") type of the field. @@ -1315,7 +1708,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ToType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) + | ProvidedField(amap, fi, m) -> (Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) #endif member x.ApparentEnclosingAppType = x.ApparentEnclosingType @@ -1336,7 +1729,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ILTypeRef #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef + | ProvidedField(amap, fi, m) -> (Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef #endif /// Get the scope used to interpret IL metadata @@ -1407,7 +1800,7 @@ type ILFieldInfo = match x with | ILFieldInfo (_, fdef) -> fdef.FieldType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType), m)) + | ProvidedField(amap, fi, m) -> Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Get the type of the field as an F# type @@ -1415,7 +1808,7 @@ type ILFieldInfo = match x with | ILFieldInfo (tinfo, fdef) -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] fdef.FieldType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType), m)) + | ProvidedField(amap, fi, m) -> Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Tests whether two infos have the same underlying definition. @@ -1609,7 +2002,7 @@ type PropInfo = #if !NO_TYPEPROVIDERS /// An F# use of a property backed by provided metadata - | ProvidedProp of amap: ImportMap * providedProp: Tainted * range: range + | ProvidedProp of amap: Import.ImportMap * providedProp: Tainted * range: range #endif /// Get the enclosing type of the property. @@ -1621,7 +2014,7 @@ type PropInfo = | FSProp(_, ty, _, _) -> ty #if !NO_TYPEPROVIDERS | ProvidedProp(amap, pi, m) -> - ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) + Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -1848,7 +2241,7 @@ type PropInfo = | FSProp _ -> failwith "unreachable" #if !NO_TYPEPROVIDERS | ProvidedProp(_, pi, m) -> - ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType), m)) + Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType), m)) #endif /// Get the names and types of the indexer parameters associated with the property @@ -1866,7 +2259,7 @@ type PropInfo = | ProvidedProp (_, pi, m) -> [ for p in pi.PApplyArray((fun pi -> pi.GetIndexParameters()), "GetIndexParameters", m) do let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some (mkSynId m s)), m) - let paramType = ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) + let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) yield ParamNameAndType(paramName, paramType) ] #endif @@ -1926,7 +2319,7 @@ type PropInfo = match pi with | ILProp ilpinfo -> hash ilpinfo.RawMetadata.Name | FSProp(_, _, vrefOpt1, vrefOpt2) -> - // Hash on string option * string option + // Hash on option*option let vth = (vrefOpt1 |> Option.map (fun vr -> vr.LogicalName), (vrefOpt2 |> Option.map (fun vr -> vr.LogicalName))) hash vth #if !NO_TYPEPROVIDERS @@ -2026,7 +2419,7 @@ type EventInfo = #if !NO_TYPEPROVIDERS /// An F# use of an event backed by provided metadata - | ProvidedEvent of amap: ImportMap * providedEvent: Tainted * range: range + | ProvidedEvent of amap: Import.ImportMap * providedEvent: Tainted * range: range #endif /// Get the enclosing type of the event. @@ -2037,7 +2430,7 @@ type EventInfo = | ILEvent ileinfo -> ileinfo.ApparentEnclosingType | FSEvent (_, p, _, _) -> p.ApparentEnclosingType #if !NO_TYPEPROVIDERS - | ProvidedEvent (amap, ei, m) -> ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) + | ProvidedEvent (amap, ei, m) -> Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types member x.ApparentEnclosingAppType = @@ -2160,7 +2553,7 @@ type EventInfo = FindDelegateTypeOfPropertyEvent g amap x.EventName m (p.GetPropertyType(amap, m)) #if !NO_TYPEPROVIDERS | ProvidedEvent (_, ei, _) -> - ImportProvidedType amap m (ei.PApply((fun ei -> ei.EventHandlerType), m)) + Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.EventHandlerType), m)) #endif /// Test whether two event infos have the same underlying definition. diff --git a/src/fsharp/infos.fsi b/src/fsharp/infos.fsi index b0af49e2f60..183f8ccd199 100644 --- a/src/fsharp/infos.fsi +++ b/src/fsharp/infos.fsi @@ -16,6 +16,171 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeProviders #endif +/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. +val ImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType + +val CanImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> ilty: ILType -> bool + +/// Indicates if an F# type is the type associated with an F# exception declaration +val isExnDeclTy: g: TcGlobals -> ty: TType -> bool + +/// Get the base type of a type, taking into account type instantiations. Return None if the +/// type has no base type. +val GetSuperTypeOfType: g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option + +/// Indicates whether we can skip interface types that lie outside the reference set +[] +type SkipUnrefInterfaces = + | Yes + | No + +/// Collect the set of immediate declared interface types for an F# type, but do not +/// traverse the type hierarchy to collect further interfaces. +val GetImmediateInterfacesOfType: + skipUnref: SkipUnrefInterfaces -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType list + +/// Indicates whether we should visit multiple instantiations of the same generic interface or not +[] +type AllowMultiIntfInstantiations = + | Yes + | No + +/// Fold, do not follow interfaces (unless the type is itself an interface) +val FoldPrimaryHierarchyOfType: + f: (TType -> 'a -> 'a) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + acc: 'a -> + 'a + +/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +val FoldEntireHierarchyOfType: + f: (TType -> 'a -> 'a) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + acc: 'a -> + 'a + +/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +val IterateEntireHierarchyOfType: + f: (TType -> unit) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + unit + +/// Search for one element satisfying a predicate, following interfaces +val ExistsInEntireHierarchyOfType: + f: (TType -> bool) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + bool + +/// Search for one element where a function returns a 'Some' result, following interfaces +val SearchEntireHierarchyOfType: + f: (TType -> bool) -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option + +/// Get all super types of the type, including the type itself +val AllSuperTypesOfType: + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + TType list + +/// Get all interfaces of a type, including the type itself if it is an interface +val AllInterfacesOfType: + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + TType list + +/// Check if two types have the same nominal head type +val HaveSameHeadType: g: TcGlobals -> ty1: TType -> ty2: TType -> bool + +/// Check if a type has a particular head type +val HasHeadType: g: TcGlobals -> tcref: TyconRef -> ty2: TType -> bool + +/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) +val ExistsSameHeadTypeInHierarchy: + g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> typeToLookFor: TType -> bool + +/// Check if a type exists somewhere in the hierarchy which has the given head type. +val ExistsHeadTypeInEntireHierarchy: + g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> tcrefToLookFor: TyconRef -> bool + +/// Read an Abstract IL type from metadata and convert to an F# type. +val ImportILTypeFromMetadata: + amap: ImportMap -> m: range -> scoref: ILScopeRef -> tinst: TType list -> minst: TType list -> ilty: ILType -> TType + +/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. +val ImportILTypeFromMetadataWithAttributes: + amap: ImportMap -> + m: range -> + scoref: ILScopeRef -> + tinst: TType list -> + minst: TType list -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + TType + +/// Get the parameter type of an IL method. +val ImportParameterTypeFromMetadata: + amap: ImportMap -> + m: range -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + scoref: ILScopeRef -> + tinst: TType list -> + mist: TType list -> + TType + +/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and +/// translating 'void' to 'None'. +val ImportReturnTypeFromMetadata: + amap: ImportMap -> + m: range -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + scoref: ILScopeRef -> + tinst: TType list -> + minst: TType list -> + TType option + +/// Copy constraints. If the constraint comes from a type parameter associated +/// with a type constructor then we are simply renaming type variables. If it comes +/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the +/// instantiation associated with 'ty' as well as copying the type parameters associated with +/// M and instantiating their constraints +/// +/// Note: this now looks identical to constraint instantiation. + +val CopyTyparConstraints: m: range -> tprefInst: TyparInst -> tporig: Typar -> TyparConstraint list + +/// The constraints for each typar copied from another typar can only be fixed up once +/// we have generated all the new constraints, e.g. f List, B :> List> ... +val FixupNewTypars: + m: range -> + formalEnclosingTypars: Typars -> + tinst: TType list -> + tpsorig: Typars -> + tps: Typars -> + TyparInst * TTypes + type ValRef with /// Indicates if an F#-declared function or member value is a CLIEvent property compiled as a .NET event diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index bc06a67f684..be194d99cc2 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -21,7 +21,7 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open FSharp.Compiler.AbstractIL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index 698ada21335..ac67680eef2 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -10,7 +10,7 @@ open Internal.Utilities.Library open Internal.Utilities.Text.Lexing open FSharp.Compiler.IO -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers open FSharp.Compiler.UnicodeLexing @@ -52,7 +52,7 @@ type LexArgs = { conditionalDefines: string list resourceManager: LexResourceManager - errorLogger: DiagnosticsLogger + errorLogger: ErrorLogger applyLineDirectives: bool pathMap: PathMap mutable ifdefStack: LexerIfdefStack diff --git a/src/fsharp/lexhelp.fsi b/src/fsharp/lexhelp.fsi index 246da511506..7c17152fa8e 100644 --- a/src/fsharp/lexhelp.fsi +++ b/src/fsharp/lexhelp.fsi @@ -6,7 +6,7 @@ open FSharp.Compiler.IO open Internal.Utilities open Internal.Utilities.Text -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.ParseHelpers open FSharp.Compiler.UnicodeLexing open FSharp.Compiler.Parser @@ -32,7 +32,7 @@ type LexResourceManager = type LexArgs = { conditionalDefines: string list resourceManager: LexResourceManager - errorLogger: DiagnosticsLogger + errorLogger: ErrorLogger applyLineDirectives: bool pathMap: PathMap mutable ifdefStack: LexerIfdefStack @@ -51,7 +51,7 @@ val mkLexargs: lightStatus: IndentationAwareSyntaxStatus * resourceManager: LexResourceManager * ifdefStack: LexerIfdefStack * - errorLogger: DiagnosticsLogger * + errorLogger: ErrorLogger * pathMap: PathMap -> LexArgs diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index a77d087f94f..9ee981d30d6 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -14,7 +14,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/pplex.fsl b/src/fsharp/pplex.fsl index 4b6da64ff55..fdd59bc6f81 100644 --- a/src/fsharp/pplex.fsl +++ b/src/fsharp/pplex.fsl @@ -6,7 +6,7 @@ module internal FSharp.Compiler.PPLexer open System -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Lexhelp open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/pppars.fsy b/src/fsharp/pppars.fsy index 53616c481e6..5775c898670 100644 --- a/src/fsharp/pppars.fsy +++ b/src/fsharp/pppars.fsy @@ -1,7 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. %{ -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 7398e1d00ea..5e04d0cc569 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -26,7 +26,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.EditorServices.DeclarationListHelpers -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -1115,7 +1115,7 @@ type internal TypeCheckInfo /// Determines if a long ident is resolvable at a specific point. member _.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = - DiagnosticsScope.Protect + ErrorScope.Protect range0 (fun () -> /// Find items in the best naming environment. @@ -1132,7 +1132,7 @@ type internal TypeCheckInfo /// Get the auto-complete items at a location member _.GetDeclarations (parseResultsOpt, line, lineStr, partialName, completionContextAtPos, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = @@ -1159,7 +1159,7 @@ type internal TypeCheckInfo /// Get the symbols for auto-complete items at a location member _.GetDeclarationListSymbols (parseResultsOpt, line, lineStr, partialName, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = @@ -1282,7 +1282,7 @@ type internal TypeCheckInfo let tip = LayoutRender.toArray tip ToolTipElement.Single(tip, FSharpXmlDoc.None)] - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 dataTipOfReferences (fun err -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetReferenceResolutionStructuredToolTipText: '%s'" err) @@ -1302,7 +1302,7 @@ type internal TypeCheckInfo // GetToolTipText: return the "pop up" (or "Quick Info") text given a certain context. member _.GetStructuredToolTipText(line, lineStr, colAtEndOfNames, names) = let Compute() = - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition(None, Some names, None, None, @@ -1328,7 +1328,7 @@ type internal TypeCheckInfo res member _.GetF1Keyword (line, lineStr, colAtEndOfNames, names) : string option = - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = @@ -1366,7 +1366,7 @@ type internal TypeCheckInfo None) member _.GetMethods (line, lineStr, colAtEndOfNames, namesOpt) = - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = @@ -1390,7 +1390,7 @@ type internal TypeCheckInfo MethodGroup(msg,[| |])) member _.GetMethodsAsSymbols (line, lineStr, colAtEndOfNames, names) = - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition (None, Some names, None, @@ -1410,7 +1410,7 @@ type internal TypeCheckInfo None) member _.GetDeclarationLocation (line, lineStr, colAtEndOfNames, names, preferFlag) = - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = @@ -1519,7 +1519,7 @@ type internal TypeCheckInfo FindDeclResult.DeclNotFound (FindDeclFailureReason.Unknown msg)) member _.GetSymbolUseAtLocation (line, lineStr, colAtEndOfNames, names) = - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition (None, Some names, None, None, @@ -1605,7 +1605,7 @@ type FSharpParsingOptions = static member FromTcConfig(tcConfig: TcConfig, sourceFiles, isInteractive: bool) = { SourceFiles = sourceFiles ConditionalDefines = tcConfig.conditionalDefines - ErrorSeverityOptions = tcConfig.diagnosticsOptions + ErrorSeverityOptions = tcConfig.errorSeverityOptions LangVersionText = tcConfig.langVersion.VersionText IsInteractive = isInteractive IndentationAwareSyntax = tcConfig.indentationAwareSyntax @@ -1616,7 +1616,7 @@ type FSharpParsingOptions = { SourceFiles = sourceFiles ConditionalDefines = tcConfigB.conditionalDefines - ErrorSeverityOptions = tcConfigB.diagnosticsOptions + ErrorSeverityOptions = tcConfigB.errorSeverityOptions LangVersionText = tcConfigB.langVersion.VersionText IsInteractive = isInteractive IndentationAwareSyntax = tcConfigB.indentationAwareSyntax @@ -1627,8 +1627,8 @@ type FSharpParsingOptions = module internal ParseAndCheckFile = /// Error handler for parsing & type checking while processing a single file - type ErrorHandler(reportErrors, mainInputFileName, diagnosticsOptions: FSharpDiagnosticOptions, sourceText: ISourceText, suggestNamesForErrors: bool) = - let mutable options = diagnosticsOptions + type ErrorHandler(reportErrors, mainInputFileName, errorSeverityOptions: FSharpDiagnosticOptions, sourceText: ISourceText, suggestNamesForErrors: bool) = + let mutable options = errorSeverityOptions let errorsAndWarningsCollector = ResizeArray<_>() let mutable errorCount = 0 @@ -1659,12 +1659,12 @@ module internal ParseAndCheckFile = | e -> report e let errorLogger = - { new DiagnosticsLogger("ErrorHandler") with + { new ErrorLogger("ErrorHandler") with member x.DiagnosticSink (exn, severity) = diagnosticSink severity exn member x.ErrorCount = errorCount } // Public members - member _.DiagnosticsLogger = errorLogger + member _.ErrorLogger = errorLogger member _.CollectedDiagnostics = errorsAndWarningsCollector.ToArray() @@ -1693,7 +1693,7 @@ module internal ParseAndCheckFile = // When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives. // TODO(pathmap): expose PathMap on the service API, and thread it through here - let lexargs = mkLexargs(conditionalDefines, lightStatus, lexResourceManager, [], errHandler.DiagnosticsLogger, PathMap.empty) + let lexargs = mkLexargs(conditionalDefines, lightStatus, lexResourceManager, [], errHandler.ErrorLogger, PathMap.empty) let lexargs = { lexargs with applyLineDirectives = false } let tokenizer = LexFilter.LexFilter(lightStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf) @@ -1703,15 +1703,15 @@ module internal ParseAndCheckFile = UnicodeLexing.SourceTextAsLexbuf(true, LanguageVersion(langVersion), sourceText) let matchBraces(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = - let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + let delayedLogger = CapturingErrorLogger("matchBraces") + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) - // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors - let delayedLogger = CapturingDiagnosticsLogger("matchBraces") - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + // Make sure there is an ErrorLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors + let delayedLogger = CapturingErrorLogger("matchBraces") + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let matchingBraces = ResizeArray<_>() @@ -1788,7 +1788,7 @@ module internal ParseAndCheckFile = let parseFile(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) let errHandler = ErrorHandler(true, fileName, options.ErrorSeverityOptions, sourceText, suggestNamesForErrors) - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) + use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let parseResult = @@ -1801,9 +1801,9 @@ module internal ParseAndCheckFile = let isExe = options.IsExe try - ParseInput(lexfun, options.ErrorSeverityOptions, errHandler.DiagnosticsLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) + ParseInput(lexfun, options.ErrorSeverityOptions, errHandler.ErrorLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) with e -> - errHandler.DiagnosticsLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None. + errHandler.ErrorLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None. EmptyParsedInput(fileName, (isLastCompiland, isExe))) errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors @@ -1903,16 +1903,16 @@ module internal ParseAndCheckFile = let parsedMainInput = parseResults.ParseTree // Initialize the error handler - let errHandler = ErrorHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) + let errHandler = ErrorHandler(true, mainInputFileName, tcConfig.errorSeverityOptions, sourceText, suggestNamesForErrors) - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck // Apply nowarns to tcConfig (may generate errors, so ensure errorLogger is installed) let tcConfig = ApplyNoWarnsToTcConfig (tcConfig, parsedMainInput,Path.GetDirectoryName mainInputFileName) // update the error handler with the modified tcConfig - errHandler.ErrorSeverityOptions <- tcConfig.diagnosticsOptions + errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions // Play background errors and warnings for this file. do for err, severity in backgroundDiagnostics do @@ -1939,7 +1939,7 @@ module internal ParseAndCheckFile = // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance // for the client to claim the result as obsolete and have the typecheck abort. - use _unwind = new CompilationGlobalsScope (errHandler.DiagnosticsLogger, BuildPhase.TypeCheck) + use _unwind = new CompilationGlobalsScope (errHandler.ErrorLogger, BuildPhase.TypeCheck) let! result = CheckOneInputAndFinish(checkForErrors, tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index c7fea4e9b61..a8e65487a28 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -15,7 +15,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Symbols open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs diff --git a/src/fsharp/service/FSharpParseFileResults.fs b/src/fsharp/service/FSharpParseFileResults.fs index 9ee0e816b52..d67044ea10d 100644 --- a/src/fsharp/service/FSharpParseFileResults.fs +++ b/src/fsharp/service/FSharpParseFileResults.fs @@ -456,7 +456,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, /// Get declared items and the selected item at the specified location member _.GetNavigationItemsImpl() = - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> match input with | ParsedInput.ImplFile _ as p -> @@ -808,7 +808,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules | _ -> [] - DiagnosticsScope.Protect range0 + ErrorScope.Protect range0 (fun () -> let locations = findBreakPoints() diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index f87d4bf9ffe..5aa4a2288dd 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -4,8 +4,6 @@ namespace FSharp.Compiler.CodeAnalysis open System open System.Collections.Generic -open System.Collections.Immutable -open System.Diagnostics open System.IO open System.Threading open Internal.Utilities.Library @@ -24,7 +22,7 @@ open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.NameResolution @@ -57,17 +55,14 @@ module IncrementalBuilderEventTesting = let data = Array.create MAX None let mutable curIndex = 0 let mutable numAdds = 0 - // called by the product, to note when a parse/typecheck happens for a file member _.Add(fileName:'T) = numAdds <- numAdds + 1 data[curIndex] <- Some fileName curIndex <- (curIndex + 1) % MAX - member _.CurrentEventNum = numAdds // called by unit tests, returns 'n' most recent additions. - - member _.MostRecentList(n: int) : 'T list = + member this.MostRecentList(n: int) : list<'T> = if n < 0 || n > MAX then raise <| ArgumentOutOfRangeException("n", sprintf "n must be between 0 and %d, inclusive, but got %d" MAX n) let mutable remaining = n @@ -114,7 +109,7 @@ module IncrementalBuildSyntaxTree = let mutable weakCache: WeakReference<_> option = None let parse(sigNameOpt: QualifiedNameOfFile option) = - let errorLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) + let errorLogger = CompilationErrorLogger("Parse", tcConfig.errorSeverityOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parse) @@ -185,16 +180,16 @@ type TcInfo = latestCcuSigForFile: ModuleOrNamespaceType option - /// Accumulated diagnostics, last file first - tcDiagnosticsRev:(PhasedDiagnostic * FSharpDiagnosticSeverity)[] list + /// Accumulated errors, last file first + tcErrorsRev:(PhasedDiagnostic * FSharpDiagnosticSeverity)[] list tcDependencyFiles: string list sigNameOpt: (string * QualifiedNameOfFile) option } - member x.TcDiagnostics = - Array.concat (List.rev x.tcDiagnosticsRev) + member x.TcErrors = + Array.concat (List.rev x.tcErrorsRev) /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] @@ -363,7 +358,7 @@ type BoundModel private (tcConfig: TcConfig, else this - member _.Next(syntaxTree, tcInfo) = + member this.Next(syntaxTree, tcInfo) = BoundModel( tcConfig, tcGlobals, @@ -379,10 +374,10 @@ type BoundModel private (tcConfig: TcConfig, Some syntaxTree, None) - member _.Finish(finalTcDiagnosticsRev, finalTopAttribs) = + member this.Finish(finalTcErrorsRev, finalTopAttribs) = node { let createFinish tcInfo = - { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } + { tcInfo with tcErrorsRev = finalTcErrorsRev; topAttribs = finalTopAttribs } let! finishState = node { @@ -472,14 +467,14 @@ type BoundModel private (tcConfig: TcConfig, | input, _sourceRange, fileName, parseErrors -> IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) - let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") - let errorLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) + let capturingErrorLogger = CapturingErrorLogger("TypeCheck") + let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.errorSeverityOptions, capturingErrorLogger) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) beforeFileChecked.Trigger fileName let prevModuleNamesDict = prevTcInfo.moduleNamesDict let prevTcState = prevTcInfo.tcState - let prevTcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev + let prevTcErrorsRev = prevTcInfo.tcErrorsRev let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore @@ -503,7 +498,7 @@ type BoundModel private (tcConfig: TcConfig, Logger.LogBlockMessageStop fileName LogCompilerFunctionId.IncrementalBuild_TypeCheck fileChecked.Trigger fileName - let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) + let newErrors = Array.append parseErrors (capturingErrorLogger.Diagnostics |> List.toArray) let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls let tcInfo = @@ -512,7 +507,7 @@ type BoundModel private (tcConfig: TcConfig, tcEnvAtEndOfFile = tcEnvAtEndOfFile moduleNamesDict = moduleNamesDict latestCcuSigForFile = Some ccuSigForFile - tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev + tcErrorsRev = newErrors :: prevTcErrorsRev topAttribs = Some topAttribs tcDependencyFiles = fileName :: prevTcDependencyFiles sigNameOpt = @@ -731,28 +726,27 @@ module IncrementalBuilderHelpers = // Link all the assemblies together and produce the input typecheck accumulator let CombineImportedAssembliesTask ( - assemblyName, - tcConfig: TcConfig, - tcConfigP, - tcGlobals, - frameworkTcImports, - nonFrameworkResolutions, - unresolvedReferences, - dependencyProvider, - loadClosureOpt: LoadClosure option, - niceNameGen, - basicDependencies, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - defaultPartialTypeChecking, - beforeFileChecked, - fileChecked, - importsInvalidatedByTypeProvider: Event) : NodeCode = - + assemblyName, + tcConfig: TcConfig, + tcConfigP, + tcGlobals, + frameworkTcImports, + nonFrameworkResolutions, + unresolvedReferences, + dependencyProvider, + loadClosureOpt: LoadClosure option, + niceNameGen, + basicDependencies, + keepAssemblyContents, + keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + defaultPartialTypeChecking, + beforeFileChecked, + fileChecked, + importsInvalidatedByTypeProvider: Event) : NodeCode = node { - let errorLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) + let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) let! tcImports = @@ -783,7 +777,7 @@ module IncrementalBuilderHelpers = #endif return tcImports with exn -> - Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" exn) + System.Diagnostics.Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" exn) errorLogger.Warning exn return frameworkTcImports } @@ -804,7 +798,7 @@ module IncrementalBuilderHelpers = tcEnvAtEndOfFile=tcInitial topAttribs=None latestCcuSigForFile=None - tcDiagnosticsRev = [ initialErrors ] + tcErrorsRev = [ initialErrors ] moduleNamesDict = Map.empty tcDependencyFiles = basicDependencies sigNameOpt = None @@ -843,14 +837,14 @@ module IncrementalBuilderHelpers = } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: ImmutableArray) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: block) = node { - let errorLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) + let errorLogger = CompilationErrorLogger("FinalizeTypeCheckTask", tcConfig.errorSeverityOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) let! results = boundModels - |> ImmutableArray.map (fun boundModel -> node { + |> Block.map (fun boundModel -> node { if enablePartialTypeChecking then let! tcInfo = boundModel.GetOrComputeTcInfo() return tcInfo, None @@ -858,7 +852,7 @@ module IncrementalBuilderHelpers = let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() return tcInfo, tcInfoExtras.latestImplFile }) - |> ImmutableArray.map (fun work -> + |> Block.map (fun work -> node { let! tcInfo, latestImplFile = work return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) @@ -926,7 +920,7 @@ module IncrementalBuilderHelpers = errorRecoveryNoRange exn mkSimpleAssemblyRef assemblyName, ProjectAssemblyDataResult.Unavailable true, None - let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcDiagnosticsRev + let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev let! finalBoundModelWithErrors = finalBoundModel.Finish(diagnostics, Some topAttrs) return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } @@ -939,12 +933,12 @@ type IncrementalBuilderInitialState = { initialBoundModel: BoundModel tcGlobals: TcGlobals - referencedAssemblies: ImmutableArray * (TimeStampCache -> DateTime)> + referencedAssemblies: block * (TimeStampCache -> DateTime)> tcConfig: TcConfig outfile: string assemblyName: string lexResourceManager: Lexhelp.LexResourceManager - fileNames: ImmutableArray + fileNames: block enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event @@ -980,12 +974,12 @@ type IncrementalBuilderInitialState = { initialBoundModel = initialBoundModel tcGlobals = tcGlobals - referencedAssemblies = nonFrameworkAssemblyInputs |> ImmutableArray.ofSeq + referencedAssemblies = nonFrameworkAssemblyInputs |> Block.ofSeq tcConfig = tcConfig outfile = outfile assemblyName = assemblyName lexResourceManager = lexResourceManager - fileNames = sourceFiles |> ImmutableArray.ofSeq + fileNames = sourceFiles |> Block.ofSeq enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked @@ -1008,18 +1002,18 @@ type IncrementalBuilderState = { // stampedFileNames represent the real stamps of the files. // logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. - stampedFileNames: ImmutableArray - logicalStampedFileNames: ImmutableArray - stampedReferencedAssemblies: ImmutableArray + stampedFileNames: block + logicalStampedFileNames: block + stampedReferencedAssemblies: block initialBoundModel: GraphNode - boundModels: ImmutableArray> + boundModels: block> finalizedBoundModel: GraphNode<(ILAssemblyRef * ProjectAssemblyDataResult * TypedImplFile list option * BoundModel) * DateTime> } [] module IncrementalBuilderStateHelpers = - let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: ImmutableArray>.Builder) i = + let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: blockbuilder>) i = let fileInfo = initialState.fileNames[i] let prevBoundModelGraphNode = match i with @@ -1031,13 +1025,13 @@ module IncrementalBuilderStateHelpers = return! TypeCheckTask initialState.enablePartialTypeChecking prevBoundModel syntaxTree }) - let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = + let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: blockbuilder>) = GraphNode(node { // Compute last bound model then get all the evaluated models. let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue() let boundModels = boundModels.ToImmutable() - |> ImmutableArray.map (fun x -> x.TryPeekValue().Value) + |> Block.map (fun x -> x.TryPeekValue().Value) let! result = FinalizeTypeCheckTask @@ -1091,7 +1085,7 @@ module IncrementalBuilderStateHelpers = and computeStampedFileNames (initialState: IncrementalBuilderInitialState) state (cache: TimeStampCache) = let mutable i = 0 (state, initialState.fileNames) - ||> ImmutableArray.fold (fun state fileInfo -> + ||> Block.fold (fun state fileInfo -> let newState = computeStampedFileName initialState state cache i fileInfo i <- i + 1 newState @@ -1102,7 +1096,7 @@ module IncrementalBuilderStateHelpers = let mutable referencesUpdated = false initialState.referencedAssemblies - |> ImmutableArray.iteri (fun i asmInfo -> + |> Block.iteri (fun i asmInfo -> let currentStamp = state.stampedReferencedAssemblies[i] let stamp = StampReferencedAssemblyTask cache asmInfo @@ -1137,16 +1131,16 @@ type IncrementalBuilderState with let cache = TimeStampCache(defaultTimeStamp) let initialBoundModel = GraphNode(node.Return initialBoundModel) - let boundModels = ImmutableArrayBuilder.create fileNames.Length + let boundModels = BlockBuilder.create fileNames.Length for slot = 0 to fileNames.Length - 1 do boundModels.Add(createBoundModelGraphNode initialState initialBoundModel boundModels slot) let state = { - stampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) - logicalStampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) - stampedReferencedAssemblies = ImmutableArray.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) + stampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) + logicalStampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) + stampedReferencedAssemblies = Block.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) initialBoundModel = initialBoundModel boundModels = boundModels.ToImmutable() finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels @@ -1357,19 +1351,19 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc String.Compare(fileName, f2.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 || String.Compare(FileSystem.GetFullPathShim fileName, FileSystem.GetFullPathShim f2.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 result - match fileNames |> ImmutableArray.tryFindIndex CompareFileNames with + match fileNames |> Block.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None - member builder.GetSlotOfFileName(fileName: string) = - match builder.TryGetSlotOfFileName(fileName) with + member this.GetSlotOfFileName(fileName: string) = + match this.TryGetSlotOfFileName(fileName) with | Some slot -> slot | None -> failwith (sprintf "The file '%s' was not part of the project. Did you call InvalidateConfiguration when the list of files in the project changed?" fileName) member _.GetSlotsCount () = fileNames.Length - member builder.ContainsFile(fileName: string) = - (builder.TryGetSlotOfFileName fileName).IsSome + member this.ContainsFile(fileName: string) = + (this.TryGetSlotOfFileName fileName).IsSome member builder.GetParseResultsForFile fileName = let slotOfFile = builder.GetSlotOfFileName fileName @@ -1407,8 +1401,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc node { - // Trap and report diagnostics from creation. - let delayedLogger = CapturingDiagnosticsLogger("IncrementalBuilderCreation") + // Trap and report warnings and errors from creation. + let delayedLogger = CapturingErrorLogger("IncrementalBuilderCreation") use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) let! builderOpt = @@ -1519,7 +1513,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorLogger = CompilationDiagnosticLogger("nonFrameworkAssemblyInputs", tcConfig.diagnosticsOptions) + let errorOptions = tcConfig.errorSeverityOptions + let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) // Get the names and time stamps of all the non-framework referenced assemblies, which will act @@ -1529,7 +1524,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let nonFrameworkAssemblyInputs = // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorLogger = CompilationDiagnosticLogger("nonFrameworkAssemblyInputs", tcConfig.diagnosticsOptions) + let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) @@ -1540,6 +1535,10 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc for pr in projectReferences do yield Choice2Of2 pr, (fun (cache: TimeStampCache) -> cache.GetProjectReferenceTimeStamp pr) ] + // + // + // + // // Start importing let tcConfigP = TcConfigProvider.Constant tcConfig @@ -1640,14 +1639,13 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let diagnostics = match builderOpt with | Some builder -> - let diagnosticsOptions = builder.TcConfig.diagnosticsOptions - let errorLogger = CompilationDiagnosticLogger("IncrementalBuilderCreation", diagnosticsOptions) + let errorSeverityOptions = builder.TcConfig.errorSeverityOptions + let errorLogger = CompilationErrorLogger("IncrementalBuilderCreation", errorSeverityOptions) delayedLogger.CommitDelayedDiagnostics errorLogger errorLogger.GetDiagnostics() | _ -> Array.ofList delayedLogger.Diagnostics - |> Array.map (fun (diag, severity) -> - FSharpDiagnostic.CreateFromException(diag, severity, range.Zero, suggestNamesForErrors)) + |> Array.map (fun (d, severity) -> FSharpDiagnostic.CreateFromException(d, severity, range.Zero, suggestNamesForErrors)) return builderOpt, diagnostics } \ No newline at end of file diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index d55e1dcf7f9..ac4b206eb54 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -12,7 +12,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure @@ -57,14 +57,13 @@ type internal TcInfo = latestCcuSigForFile: ModuleOrNamespaceType option /// Accumulated errors, last file first - tcDiagnosticsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] list + tcErrorsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] list tcDependencyFiles: string list sigNameOpt: (string * QualifiedNameOfFile) option } - /// Accumulated diagnostics - member TcDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + member TcErrors: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 0cb7f19ba78..1f55a0e5c70 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -9,7 +9,7 @@ open Internal.Utilities.Library open FSharp.Compiler.Diagnostics open FSharp.Compiler.Import open FSharp.Compiler.Infos -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.TcGlobals @@ -17,7 +17,6 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy type SemanticClassificationType = | ReferenceType = 0 @@ -72,7 +71,7 @@ module TcResolutionsExtensions = type TcResolutions with member sResolutions.GetSemanticClassification(g: TcGlobals, amap: ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : SemanticClassificationItem [] = - DiagnosticsScope.Protect range0 (fun () -> + ErrorScope.Protect range0 (fun () -> let (|LegitTypeOccurence|_|) = function | ItemOccurence.UseInType | ItemOccurence.UseInAttribute @@ -342,7 +341,7 @@ module TcResolutionsExtensions = | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then add m SemanticClassificationType.Enumeration - elif tcref.IsFSharpException then + elif tcref.IsExceptionDecl then add m SemanticClassificationType.Exception elif tcref.IsFSharpDelegateTycon then add m SemanticClassificationType.Delegate diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index 0a89eb646d2..e65d12b8fa4 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -247,7 +247,7 @@ module AssemblyContent = // are not triggered (see "if not entity.IsProvided") and the other data accessed is immutable or computed safely // on-demand. However a more compete review may be warranted. - use _ignoreAllDiagnostics = new DiagnosticsScope() + use _ignoreAllDiagnostics = new ErrorScope() signature.TryGetEntities() |> Seq.collect (traverseEntity contentType Parent.Empty) @@ -265,7 +265,7 @@ module AssemblyContent = // concurrently with other threads. On an initial review this is not a problem since type provider computations // are not triggered (see "if not entity.IsProvided") and the other data accessed is immutable or computed safely // on-demand. However a more compete review may be warranted. - use _ignoreAllDiagnostics = new DiagnosticsScope() + use _ignoreAllDiagnostics = new ErrorScope() #if !NO_TYPEPROVIDERS match assemblies |> List.filter (fun x -> not x.IsProviderGenerated), fileName with diff --git a/src/fsharp/service/ServiceCompilerDiagnostics.fs b/src/fsharp/service/ServiceCompilerDiagnostics.fs index f61b8ad9b6f..abbedea37d2 100644 --- a/src/fsharp/service/ServiceCompilerDiagnostics.fs +++ b/src/fsharp/service/ServiceCompilerDiagnostics.fs @@ -17,7 +17,7 @@ module CompilerDiagnostics = | FSharpDiagnosticKind.AddIndexerDot -> FSComp.SR.addIndexerDot() | FSharpDiagnosticKind.ReplaceWithSuggestion s -> FSComp.SR.replaceWithSuggestion(s) - let GetSuggestedNames (suggestionsF: FSharp.Compiler.DiagnosticsLogger.Suggestions) (unresolvedIdentifier: string) = + let GetSuggestedNames (suggestionsF: FSharp.Compiler.ErrorLogger.Suggestions) (unresolvedIdentifier: string) = let buffer = SuggestionBuffer(unresolvedIdentifier) if buffer.Disabled then Seq.empty diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index cae7ebfe708..e0ec1e81016 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution @@ -222,7 +222,7 @@ module DeclarationListHelpers = let remarks = toArray remarks ToolTipElement.Single (layout, xml, remarks=remarks) - | Item.RecdField rfinfo when rfinfo.TyconRef.IsFSharpException -> + | Item.RecdField rfinfo when rfinfo.TyconRef.IsExceptionDecl -> let ty, _ = PrettyTypes.PrettifyType g rfinfo.FieldType let id = rfinfo.RecdField.Id let layout = @@ -459,7 +459,7 @@ module DeclarationListHelpers = /// Format the structured version of a tooltip for an item let FormatStructuredDescriptionOfItem isDecl infoReader ad m denv item = - DiagnosticsScope.Protect m + ErrorScope.Protect m (fun () -> FormatItemDescriptionToToolTipElement isDecl infoReader ad m denv item) (fun err -> ToolTipElement.CompositionError err) @@ -857,7 +857,7 @@ module internal DescriptionListsImpl = | Item.Types _ -> FSharpGlyph.Class | Item.UnqualifiedType (tcref :: _) -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then FSharpGlyph.Enum - elif tcref.IsFSharpException then FSharpGlyph.Exception + elif tcref.IsExceptionDecl then FSharpGlyph.Exception elif tcref.IsFSharpDelegateTycon then FSharpGlyph.Delegate elif tcref.IsFSharpInterfaceTycon then FSharpGlyph.Interface elif tcref.IsFSharpStructOrEnumTycon then FSharpGlyph.Struct @@ -1183,7 +1183,7 @@ type MethodGroup( name: string, unsortedMethods: MethodGroupItem[] ) = let methods = flatItems |> Array.ofList |> Array.map (fun flatItem -> let prettyParams, prettyRetTyL = - DiagnosticsScope.Protect m + ErrorScope.Protect m (fun () -> PrettyParamsAndReturnTypeOfItem infoReader m denv { item with Item = flatItem }) (fun err -> [], wordL (tagText err)) diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index a823215c5f3..8996aa276ee 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -11,7 +11,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Lexhelp open FSharp.Compiler.Parser @@ -334,20 +334,10 @@ module internal TestExpose = type FSharpTokenizerLexState = { PosBits: int64 OtherBits: int64 } - static member Initial = { PosBits = 0L; OtherBits = 0L } - - member this.Equals (other: FSharpTokenizerLexState) = - (this.PosBits = other.PosBits) && - (this.OtherBits = other.OtherBits) - - override this.Equals (obj: obj) = - match obj with - | :? FSharpTokenizerLexState as other -> this.Equals other - | _ -> false - - override this.GetHashCode () = - hash this.PosBits + hash this.OtherBits + member this.Equals (other: FSharpTokenizerLexState) = (this.PosBits = other.PosBits) && (this.OtherBits = other.OtherBits) + override this.Equals (obj: obj) = match obj with :? FSharpTokenizerLexState as other -> this.Equals other | _ -> false + override this.GetHashCode () = hash this.PosBits + hash this.OtherBits type FSharpTokenizerColorState = | Token = 1 @@ -832,7 +822,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, member x.ScanToken (lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) let lightStatus, lexcont = LexerStateEncoding.decodeLexInt lexState let lightStatus = IndentationAwareSyntaxStatus(lightStatus, false) @@ -1521,7 +1511,7 @@ type FSharpToken = [] module FSharpLexerImpl = - let lexWithDiagnosticsLogger (text: ISourceText) conditionalDefines (flags: FSharpLexerFlags) reportLibraryOnlyFeatures langVersion errorLogger onToken pathMap (ct: CancellationToken) = + let lexWithErrorLogger (text: ISourceText) conditionalDefines (flags: FSharpLexerFlags) reportLibraryOnlyFeatures langVersion errorLogger onToken pathMap (ct: CancellationToken) = let canSkipTrivia = (flags &&& FSharpLexerFlags.SkipTrivia) = FSharpLexerFlags.SkipTrivia let isLightSyntaxOn = (flags &&& FSharpLexerFlags.LightSyntaxOn) = FSharpLexerFlags.LightSyntaxOn let isCompiling = (flags &&& FSharpLexerFlags.Compiling) = FSharpLexerFlags.Compiling @@ -1543,7 +1533,7 @@ module FSharpLexerImpl = lexer use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) resetLexbufPos "" lexbuf while not lexbuf.IsPastEndOfStream do @@ -1551,8 +1541,8 @@ module FSharpLexerImpl = onToken (getNextToken lexbuf) lexbuf.LexemeRange let lex text conditionalDefines flags reportLibraryOnlyFeatures langVersion lexCallback pathMap ct = - let errorLogger = CompilationDiagnosticLogger("Lexer", FSharpDiagnosticOptions.Default) - lexWithDiagnosticsLogger text conditionalDefines flags reportLibraryOnlyFeatures langVersion errorLogger lexCallback pathMap ct + let errorLogger = CompilationErrorLogger("Lexer", FSharpDiagnosticOptions.Default) + lexWithErrorLogger text conditionalDefines flags reportLibraryOnlyFeatures langVersion errorLogger lexCallback pathMap ct [] type FSharpLexer = diff --git a/src/fsharp/service/ServiceNavigation.fs b/src/fsharp/service/ServiceNavigation.fs index de3b0bece2c..520587fd50d 100755 --- a/src/fsharp/service/ServiceNavigation.fs +++ b/src/fsharp/service/ServiceNavigation.fs @@ -218,7 +218,7 @@ module NavigationImpl = | _ -> [] // Returns class-members for the right dropdown - and processMembers members enclosingEntityKind = + and processMembers members enclosingEntityKind : range * list = let members = members |> List.groupBy (fun x -> x.Range) @@ -389,7 +389,7 @@ module NavigationImpl = //| TyconCore_repr_hidden of range | _ -> [] - and processSigMembers (members: SynMemberSig list) = + and processSigMembers (members: SynMemberSig list): list = [ for memb in members do match memb with | SynMemberSig.Member(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _, _) -> @@ -399,40 +399,37 @@ module NavigationImpl = | _ -> () ] // Process declarations in a module that belong to the right drop-down (let bindings) - let processNestedSigDeclarations decls = - decls |> List.collect (fun decl -> - match decl with - | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _) -> - [ createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) ] - | _ -> [] ) + let processNestedSigDeclarations decls = decls |> List.collect (function + | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _) -> + [ createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) ] + | _ -> [] ) // Process declarations nested in a module that should be displayed in the left dropdown // (such as type declarations, nested modules etc.) let rec processNavigationTopLevelSigDeclarations(baseName, decls) = - decls |> List.collect (fun decl -> - match decl with - | SynModuleSigDecl.ModuleAbbrev(id, lid, m) -> - [ createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, rangeOfLid lid, [], NavigationEntityKind.Module, false, None) ] + decls + |> List.collect (function + | SynModuleSigDecl.ModuleAbbrev(id, lid, m) -> + [ createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, rangeOfLid lid, [], NavigationEntityKind.Module, false, None) ] - | SynModuleSigDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); moduleDecls=decls; range=m) -> - // Find let bindings (for the right dropdown) - let nested = processNestedSigDeclarations(decls) - let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) + | SynModuleSigDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); moduleDecls=decls; range=m) -> + // Find let bindings (for the right dropdown) + let nested = processNestedSigDeclarations(decls) + let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) - // Get nested modules and types (for the left dropdown) - let other = processNavigationTopLevelSigDeclarations(newBaseName, decls) - createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other), nested, NavigationEntityKind.Module, false, access) :: other + // Get nested modules and types (for the left dropdown) + let other = processNavigationTopLevelSigDeclarations(newBaseName, decls) + createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other), nested, NavigationEntityKind.Module, false, access) :: other - | SynModuleSigDecl.Types(tydefs, _) -> tydefs |> List.collect (processTycon baseName) - | SynModuleSigDecl.Exception (defn,_) -> processExnSig baseName defn - | _ -> []) + | SynModuleSigDecl.Types(tydefs, _) -> tydefs |> List.collect (processTycon baseName) + | SynModuleSigDecl.Exception (defn,_) -> processExnSig baseName defn + | _ -> []) // Collect all the items let items = // Show base name for this module only if it's not the root one let singleTopLevel = (modules.Length = 1) - modules |> List.collect (fun modulSig -> - let (SynModuleOrNamespaceSig(id, _isRec, kind, decls, _, _, access, m, _)) = modulSig + modules |> List.collect (fun (SynModuleOrNamespaceSig(id, _isRec, kind, decls, _, _, access, m, _)) -> let baseName = if (not singleTopLevel) then textOfLid id else "" // Find let bindings (for the right dropdown) let nested = processNestedSigDeclarations(decls) diff --git a/src/fsharp/service/ServiceParamInfoLocations.fs b/src/fsharp/service/ServiceParamInfoLocations.fs index 8d1f8e93d23..f883e171430 100755 --- a/src/fsharp/service/ServiceParamInfoLocations.fs +++ b/src/fsharp/service/ServiceParamInfoLocations.fs @@ -34,22 +34,14 @@ type ParameterLocations // (compare to f( or f(42, where the parser injects a fake "AbrExpr" to represent the missing argument) assert(tupleEndLocations.Length = namedParamNames.Length + 1) [| yield! namedParamNames; yield None |] // None is representation of a non-named param - - member _.LongId = longId - - member _.LongIdStartLocation = longIdRange.Start - - member _.LongIdEndLocation = longIdRange.End - - member _.OpenParenLocation = openParenLocation - - member _.TupleEndLocations = tupleEndLocations - - member _.IsThereACloseParen = isThereACloseParen - - member _.NamedParamNames = namedParamNames - - member _.ArgumentLocations = argRanges |> Array.ofList + member this.LongId = longId + member this.LongIdStartLocation = longIdRange.Start + member this.LongIdEndLocation = longIdRange.End + member this.OpenParenLocation = openParenLocation + member this.TupleEndLocations = tupleEndLocations + member this.IsThereACloseParen = isThereACloseParen + member this.NamedParamNames = namedParamNames + member this.ArgumentLocations = argRanges |> Array.ofList [] module internal ParameterLocationsImpl = @@ -191,7 +183,7 @@ module internal ParameterLocationsImpl = let traverseInput(pos, parseTree) = SyntaxTraversal.Traverse(pos, parseTree, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let expr = expr // fix debug locals match expr with @@ -266,12 +258,12 @@ module internal ParameterLocationsImpl = | _ -> defaultTraverse expr - member _.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = + member this.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = match tyAbbrevRhs with | StaticParameters pos loc -> Some loc | _ -> None - member _.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = + member this.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = match defaultTraverse expr with | Some _ as r -> r | None -> diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index 5e19aed8106..b98dd95378b 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -165,7 +165,7 @@ module SyntaxTraversal = let dive node range project = range,(fun() -> project node) - let pick pos (outerRange:range) (debugObj:obj) (diveResults: (range * _) list) = + let pick pos (outerRange:range) (debugObj:obj) (diveResults:list) = match diveResults with | [] -> None | _ -> diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index 16000de1e75..0ef54b9058e 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -355,7 +355,7 @@ module ParsedInput = let pick x = SyntaxTraversal.pick pos x let walker = { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let pick = pick expr.Range let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars if not(rangeContainsPos expr.Range pos) then @@ -1610,7 +1610,7 @@ module ParsedInput = // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new DiagnosticsScope() + use _ignoreAllDiagnostics = new ErrorScope() let mutable result = None let mutable ns = None @@ -1742,7 +1742,7 @@ module ParsedInput = // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new DiagnosticsScope() + use _ignoreAllDiagnostics = new ErrorScope() match res with | None -> [||] | Some (scope, ns, pos) -> diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index bc9f5255c3e..8aa0a7e1ed4 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -705,7 +705,7 @@ module Structure = with the following construct. This necessitates inspecting the children of the construct and finding the end of the last child's range to use instead. - Detailed further in - https://github.com/dotnet/fsharp/issues/2094 + Detailed further in - https://github.com/Microsoft/visualfsharp/issues/2094 *) let lastMemberSigRangeElse r memberSigs = diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 9f4bb64466e..0c8e892e156 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.CompilerOptions open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.IO open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure @@ -85,33 +85,28 @@ module Helpers = && FSharpProjectOptions.UseSameProject(o1,o2) module CompileHelpers = - let mkCompilationDiagnosticsHandlers() = - let diagnostics = ResizeArray<_>() + let mkCompilationErrorHandlers() = + let errors = ResizeArray<_>() - let diagnosticSink isError exn = - let main, related = SplitRelatedDiagnostics exn - let oneDiagnostic e = diagnostics.Add(FSharpDiagnostic.CreateFromException (e, isError, range0, true)) // Suggest names for errors - oneDiagnostic main - List.iter oneDiagnostic related + let errorSink isError exn = + let mainError, relatedErrors = SplitRelatedDiagnostics exn + let oneError e = errors.Add(FSharpDiagnostic.CreateFromException (e, isError, range0, true)) // Suggest names for errors + oneError mainError + List.iter oneError relatedErrors let errorLogger = - { new DiagnosticsLogger("CompileAPI") with - - member _.DiagnosticSink(exn, isError) = diagnosticSink isError exn - - member _.ErrorCount = - diagnostics - |> Seq.filter (fun diag -> diag.Severity = FSharpDiagnosticSeverity.Error) - |> Seq.length } + { new ErrorLogger("CompileAPI") with + member x.DiagnosticSink(exn, isError) = errorSink isError exn + member x.ErrorCount = errors |> Seq.filter (fun e -> e.Severity = FSharpDiagnosticSeverity.Error) |> Seq.length } let loggerProvider = - { new DiagnosticsLoggerProvider() with - member _.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } - diagnostics, errorLogger, loggerProvider + { new ErrorLoggerProvider() with + member x.CreateErrorLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } + errors, errorLogger, loggerProvider let tryCompile errorLogger f = use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) + use unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) let exiter = { new Exiter with member x.Exit n = raise StopProcessing } try f exiter @@ -123,25 +118,25 @@ module CompileHelpers = /// Compile using the given flags. Source files names are resolved via the FileSystem API. The output file must be given by a -o flag. let compileFromArgs (ctok, argv: string[], legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) = - let diagnostics, errorLogger, loggerProvider = mkCompilationDiagnosticsHandlers() + let errors, errorLogger, loggerProvider = mkCompilationErrorHandlers() let result = tryCompile errorLogger (fun exiter -> - CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) + mainCompile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) - diagnostics.ToArray(), result + errors.ToArray(), result let compileFromAsts (ctok, legacyReferenceResolver, asts, assemblyName, outFile, dependencies, noframework, pdbFile, executable, tcImportsCapture, dynamicAssemblyCreator) = - let diagnostics, errorLogger, loggerProvider = mkCompilationDiagnosticsHandlers() + let errors, errorLogger, loggerProvider = mkCompilationErrorHandlers() let executable = defaultArg executable true let target = if executable then CompilerTarget.ConsoleExe else CompilerTarget.Dll let result = tryCompile errorLogger (fun exiter -> - CompileFromSyntaxTrees (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) + compileOfAst (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) - diagnostics.ToArray(), result + errors.ToArray(), result let createDynamicAssembly (debugInfo: bool, tcImportsRef: TcImports option ref, execute: bool, assemblyBuilderRef: _ option ref) (tcConfig: TcConfig, tcGlobals:TcGlobals, outfile, ilxMainModule) = @@ -522,7 +517,7 @@ type BackgroundCompiler( return FSharpParseFileResults(creationDiags, parseTree, true, [| |]) | Some builder -> let parseTree,_,_,parseDiags = builder.GetParseResultsForFile fileName - let diagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.diagnosticsOptions, false, fileName, parseDiags, suggestNamesForErrors) |] + let diagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.errorSeverityOptions, false, fileName, parseDiags, suggestNamesForErrors) |] return FSharpParseFileResults(diagnostics = diagnostics, input = parseTree, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) } @@ -578,7 +573,7 @@ type BackgroundCompiler( tcInfo.tcState, tcInfo.moduleNamesDict, loadClosure, - tcInfo.TcDiagnostics, + tcInfo.TcErrors, options.IsIncompleteTypeCheckEnvironment, options, builder, @@ -730,10 +725,10 @@ type BackgroundCompiler( let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile let latestImplementationFile = tcInfoExtras.latestImplFile let tcDependencyFiles = tcInfo.tcDependencyFiles - let tcDiagnostics = tcInfo.TcDiagnostics - let diagnosticsOptions = builder.TcConfig.diagnosticsOptions - let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, parseDiags, suggestNamesForErrors) |] - let tcDiagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, tcDiagnostics, suggestNamesForErrors) |] + let tcErrors = tcInfo.TcErrors + let errorOptions = builder.TcConfig.errorSeverityOptions + let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, parseDiags, suggestNamesForErrors) |] + let tcErrors = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, tcErrors, suggestNamesForErrors) |] let parseResults = FSharpParseFileResults(diagnostics=parseDiags, input=parseTree, parseHadErrors=false, dependencyFiles=builder.AllDependenciesDeprecated) let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) let typedResults = @@ -748,7 +743,7 @@ type BackgroundCompiler( Array.ofList tcDependencyFiles, creationDiags, parseResults.Diagnostics, - tcDiagnostics, + tcErrors, keepAssemblyContents, Option.get latestCcuSigForFile, tcState.Ccu, @@ -820,7 +815,7 @@ type BackgroundCompiler( return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationDiags, None) | Some builder -> let! tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = builder.GetFullCheckResultsAndImplementationsForProject() - let diagnosticsOptions = tcProj.TcConfig.diagnosticsOptions + let errorOptions = tcProj.TcConfig.errorSeverityOptions let fileName = DummyFileNameForRangesWithoutASpecificLocation // Although we do not use 'tcInfoExtras', computing it will make sure we get an extra info. @@ -829,32 +824,28 @@ type BackgroundCompiler( let topAttribs = tcInfo.topAttribs let tcState = tcInfo.tcState let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile - let tcDiagnostics = tcInfo.TcDiagnostics + let tcErrors = tcInfo.TcErrors let tcDependencyFiles = tcInfo.tcDependencyFiles let diagnostics = [| yield! creationDiags; - yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, true, fileName, tcDiagnostics, suggestNamesForErrors) |] + yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, true, fileName, tcErrors, suggestNamesForErrors) |] let getAssemblyData() = match tcAssemblyDataOpt with | ProjectAssemblyDataResult.Available data -> Some data | _ -> None - let details = - (tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, - Choice1Of2 builder, topAttribs, getAssemblyData, ilAssemRef, - tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, - Array.ofList tcDependencyFiles, - options) - let results = - FSharpCheckProjectResults( - options.ProjectFileName, + FSharpCheckProjectResults + (options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, - diagnostics, - Some details - ) + diagnostics, + Some(tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, + (Choice1Of2 builder), topAttribs, getAssemblyData, ilAssemRef, + tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, + Array.ofList tcDependencyFiles, + options)) return results } @@ -887,7 +878,7 @@ type BackgroundCompiler( member _.GetProjectOptionsFromScript(fileName, sourceText, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib: bool option, useSdkRefs: bool option, sdkDirOverride: string option, assumeDotNetFramework: bool option, optionsStamp: int64 option, _userOpName) = cancellable { - use diagnostics = new DiagnosticsScope() + use errors = new ErrorScope() // Do we add a reference to FSharp.Compiler.Interactive.Settings by default? let useFsiAuxLib = defaultArg useFsiAuxLib true @@ -944,7 +935,7 @@ type BackgroundCompiler( } scriptClosureCache.Set(AnyCallerThread, options, loadClosure) // Save the full load closure for later correlation. let diags = loadClosure.LoadClosureRootFileDiagnostics |> List.map (fun (exn, isError) -> FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false)) - return options, (diags @ diagnostics.Diagnostics) + return options, (diags @ errors.Diagnostics) } |> Cancellable.toAsync @@ -1159,7 +1150,7 @@ type FSharpChecker(legacyReferenceResolver, let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) // Perform the compilation, given the above capturing function. - let diagnostics, result = CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) + let errorsAndWarnings, result = CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) // Retrieve and return the results let assemblyOpt = @@ -1167,7 +1158,7 @@ type FSharpChecker(legacyReferenceResolver, | None -> None | Some a -> Some (a :> Assembly) - return diagnostics, result, assemblyOpt + return errorsAndWarnings, result, assemblyOpt } member _.CompileToDynamicAssembly (ast:ParsedInput list, assemblyName:string, dependencies:string list, execute: (TextWriter * TextWriter) option, ?debug:bool, ?noframework:bool, ?userOpName: string) = @@ -1192,7 +1183,7 @@ type FSharpChecker(legacyReferenceResolver, let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) // Perform the compilation, given the above capturing function. - let diagnostics, result = + let errorsAndWarnings, result = CompileHelpers.compileFromAsts (ctok, legacyReferenceResolver, ast, assemblyName, outFile, dependencies, noframework, None, Some execute.IsSome, tcImportsCapture, dynamicAssemblyCreator) // Retrieve and return the results @@ -1201,7 +1192,7 @@ type FSharpChecker(legacyReferenceResolver, | None -> None | Some a -> Some (a :> Assembly) - return diagnostics, result, assemblyOpt + return errorsAndWarnings, result, assemblyOpt } /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation. @@ -1304,7 +1295,7 @@ type FSharpChecker(legacyReferenceResolver, member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive, ?isEditing) = let isEditing = defaultArg isEditing false let isInteractive = defaultArg isInteractive false - use errorScope = new DiagnosticsScope() + use errorScope = new ErrorScope() let tcConfigB = TcConfigBuilder.CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, @@ -1377,7 +1368,7 @@ open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.EditorServices open FSharp.Compiler.Text.Range -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger type CompilerEnvironment() = /// Source file extensions diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index e9ccc85ddc8..b479ec8a47e 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -6,7 +6,7 @@ open FSharp.Compiler open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Infos open FSharp.Compiler.QuotationTranslator open FSharp.Compiler.Syntax @@ -14,7 +14,6 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations [] diff --git a/src/fsharp/symbols/FSharpDiagnostic.fs b/src/fsharp/symbols/FSharpDiagnostic.fs deleted file mode 100644 index 09e118a3ea4..00000000000 --- a/src/fsharp/symbols/FSharpDiagnostic.fs +++ /dev/null @@ -1,207 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -//---------------------------------------------------------------------------- -// Open up the compiler as an incremental service for parsing, -// type checking and intellisense-like environment-reporting. -//-------------------------------------------------------------------------- - -namespace FSharp.Compiler.Diagnostics - -open System - -open Internal.Utilities.Library -open Internal.Utilities.Library.Extras - -open FSharp.Core.Printf -open FSharp.Compiler -open FSharp.Compiler.CompilerDiagnostics -open FSharp.Compiler.Diagnostics -open FSharp.Compiler.DiagnosticsLogger -open FSharp.Compiler.Text -open FSharp.Compiler.Text.Position -open FSharp.Compiler.Text.Range - -type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string) = - member _.Range = m - - member _.Severity = severity - - member _.Message = message - - member _.Subcategory = subcategory - - member _.ErrorNumber = errorNum - - member _.ErrorNumberPrefix = numberPrefix - - member _.ErrorNumberText = numberPrefix + errorNum.ToString("0000") - - member _.Start = m.Start - - member _.End = m.End - - member _.StartLine = m.Start.Line - - member _.EndLine = m.End.Line - - member _.StartColumn = m.Start.Column - - member _.EndColumn = m.End.Column - - member _.FileName = m.FileName - - member _.WithStart newStart = - let m = mkFileIndexRange m.FileIndex newStart m.End - FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) - - member _.WithEnd newEnd = - let m = mkFileIndexRange m.FileIndex m.Start newEnd - FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) - - override _.ToString() = - let fileName = m.FileName - let s = m.Start - let e = m.End - let severity = - match severity with - | FSharpDiagnosticSeverity.Warning -> "warning" - | FSharpDiagnosticSeverity.Error -> "error" - | FSharpDiagnosticSeverity.Info -> "info" - | FSharpDiagnosticSeverity.Hidden -> "hidden" - sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message - - /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromException(diag, severity, fallbackRange: range, suggestNames: bool) = - let m = match GetRangeOfDiagnostic diag with Some m -> m | None -> fallbackRange - let msg = bufs (fun buf -> OutputPhasedDiagnostic buf diag false suggestNames) - let errorNum = GetDiagnosticNumber diag - FSharpDiagnostic(m, severity, msg, diag.Subcategory(), errorNum, "FS") - - /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromExceptionAndAdjustEof(diag, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = - let diag = FSharpDiagnostic.CreateFromException(diag, severity, fallbackRange, suggestNames) - - // Adjust to make sure that errors reported at Eof are shown at the linesCount - let startline, schange = min (Line.toZ diag.Range.StartLine, false) (linesCount, true) - let endline, echange = min (Line.toZ diag.Range.EndLine, false) (linesCount, true) - - if not (schange || echange) then diag - else - let r = if schange then diag.WithStart(mkPos startline lastLength) else diag - if echange then r.WithEnd(mkPos endline (1 + lastLength)) else r - - static member NewlineifyErrorString(message) = NewlineifyErrorString(message) - - static member NormalizeErrorString(text) = NormalizeErrorString(text) - - static member Create(severity: FSharpDiagnosticSeverity, message: string, number: int, range: range, ?numberPrefix: string, ?subcategory: string) = - let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck - let numberPrefix = defaultArg numberPrefix "FS" - FSharpDiagnostic(range, severity, message, subcategory, number, numberPrefix) - -/// Use to reset error and warning handlers -[] -type DiagnosticsScope() = - let mutable diags = [] - let mutable firstError = None - let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck - let unwindEL = - PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> - { new DiagnosticsLogger("DiagnosticsScope") with - member x.DiagnosticSink(exn, severity) = - let err = FSharpDiagnostic.CreateFromException(exn, severity, range.Zero, false) - diags <- err :: diags - if severity = FSharpDiagnosticSeverity.Error && firstError.IsNone then - firstError <- Some err.Message - member x.ErrorCount = diags.Length }) - - member _.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) - - member _.Diagnostics = diags - - member x.TryGetFirstErrorText() = - match x.Errors with - | error :: _ -> Some error.Message - | [] -> None - - interface IDisposable with - member _.Dispose() = - unwindEL.Dispose() (* unwind pushes when DiagnosticsScope disposes *) - unwindBP.Dispose() - - member _.FirstError with get() = firstError and set v = firstError <- v - - /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and - /// perform other operations which might expose us to either bona-fide F# error messages such - /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, - /// may hit internal compiler failures. - /// - /// In some calling cases, we get a chance to report the error as part of user text. For example - /// if there is a "missing assembly" error while formatting the text of the description of an - /// autocomplete, then the error message is shown in replacement of the text (rather than crashing Visual - /// Studio, or swallowing the exception completely) - static member Protect<'a> (m: range) (f: unit->'a) (err: string->'a): 'a = - use errorScope = new DiagnosticsScope() - let res = - try - Some (f()) - with e -> - // Here we only call errorRecovery to save the error message for later use by TryGetFirstErrorText. - try - errorRecovery e m - with _ -> - // If error recovery fails, then we have an internal compiler error. In this case, we show the whole stack - // in the extra message, should the extra message be used. - errorScope.FirstError <- Some (e.ToString()) - None - match res with - | Some res -> res - | None -> - match errorScope.TryGetFirstErrorText() with - | Some text -> err text - | None -> err "" - -/// An error logger that capture errors, filtering them according to warning levels etc. -type internal CompilationDiagnosticLogger (debugName: string, options: FSharpDiagnosticOptions) = - inherit DiagnosticsLogger("CompilationDiagnosticLogger("+debugName+")") - - let mutable errorCount = 0 - let diagnostics = ResizeArray<_>() - - override _.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError options (err, severity) then - diagnostics.Add(err, FSharpDiagnosticSeverity.Error) - errorCount <- errorCount + 1 - elif ReportDiagnosticAsWarning options (err, severity) then - diagnostics.Add(err, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo options (err, severity) then - diagnostics.Add(err, severity) - override x.ErrorCount = errorCount - - member x.GetDiagnostics() = diagnostics.ToArray() - -module DiagnosticHelpers = - - let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) = - [ let severity = - if ReportDiagnosticAsError options (exn, severity) then FSharpDiagnosticSeverity.Error - else severity - if (severity = FSharpDiagnosticSeverity.Error || ReportDiagnosticAsWarning options (exn, severity) || ReportDiagnosticAsInfo options (exn, severity)) then - let oneError exn = - [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. - // Not ideal, but it's hard to see what else to do. - let fallbackRange = rangeN mainInputFileName 1 - let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, severity, fallbackRange, fileInfo, suggestNames) - let fileName = ei.Range.FileName - if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then - yield ei ] - - let mainError, relatedErrors = SplitRelatedDiagnostics exn - yield! oneError mainError - for e in relatedErrors do - yield! oneError e ] - - let CreateDiagnostics (options, allErrors, mainInputFileName, errors, suggestNames) = - let fileInfo = (Int32.MaxValue, Int32.MaxValue) - [| for exn, severity in errors do - yield! ReportDiagnostic (options, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) |] diff --git a/src/fsharp/symbols/FSharpDiagnostic.fsi b/src/fsharp/symbols/FSharpDiagnostic.fsi deleted file mode 100644 index 2e5ea40dcf2..00000000000 --- a/src/fsharp/symbols/FSharpDiagnostic.fsi +++ /dev/null @@ -1,130 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -//---------------------------------------------------------------------------- -// Helpers for quick info and information about items -//---------------------------------------------------------------------------- - -namespace FSharp.Compiler.Diagnostics - -open System -open FSharp.Compiler.Text -open FSharp.Compiler.DiagnosticsLogger - -/// Represents a diagnostic produced by the F# compiler -[] -type public FSharpDiagnostic = - - /// Gets the file name for the diagnostic - member FileName: string - - /// Gets the start position for the diagnostic - member Start: Position - - /// Gets the end position for the diagnostic - member End: Position - - /// Gets the start column for the diagnostic - member StartColumn: int - - /// Gets the end column for the diagnostic - member EndColumn: int - - /// Gets the start line for the diagnostic - member StartLine: int - - /// Gets the end line for the diagnostic - member EndLine: int - - /// Gets the range for the diagnostic - member Range: range - - /// Gets the severity for the diagnostic - member Severity: FSharpDiagnosticSeverity - - /// Gets the message for the diagnostic - member Message: string - - /// Gets the sub-category for the diagnostic - member Subcategory: string - - /// Gets the number for the diagnostic - member ErrorNumber: int - - /// Gets the number prefix for the diagnostic, usually "FS" but may differ for analyzers - member ErrorNumberPrefix: string - - /// Gets the full error number text e.g "FS0031" - member ErrorNumberText: string - - /// Creates a diagnostic, e.g. for reporting from an analyzer - static member Create: - severity: FSharpDiagnosticSeverity * - message: string * - number: int * - range: range * - ?numberPrefix: string * - ?subcategory: string -> - FSharpDiagnostic - - static member internal CreateFromExceptionAndAdjustEof: - diag: PhasedDiagnostic * - severity: FSharpDiagnosticSeverity * - range * - lastPosInFile: (int * int) * - suggestNames: bool -> - FSharpDiagnostic - - static member internal CreateFromException: - diag: PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic - - /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), - /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo - static member NewlineifyErrorString: message: string -> string - - /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), - /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo - static member NormalizeErrorString: text: string -> string - -//---------------------------------------------------------------------------- -// Internal only - -// Implementation details used by other code in the compiler -[] -type internal DiagnosticsScope = - - interface IDisposable - - new: unit -> DiagnosticsScope - - member Diagnostics: FSharpDiagnostic list - - static member Protect<'T> : range -> (unit -> 'T) -> (string -> 'T) -> 'T - -/// An error logger that capture errors, filtering them according to warning levels etc. -type internal CompilationDiagnosticLogger = - inherit DiagnosticsLogger - - /// Create the diagnostics logger - new: debugName: string * options: FSharpDiagnosticOptions -> CompilationDiagnosticLogger - - /// Get the captured diagnostics - member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity) [] - -module internal DiagnosticHelpers = - - val ReportDiagnostic: - FSharpDiagnosticOptions * - allErrors: bool * - mainInputFileName: string * - fileInfo: (int * int) * - (PhasedDiagnostic * FSharpDiagnosticSeverity) * - suggestNames: bool -> - FSharpDiagnostic list - - val CreateDiagnostics: - FSharpDiagnosticOptions * - allErrors: bool * - mainInputFileName: string * - seq * - suggestNames: bool -> - FSharpDiagnostic [] diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 5def8ebe7be..8f7962d8862 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -1,5 +1,212 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +//---------------------------------------------------------------------------- +// Open up the compiler as an incremental service for parsing, +// type checking and intellisense-like environment-reporting. +//-------------------------------------------------------------------------- + +namespace FSharp.Compiler.Diagnostics + +open System + +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +open FSharp.Core.Printf +open FSharp.Compiler +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Position +open FSharp.Compiler.Text.Range + +type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string) = + member _.Range = m + + member _.Severity = severity + + member _.Message = message + + member _.Subcategory = subcategory + + member _.ErrorNumber = errorNum + + member _.ErrorNumberPrefix = numberPrefix + + member _.ErrorNumberText = numberPrefix + errorNum.ToString("0000") + + member _.Start = m.Start + + member _.End = m.End + + member _.StartLine = m.Start.Line + + member _.EndLine = m.End.Line + + member _.StartColumn = m.Start.Column + + member _.EndColumn = m.End.Column + + member _.FileName = m.FileName + + member _.WithStart newStart = + let m = mkFileIndexRange m.FileIndex newStart m.End + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) + + member _.WithEnd newEnd = + let m = mkFileIndexRange m.FileIndex m.Start newEnd + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) + + override _.ToString() = + let fileName = m.FileName + let s = m.Start + let e = m.End + let severity = + match severity with + | FSharpDiagnosticSeverity.Warning -> "warning" + | FSharpDiagnosticSeverity.Error -> "error" + | FSharpDiagnosticSeverity.Info -> "info" + | FSharpDiagnosticSeverity.Hidden -> "hidden" + sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message + + /// Decompose a warning or error into parts: position, severity, message, error number + static member CreateFromException(exn, severity, fallbackRange: range, suggestNames: bool) = + let m = match GetRangeOfDiagnostic exn with Some m -> m | None -> fallbackRange + let msg = bufs (fun buf -> OutputPhasedDiagnostic buf exn false suggestNames) + let errorNum = GetDiagnosticNumber exn + FSharpDiagnostic(m, severity, msg, exn.Subcategory(), errorNum, "FS") + + /// Decompose a warning or error into parts: position, severity, message, error number + static member CreateFromExceptionAndAdjustEof(exn, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = + let r = FSharpDiagnostic.CreateFromException(exn, severity, fallbackRange, suggestNames) + + // Adjust to make sure that errors reported at Eof are shown at the linesCount + let startline, schange = min (Line.toZ r.Range.StartLine, false) (linesCount, true) + let endline, echange = min (Line.toZ r.Range.EndLine, false) (linesCount, true) + + if not (schange || echange) then r + else + let r = if schange then r.WithStart(mkPos startline lastLength) else r + if echange then r.WithEnd(mkPos endline (1 + lastLength)) else r + + static member NewlineifyErrorString(message) = NewlineifyErrorString(message) + + static member NormalizeErrorString(text) = NormalizeErrorString(text) + + static member Create(severity: FSharpDiagnosticSeverity, message: string, number: int, range: range, ?numberPrefix: string, ?subcategory: string) = + let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck + let numberPrefix = defaultArg numberPrefix "FS" + FSharpDiagnostic(range, severity, message, subcategory, number, numberPrefix) + +/// Use to reset error and warning handlers +[] +type ErrorScope() = + let mutable diags = [] + let mutable firstError = None + let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + let unwindEL = + PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> + { new ErrorLogger("ErrorScope") with + member x.DiagnosticSink(exn, severity) = + let err = FSharpDiagnostic.CreateFromException(exn, severity, range.Zero, false) + diags <- err :: diags + if severity = FSharpDiagnosticSeverity.Error && firstError.IsNone then + firstError <- Some err.Message + member x.ErrorCount = diags.Length }) + + member x.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) + + member x.Diagnostics = diags + + member x.TryGetFirstErrorText() = + match x.Errors with + | error :: _ -> Some error.Message + | [] -> None + + interface IDisposable with + member d.Dispose() = + unwindEL.Dispose() (* unwind pushes when ErrorScope disposes *) + unwindBP.Dispose() + + member x.FirstError with get() = firstError and set v = firstError <- v + + /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and + /// perform other operations which might expose us to either bona-fide F# error messages such + /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, + /// may hit internal compiler failures. + /// + /// In some calling cases, we get a chance to report the error as part of user text. For example + /// if there is a "missing assembly" error while formatting the text of the description of an + /// autocomplete, then the error message is shown in replacement of the text (rather than crashing Visual + /// Studio, or swallowing the exception completely) + static member Protect<'a> (m: range) (f: unit->'a) (err: string->'a): 'a = + use errorScope = new ErrorScope() + let res = + try + Some (f()) + with e -> + // Here we only call errorRecovery to save the error message for later use by TryGetFirstErrorText. + try + errorRecovery e m + with _ -> + // If error recovery fails, then we have an internal compiler error. In this case, we show the whole stack + // in the extra message, should the extra message be used. + errorScope.FirstError <- Some (e.ToString()) + None + match res with + | Some res -> res + | None -> + match errorScope.TryGetFirstErrorText() with + | Some text -> err text + | None -> err "" + +/// An error logger that capture errors, filtering them according to warning levels etc. +type internal CompilationErrorLogger (debugName: string, options: FSharpDiagnosticOptions) = + inherit ErrorLogger("CompilationErrorLogger("+debugName+")") + + let mutable errorCount = 0 + let diagnostics = ResizeArray<_>() + + override x.DiagnosticSink(err, severity) = + if ReportDiagnosticAsError options (err, severity) then + diagnostics.Add(err, FSharpDiagnosticSeverity.Error) + errorCount <- errorCount + 1 + elif ReportDiagnosticAsWarning options (err, severity) then + diagnostics.Add(err, FSharpDiagnosticSeverity.Warning) + elif ReportDiagnosticAsInfo options (err, severity) then + diagnostics.Add(err, severity) + override x.ErrorCount = errorCount + + member x.GetDiagnostics() = diagnostics.ToArray() + +module DiagnosticHelpers = + + let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) = + [ let severity = + if ReportDiagnosticAsError options (exn, severity) then FSharpDiagnosticSeverity.Error + else severity + if (severity = FSharpDiagnosticSeverity.Error || ReportDiagnosticAsWarning options (exn, severity) || ReportDiagnosticAsInfo options (exn, severity)) then + let oneError exn = + [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. + // Not ideal, but it's hard to see what else to do. + let fallbackRange = rangeN mainInputFileName 1 + let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, severity, fallbackRange, fileInfo, suggestNames) + let fileName = ei.Range.FileName + if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then + yield ei ] + + let mainError, relatedErrors = SplitRelatedDiagnostics exn + yield! oneError mainError + for e in relatedErrors do + yield! oneError e ] + + let CreateDiagnostics (options, allErrors, mainInputFileName, errors, suggestNames) = + let fileInfo = (Int32.MaxValue, Int32.MaxValue) + [| for exn, severity in errors do + yield! ReportDiagnostic (options, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) |] + + namespace FSharp.Compiler.Symbols open System.IO @@ -9,7 +216,7 @@ open Internal.Utilities.Library.Extras open FSharp.Core.Printf open FSharp.Compiler open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.IO @@ -23,7 +230,6 @@ open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TcGlobals /// Describe a comment as either a block of text or a file+signature reference into an intellidoc file. @@ -553,7 +759,7 @@ module internal SymbolHelpers = let tcref = rfinfo.TyconRef let xmldoc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then - if tcref.IsFSharpException then + if tcref.IsExceptionDecl then Some tcref.XmlDoc else Some rfinfo.RecdField.XmlDoc diff --git a/src/fsharp/symbols/SymbolHelpers.fsi b/src/fsharp/symbols/SymbolHelpers.fsi index d0057c47496..8cb781565db 100755 --- a/src/fsharp/symbols/SymbolHelpers.fsi +++ b/src/fsharp/symbols/SymbolHelpers.fsi @@ -4,6 +4,122 @@ // Helpers for quick info and information about items //---------------------------------------------------------------------------- +namespace FSharp.Compiler.Diagnostics + +open System +open FSharp.Compiler.Text +open FSharp.Compiler.ErrorLogger + +/// Represents a diagnostic produced by the F# compiler +[] +type public FSharpDiagnostic = + + /// Gets the file name for the diagnostic + member FileName: string + + /// Gets the start position for the diagnostic + member Start: Position + + /// Gets the end position for the diagnostic + member End: Position + + /// Gets the start column for the diagnostic + member StartColumn: int + + /// Gets the end column for the diagnostic + member EndColumn: int + + /// Gets the start line for the diagnostic + member StartLine: int + + /// Gets the end line for the diagnostic + member EndLine: int + + /// Gets the range for the diagnostic + member Range: range + + /// Gets the severity for the diagnostic + member Severity: FSharpDiagnosticSeverity + + /// Gets the message for the diagnostic + member Message: string + + /// Gets the sub-category for the diagnostic + member Subcategory: string + + /// Gets the number for the diagnostic + member ErrorNumber: int + + /// Gets the number prefix for the diagnostic, usually "FS" but may differ for analyzers + member ErrorNumberPrefix: string + + /// Gets the full error number text e.g "FS0031" + member ErrorNumberText: string + + /// Creates a diagnostic, e.g. for reporting from an analyzer + static member Create: + severity: FSharpDiagnosticSeverity * + message: string * + number: int * + range: range * + ?numberPrefix: string * + ?subcategory: string -> + FSharpDiagnostic + + static member internal CreateFromExceptionAndAdjustEof: + PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int * int) * suggestNames: bool -> + FSharpDiagnostic + + static member internal CreateFromException: + PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic + + /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), + /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo + static member NewlineifyErrorString: message: string -> string + + /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), + /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo + static member NormalizeErrorString: text: string -> string + +//---------------------------------------------------------------------------- +// Internal only + +// Implementation details used by other code in the compiler +[] +type internal ErrorScope = + interface IDisposable + new: unit -> ErrorScope + member Diagnostics: FSharpDiagnostic list + static member Protect<'a> : range -> (unit -> 'a) -> (string -> 'a) -> 'a + +/// An error logger that capture errors, filtering them according to warning levels etc. +type internal CompilationErrorLogger = + inherit ErrorLogger + + /// Create the diagnostics logger + new: debugName: string * options: FSharpDiagnosticOptions -> CompilationErrorLogger + + /// Get the captured diagnostics + member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + +module internal DiagnosticHelpers = + val ReportDiagnostic: + FSharpDiagnosticOptions * + allErrors: bool * + mainInputFileName: string * + fileInfo: (int * int) * + (PhasedDiagnostic * FSharpDiagnosticSeverity) * + suggestNames: bool -> + FSharpDiagnostic list + + val CreateDiagnostics: + FSharpDiagnosticOptions * + allErrors: bool * + mainInputFileName: string * + seq * + suggestNames: bool -> + FSharpDiagnostic [] + namespace FSharp.Compiler.Symbols open Internal.Utilities.Library diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 292457e6e67..25183fd4652 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -16,16 +16,15 @@ open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax -open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.Xml -open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.TypeHierarchy +open FSharp.Compiler.Syntax.PrettyNaming type FSharpAccessibility(a:Accessibility, ?isProtected) = let isProtected = defaultArg isProtected false @@ -76,7 +75,7 @@ type SymbolEnv(g: TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceTyp [] module Impl = let protect f = - DiagnosticsLogger.protectAssemblyExplorationF + ErrorLogger.protectAssemblyExplorationF (fun (asmName, path) -> invalidOp (sprintf "The entity or value '%s' does not exist or is in an unresolved assembly. You may need to add a reference to assembly '%s'" path asmName)) f @@ -547,7 +546,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = entity.IsEnumTycon member _.IsFSharpExceptionDeclaration = - isResolvedAndFSharp() && entity.IsFSharpException + isResolvedAndFSharp() && entity.IsExceptionDecl member _.IsUnresolved = isUnresolved() @@ -587,7 +586,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.DeclaredInterfaces = if isUnresolved() then makeReadOnlyCollection [] else let ty = generalizedTyconRef cenv.g entity - DiagnosticsLogger.protectAssemblyExploration [] (fun () -> + ErrorLogger.protectAssemblyExploration [] (fun () -> [ for ity in GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes cenv.g cenv.amap range0 ty do yield FSharpType(cenv, ity) ]) |> makeReadOnlyCollection @@ -595,7 +594,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.AllInterfaces = if isUnresolved() then makeReadOnlyCollection [] else let ty = generalizedTyconRef cenv.g entity - DiagnosticsLogger.protectAssemblyExploration [] (fun () -> + ErrorLogger.protectAssemblyExploration [] (fun () -> [ for ity in AllInterfacesOfType cenv.g cenv.amap range0 AllowMultiIntfInstantiations.Yes ty do yield FSharpType(cenv, ity) ]) |> makeReadOnlyCollection @@ -603,13 +602,13 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.IsAttributeType = if isUnresolved() then false else let ty = generalizedTyconRef cenv.g entity - DiagnosticsLogger.protectAssemblyExploration false <| fun () -> + ErrorLogger.protectAssemblyExploration false <| fun () -> ExistsHeadTypeInEntireHierarchy cenv.g cenv.amap range0 ty cenv.g.tcref_System_Attribute member _.IsDisposableType = if isUnresolved() then false else let ty = generalizedTyconRef cenv.g entity - DiagnosticsLogger.protectAssemblyExploration false <| fun () -> + ErrorLogger.protectAssemblyExploration false <| fun () -> ExistsHeadTypeInEntireHierarchy cenv.g cenv.amap range0 ty cenv.g.tcref_System_IDisposable member _.BaseType = @@ -2323,7 +2322,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = type FSharpType(cenv, ty:TType) = let isUnresolved() = - DiagnosticsLogger.protectAssemblyExploration true <| fun () -> + ErrorLogger.protectAssemblyExploration true <| fun () -> match stripTyparEqns ty with | TType_app (tcref, _, _) -> FSharpEntity(cenv, tcref).IsUnresolved | TType_measure (Measure.Con tcref) -> FSharpEntity(cenv, tcref).IsUnresolved diff --git a/src/fsharp/tainted.fs b/src/fsharp/tainted.fs index 0eb274fa48b..a50b2dd2dba 100644 --- a/src/fsharp/tainted.fs +++ b/src/fsharp/tainted.fs @@ -107,7 +107,7 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = let errNum,_ = FSComp.SR.etProviderError("", "") raise <| TypeProviderError((errNum, e.Message), this.TypeProviderDesignation, range) - member _.TypeProvider = Tainted<_>(context, context.TypeProvider) + member this.TypeProvider = Tainted<_>(context, context.TypeProvider) member this.PApply(f,range: range) = let u = this.Protect f range @@ -148,13 +148,13 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = member this.PUntaintNoFailure f = this.PUntaint(f, range0) /// Access the target object directly. Use with extreme caution. - member _.AccessObjectDirectly = value + member this.AccessObjectDirectly = value static member CreateAll(providerSpecs: (ITypeProvider * ILScopeRef) list) = [for tp,nm in providerSpecs do yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; Lock=TypeProviderLock() },tp) ] - member _.OfType<'U> () = + member this.OfType<'U> () = match box value with | :? 'U as u -> Some (Tainted(context,u)) | _ -> None diff --git a/src/fsharp/utils/CompilerLocationUtils.fs b/src/fsharp/utils/CompilerLocationUtils.fs index 3e22c1aab0a..d6df7915d7f 100644 --- a/src/fsharp/utils/CompilerLocationUtils.fs +++ b/src/fsharp/utils/CompilerLocationUtils.fs @@ -248,7 +248,7 @@ module internal FSharpEnvironment = // Specify the tooling-compatible fragments of a path such as: // typeproviders/fsharp41/net461/MyProvider.DesignTime.dll // tools/fsharp41/net461/MyProvider.DesignTime.dll - // See https://github.com/dotnet/fsharp/issues/3736 + // See https://github.com/Microsoft/visualfsharp/issues/3736 // Represents the F#-compiler <-> type provider protocol. // When the API or protocol updates, add a new version moniker to the front of the list here. diff --git a/src/fsharp/utils/prim-lexing.fs b/src/fsharp/utils/prim-lexing.fs index be5740f14d2..4e33ef35c65 100644 --- a/src/fsharp/utils/prim-lexing.fs +++ b/src/fsharp/utils/prim-lexing.fs @@ -255,7 +255,7 @@ namespace Internal.Utilities.Text.Lexing member _.SupportsFeature featureId = langVersion.SupportsFeature featureId member _.CheckLanguageFeatureErrorRecover featureId range = - FSharp.Compiler.DiagnosticsLogger.checkLanguageFeatureErrorRecover langVersion featureId range + FSharp.Compiler.ErrorLogger.checkLanguageFeatureErrorRecover langVersion featureId range static member FromFunction (reportLibraryOnlyFeatures, langVersion, f : 'Char[] * int * int -> int) : LexBuffer<'Char> = let extension= Array.zeroCreate 4096 diff --git a/src/fsharp/utils/sformat.fs b/src/fsharp/utils/sformat.fs index 1ee3032b150..c29ff687543 100644 --- a/src/fsharp/utils/sformat.fs +++ b/src/fsharp/utils/sformat.fs @@ -443,7 +443,7 @@ module ReflectUtils = let isListType ty = FSharpType.IsUnion ty && (let cases = FSharpType.GetUnionCases ty - cases.Length > 0 && equivHeadTypes typedefof<_ list> cases[0].DeclaringType) + cases.Length > 0 && equivHeadTypes typedefof> cases[0].DeclaringType) [] type TupleType = diff --git a/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs b/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs index ad3c87c24fc..a5d852b2625 100644 --- a/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs +++ b/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs @@ -14,36 +14,27 @@ type MockEngine() = member val Messages = ResizeArray() with get interface IBuildEngine with - - member _.BuildProjectFile(projectFileName: string, targetNames: string [], globalProperties: System.Collections.IDictionary, targetOutputs: System.Collections.IDictionary): bool = + member this.BuildProjectFile(projectFileName: string, targetNames: string [], globalProperties: System.Collections.IDictionary, targetOutputs: System.Collections.IDictionary): bool = failwith "Not Implemented" - - member _.ColumnNumberOfTaskNode: int = 0 - - member _.ContinueOnError = true - - member _.LineNumberOfTaskNode: int = 0 - + member this.ColumnNumberOfTaskNode: int = 0 + member this.ContinueOnError: bool = true + member this.LineNumberOfTaskNode: int = 0 member this.LogCustomEvent(e: CustomBuildEventArgs): unit = this.Custom.Add e failwith "Not Implemented" - member this.LogErrorEvent(e: BuildErrorEventArgs): unit = this.Errors.Add e - member this.LogMessageEvent(e: BuildMessageEventArgs): unit = this.Messages.Add e - member this.LogWarningEvent(e: BuildWarningEventArgs): unit = this.Warnings.Add e - - member _.ProjectFileOfTaskNode: string = "" + member this.ProjectFileOfTaskNode: string = "" type SourceRoot = SourceRoot of path: string * - props: (string * string) list * - expectedProps: (string * string) list + props: list * + expectedProps: list /// these tests are ported from https://github.com/dotnet/roslyn/blob/093ea477717001c58be6231cf2a793f4245cbf72/src/Compilers/Core/MSBuildTaskTests/MapSourceRootTests.cs @@ -80,7 +71,7 @@ type MapSourceRootsTests() = |> Array.iteri checkExpectations [] - member _.``basic deterministic scenarios`` () = + member this.``basic deterministic scenarios`` () = let items = [| SourceRoot(@"c:\packages\SourcePackage1\", [], ["MappedPath", @"/_1/"]) @@ -105,7 +96,7 @@ type MapSourceRootsTests() = [] - member _.``invalid chars`` () = + member this.``invalid chars`` () = let items = [| SourceRoot(@"!@#:;$%^&*()_+|{}\", [], ["MappedPath", @"/_1/"]) @@ -125,7 +116,7 @@ type MapSourceRootsTests() = successfulTest items [] - member _.``input paths must end with separator`` () = + member this.``input paths must end with separator`` () = let items = [| SourceRoot(@"C:\", [], []) @@ -154,7 +145,7 @@ type MapSourceRootsTests() = Assert.Fail("Expected to fail on the inputs") [] - member _.``nested roots separators`` () = + member this.``nested roots separators`` () = let items = [| SourceRoot(@"c:\MyProjects\MyProject\", [], [ @@ -183,7 +174,7 @@ type MapSourceRootsTests() = successfulTest items [] - member _.``sourceroot case sensitivity``() = + member this.``sourceroot case sensitivity``() = let items = [| SourceRoot(@"c:\packages\SourcePackage1\", [], ["MappedPath", @"/_/"]) SourceRoot(@"C:\packages\SourcePackage1\", [], ["MappedPath", @"/_1/"]) @@ -193,7 +184,7 @@ type MapSourceRootsTests() = successfulTest items [] - member _.``recursion error`` () = + member this.``recursion error`` () = let path1 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\1\" let path2 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\2\" let path3 = Utilities.FixFilePath @"c:\MyProjects\MyProject\" @@ -234,7 +225,7 @@ type MapSourceRootsTests() = [] [] [] - member _.``metadata merge 1`` (deterministic: bool) = + member this.``metadata merge 1`` (deterministic: bool) = let path1 = Utilities.FixFilePath @"c:\packages\SourcePackage1\" let path2 = Utilities.FixFilePath @"c:\packages\SourcePackage2\" let path3 = Utilities.FixFilePath @"c:\packages\SourcePackage3\" @@ -328,7 +319,7 @@ type MapSourceRootsTests() = |> Array.iteri checkExpectations [] - member _.``missing containing root`` () = + member this.``missing containing root`` () = let items = [| SourceRoot(@"c:\MyProjects\MYPROJECT\", [], []) SourceRoot(@"c:\MyProjects\MyProject\a\b\", [ @@ -361,7 +352,7 @@ type MapSourceRootsTests() = Assert.Fail("Expected to fail on the inputs") [] - member _.``no containing root`` () = + member this.``no containing root`` () = let items = [| SourceRoot(@"c:\MyProjects\MyProject\", [], []) SourceRoot(@"c:\MyProjects\MyProject\a\b\", [ @@ -394,7 +385,7 @@ type MapSourceRootsTests() = [] [] [] - member _.``no top level source root`` (deterministic: bool) = + member this.``no top level source root`` (deterministic: bool) = let path1 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\b\" let items = [| SourceRoot(path1, [ diff --git a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs index d295f60f4ee..642541c7f90 100644 --- a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs +++ b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs @@ -18,24 +18,26 @@ type WriteCodeFragmentFSharpTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member _.``No parameters``() = + member this.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member _.``Skipped and out of order positional parameters``() = + member this.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member _.``Named parameters``() = + member this.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member _.``Named and positional parameters``() = + member this.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member _.``Escaped string parameters``() = + member this.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" + // this should look like: SomeAttribute("\"uno\"") + [] type WriteCodeFragmentCSharpTests() = @@ -48,23 +50,23 @@ type WriteCodeFragmentCSharpTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member _.``No parameters``() = + member this.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member _.``Skipped and out of order positional parameters``() = + member this.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member _.``Named parameters``() = + member this.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member _.``Named and positional parameters``() = + member this.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member _.``Escaped string parameters``() = + member this.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" // this should look like: SomeAttribute("\"uno\"") @@ -80,23 +82,23 @@ type WriteCodeFragmentVisualBasicTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member _.``No parameters``() = + member this.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member _.``Skipped and out of order positional parameters``() = + member this.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member _.``Named parameters``() = + member this.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member _.``Named and positional parameters``() = + member this.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member _.``Escaped string parameters``() = + member this.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" // this should look like: SomeAttribute("\"uno\"") diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs index 3eb8c174d29..325dcc0f769 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs @@ -12,7 +12,7 @@ let testNoOverflow op overflowArg = | :? OverflowException -> failwith "Failed: 1" type T(x : float) = - member _.Data = x + member this.Data = x static member op_Explicit (x : T) = byte x.Data static member op_Explicit (x : T) = char x.Data static member op_Explicit (x : T) = int16 x.Data diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs index fb57826cbe9..5210295c8eb 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs @@ -1,4 +1,4 @@ -// regression test for https://github.com/dotnet/fsharp/issues/420 +// regression test for https://github.com/Microsoft/visualfsharp/issues/420 [] type X public (i : int) = diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs index 7c67a679fa9..b1cca3856b1 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs @@ -10,7 +10,7 @@ let public funcA n = | _ -> Some( 22 ) // debug range should cover all of "Some( 22 )" -// Test case from https://github.com/dotnet/fsharp/issues/105 +// Test case from https://github.com/Microsoft/visualfsharp/issues/105 let OuterWithGenericInner list = let GenericInner (list: 'T list) = match list with @@ -19,7 +19,7 @@ let OuterWithGenericInner list = GenericInner list -// Test case from https://github.com/dotnet/fsharp/issues/105 +// Test case from https://github.com/Microsoft/visualfsharp/issues/105 let OuterWithNonGenericInner list = let NonGenericInner (list: int list) = match list with @@ -28,7 +28,7 @@ let OuterWithNonGenericInner list = NonGenericInner list -// Test case from https://github.com/dotnet/fsharp/issues/105 +// Test case from https://github.com/Microsoft/visualfsharp/issues/105 let OuterWithNonGenericInnerWithCapture x list = let NonGenericInnerWithCapture (list: int list) = match list with diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs index c150c1b81a1..05e33058136 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs @@ -1,7 +1,7 @@ // #NoMono #NoMT #CodeGen #EmittedIL #Tuples type A() = class end -// A code+optimization pattern, see https://github.com/dotnet/fsharp/issues/6532 +// A code+optimization pattern, see https://github.com/Microsoft/visualfsharp/issues/6532 type C() = static member inline F (?x1: A, ?x2: A) = let count = 0 diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx b/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx index f10327acf31..26fc292d037 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx @@ -1,5 +1,5 @@ // #Regression #NoMT #Printing -// Regression test for https://github.com/dotnet/fsharp/issues/109 +// Regression test for https://github.com/Microsoft/visualfsharp/issues/109 // pretty printing signatures with params arguments //type Heterogeneous = diff --git a/tests/FSharp.Compiler.UnitTests/BlockTests.fs b/tests/FSharp.Compiler.UnitTests/BlockTests.fs index aaa0084773e..08a718f5244 100644 --- a/tests/FSharp.Compiler.UnitTests/BlockTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BlockTests.fs @@ -5,15 +5,15 @@ open Xunit open FSharp.Test open Internal.Utilities.Library -module ImmutableArrayTests = +module BlockTests = [] let ``Iter should work correctly``() = - let b = ImmutableArray.init 5 id + let b = Block.init 5 id let results = ResizeArray() b - |> ImmutableArray.iter (fun x -> + |> Block.iter (fun x -> results.Add(x) ) @@ -30,9 +30,9 @@ module ImmutableArrayTests = [] let ``Map should work correctly``() = - let b = ImmutableArray.init 5 id + let b = Block.init 5 id - let b2 = b |> ImmutableArray.map (fun x -> x + 1) + let b2 = b |> Block.map (fun x -> x + 1) Assert.Equal( [ @@ -47,11 +47,11 @@ module ImmutableArrayTests = [] let ``Fold should work correctly``() = - let b = ImmutableArray.init 5 id + let b = Block.init 5 id let result = (0, b) - ||> ImmutableArray.fold (fun state n -> + ||> Block.fold (fun state n -> state + n ) diff --git a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs index 91244459fdd..bc4b3f9f0bc 100644 --- a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs +++ b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs @@ -5,5 +5,5 @@ module CompilerTestHelpers = let (|Warning|_|) (exn: System.Exception) = match exn with - | :? FSharp.Compiler.DiagnosticsLogger.DiagnosticWithText as e -> Some (e.number, e.message) + | :? FSharp.Compiler.ErrorLogger.Error as e -> let n,d = e.Data0 in Some (n,d) | _ -> None diff --git a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs index 42442377a5a..b3442017bc4 100644 --- a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs +++ b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs @@ -13,34 +13,37 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Lexer open FSharp.Compiler.Lexhelp -open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers +open FSharp.Compiler.Syntax type public HashIfExpression() = - let preludes = [|"#if "; "#elif "|] - let epilogues = [|""; " // Testing"|] + let preludes = [|"#if "; "#elif "|] + let epilogues = [|""; " // Testing"|] - let ONE = IfdefId "ONE" - let TWO = IfdefId "TWO" - let THREE = IfdefId "THREE" + let ONE = IfdefId "ONE" + let TWO = IfdefId "TWO" + let THREE = IfdefId "THREE" let isSet l r = (l &&& r) <> 0 - let (!!) e = IfdefNot(e) - let (&&&) l r = IfdefAnd(l,r) - let (|||) l r = IfdefOr(l,r) + let (!!) e = IfdefNot(e) + let (&&&) l r = IfdefAnd(l,r) + let (|||) l r = IfdefOr(l,r) + let exprAsString (e : LexerIfdefExpression) : string = - let sb = StringBuilder() + let sb = StringBuilder() let append (s : string) = ignore <| sb.Append s let rec build (e : LexerIfdefExpression) : unit = match e with - | IfdefAnd (l,r) -> append "("; build l; append " && "; build r; append ")" + | IfdefAnd (l,r)-> append "("; build l; append " && "; build r; append ")" | IfdefOr (l,r) -> append "("; build l; append " || "; build r; append ")" - | IfdefNot ee -> append "!"; build ee - | IfdefId nm -> append nm + | IfdefNot ee -> append "!"; build ee + | IfdefId nm -> append nm build e @@ -52,9 +55,9 @@ type public HashIfExpression() = let errorLogger = { - new DiagnosticsLogger("TestDiagnosticsLogger") with - member _.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e - member _.ErrorCount = errors.Count + new ErrorLogger("TestErrorLogger") with + member x.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e + member x.ErrorCount = errors.Count } let lightSyntax = IndentationAwareSyntaxStatus(true, false) @@ -63,27 +66,27 @@ type public HashIfExpression() = let startPos = Position.Empty let args = mkLexargs (defines, lightSyntax, resourceManager, [], errorLogger, PathMap.empty) - CompileThreadStatic.DiagnosticsLogger <- errorLogger + CompileThreadStatic.ErrorLogger <- errorLogger let parser (s : string) = - let lexbuf = LexBuffer.FromChars (true, LanguageVersion.Default, s.ToCharArray ()) - lexbuf.StartPos <- startPos - lexbuf.EndPos <- startPos - let tokenStream = PPLexer.tokenstream args + let lexbuf = LexBuffer.FromChars (true, LanguageVersion.Default, s.ToCharArray ()) + lexbuf.StartPos <- startPos + lexbuf.EndPos <- startPos + let tokenStream = PPLexer.tokenstream args PPParser.start tokenStream lexbuf errors, warnings, parser do // Setup - CompileThreadStatic.BuildPhase <- BuildPhase.Compile + CompileThreadStatic.BuildPhase <- BuildPhase.Compile interface IDisposable with // Teardown member _.Dispose() = - CompileThreadStatic.BuildPhase <- BuildPhase.DefaultPhase - CompileThreadStatic.DiagnosticsLogger <- CompileThreadStatic.DiagnosticsLogger + CompileThreadStatic.BuildPhase <- BuildPhase.DefaultPhase + CompileThreadStatic.ErrorLogger <- CompileThreadStatic.ErrorLogger [] - member _.PositiveParserTestCases()= + member this.PositiveParserTestCases()= let errors, warnings, parser = createParser () @@ -114,8 +117,8 @@ type public HashIfExpression() = "false" , IfdefId "false" |] - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for test,expected in positiveTestCases do for prelude in preludes do @@ -123,12 +126,12 @@ type public HashIfExpression() = for epilogue in epilogues do let test = test + epilogue try - let expr = parser test + let expr = parser test if expected <> expr then fail <| sprintf "'%s', expected %A, actual %A" test (exprAsString expected) (exprAsString expr) - with e -> - fail <| sprintf "'%s', expected %A, actual %s,%A" test (exprAsString expected) (e.GetType().Name) e.Message + with + | e -> fail <| sprintf "'%s', expected %A, actual %s,%A" test (exprAsString expected) (e.GetType().Name) e.Message let fs = @@ -144,9 +147,9 @@ type public HashIfExpression() = () [] - member _.NegativeParserTestCases()= + member this.NegativeParserTestCases()= - let errors, _warnings, parser = createParser () + let errors, warnings, parser = createParser () let negativeTests = [| @@ -180,18 +183,18 @@ type public HashIfExpression() = "ONE )(@$&%*@^#%#!$)" |] - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for test in negativeTests do for prelude in preludes do let test = prelude + test for epilogue in epilogues do - let test = test + epilogue + let test = test + epilogue try - let bec = errors.Count - let expr = parser test - let aec = errors.Count + let bec = errors.Count + let expr = parser test + let aec = errors.Count if bec = aec then // No new errors discovered fail <| sprintf "'%s', expected 'parse error', actual %A" test (exprAsString expr) @@ -205,22 +208,22 @@ type public HashIfExpression() = Assert.shouldBe "" fails [] - member _.LexerIfdefEvalTestCases()= + member this.LexerIfdefEvalTestCases()= - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for i in 0..7 do - let one = isSet i 1 - let two = isSet i 2 - let three = isSet i 4 + let one = isSet i 1 + let two = isSet i 2 + let three = isSet i 4 let lookup s = match s with - | "ONE" -> one - | "TWO" -> two - | "THREE" -> three - | _ -> false + | "ONE" -> one + | "TWO" -> two + | "THREE" -> three + | _ -> false let testCases = [| diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs index 817d1fcc473..cb74c489da0 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs @@ -1552,7 +1552,7 @@ module ComparersRegression = exception ValidationException of lhs:obj * rhs:obj * expected:obj * received:obj - let make_result_set<'a,'b when 'b : equality> (f: IOperation<'a>) (items: 'a[]) (validation_set: int[] option)= + let make_result_set<'a,'b when 'b : equality> (f:IOperation<'a>) (items:array<'a>) (validation_set:option>)= let results = Array.zeroCreate (items.Length*items.Length) for i = 0 to items.Length-1 do for j = 0 to items.Length-1 do diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 103b636c127..89b74783e9f 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -580,7 +580,7 @@ type AsyncModule() = #if IGNORED - [] + [] member _.``SleepContinuations``() = let okCount = ref 0 let errCount = ref 0 diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 29d086d0f20..30fef17666e 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -338,7 +338,7 @@ type AsyncType() = #if IGNORED [] - [] + [] member _.CancellationPropagatesToImmediateTask () = let a = async { while true do () @@ -355,7 +355,7 @@ type AsyncType() = #if IGNORED [] - [] + [] member _.CancellationPropagatesToGroupImmediate () = let ewh = new ManualResetEvent(false) let cancelled = ref false diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs index 2a180783da0..c887eb470c8 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs @@ -72,7 +72,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/dotnet/fsharp/issues/3337 + // https://github.com/Microsoft/visualfsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = @@ -114,7 +114,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/dotnet/fsharp/issues/3337 + // https://github.com/Microsoft/visualfsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = @@ -156,7 +156,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/dotnet/fsharp/issues/3337 + // https://github.com/Microsoft/visualfsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs index ee2b662bfe5..81429996a05 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs @@ -911,7 +911,7 @@ open NonStructuralComparison type NonStructuralComparisonTests() = [] - member _.CompareFloat32() = // https://github.com/dotnet/fsharp/pull/4493 + member _.CompareFloat32() = // https://github.com/Microsoft/visualfsharp/pull/4493 let x = 32 |> float32 let y = 32 |> float32 diff --git a/tests/benchmarks/TaskPerf/option.fs b/tests/benchmarks/TaskPerf/option.fs index 2df8610880f..20003378273 100644 --- a/tests/benchmarks/TaskPerf/option.fs +++ b/tests/benchmarks/TaskPerf/option.fs @@ -72,11 +72,11 @@ type OptionBuilderUsingInlineIfLambdaBase() = (fun () -> ValueSome value) - member inline _.ReturnFrom (source: 'T option) : OptionCode<'T> = + member inline this.ReturnFrom (source: option<'T>) : OptionCode<'T> = (fun () -> match source with Some x -> ValueOption.Some x | None -> ValueOption.None) - member inline _.ReturnFrom (source: voption<'T>) : OptionCode<'T> = + member inline this.ReturnFrom (source: voption<'T>) : OptionCode<'T> = (fun () -> source) type OptionBuilderUsingInlineIfLambda() = diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 8e7669ddc69..4cdc2adaf89 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -1318,7 +1318,7 @@ module CoreTests = exec cfg ("." ++ "main.exe") "" - // Repro for https://github.com/dotnet/fsharp/issues/1298 + // Repro for https://github.com/Microsoft/visualfsharp/issues/1298 [] let fileorder () = let cfg = testConfig "core/fileorder" @@ -1345,7 +1345,7 @@ module CoreTests = exec cfg ("." ++ "test2.exe") "" - // Repro for https://github.com/dotnet/fsharp/issues/2679 + // Repro for https://github.com/Microsoft/visualfsharp/issues/2679 [] let ``add files with same name from different folders`` () = let cfg = testConfig "core/samename" @@ -1390,7 +1390,7 @@ module CoreTests = [] let ``no-warn-2003-tests`` () = - // see https://github.com/dotnet/fsharp/issues/3139 + // see https://github.com/Microsoft/visualfsharp/issues/3139 let cfg = testConfig "core/versionAttributes" let stdoutPath = "out.stdout.txt" |> getfullpath cfg let stderrPath = "out.stderr.txt" |> getfullpath cfg @@ -1593,7 +1593,7 @@ module CoreTests = [] let ``patterns-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/patterns" FSC_OPTIMIZED "preview" -//BUGBUG: https://github.com/dotnet/fsharp/issues/6601 +//BUGBUG: https://github.com/Microsoft/visualfsharp/issues/6601 // [] // let ``patterns-FSI`` () = singleTestBuildAndRun' "core/patterns" FSI @@ -2105,7 +2105,7 @@ module VersionTests = [] module ToolsTests = - // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 [] let bundle () = let cfg = testConfig "tools/bundle" @@ -2265,7 +2265,7 @@ module RegressionTests = let ``321`` () = singleTestBuildAndRun "regression/321" FSC_OPTIMIZED #if !NETCOREAPP - // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 [] let ``655`` () = let cfg = testConfig "regression/655" @@ -2284,7 +2284,7 @@ module RegressionTests = testOkFile.CheckExists() - // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 [] let ``656`` () = let cfg = testConfig "regression/656" @@ -2318,7 +2318,7 @@ module RegressionTests = let ``struct-tuple-bug-1-FSI`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSI #if !NETCOREAPP - // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 [] let ``struct-measure-bug-1`` () = let cfg = testConfig "regression/struct-measure-bug-1" diff --git a/tests/service/Common.fs b/tests/service/Common.fs index efc7e115084..d73c89e7bfb 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -235,16 +235,16 @@ let tups (m: range) = (m.StartLine, m.StartColumn), (m.EndLine, m.EndColumn) /// Extract range info and convert to zero-based line - please don't use this one any more let tupsZ (m: range) = (m.StartLine-1, m.StartColumn), (m.EndLine-1, m.EndColumn) -let attribsOfSymbolUse (symbolUse: FSharpSymbolUse) = - [ if symbolUse.IsFromDefinition then yield "defn" - if symbolUse.IsFromType then yield "type" - if symbolUse.IsFromAttribute then yield "attribute" - if symbolUse.IsFromDispatchSlotImplementation then yield "override" - if symbolUse.IsFromPattern then yield "pattern" - if symbolUse.IsFromComputationExpression then yield "compexpr" ] - -let attribsOfSymbol (symbol: FSharpSymbol) = - [ match symbol with +let attribsOfSymbolUse (s:FSharpSymbolUse) = + [ if s.IsFromDefinition then yield "defn" + if s.IsFromType then yield "type" + if s.IsFromAttribute then yield "attribute" + if s.IsFromDispatchSlotImplementation then yield "override" + if s.IsFromPattern then yield "pattern" + if s.IsFromComputationExpression then yield "compexpr" ] + +let attribsOfSymbol (s:FSharpSymbol) = + [ match s with | :? FSharpField as v -> yield "field" if v.IsCompilerGenerated then yield "compgen" @@ -310,26 +310,26 @@ let attribsOfSymbol (symbol: FSharpSymbol) = | _ -> () ] let rec allSymbolsInEntities compGen (entities: IList) = - [ for entity in entities do - yield (entity :> FSharpSymbol) - for gp in entity.GenericParameters do + [ for e in entities do + yield (e :> FSharpSymbol) + for gp in e.GenericParameters do if compGen || not gp.IsCompilerGenerated then yield (gp :> FSharpSymbol) - for x in entity.MembersFunctionsAndValues do + for x in e.MembersFunctionsAndValues do if compGen || not x.IsCompilerGenerated then yield (x :> FSharpSymbol) for gp in x.GenericParameters do if compGen || not gp.IsCompilerGenerated then yield (gp :> FSharpSymbol) - for x in entity.UnionCases do + for x in e.UnionCases do yield (x :> FSharpSymbol) for f in x.Fields do if compGen || not f.IsCompilerGenerated then yield (f :> FSharpSymbol) - for x in entity.FSharpFields do + for x in e.FSharpFields do if compGen || not x.IsCompilerGenerated then yield (x :> FSharpSymbol) - yield! allSymbolsInEntities compGen entity.NestedEntities ] + yield! allSymbolsInEntities compGen e.NestedEntities ] let getParseResults (source: string) = @@ -351,8 +351,8 @@ let getParseAndCheckResults50 (source: string) = parseAndCheckScript50("Test.fsx", source) -let inline dumpDiagnostics (results: FSharpCheckFileResults) = - results.Diagnostics +let inline dumpErrors results = + (^TResults: (member Diagnostics: FSharpDiagnostic[]) results) |> Array.map (fun e -> let message = e.Message.Split('\n') diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 9ca4362ead7..92b184d99c9 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -14,7 +14,7 @@ match () with | x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(3,2--3,4): This expression was expected to have type 'unit' but here has type 'string'" ] @@ -27,7 +27,7 @@ let ``Wrong type 02 - Binding`` () = let ("": unit), (x: int) = let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(2,5--2,7): This expression was expected to have type 'unit' but here has type 'string'" "(2,41--2,43): This expression was expected to have type 'unit * int' but here has type 'unit'" "(2,4--2,24): Incomplete pattern matches on this expression." @@ -44,7 +44,7 @@ match () with | [] x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"; "CompiledNameAttribute"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(3,2--3,25): Attributes are not allowed within patterns" "(3,4--3,16): This attribute is not valid for use on this language element" ] @@ -60,7 +60,7 @@ match () with | ?x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(3,2--3,4): Optional arguments are only permitted on type members" ] @@ -75,7 +75,7 @@ match 1, 2 with | null -> let y = () in () """ assertHasSymbolUsages ["y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(3,2--3,6): The type '(int * int)' does not have 'null' as a proper value" "(2,6--2,10): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." ] @@ -95,7 +95,7 @@ match A with | B (x, _) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,2--7,10): This union case expects 3 arguments in tupled form" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -115,7 +115,7 @@ match A with | B (_, _, x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,5--7,12): This expression was expected to have type 'int' but here has type ''a * 'b * 'c'" "(6,6--6,7): Incomplete pattern matches on this expression." ] @@ -135,7 +135,7 @@ match A with | B (_, _, x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,11--7,12): This constructor is applied to 3 argument(s) but expects 2" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -154,7 +154,7 @@ match A with | A x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,2--7,5): This union case does not take arguments" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'B (_)' may indicate a case not covered by the pattern(s)." ] @@ -173,7 +173,7 @@ match A with | B x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -192,7 +192,7 @@ match A with | B (name = x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,5--7,9): The union case 'B' does not have a field named 'name'." "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -212,7 +212,7 @@ match A with | B (field = x; field = z) -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,16--7,21): Union case/exception field 'field' cannot be used more than once." "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -232,7 +232,7 @@ match A with | B x z -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,2--7,7): This union case expects 2 arguments in tupled form" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -246,7 +246,7 @@ match None with | Some (x, z) -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ ] @@ -262,7 +262,7 @@ match 1 with | Foo (field = x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(5,2--5,17): Foo is an active pattern and cannot be treated as a discriminated union case with named fields." ] @@ -279,7 +279,7 @@ match 1 with | Foo x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(5,2--5,7): This literal pattern does not take arguments" "(4,6--4,7): Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s)." ] @@ -297,7 +297,7 @@ match TraceLevel.Off with | TraceLevel.Off x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(5,2--5,18): This literal pattern does not take arguments" "(4,6--4,20): Incomplete pattern matches on this expression. For example, the value 'TraceLevel.Error' may indicate a case not covered by the pattern(s)." ] @@ -319,7 +319,7 @@ let dowork () = f (Case 1) 0 // return an integer exit code""" assertHasSymbolUsages ["DU"; "dowork"; "du"; "f"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(6,6--6,10): This constructor is applied to 0 argument(s) but expects 1" ] @@ -330,7 +330,7 @@ match 1 with | x | x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpDiagnostics checkResults |> shouldEqual [] + dumpErrors checkResults |> shouldEqual [] [] @@ -343,7 +343,7 @@ match 1 with | x | z -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(3,2--3,7): The two sides of this 'or' pattern bind different sets of variables" ] @@ -362,7 +362,7 @@ match A with | B (x, y) | B (a, x) -> let z = x + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,2--7,21): The two sides of this 'or' pattern bind different sets of variables" "(7,19--7,20): This expression was expected to have type 'int' but here has type 'string'" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." @@ -381,7 +381,7 @@ match 3 with | a as b -> let c = a + b in () """ assertHasSymbolUsages ["a"; "b"; "c"; "w"; "x"; "y"; "z"] checkResults - dumpDiagnostics checkResults |> shouldEqual [] + dumpErrors checkResults |> shouldEqual [] [] @@ -399,7 +399,7 @@ match box 1 with | :? int8 as Id i as j -> let x = i + 5y + j in () // Only the first "as" will have the derived type """ assertHasSymbolUsages (List.map string ['a'..'j']) checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(5,34--5,35): The type 'obj' does not support the operator '+'" "(5,32--5,33): The type 'obj' does not support the operator '+'" "(7,45--7,46): The type 'obj' does not match the type 'uint64'" @@ -423,7 +423,7 @@ match Unchecked.defaultof with | _ -> () """ assertHasSymbolUsages ["a"; "b"; "c"; "d"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(5,21--5,27): Type constraint mismatch. The type 'int' is not compatible with type 'System.Enum' " ] @@ -439,7 +439,7 @@ match Unchecked.defaultof with | g -> () """ assertHasSymbolUsages ["a"; "b"; "c"; "d"; "e"; "f"; "g"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(4,2--4,85): This rule will never be matched" ] @@ -456,7 +456,7 @@ match Unchecked.defaultof with | :? _ as z -> let _ = z in () """ assertHasSymbolUsages ["a"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(2,6--2,30): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." "(6,2--6,6): The type 'int' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." ] @@ -477,7 +477,7 @@ match Unchecked.defaultof with | k & l as (m as (false as n)) as (o as _) -> if k || l || m || n || o then () """ assertHasSymbolUsages (List.map string ['a'..'o']) checkResults - dumpDiagnostics checkResults |> shouldEqual [] + dumpErrors checkResults |> shouldEqual [] [] let ``As 07 - syntactical precedence matrix testing right - total patterns`` () = @@ -556,7 +556,7 @@ Some v |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpDiagnostics checkResults |> shouldEqual [] + dumpErrors checkResults |> shouldEqual [] [] #if !NETCOREAPP @@ -601,7 +601,7 @@ Some w |> eq () """ assertHasSymbolUsages (List.map string ['a'..'y']) checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(8,4--8,18): Incomplete pattern matches on this expression. For example, the value '[]' may indicate a case not covered by the pattern(s)." "(9,4--9,14): Incomplete pattern matches on this expression." "(10,4--10,18): Incomplete pattern matches on this expression." @@ -643,7 +643,7 @@ let v as struct w = 15 let x as () = y let z as """ - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(10,9--10,10): Unexpected symbol ',' in binding" "(11,9--11,10): Unexpected symbol ':' in binding" "(12,9--12,11): Unexpected symbol '::' in binding" @@ -692,7 +692,7 @@ Some x |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpDiagnostics checkResults |> shouldEqual [] + dumpErrors checkResults |> shouldEqual [] [] #if !NETCOREAPP @@ -737,7 +737,7 @@ Some w |> eq () """ assertHasSymbolUsages (List.map string ['a'..'y']) checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(8,4--8,20): Incomplete pattern matches on this expression. For example, the value '[]' may indicate a case not covered by the pattern(s)." "(9,4--9,14): Incomplete pattern matches on this expression." "(10,4--10,18): Incomplete pattern matches on this expression." @@ -779,7 +779,7 @@ let v struct as w = 15 let () as x = y let z as = """ - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" @@ -854,7 +854,7 @@ Some x |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(11,25--11,26): This expression was expected to have type 'int' but here has type 'obj'" "(28,6--28,24): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." "(26,6--26,12): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." @@ -930,7 +930,7 @@ Some w |> eq () """ assertHasSymbolUsages (set ['a' .. 'y'] |> Set.remove 'n' |> Set.map string |> Set.toList) checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(21,2--21,8): This type test or downcast will always hold" "(34,6--34,14): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." "(32,6--32,14): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." @@ -973,7 +973,7 @@ let :? v as struct w = 15 let :? x as () = y let :? z as """ - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(10,12--10,13): Unexpected symbol ',' in binding" "(11,12--11,13): Unexpected symbol ':' in binding" "(12,12--12,14): Unexpected symbol '::' in binding" @@ -1046,7 +1046,7 @@ match box {{ aaa = 9 }} with Some "" |> eq // No more type checks after the above line? """ assertHasSymbolUsages (Set.toList validSet) checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(27,2--27,14): This expression was expected to have type 'obj' but here has type 'struct ('a * 'b)'" "(52,2--52,13): This expression was expected to have type 'obj' but here has type 'AAA'" "(26,6--26,24): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." @@ -1131,7 +1131,7 @@ match box [|11|] with Some "" |> eq """ assertHasSymbolUsages (set ['a'..'y'] - set [ 'm'..'r' ] |> Set.map string |> Set.toList) checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(19,2--19,4): This expression was expected to have type 'obj' but here has type 'int'" "(21,2--21,7): This expression was expected to have type 'obj' but here has type 'bool'" "(23,2--23,6): This expression was expected to have type 'obj' but here has type 'bool'" @@ -1180,7 +1180,7 @@ let v [ as :? w = 15 let () as :? x = y let as :? z = """ - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" @@ -1234,7 +1234,7 @@ let ?w as x = 7 let y as ?z = 8 () """ - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(7,9--7,11): Unexpected symbol '[<' in binding" "(4,4--4,12): This construct is deprecated: Character range matches have been removed in F#. Consider using a 'when' pattern guard instead." "(4,4--4,17): Incomplete pattern matches on this expression. For example, the value '' '' may indicate a case not covered by the pattern(s)." @@ -1266,6 +1266,6 @@ let f : obj -> _ = () """ assertHasSymbolUsages ["i"] checkResults - dumpDiagnostics checkResults |> shouldEqual [ + dumpErrors checkResults |> shouldEqual [ "(5,6--5,18): Feature 'non-variable patterns to the right of 'as' patterns' is not available in F# 5.0. Please use language version 6.0 or greater." ] \ No newline at end of file diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 00ae15bc4e1..342712caa39 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -5246,7 +5246,7 @@ module internal ProjectBig = [] -// Simplified repro for https://github.com/dotnet/fsharp/issues/2679 +// Simplified repro for https://github.com/Microsoft/visualfsharp/issues/2679 let ``add files with same name from different folders`` () = let fileNames = [ __SOURCE_DIRECTORY__ + "/data/samename/folder1/a.fs" @@ -5333,7 +5333,7 @@ let x = (1 = 3.0) let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) [] -let ``Test line directives in foreground analysis`` () = // see https://github.com/dotnet/fsharp/issues/3317 +let ``Test line directives in foreground analysis`` () = // see https://github.com/Microsoft/visualfsharp/issues/3317 // In background analysis and normal compiler checking, the errors are reported w.r.t. the line directives let wholeProjectResults = checker.ParseAndCheckProject(ProjectLineDirectives.options) |> Async.RunImmediate diff --git a/tests/service/data/TestTP/ProvidedTypes.fs b/tests/service/data/TestTP/ProvidedTypes.fs index 2b609793233..7ea2cd5ba46 100644 --- a/tests/service/data/TestTP/ProvidedTypes.fs +++ b/tests/service/data/TestTP/ProvidedTypes.fs @@ -8102,7 +8102,7 @@ namespace ProviderImplementation.ProvidedTypes // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, // which fortunately also correspond to element types. We just use the design-time types instead. // See convertConstExpr in the compiler, e.g. - // https://github.com/dotnet/fsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 // for the accepted types. match inp.Namespace, inp.Name with //| USome "System", "Void"-> typeof diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index 3d93c28d3b8..dcdc6cd7291 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -33,7 +33,7 @@ type internal FSharpCompletionProvider inherit FSharpCompletionProviderBase() // Save the backing data in a cache, we need to save for at least the length of the completion session - // See https://github.com/dotnet/fsharp/issues/4714 + // See https://github.com/Microsoft/visualfsharp/issues/4714 static let mutable declarationItems: DeclarationListItem[] = [||] static let [] NameInCodePropName = "NameInCode" static let [] FullNamePropName = "FullName" diff --git a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs index 689c410b5f1..d7995bcf509 100644 --- a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs +++ b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs @@ -51,7 +51,7 @@ type CodeFixesOptions = SuggestNamesForErrors: bool } static member Default = { // We have this off by default, disable until we work out how to make this low priority - // See https://github.com/dotnet/fsharp/pull/3238#issue-237699595 + // See https://github.com/Microsoft/visualfsharp/pull/3238#issue-237699595 SimplifyName = false AlwaysPlaceOpensAtTopLevel = true UnusedOpens = true diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs index 4be4c71d300..38ad605c2bc 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs @@ -1604,7 +1604,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem MSBuildProject.SetGlobalProperty(projNode.BuildProject, ProjectFileConstants.Platform, currentConfigName.MSBuildPlatform) projNode.UpdateMSBuildState() - // The following event sequences are observed in Visual Studio 2017, see https://github.com/dotnet/fsharp/pull/3025#pullrequestreview-38005713 + // The following event sequences are observed in Visual Studio 2017, see https://github.com/Microsoft/visualfsharp/pull/3025#pullrequestreview-38005713 // // Loading tests\projects\misc\TestProjectChanges.sln: // diff --git a/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs b/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs index 2e6291ef3ec..a5e3128e872 100644 --- a/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs +++ b/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs @@ -13,7 +13,7 @@ open Microsoft.VisualStudio.Utilities // type internal TextBufferStream(textLines:ITextBuffer, contentTypeRegistry: IContentTypeRegistryService) = do if null = textLines then raise (new ArgumentNullException("textLines")) - // The following line causes unhandled excepiton on a background thread, see https://github.com/dotnet/fsharp/issues/2318#issuecomment-279340343 + // The following line causes unhandled excepiton on a background thread, see https://github.com/Microsoft/visualfsharp/issues/2318#issuecomment-279340343 // It seems we should provide a Quick Info Provider at the same time as uncommenting it. //do textLines.ChangeContentType(contentTypeRegistry.GetContentType Guids.fsiContentTypeName, Guid Guids.guidFsiLanguageService) diff --git a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs index ca7f220fa73..a07104b2e7f 100644 --- a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs +++ b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs @@ -7723,7 +7723,7 @@ namespace ProviderImplementation.ProvidedTypes // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, // which fortunately also correspond to element types. We just use the design-time types instead. // See convertConstExpr in the compiler, e.g. - // https://github.com/dotnet/fsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 // for the accepted types. match inp.Namespace, inp.Name with | USome "System", "Void"-> typeof @@ -8984,7 +8984,7 @@ namespace ProviderImplementation.ProvidedTypes let systemRuntimeContainsTypeObj = config.GetField("systemRuntimeContainsType") - // Account for https://github.com/dotnet/fsharp/pull/591 + // Account for https://github.com/Microsoft/visualfsharp/pull/591 let systemRuntimeContainsTypeObj2 = if systemRuntimeContainsTypeObj.HasField("systemRuntimeContainsTypeRef") then systemRuntimeContainsTypeObj.GetField("systemRuntimeContainsTypeRef").GetProperty("Value") diff --git a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs index e94163042e4..c4a1d61cde8 100644 --- a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs @@ -162,7 +162,7 @@ type BraceMatchingServiceTests() = [] member this.BraceMatchingAtEndOfLine_Bug1597() = - // https://github.com/dotnet/fsharp/issues/1597 + // https://github.com/Microsoft/visualfsharp/issues/1597 let code = """ [] let main argv = diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 381e9d0e5ec..52193afac40 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -457,7 +457,7 @@ let _ = new A(Setta) let notExpected = ["SettableProperty@"; "AnotherSettableProperty@"; "NonSettableProperty@"] VerifyCompletionList(fileContents, "(Setta", expected, notExpected) -[] +[] let ``Constructing a new fully qualified class with object initializer syntax without ending paren``() = let fileContents = """ module M = diff --git a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs index c9674a89861..2f3b76b2965 100644 --- a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs @@ -392,7 +392,7 @@ let g (t : T) = t.Count() [] member public this.DocumentDiagnosticsDontReportProjectErrors_Bug1596() = - // https://github.com/dotnet/fsharp/issues/1596 + // https://github.com/Microsoft/visualfsharp/issues/1596 this.VerifyNoErrors( fileContents = """ let x = 3 diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index 368df57ad3f..68cbcec09ec 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -29,7 +29,7 @@ module StandardSettings = type UsingMSBuild() as this = inherit LanguageServiceBaseTests() - let createFile (code : string list) fileKind refs otherFlags = + let createFile (code : list) fileKind refs otherFlags = let (_, _, file) = match code with | [code] when code.IndexOfAny([|'\r'; '\n'|]) <> -1 -> @@ -38,7 +38,7 @@ type UsingMSBuild() as this = this.CreateSingleFileProject(code, fileKind = fileKind, references = refs, ?otherFlags=otherFlags) file - let DoWithAutoCompleteUsingExtraRefs refs otherFlags coffeeBreak fileKind reason (code : string list) marker f = + let DoWithAutoCompleteUsingExtraRefs refs otherFlags coffeeBreak fileKind reason (code : list) marker f = // Up to 2 untyped parse operations are OK: we do an initial parse to provide breakpoint valdiation etc. // This might be before the before the background builder is ready to process the foreground typecheck. // In this case the background builder calls us back when its ready, and we then request a foreground typecheck @@ -53,7 +53,7 @@ type UsingMSBuild() as this = gpatcc.AssertExactly(0,0) - let DoWithAutoComplete coffeeBreak fileKind reason otherFlags (code : string list) marker f = + let DoWithAutoComplete coffeeBreak fileKind reason otherFlags (code : list) marker f = DoWithAutoCompleteUsingExtraRefs [] otherFlags coffeeBreak fileKind reason code marker f let AssertAutoCompleteContainsAux coffeeBreak fileName reason otherFlags code marker should shouldnot = @@ -134,7 +134,7 @@ type UsingMSBuild() as this = // There are some dot completion tests in this type as well, in the systematic tests for queries - member private this.VerifyDotCompListContainAllAtStartOfMarker(fileContents : string, marker : string, list :string list, ?addtlRefAssy:string list, ?coffeeBreak:bool) = + member private this.VerifyDotCompListContainAllAtStartOfMarker(fileContents : string, marker : string, list :string list, ?addtlRefAssy:list, ?coffeeBreak:bool) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) //to add references @@ -143,7 +143,7 @@ type UsingMSBuild() as this = AssertCompListContainsAll(completions, list) // There are some quickinfo tests in this file as well, in the systematic tests for queries - member public this.InfoInDeclarationTestQuickInfoImpl(code : string,marker,expected,atStart, ?addtlRefAssy : string list) = + member public this.InfoInDeclarationTestQuickInfoImpl(code : string,marker,expected,atStart, ?addtlRefAssy : list) = let (solution, project, file) = this.CreateSingleFileProject(code, ?references = addtlRefAssy) let gpatcc = GlobalParseAndTypeCheckCounter.StartNew(this.VS) @@ -156,7 +156,7 @@ type UsingMSBuild() as this = AssertContains(tooltip, expected) gpatcc.AssertExactly(0,0) - member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : string list) = + member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,false,?addtlRefAssy=addtlRefAssy) static member charExpectedCompletions = [ "CompareTo"; // Members defined on System.Char @@ -207,7 +207,7 @@ type UsingMSBuild() as this = [ ] // should not contain //**Help Function for checking Ctrl-Space Completion Contains the expected value ************* - member private this.AssertCtrlSpaceCompletionContains(fileContents : string list, marker, expected, ?addtlRefAssy: string list) = + member private this.AssertCtrlSpaceCompletionContains(fileContents : list, marker, expected, ?addtlRefAssy: list) = this.AssertCtrlSpaceCompletion( fileContents, marker, @@ -222,19 +222,19 @@ type UsingMSBuild() as this = ) //**Help Function for checking Ctrl-Space Completion Contains the expected value ************* - member private this.AssertCtrlSpaceCompletion(fileContents : string list, marker, checkCompletion: (CompletionItem array -> unit), ?addtlRefAssy: string list) = + member private this.AssertCtrlSpaceCompletion(fileContents : list, marker, checkCompletion: (CompletionItem array -> unit), ?addtlRefAssy: list) = let (_, _, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToEndOfMarker(file,marker) let completions = CtrlSpaceCompleteAtCursor file checkCompletion completions - member private this.AutoCompletionListNotEmpty (fileContents : string list) marker = + member private this.AutoCompletionListNotEmpty (fileContents : list) marker = let (_, _, file) = this.CreateSingleFileProject(fileContents) MoveCursorToEndOfMarker(file,marker) let completions = AutoCompleteAtCursor file Assert.AreNotEqual(0,completions.Length) - member public this.TestCompletionNotShowingWhenFastUpdate (firstSrc : string list) secondSrc marker = + member public this.TestCompletionNotShowingWhenFastUpdate (firstSrc : list) secondSrc marker = let (_, _, file) = this.CreateSingleFileProject(firstSrc) MoveCursorToEndOfMarker(file,marker) @@ -257,14 +257,14 @@ type UsingMSBuild() as this = AssertCompListContainsAll(completions, list) //DoesNotContainAny At Start Of Marker Helper Function - member private this.VerifyDotCompListDoesNotContainAnyAtStartOfMarker(fileContents : string, marker : string, list : string list, ?addtlRefAssy : string list) = + member private this.VerifyDotCompListDoesNotContainAnyAtStartOfMarker(fileContents : string, marker : string, list : string list, ?addtlRefAssy : list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) let completions = DotCompletionAtStartOfMarker file marker AssertCompListDoesNotContainAny(completions, list) //DotCompList Is Empty At Start Of Marker Helper Function - member private this.VerifyDotCompListIsEmptyAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : string list) = + member private this.VerifyDotCompListIsEmptyAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) let completions = DotCompletionAtStartOfMarker file marker @@ -1237,7 +1237,7 @@ for i in 0..a."] AssertCtrlSpaceCompleteContains code "? y." ["Chars"; "Length"] ["abs"] [] - [] + [] member public this.``Query.ForKeywordCanCompleteIntoIdentifier``() = let code = [ @@ -1479,7 +1479,7 @@ let x = new MyClass2(0) [] - [] + [] member public this.``AfterConstructor.5039_1``() = AssertAutoCompleteContainsNoCoffeeBreak [ "let someCall(x) = null" @@ -1489,7 +1489,7 @@ let x = new MyClass2(0) [ "LastIndexOfAny" ] // should not contain (String) [] - [] + [] member public this.``AfterConstructor.5039_1.CoffeeBreak``() = AssertAutoCompleteContains [ "let someCall(x) = null" @@ -2022,7 +2022,7 @@ let x = new MyClass2(0) [] [] - [] + [] member public this.``CurriedArguments.Regression1``() = AssertCtrlSpaceCompleteContainsNoCoffeeBreak ["let fffff x y = 1" @@ -2447,7 +2447,7 @@ let x = new MyClass2(0) [] [] [] - [] + [] member this.``QueryExpressions.QueryAndSequenceExpressionWithForYieldLoopSystematic``() = let prefix = """ @@ -2549,7 +2549,7 @@ let aaaaaa = 0 [] [] [] - [] + [] /// Incrementally enter query with a 'join' and check for availability of quick info, auto completion and dot completion member this.``QueryAndOtherExpressions.WordByWordSystematicJoinQueryOnSingleLine``() = @@ -2604,7 +2604,7 @@ let aaaaaa = 0 /// This is a sanity check that the multiple-line case is much the same as the single-line cae [] [] - [] + [] member this.``QueryAndOtherExpressions.WordByWordSystematicJoinQueryOnMultipleLine``() = let prefix = """ @@ -2771,7 +2771,7 @@ let x = query { for bbbb in abbbbc(*D0*) do (* Various parser recovery test cases -------------------------------------------------- *) //*****************Helper Function***************** - member public this.AutoCompleteRecoveryTest(source : string list, marker, expected) = + member public this.AutoCompleteRecoveryTest(source : list, marker, expected) = let (_, _, file) = this.CreateSingleFileProject(source) MoveCursorToEndOfMarker(file, marker) let completions = time1 CtrlSpaceCompleteAtCursor file "Time of first autocomplete." @@ -5064,7 +5064,7 @@ let x = query { for bbbb in abbbbc(*D0*) do Assert.IsTrue(completions.Length>0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug72561``() = let code = [ " " ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -5086,7 +5086,7 @@ let x = query { for bbbb in abbbbc(*D0*) do gpatcc.AssertExactly(0,0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug72561.Noteworthy.NowWorks``() = let code = [ "123 " ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -5109,7 +5109,7 @@ let x = query { for bbbb in abbbbc(*D0*) do gpatcc.AssertExactly(0,0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug130733.NowWorks``() = let code = [ "let someCall(x) = null" "let xe = someCall(System.IO.StringReader() "] @@ -5152,7 +5152,7 @@ let x = query { for bbbb in abbbbc(*D0*) do let completions = AutoCompleteAtCursor(file) AssertCompListContainsAll(completions, list) - member private this.VerifyCtrlSpaceListContainAllAtStartOfMarker(fileContents : string, marker : string, list : string list, ?coffeeBreak:bool, ?addtlRefAssy:string list) = + member private this.VerifyCtrlSpaceListContainAllAtStartOfMarker(fileContents : string, marker : string, list : string list, ?coffeeBreak:bool, ?addtlRefAssy:list) = let coffeeBreak = defaultArg coffeeBreak false let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker(file, marker) @@ -7067,7 +7067,7 @@ let rec f l = //Regression test for bug 65740 Fsharp: dot completion is mission after a '#' statement [] - [] + [] member this.``Identifier.In#Statement``() = this.VerifyDotCompListContainAllAtStartOfMarker( fileContents = """ diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index d96d3a16d61..add5eb9cc4d 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -94,7 +94,7 @@ type UsingMSBuild() as this = (errorTexts.ToString()) //Verify the warning list Count - member private this.VerifyWarningListCountAtOpenProject(fileContents : string, expectedNum : int, ?addtlRefAssy : string list) = + member private this.VerifyWarningListCountAtOpenProject(fileContents : string, expectedNum : int, ?addtlRefAssy : list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -102,7 +102,7 @@ type UsingMSBuild() as this = Assert.AreEqual(expectedNum,warnList.Length) //verify no the error list - member private this.VerifyNoErrorListAtOpenProject(fileContents : string, ?addtlRefAssy : string list) = + member private this.VerifyNoErrorListAtOpenProject(fileContents : string, ?addtlRefAssy : list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -113,7 +113,7 @@ type UsingMSBuild() as this = Assert.IsTrue(errorList.IsEmpty) //Verify the error list containd the expected string - member private this.VerifyErrorListContainedExpectedString(fileContents : string, expectedStr : string, ?addtlRefAssy : string list) = + member private this.VerifyErrorListContainedExpectedString(fileContents : string, expectedStr : string, ?addtlRefAssy : list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -571,7 +571,7 @@ but here has type Assert.IsTrue(errorList.IsEmpty) [] - [] + [] member public this.``UnicodeCharacters``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs index b1049408fac..5a369da4093 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs @@ -22,7 +22,7 @@ type UsingMSBuild() = inherit LanguageServiceBaseTests() //GoToDefinitionSuccess Helper Function - member private this.VerifyGoToDefnSuccessAtStartOfMarker(fileContents : string, marker : string, definitionCode : string,?addtlRefAssy : string list) = + member private this.VerifyGoToDefnSuccessAtStartOfMarker(fileContents : string, marker : string, definitionCode : string,?addtlRefAssy : list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) @@ -44,7 +44,7 @@ type UsingMSBuild() = Assert.AreEqual(pos, actualPos, "pos") //GoToDefinitionFail Helper Function - member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string,?addtlRefAssy : string list) = + member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string,?addtlRefAssy : list) = this.VerifyGoToDefnFailAtStartOfMarker( fileContents = fileContents, @@ -55,7 +55,7 @@ type UsingMSBuild() = //GoToDefinitionFail Helper Function - member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string, f : OpenFile * GotoDefnResult -> unit, ?addtlRefAssy : string list) = + member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string, f : OpenFile * GotoDefnResult -> unit, ?addtlRefAssy : list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) @@ -67,7 +67,7 @@ type UsingMSBuild() = //The verification result should be: // Fail at automation lab // Succeed on dev machine with enlistment installed. - member private this.VerifyGoToDefnNoErrorDialogAtStartOfMarker(fileContents : string, marker :string, definitionCode : string, ?addtlRefAssy : string list) = + member private this.VerifyGoToDefnNoErrorDialogAtStartOfMarker(fileContents : string, marker :string, definitionCode : string, ?addtlRefAssy : list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs index 0da7fce519b..9404ca301e4 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs @@ -59,7 +59,7 @@ type UsingMSBuild() = (expectedParamNames,paramDisplays) ||> List.forall2 (fun expectedParamName paramDisplay -> paramDisplay.Contains(expectedParamName)))) - member private this.GetMethodListForAMethodTip(fileContents : string, marker : string, ?addtlRefAssy : string list) = + member private this.GetMethodListForAMethodTip(fileContents : string, marker : string, ?addtlRefAssy : list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker(file, marker) @@ -67,22 +67,22 @@ type UsingMSBuild() = GetParameterInfoAtCursor(file) //Verify all the overload method parameterInfo - member private this.VerifyParameterInfoAtStartOfMarker(fileContents : string, marker : string, expectedParamNamesSet:string list list, ?addtlRefAssy :string list) = + member private this.VerifyParameterInfoAtStartOfMarker(fileContents : string, marker : string, expectedParamNamesSet:string list list, ?addtlRefAssy :list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertMethodGroup(methodstr,expectedParamNamesSet) //Verify No parameterInfo at the marker - member private this.VerifyNoParameterInfoAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : string list) = + member private this.VerifyNoParameterInfoAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertEmptyMethodGroup(methodstr) //Verify one method parameterInfo if contained in parameterInfo list - member private this.VerifyParameterInfoContainedAtStartOfMarker(fileContents : string, marker : string, expectedParamNames:string list, ?addtlRefAssy : string list) = + member private this.VerifyParameterInfoContainedAtStartOfMarker(fileContents : string, marker : string, expectedParamNames:string list, ?addtlRefAssy : list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertMethodGroupContain(methodstr,expectedParamNames) //Verify the parameterInfo of one of the list order - member private this.VerifyParameterInfoOverloadMethodIndex(fileContents : string, marker : string, index : int, expectedParams:string list, ?addtlRefAssy : string list) = + member private this.VerifyParameterInfoOverloadMethodIndex(fileContents : string, marker : string, index : int, expectedParams:string list, ?addtlRefAssy : list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) Assert.IsTrue(methodstr.IsSome, "Expected a method group") let methodstr = methodstr.Value @@ -102,7 +102,7 @@ type UsingMSBuild() = Assert.IsTrue (methodstr.GetCount() > 0) //Verify return content after the colon - member private this.VerifyFirstParameterInfoColonContent(fileContents : string, marker : string, expectedStr : string, ?addtlRefAssy : string list) = + member private this.VerifyFirstParameterInfoColonContent(fileContents : string, marker : string, expectedStr : string, ?addtlRefAssy : list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) Assert.IsTrue(methodstr.IsSome, "Expected a method group") let methodstr = methodstr.Value @@ -253,7 +253,7 @@ type UsingMSBuild() = this.VerifyHasParameterInfo(fileContent, "(*Mark*)") [] - [] + [] member public this.``Single.DotNet.StaticMethod``() = let code = ["#light" @@ -426,7 +426,7 @@ type UsingMSBuild() = [] - [] + [] member public this.``Single.InMatchClause``() = let v461 = Version(4,6,1) let fileContent = """ @@ -604,7 +604,7 @@ type UsingMSBuild() = // Test PI does not pop up after non-parameterized properties and after values [] - [] + [] member public this.``Single.Locations.EndOfFile`` () = this.TestSystematicParameterInfo("System.Console.ReadLine(", [ [] ]) @@ -640,59 +640,50 @@ type UsingMSBuild() = [] member public this.``Single.Generics.Typeof``() = + let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("typeof(", []) - [] - [] + [] member public this.``Single.Generics.MathAbs``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Math.Abs(", sevenTimes ["value"]) - [] - [] + [] member public this.``Single.Generics.ExchangeInt``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange(", sevenTimes ["location1"; "value"]) - [] - [] + [] member public this.``Single.Generics.Exchange``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange(", sevenTimes ["location1"; "value"]) - [] - [] + [] member public this.``Single.Generics.ExchangeUnder``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange<_> (", sevenTimes ["location1"; "value"]) - [] - [] + [] member public this.``Single.Generics.Dictionary``() = this.TestGenericParameterInfo("System.Collections.Generic.Dictionary<_, option>(", [ []; ["capacity"]; ["comparer"]; ["capacity"; "comparer"]; ["dictionary"]; ["dictionary"; "comparer"] ]) - [] - [] + [] member public this.``Single.Generics.List``() = this.TestGenericParameterInfo("new System.Collections.Generic.List< _ > ( ", [ []; ["capacity"]; ["collection"] ]) - [] - [] + [] member public this.``Single.Generics.ListInt``() = this.TestGenericParameterInfo("System.Collections.Generic.List(", [ []; ["capacity"]; ["collection"] ]) - [] - [] + [] member public this.``Single.Generics.EventHandler``() = this.TestGenericParameterInfo("new System.EventHandler( ", [ [""] ]) // function arg doesn't have a name - [] - [] + [] member public this.``Single.Generics.EventHandlerEventArgs``() = this.TestGenericParameterInfo("System.EventHandler(", [ [""] ]) // function arg doesn't have a name - [] - [] + [] member public this.``Single.Generics.EventHandlerEventArgsNew``() = this.TestGenericParameterInfo("new System.EventHandler ( ", [ [""] ]) // function arg doesn't have a name @@ -706,7 +697,7 @@ type UsingMSBuild() = failwith "bad unit test: did not find '$' in input to mark cursor location!" idx, lines - member public this.TestParameterInfoNegative (testLine, ?addtlRefAssy : string list) = + member public this.TestParameterInfoNegative (testLine, ?addtlRefAssy : list) = let cursorPrefix, testLines = this.ExtractLineInfo testLine let code = @@ -721,7 +712,7 @@ type UsingMSBuild() = Assert.IsTrue(info.IsNone, "expected no parameter info") gpatcc.AssertExactly(0,0) - member public this.TestParameterInfoLocation (testLine, expectedPos, ?addtlRefAssy : string list) = + member public this.TestParameterInfoLocation (testLine, expectedPos, ?addtlRefAssy : list) = let cursorPrefix, testLines = this.ExtractLineInfo testLine let code = [ "#light" @@ -765,7 +756,7 @@ type UsingMSBuild() = this.TestParameterInfoLocation("let a = Interlocked.Exchange($", 8) [] - [] + [] member public this.``Single.Locations.WithGenericArgs``() = this.TestParameterInfoLocation("Interlocked.Exchange($", 0) @@ -788,7 +779,7 @@ type UsingMSBuild() = [] [] [] - [] + [] //This test verifies that ParamInfo location on a provided type with namespace that exposes static parameter that takes >1 argument works normally. member public this.``TypeProvider.Type.ParameterInfoLocation.WithNamespace`` () = this.TestParameterInfoLocation("type boo = N1.T<$",11, @@ -797,7 +788,7 @@ type UsingMSBuild() = [] [] [] - [] + [] //This test verifies that ParamInfo location on a provided type without the namespace that exposes static parameter that takes >1 argument works normally. member public this.``TypeProvider.Type.ParameterInfoLocation.WithOutNamespace`` () = this.TestParameterInfoLocation("open N1 \n"+"type boo = T<$", @@ -890,7 +881,7 @@ type UsingMSBuild() = ("// System.Console.WriteLine($)") [] - [] + [] member this.``Regression.LocationOfParams.AfterQuicklyTyping.Bug91373``() = let code = [ "let f x = x " "let f1 y = y " @@ -915,7 +906,7 @@ type UsingMSBuild() = AssertEqual([|(2,10);(2,12);(2,13);(3,0)|], info.GetParameterLocations()) [] - [] + [] member this.``LocationOfParams.AfterQuicklyTyping.CallConstructor``() = let code = [ "type Foo() = class end" ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -1081,7 +1072,7 @@ We really need to rewrite some code paths here to use the real parse tree rather () [] - [] + [] member public this.``Regression.LocationOfParams.Bug91479``() = this.TestParameterInfoLocationOfParams("""let z = fun x -> x + ^System.Int16.Parse^(^$ """, markAtEOF=true) @@ -1207,7 +1198,7 @@ We really need to rewrite some code paths here to use the real parse tree rather ^l.Aggregate^(^$^) // was once a bug""") [] - [] + [] member public this.``LocationOfParams.BY_DESIGN.WayThatMismatchedParensFailOver.Case1``() = // when only one 'statement' after the mismatched parens after a comma, the comma swallows it and it becomes a badly-indented // continuation of the expression from the previous line @@ -1219,7 +1210,7 @@ We really need to rewrite some code paths here to use the real parse tree rather c.M(1,2,3,4)""", markAtEOF=true) [] - [] + [] member public this.``LocationOfParams.BY_DESIGN.WayThatMismatchedParensFailOver.Case2``() = // when multiple 'statements' after the mismatched parens after a comma, the parser sees a single argument to the method that // is a statement sequence, e.g. a bunch of discarded expressions. That is, @@ -1253,7 +1244,7 @@ We really need to rewrite some code paths here to use the real parse tree rather ^System.Console.WriteLine^(^ $(42,43) ^) // oops""") [] - [] + [] member public this.``LocationOfParams.Tuples.Bug123219``() = this.TestParameterInfoLocationOfParams(""" type Expr = | Num of int @@ -1394,7 +1385,7 @@ We really need to rewrite some code paths here to use the real parse tree rather [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix0``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ $ """, // missing all params, just have < @@ -1402,7 +1393,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix1``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ 42 """, // missing > @@ -1410,7 +1401,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix1Named``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored=42 """, // missing > @@ -1418,7 +1409,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ """, // missing last param @@ -1426,7 +1417,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2Named1``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored= """, // missing last param after name with equals @@ -1434,7 +1425,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2Named2``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored """, // missing last param after name sans equals @@ -1498,7 +1489,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.StaticParametersAtConstructorCallSite``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" let x = new ^N1.T^<^ "fo$o",^ 42 ^>()""", @@ -1636,7 +1627,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["string";"System.Globalization.NumberStyles"]) [] - [] + [] member public this.``Multi.DotNet.StaticMethod.WithinLambda``() = let fileContents = """let z = fun x -> x + System.Int16.Parse("",(*Mark*)""" this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["string";"System.Globalization.NumberStyles"]) @@ -1655,7 +1646,7 @@ We really need to rewrite some code paths here to use the real parse tree rather (* Common functions for multi-parameterinfo tests -------------------------------------------------- *) [] - [] + [] member public this.``Multi.DotNet.Constructor``() = let fileContents = "let _ = new System.DateTime(2010,12,(*Mark*)" this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["int";"int";"int"]) @@ -1751,7 +1742,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoAtStartOfMarker(fileContents,"(*Mark*)",[["int list"]]) [] - [] + [] member public this.``Multi.Function.WithOptionType``() = let fileContents = """ let foo( a : int option, b : string ref) = 0 @@ -1768,7 +1759,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoAtStartOfMarker(fileContents,"(*Mark*)",[["int option";"float option"]]) [] - [] + [] member public this.``Multi.Function.WithRefType``() = let fileContents = """ let foo( a : int ref, b : string ref) = 0 diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs index d62f4274062..388bb365fd9 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs @@ -54,7 +54,7 @@ type UsingMSBuild() = AssertContains(trimnewlines tooltip, trimnewlines expected) gpatcc.AssertExactly(0,0) - member public this.CheckTooltip(code : string,marker,atStart, f, ?addtlRefAssy : string list) = + member public this.CheckTooltip(code : string,marker,atStart, f, ?addtlRefAssy : list) = let (_, _, file) = this.CreateSingleFileProject(code, ?references = addtlRefAssy) let gpatcc = GlobalParseAndTypeCheckCounter.StartNew(this.VS) @@ -67,14 +67,14 @@ type UsingMSBuild() = f (tooltip, pos) gpatcc.AssertExactly(0,0) - member public this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,atStart, ?addtlRefAssy : string list) = + member public this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,atStart, ?addtlRefAssy : list) = let check ((tooltip, _), _) = AssertContains(tooltip, expected) this.CheckTooltip(code, marker, atStart, check, ?addtlRefAssy=addtlRefAssy ) - member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : string list) = + member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,false,?addtlRefAssy=addtlRefAssy) - member public this.AssertQuickInfoContainsAtStartOfMarker(code, marker, expected, ?addtlRefAssy : string list) = + member public this.AssertQuickInfoContainsAtStartOfMarker(code, marker, expected, ?addtlRefAssy : list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,true,?addtlRefAssy=addtlRefAssy) member public this.VerifyQuickInfoDoesNotContainAnyAtEndOfMarker (code : string) marker notexpected = @@ -1684,7 +1684,7 @@ let f (tp:ITypeProvider(*$$$*)) = tp.Invalidate /// Complete a member completion and confirm that its data tip contains the fragments /// in rhsContainsOrder - member public this.AssertMemberDataTipContainsInOrder(code : string list,marker,completionName,rhsContainsOrder) = + member public this.AssertMemberDataTipContainsInOrder(code : list,marker,completionName,rhsContainsOrder) = let code = code |> Seq.collect (fun s -> s.Split [|'\r'; '\n'|]) |> List.ofSeq let (_, project, file) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(this.VS) (* why needed? *) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs index 7f854cb01e3..ea2d28ad606 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs @@ -24,7 +24,7 @@ type UsingMSBuild() as this = let (_, p, f) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) (p, f) - let createSingleFileFsxFromLines (code : string list) = + let createSingleFileFsxFromLines (code : list) = let (_, p, f) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) (p, f) @@ -582,7 +582,7 @@ type UsingMSBuild() as this = [] [] - [] + [] member public this.``Fsx.NoError.HashR.RelativePath1``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -619,7 +619,7 @@ type UsingMSBuild() as this = AssertNoSquiggle(ans) [] - [] + [] member public this.``Fsx.NoError.HashR.RelativePath2``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs index e89d828ac24..34021a7dd1a 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs @@ -89,7 +89,7 @@ type UsingMSBuild() = // In this bug, the referenced project output didn't exist yet. Building dependee should cause update in dependant [] - [] + [] member public this.``Regression.NoContainedString.Timestamps.Bug3368a``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -166,7 +166,7 @@ type UsingMSBuild() = // FEATURE: When a referenced assembly's timestamp changes the reference is reread. [] - [] + [] member public this.``Timestamps.ReferenceAssemblyChangeAbsolute``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -213,7 +213,7 @@ type UsingMSBuild() = // In this bug, relative paths to referenced assemblies weren't seen. [] - [] + [] member public this.``Timestamps.ReferenceAssemblyChangeRelative``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -268,7 +268,7 @@ type UsingMSBuild() = // FEATURE: When a referenced project's assembly timestamp changes the reference is reread. [] - [] + [] member public this.``Timestamps.ProjectReferenceAssemblyChange``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs index 8b56c8ae806..5f3f2f63c9a 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs @@ -684,7 +684,7 @@ type Project() = File.Delete(absFilePath) )) - [] //ref bug https://github.com/dotnet/fsharp/issues/259 + [] //ref bug https://github.com/Microsoft/visualfsharp/issues/259 member public this.``RenameFile.InFolder``() = this.MakeProjectAndDo(["file1.fs"; @"Folder1\file2.fs"; @"Folder1\nested1.fs"], [], "", (fun project -> let absFilePath = Path.Combine(project.ProjectFolder, "Folder1", "nested1.fs") @@ -746,7 +746,7 @@ type Project() = if File.Exists(absFilePath) then File.Delete(absFilePath) )) -(* Disabled for now - see https://github.com/dotnet/fsharp/pull/3071 - this is testing old project system features +(* Disabled for now - see https://github.com/Microsoft/visualfsharp/pull/3071 - this is testing old project system features [] member public this.``RenameFile.BuildActionIsResetBasedOnFilenameExtension``() = diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs index 50805ed6356..bdedda27f09 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs @@ -508,10 +508,10 @@ type References() = AssertContains contents newPropVal ) - // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 + // Disabled due to: https://github.com/Microsoft/visualfsharp/issues/1460 // On DEV 15 Preview 4 the VS IDE Test fails with : // System.InvalidOperationException : Operation is not valid due to the current state of the object. - // [] // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 + // [] // Disabled due to: https://github.com/Microsoft/visualfsharp/issues/1460 member public this.``AddReference.COM`` () = DoWithTempFile "Test.fsproj" (fun projFile -> File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [], "")) diff --git a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs index 35fe73cb680..c33223c6ff0 100644 --- a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs +++ b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs @@ -32,21 +32,21 @@ type internal SourceFileKind = FS | FSI | FSX type internal ISingleFileTestRunner = abstract CreateSingleFileProject : content : string * - ?references : string list * - ?defines : string list * + ?references : list * + ?defines : list * ?fileKind : SourceFileKind * - ?disabledWarnings : string list * + ?disabledWarnings : list * ?fileName : string -> (OpenSolution * OpenProject * OpenFile) abstract CreateSingleFileProject : - content : string list * - ?references : string list * - ?defines : string list * + content : list * + ?references : list * + ?defines : list * ?fileKind : SourceFileKind * - ?disabledWarnings : string list* + ?disabledWarnings : list* ? fileName : string -> (OpenSolution * OpenProject * OpenFile) type internal Helper = - static member TrimOutExtraMscorlibs (libList:string list) = + static member TrimOutExtraMscorlibs (libList:list) = // There may be multiple copies of mscorlib referenced; but we're only allowed to use one. Pick the highest one. let allExceptMscorlib = libList |> List.filter (fun s -> not(s.Contains("mscorlib"))) let mscorlibs = libList |> List.filter (fun s -> s.Contains("mscorlib")) @@ -78,7 +78,7 @@ type internal Helper = Impl SourceFileKind.FS Impl SourceFileKind.FSX - static member AssertMemberDataTipContainsInOrder(sftr : ISingleFileTestRunner, code : string list,marker,completionName,rhsContainsOrder) = + static member AssertMemberDataTipContainsInOrder(sftr : ISingleFileTestRunner, code : list,marker,completionName,rhsContainsOrder) = let (_solution, project, file) = sftr.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(file.VS) (* why needed? *) MoveCursorToEndOfMarker(file,marker) @@ -193,7 +193,7 @@ type internal GlobalParseAndTypeCheckCounter private(initialParseCount:int, init | Some(aat) -> aat :: (expectedTypeCheckedFiles |> List.map GetNameOfOpenFile) | _ -> (expectedTypeCheckedFiles |> List.map GetNameOfOpenFile) this.AssertExactly(p.Length, t.Length, p, t, expectCreate) - member private this.AssertExactly(expectedParses, expectedTypeChecks, expectedParsedFiles : string list, expectedTypeCheckedFiles : string list, expectCreate : bool) = + member private this.AssertExactly(expectedParses, expectedTypeChecks, expectedParsedFiles : list, expectedTypeCheckedFiles : list, expectCreate : bool) = let note,ok = if expectCreate then if this.SawIBCreated() then ("The incremental builder was created, as expected",true) else ("The incremental builder was NOT deleted and recreated, even though we expected it to be",false) @@ -254,41 +254,46 @@ type LanguageServiceBaseTests() = let mutable defaultVS : VisualStudio = Unchecked.defaultof<_> let mutable currentVS : VisualStudio = Unchecked.defaultof<_> - // VsOps is internal, but this type needs to be public + (* VsOps is internal, but this type needs to be public *) let mutable ops = BuiltMSBuildTestFlavour() let testStopwatch = new Stopwatch() - // Timings ----------------------------------------------------------------------------- + (* Timings ----------------------------------------------------------------------------- *) let stopWatch = new Stopwatch() let ResetStopWatch() = stopWatch.Reset(); stopWatch.Start() + let time1 op a message = + ResetStopWatch() + let result = op a + printf "%s %d ms\n" message stopWatch.ElapsedMilliseconds + result - member internal _.VsOpts + member internal this.VsOpts with set op = ops <- op member internal this.TestRunner : ISingleFileTestRunner = SingleFileTestRunner(this) :> _ - member internal _.VS = currentVS + member internal this.VS = currentVS member internal this.CreateSingleFileProject ( content : string, - ?references : string list, - ?defines : string list, + ?references : list, + ?defines : list, ?fileKind : SourceFileKind, - ?disabledWarnings : string list, + ?disabledWarnings : list, ?fileName : string, ?otherFlags: string ) = let content = content.Split( [|"\r\n"|], StringSplitOptions.None) |> List.ofArray this.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName, ?otherFlags = otherFlags) - member internal _.CreateSingleFileProject + member internal this.CreateSingleFileProject ( - content : string list, - ?references : string list, - ?defines : string list, + content : list, + ?references : list, + ?defines : list, ?fileKind : SourceFileKind, - ?disabledWarnings : string list, + ?disabledWarnings : list, ?fileName : string, ?otherFlags: string ) = @@ -348,12 +353,12 @@ type LanguageServiceBaseTests() = defaultSolution, proj, file - member internal _.CreateSolution() = + member internal this.CreateSolution() = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" GlobalFunctions.CreateSolution(currentVS) - member internal _.CloseSolution(sln : OpenSolution) = + member internal this.CloseSolution(sln : OpenSolution) = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" if (box sln.VS <> box currentVS) then @@ -361,7 +366,7 @@ type LanguageServiceBaseTests() = GlobalFunctions.CloseSolution(sln) - member internal _.AddAssemblyReference(proj, ref) = + member internal this.AddAssemblyReference(proj, ref) = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" @@ -461,21 +466,21 @@ and internal SingleFileTestRunner(owner : LanguageServiceBaseTests) = member sftr.CreateSingleFileProject ( content : string, - ?references : string list, - ?defines : string list, + ?references : list, + ?defines : list, ?fileKind : SourceFileKind, - ?disabledWarnings : string list, + ?disabledWarnings : list, ?fileName : string ) = owner.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName) member sftr.CreateSingleFileProject ( - content : string list, - ?references : string list, - ?defines : string list, + content : list, + ?references : list, + ?defines : list, ?fileKind : SourceFileKind, - ?disabledWarnings : string list, + ?disabledWarnings : list, ?fileName : string ) = owner.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName) diff --git a/vsintegration/tests/UnitTests/Tests.Watson.fs b/vsintegration/tests/UnitTests/Tests.Watson.fs index 54122e4ff71..e0e44503b47 100644 --- a/vsintegration/tests/UnitTests/Tests.Watson.fs +++ b/vsintegration/tests/UnitTests/Tests.Watson.fs @@ -31,7 +31,7 @@ type Check = |] let ctok = AssumeCompilationThreadWithoutEvidence () - let _code = CompileFromCommandLineArguments (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.DiagnosticsLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) + let _code = mainCompile (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.ErrorLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) () with | :? 'TException as e -> @@ -40,8 +40,8 @@ type Check = else printfn "%s" msg Assert.Fail("The correct callstack was not reported to watson.") - | (FSharp.Compiler.DiagnosticsLogger.ReportedError (Some (FSharp.Compiler.DiagnosticsLogger.InternalError (msg, range) as e))) - | (FSharp.Compiler.DiagnosticsLogger.InternalError (msg, range) as e) -> + | (FSharp.Compiler.ErrorLogger.ReportedError (Some (FSharp.Compiler.ErrorLogger.InternalError (msg, range) as e))) + | (FSharp.Compiler.ErrorLogger.InternalError (msg, range) as e) -> printfn "InternalError Exception: %s, range = %A, stack = %s" msg range (e.ToString()) Assert.Fail("An InternalError exception occurred.") finally diff --git a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs index bcdcd67b66b..f33ffbc52da 100644 --- a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs +++ b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs @@ -184,11 +184,11 @@ module WorkspaceTests = interface IFSharpWorkspaceProjectContext with - member _.Dispose(): unit = () + member this.Dispose(): unit = () - member _.FilePath: string = mainProj.FilePath + member this.FilePath: string = mainProj.FilePath - member _.HasProjectReference(filePath: string): bool = + member this.HasProjectReference(filePath: string): bool = mainProj.ProjectReferences |> Seq.exists (fun x -> let projRef = mainProj.Solution.GetProject(x.ProjectId) @@ -198,11 +198,11 @@ module WorkspaceTests = false ) - member _.Id: ProjectId = mainProj.Id + member this.Id: ProjectId = mainProj.Id - member _.ProjectReferenceCount: int = mainProj.ProjectReferences.Count() + member this.ProjectReferenceCount: int = mainProj.ProjectReferences.Count() - member _.SetProjectReferences(projRefs: seq): unit = + member this.SetProjectReferences(projRefs: seq): unit = let currentProj = mainProj let mutable solution = currentProj.Solution @@ -224,9 +224,9 @@ module WorkspaceTests = mainProj <- solution.GetProject(currentProj.Id) - member _.MetadataReferenceCount: int = mainProj.MetadataReferences.Count + member this.MetadataReferenceCount: int = mainProj.MetadataReferences.Count - member _.HasMetadataReference(referencePath: string): bool = + member this.HasMetadataReference(referencePath: string): bool = mainProj.MetadataReferences |> Seq.exists (fun x -> match x with @@ -235,7 +235,7 @@ module WorkspaceTests = | _ -> false) - member _.SetMetadataReferences(referencePaths: string seq): unit = + member this.SetMetadataReferences(referencePaths: string seq): unit = let currentProj = mainProj let mutable solution = currentProj.Solution @@ -263,7 +263,7 @@ module WorkspaceTests = type TestFSharpWorkspaceProjectContextFactory(workspace: Workspace, miscFilesWorkspace: Workspace) = interface IFSharpWorkspaceProjectContextFactory with - member _.CreateProjectContext(filePath: string): IFSharpWorkspaceProjectContext = + member this.CreateProjectContext(filePath: string): IFSharpWorkspaceProjectContext = match miscFilesWorkspace.CurrentSolution.GetDocumentIdsWithFilePath(filePath) |> Seq.tryExactlyOne with | Some docId -> let doc = miscFilesWorkspace.CurrentSolution.GetDocument(docId) From baef7c4e6f0859edb453e75b3e030193c8a21600 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Wed, 11 May 2022 08:57:27 +0200 Subject: [PATCH 04/91] WIP --- src/fsharp/CheckExpressions.fs | 7 +++---- src/fsharp/TypedTree.fs | 4 ++-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 44a40d21c55..c5f5d301082 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -11363,19 +11363,18 @@ and AnalyzeRecursiveStaticMemberOrValDecl let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner let envinner = MakeInnerEnvForTyconRef envinner tcref isExtrinsic - let (ExplicitTyparInfo(_, declaredTypars, infer)) = explicitTyparInfo let domainTy = NewInferenceType g + CheckForNonAbstractInterface declKind tcref memberFlags id.idRange + let optInferredImplSlotTys, declaredTypars = ApplyAbstractSlotInference cenv envinner (domainTy, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, objTy, optIntfSlotTy, valSynInfo, memberFlags, bindingAttribs) let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) - let memberInfo = - let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, bindingAttribs, optInferredImplSlotTys, memberFlags, valSynInfo, id, false) + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, bindingAttribs, optInferredImplSlotTys, memberFlags, valSynInfo, id, false) envinner, tpenv, id, None, Some memberInfo, vis, vis2, None, enclosingDeclaredTypars, None, explicitTyparInfo, bindingRhs, declaredTypars diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 975b28ef1c5..db2ddd51486 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -299,8 +299,8 @@ type TyparFlags(flags: int32) = TyparFlags((if isFromError then 0b00000000000000010 else 0) ||| (if isCompGen then 0b00000000000000100 else 0) ||| (match staticReq with - | TyparStaticReq.None -> 0b00000000000000000 - | TyparStaticReq.HeadType -> 0b00000000000001000) ||| + | TyparStaticReq.None -> 0b00000000000000000 + | TyparStaticReq.HeadType -> 0b00000000000001000) ||| (match rigidity with | TyparRigidity.Rigid -> 0b00000000000000000 | TyparRigidity.WillBeRigid -> 0b00000000000100000 From 44ae7286322a35653c5927bd3488b12e7d92b39a Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 16 May 2022 17:23:23 +0200 Subject: [PATCH 05/91] Removed double check for non-abstract interface --- src/Compiler/Checking/CheckExpressions.fs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index c95e53182c4..9b51b1b13c3 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -11682,8 +11682,6 @@ and AnalyzeRecursiveStaticMemberOrValDecl let domainTy = NewInferenceType g - CheckForNonAbstractInterface declKind tcref memberFlags id.idRange - let optInferredImplSlotTys, declaredTypars = ApplyAbstractSlotInference cenv envinner (domainTy, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) From ebe10508a4040b56b9fbe066999513e2078997f2 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Fri, 20 May 2022 18:28:58 +0200 Subject: [PATCH 06/91] WIP --- src/Compiler/Checking/CheckExpressions.fs | 2 +- src/Compiler/Checking/MethodOverrides.fs | 11 +++- src/Compiler/Checking/MethodOverrides.fsi | 3 +- .../Interop/StaticsInInterfaces.fs | 53 ++++++++++++++++++- 4 files changed, 64 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 505c68c8ce2..8f3f952cf92 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -10885,7 +10885,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn match memberFlags.MemberKind with | SynMemberKind.Member -> let dispatchSlots, dispatchSlotsArityMatch = - GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData) + GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData, memberFlags) let uniqueAbstractMethSigs = match dispatchSlots with diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 9d3e6c50153..ae2a70cc4a4 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -919,7 +919,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv /// Get the methods relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does -let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData) = +let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = let minfos = match typToSearchForAbstractMembers with | _, Some(SlotImplSet(_, dispatchSlotsKeyed, _, _)) -> @@ -928,7 +928,14 @@ let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: GetIntrinsicMethInfosOfType infoReader (Some memberName.idText) ad AllowMultiIntfInstantiations.Yes IgnoreOverrides bindm ty let dispatchSlots = minfos |> List.filter (fun minfo -> minfo.IsDispatchSlot) let topValSynArities = SynInfo.AritiesOfArgs valSynData - let topValSynArities = if List.isEmpty topValSynArities then topValSynArities else topValSynArities.Tail + + // We only return everything if it's empty or if it's a non-instance member. + // If it's an instance member, we are getting rid of `this` (by only taking tail). + let topValSynArities = + if List.isEmpty topValSynArities || (not memberFlags.IsInstance) then + topValSynArities + else + topValSynArities.Tail let dispatchSlotsArityMatch = dispatchSlots |> List.filter (fun minfo -> minfo.NumArgs = topValSynArities) dispatchSlots, dispatchSlotsArityMatch diff --git a/src/Compiler/Checking/MethodOverrides.fsi b/src/Compiler/Checking/MethodOverrides.fsi index e6091626469..04155d87fd2 100644 --- a/src/Compiler/Checking/MethodOverrides.fsi +++ b/src/Compiler/Checking/MethodOverrides.fsi @@ -155,7 +155,8 @@ val GetAbstractMethInfosForSynMethodDecl: memberName: Ident * bindm: range * typToSearchForAbstractMembers: (TType * SlotImplSet option) * - valSynData: SynValInfo -> + valSynData: SynValInfo * + memberFlags: SynMemberFlags -> MethInfo list * MethInfo list /// Get the properties relevant to determining if a uniquely-identified-override exists based on the syntactic information diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 6ba5081eec8..dbb36f06e52 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -68,9 +68,60 @@ let main _ = |> withReferences [csharpLib] |> compileAndRun |> shouldSucceed - + + + (* For reference: + Roslyn generates the following interface: + .class interface public auto ansi abstract IGetNext`1<(class IGetNext`1) T> + { + // Methods + .method public hidebysig abstract virtual static + !T Next ( + !T other + ) cil managed + { + } // end of method IGetNext`1::Next + + } // end of class IGetNext`1 + + And the following implementation: + .method public hidebysig static + class RepeatSequence Next (class RepeatSequence other) cil managed + { + .override method !0 class IGetNext`1::Next(!0) + ... + } + *) #if !NETCOREAPP [] + #else + [] + #endif + let ``F# generates valid IL for abstract static interface methods`` () = + + let csharpLib = csharpBaseClass + + let fsharpSource = + """ +module StaticsTesting +open StaticsInInterfaces + +type MyRepeatSequence() = + interface IGetNext with + static member Next(other: MyRepeatSequence) : MyRepeatSequence = other +""" + Fsx fsharpSource + |> withLangVersionPreview + |> withReferences [csharpLib] + |> compile + |> shouldSucceed + |> verifyIL [ + """ +foo + """] + +#if !NETCOREAPP + [] #else [] #endif From c200abda8590c507046b04851ab55b67361142ca Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Wed, 25 May 2022 18:29:16 +0200 Subject: [PATCH 07/91] WIP --- src/Compiler/Checking/CheckExpressions.fs | 15 ++++---- src/Compiler/Checking/MethodOverrides.fs | 7 ++-- src/Compiler/CodeGen/IlxGen.fs | 27 +++++++++----- src/Compiler/TypedTree/TypedTreeOps.fs | 4 ++- .../Interop/StaticsInInterfaces.fs | 35 ++++++++++++++++++- 5 files changed, 69 insertions(+), 19 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 53319cc741e..235354f7fea 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1314,13 +1314,16 @@ let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, implS let isInstance = MemberIsCompiledAsInstance g tcref isExtrinsic memberInfo attrs - if (memberFlags.IsDispatchSlot || not (isNil intfSlotTys)) then - if not isInstance then - errorR(VirtualAugmentationOnNullValuedType(id.idRange)) + let hasUseNullAsTrueAttr = TyconHasUseNullAsTrueValueAttribute g tcref.Deref - elif not memberFlags.IsOverrideOrExplicitImpl && memberFlags.IsInstance then - if not isExtrinsic && not isInstance then - warning(NonVirtualAugmentationOnNullValuedType(id.idRange)) + if hasUseNullAsTrueAttr then + if (memberFlags.IsDispatchSlot || not (isNil intfSlotTys)) then + if not isInstance then + errorR(VirtualAugmentationOnNullValuedType(id.idRange)) + + elif not memberFlags.IsOverrideOrExplicitImpl && memberFlags.IsInstance then + if not isExtrinsic && not isInstance then + warning(NonVirtualAugmentationOnNullValuedType(id.idRange)) let compiledName = if isExtrinsic then diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index ae2a70cc4a4..7ef91000758 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -767,9 +767,10 @@ module DispatchSlotChecking = // Find the methods relevant to implementing the abstract slots listed under the reqdType being checked. let allImmediateMembersThatMightImplementDispatchSlots = allImmediateMembers |> List.filter (fun overrideBy -> - overrideBy.IsInstanceMember && // exclude static - overrideBy.IsVirtualMember && // exclude non virtual (e.g. keep override/default). [4469] - not overrideBy.IsDispatchSlotMember) + (overrideBy.IsInstanceMember // Not static OR + || ((not overrideBy.IsInstanceMember) && overrideBy.IsOverrideOrExplicitImpl) // Static in the interface + && overrideBy.IsVirtualMember // exclude non virtual (e.g. keep override/default). [4469] + && not overrideBy.IsDispatchSlotMember)) let mustOverrideSomething reqdTy (overrideBy: ValRef) = let memberInfo = overrideBy.MemberInfo.Value diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 0bb39d8d750..9bb6e41c1a9 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -4644,11 +4644,17 @@ and GenFormalSlotsig m cenv eenv slotsig = let ilRet = GenFormalReturnType m cenv eenvForSlotSig returnTy ilTy, ilParams, ilRet -and GenOverridesSpec cenv eenv slotsig m = +and GenOverridesSpec cenv eenv slotsig m isInstance = let (TSlotSig(nameOfOverridenMethod, _, _, methodTypars, _, _)) = slotsig let ilOverrideTy, ilOverrideParams, ilOverrideRet = GenFormalSlotsig m cenv eenv slotsig let ilOverrideTyRef = ilOverrideTy.TypeRef - let ilOverrideMethRef = mkILMethRef(ilOverrideTyRef, ILCallingConv.Instance, nameOfOverridenMethod, List.length (DropErasedTypars methodTypars), typesOfILParams ilOverrideParams, ilOverrideRet.Type) + let callingConv = + if isInstance then + ILCallingConv.Instance + else + ILCallingConv.Static + + let ilOverrideMethRef = mkILMethRef(ilOverrideTyRef, callingConv, nameOfOverridenMethod, List.length (DropErasedTypars methodTypars), typesOfILParams ilOverrideParams, ilOverrideRet.Type) OverridesSpec(ilOverrideMethRef, ilOverrideTy) and GenFormalReturnType m cenv eenvFormal returnTy : ILReturn = @@ -4686,8 +4692,8 @@ and GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) = else nameOfOverridenMethod -and GenMethodImpl cenv eenv (useMethodImpl, slotsig) m = - let ilOverridesSpec = GenOverridesSpec cenv eenv slotsig m +and GenMethodImpl cenv eenv (useMethodImpl, slotsig) m isInstance = + let ilOverridesSpec = GenOverridesSpec cenv eenv slotsig m isInstance let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (useMethodImpl, slotsig) nameOfOverridingMethod, @@ -4696,7 +4702,12 @@ and GenMethodImpl cenv eenv (useMethodImpl, slotsig) m = let ilParamsOfOverridingMethod, ilReturnOfOverridingMethod = GenActualSlotsig m cenv eenvForOverrideBy slotsig methTyparsOfOverridingMethod [] let ilOverrideMethGenericParams = GenGenericParams cenv eenvForOverrideBy methTyparsOfOverridingMethod let ilOverrideMethGenericArgs = mkILFormalGenericArgs 0 ilOverrideMethGenericParams - let ilOverrideBy = mkILInstanceMethSpecInTy(ilTyForOverriding, nameOfOverridingMethod, typesOfILParams ilParamsOfOverridingMethod, ilReturnOfOverridingMethod.Type, ilOverrideMethGenericArgs) + let ilOverrideBy = + if isInstance then + mkILInstanceMethSpecInTy(ilTyForOverriding, nameOfOverridingMethod, typesOfILParams ilParamsOfOverridingMethod, ilReturnOfOverridingMethod.Type, ilOverrideMethGenericArgs) + else + mkILStaticMethSpecInTy(ilTyForOverriding, nameOfOverridingMethod, typesOfILParams ilParamsOfOverridingMethod, ilReturnOfOverridingMethod.Type, ilOverrideMethGenericArgs) + { Overrides = ilOverridesSpec OverrideBy = ilOverrideBy }) @@ -4745,7 +4756,7 @@ and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], nameOfOverridenMethod, eenvForMeth, 0, selfArgOpt, methBodyExpr, sequel) - let nameOfOverridingMethod, methodImplGenerator = GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methBodyExpr.Range + let nameOfOverridingMethod, methodImplGenerator = GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methBodyExpr.Range true let mdef = mkILGenericVirtualMethod @@ -4868,7 +4879,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel | _ -> error(InternalError(sprintf "expected method %s not found" imethName, m)) let slotsig = implementedMeth.GetSlotSig(amap, m) - let ilOverridesSpec = GenOverridesSpec cenv eenvinner slotsig m + let ilOverridesSpec = GenOverridesSpec cenv eenvinner slotsig m mdef.CallingConv.IsInstance let ilOverrideBy = mkILInstanceMethSpecInTy(ilCloTy, imethName, mdef.ParameterTypes, mdef.Return.Type, []) { Overrides = ilOverridesSpec OverrideBy = ilOverrideBy } ] @@ -7936,7 +7947,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let useMethodImpl = true let eenvUnderTypars = EnvForTypars memberParentTypars eenv - let _, methodImplGenerator = GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m + let _, methodImplGenerator = GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m memberInfo.MemberFlags.IsInstance if useMethodImpl then yield methodImplGenerator (ilThisTy, memberMethodTypars) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index caaff282912..714d04e79f2 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -8841,7 +8841,9 @@ let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute att let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberInfo) attrs = // All extension members are compiled as static members if isExtensionMember then false - // Anything implementing a dispatch slot is compiled as an instance member + // Members implementing a dispatch slot is compiled as an instance member + // Exception is static interface members: + elif not membInfo.MemberFlags.IsInstance && membInfo.MemberFlags.IsOverrideOrExplicitImpl then false elif membInfo.MemberFlags.IsOverrideOrExplicitImpl then true elif not (isNil membInfo.ImplementedSlotSigs) then true else diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index dbb36f06e52..45c164eb69c 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -117,7 +117,40 @@ type MyRepeatSequence() = |> shouldSucceed |> verifyIL [ """ -foo +.class public abstract auto ansi sealed StaticsTesting + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class auto ansi serializable nested public MyRepeatSequence + extends [runtime]System.Object + implements class [csLib]StaticsInInterfaces.IGetNext`1 + { +.custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) +.method public specialname rtspecialname + instance void .ctor() cil managed +{ + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ret +} + +.method public static class StaticsTesting/MyRepeatSequence + 'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence other) cil managed +{ + .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret +} + + } + +} """] #if !NETCOREAPP From 2168e1e065466002d50b0733321d50033003a86c Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 30 May 2022 19:17:47 +0200 Subject: [PATCH 08/91] WIP --- src/Compiler/CodeGen/IlxGen.fs | 31 +++++++++++- .../Interop/StaticsInInterfaces.fs | 50 +++++++++---------- 2 files changed, 54 insertions(+), 27 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 9bb6e41c1a9..707f3e30272 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -4725,6 +4725,9 @@ and renameMethodDef nameOfOverridingMethod (mdef: ILMethodDef) = and fixupMethodImplFlags (mdef: ILMethodDef) = mdef.WithAccess(ILMemberAccess.Private).WithHideBySig().WithFinal(true).WithNewSlot +and fixupStaticAbstractSlotFlags (mdef: ILMethodDef) = + mdef.WithHideBySig(true) + and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod = let g = cenv.g @@ -6643,6 +6646,22 @@ and ComputeFlagFixupsForMemberBinding cenv (v: Val) = | Some nm -> renameMethodDef nm | None -> () ] +and ComputeMethodImplNameFixupForStaticMemberBinding cenv (v: Val) = + if isNil v.ImplementedSlotSigs then + None + else + let slotsig = v.ImplementedSlotSigs |> List.last + let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (false, slotsig) + Some nameOfOverridingMethod + +and ComputeFlagFixupsForStaticMemberBinding _cenv (_v: Val) = + [ + fixupStaticAbstractSlotFlags + (*match ComputeMethodImplNameFixupForStaticMemberBinding cenv v with + | Some nm -> renameMethodDef nm + | None -> ()*) + ] + and ComputeMethodImplAttribs cenv (_v: Val) attrs = let g = cenv.g let implflags = @@ -6875,8 +6894,16 @@ and GenMethodForBinding else let mdef = if not compileAsInstance then - mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) - + if not memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + else // We want to get potential fixups and hidebysig for abstract statics: + let flagFixups = ComputeFlagFixupsForStaticMemberBinding cenv v + let mdef = mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + + // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary + mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) + mdef elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || memberInfo.MemberFlags.IsOverrideOrExplicitImpl then diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 45c164eb69c..945592b5cb5 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -118,35 +118,35 @@ type MyRepeatSequence() = |> verifyIL [ """ .class public abstract auto ansi sealed StaticsTesting - extends [runtime]System.Object +extends [runtime]System.Object { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) .class auto ansi serializable nested public MyRepeatSequence - extends [runtime]System.Object - implements class [csLib]StaticsInInterfaces.IGetNext`1 + extends [runtime]System.Object + implements class [csLib]StaticsInInterfaces.IGetNext`1 { -.custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) -.method public specialname rtspecialname - instance void .ctor() cil managed -{ - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: callvirt instance void [runtime]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: pop - IL_0008: ret -} - -.method public static class StaticsTesting/MyRepeatSequence - 'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence other) cil managed -{ - .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ret -} + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .method public specialname rtspecialname + instance void .ctor() cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ret + } + + .method public hidebysig static class StaticsTesting/MyRepeatSequence + 'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence other) cil managed + { + .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret + } } From c91c73f08ca58f944a1fced411015a752dc8633c Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Fri, 3 Jun 2022 17:37:13 +0200 Subject: [PATCH 09/91] WIP --- src/Compiler/CodeGen/IlxGen.fs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 707f3e30272..f2818e06371 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -6654,12 +6654,12 @@ and ComputeMethodImplNameFixupForStaticMemberBinding cenv (v: Val) = let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (false, slotsig) Some nameOfOverridingMethod -and ComputeFlagFixupsForStaticMemberBinding _cenv (_v: Val) = +and ComputeFlagFixupsForStaticMemberBinding cenv (v: Val) = [ fixupStaticAbstractSlotFlags - (*match ComputeMethodImplNameFixupForStaticMemberBinding cenv v with + match ComputeMethodImplNameFixupForStaticMemberBinding cenv v with | Some nm -> renameMethodDef nm - | None -> ()*) + | None -> () ] and ComputeMethodImplAttribs cenv (_v: Val) attrs = @@ -7972,10 +7972,12 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | Some(_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars | None -> [], [] - let useMethodImpl = true + // Don't use method impl for static abstract implementation (IsInstance <> true && IsOverrideOrExplicitImpl = true): + let isStaticAbstractImpl = (not memberInfo.MemberFlags.IsInstance) && memberInfo.MemberFlags.IsOverrideOrExplicitImpl + let useMethodImpl = not isStaticAbstractImpl let eenvUnderTypars = EnvForTypars memberParentTypars eenv let _, methodImplGenerator = GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m memberInfo.MemberFlags.IsInstance - if useMethodImpl then + if useMethodImpl || isStaticAbstractImpl then yield methodImplGenerator (ilThisTy, memberMethodTypars) | _ -> () ] From 8b31c824d91eea9b19fa3035885c1c8903d61d7d Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 13 Jun 2022 19:21:50 +0200 Subject: [PATCH 10/91] WIP: Fixed method codegen --- src/Compiler/CodeGen/IlxGen.fs | 27 +---- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 12 +- .../Interop/StaticsInInterfaces.fs | 110 +++++++++++++----- 3 files changed, 90 insertions(+), 59 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 24b6aaf3759..bf6b1da16b2 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -6646,22 +6646,6 @@ and ComputeFlagFixupsForMemberBinding cenv (v: Val) = | Some nm -> renameMethodDef nm | None -> () ] -and ComputeMethodImplNameFixupForStaticMemberBinding cenv (v: Val) = - if isNil v.ImplementedSlotSigs then - None - else - let slotsig = v.ImplementedSlotSigs |> List.last - let nameOfOverridingMethod = GenNameOfOverridingMethod cenv (false, slotsig) - Some nameOfOverridingMethod - -and ComputeFlagFixupsForStaticMemberBinding cenv (v: Val) = - [ - fixupStaticAbstractSlotFlags - match ComputeMethodImplNameFixupForStaticMemberBinding cenv v with - | Some nm -> renameMethodDef nm - | None -> () - ] - and ComputeMethodImplAttribs cenv (_v: Val) attrs = let g = cenv.g let implflags = @@ -6897,12 +6881,9 @@ and GenMethodForBinding if not memberInfo.MemberFlags.IsOverrideOrExplicitImpl then mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) else // We want to get potential fixups and hidebysig for abstract statics: - let flagFixups = ComputeFlagFixupsForStaticMemberBinding cenv v + let flagFixups = [ fixupStaticAbstractSlotFlags ] let mdef = mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups - - // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary - mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) mdef elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || memberInfo.MemberFlags.IsOverrideOrExplicitImpl then @@ -7972,12 +7953,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | Some(_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars | None -> [], [] - // Don't use method impl for static abstract implementation (IsInstance <> true && IsOverrideOrExplicitImpl = true): - let isStaticAbstractImpl = (not memberInfo.MemberFlags.IsInstance) && memberInfo.MemberFlags.IsOverrideOrExplicitImpl - let useMethodImpl = not isStaticAbstractImpl + let useMethodImpl = true let eenvUnderTypars = EnvForTypars memberParentTypars eenv let _, methodImplGenerator = GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m memberInfo.MemberFlags.IsInstance - if useMethodImpl || isStaticAbstractImpl then + if useMethodImpl then yield methodImplGenerator (ilThisTy, memberMethodTypars) | _ -> () ] diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 8cb50672575..154c2af89f5 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -751,12 +751,12 @@ let StaticMemberFlags trivia k : SynMemberFlags = } let ImplementStaticMemberFlags trivia k : SynMemberFlags = - { MemberKind=k - IsInstance=false - IsDispatchSlot=false - IsOverrideOrExplicitImpl=true - IsFinal=false - Trivia=trivia } + { MemberKind = k + IsInstance = false + IsDispatchSlot = false + IsOverrideOrExplicitImpl = true + IsFinal = false + Trivia = trivia } let MemberSynMemberFlagsTrivia (mMember: range) : SynMemberFlagsTrivia = { diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 945592b5cb5..da6e7bdf3bc 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -20,6 +20,12 @@ module ``Static Methods In Interfaces`` = { static abstract T Next(T other); } + + public interface IGetNext2 where T : IGetNext2 + { + abstract T Next(T other); + } + public record RepeatSequence : IGetNext { private const char Ch = 'A'; @@ -108,7 +114,12 @@ open StaticsInInterfaces type MyRepeatSequence() = interface IGetNext with - static member Next(other: MyRepeatSequence) : MyRepeatSequence = other + static member Next(other: MyRepeatSequence) : MyRepeatSequence = other + +type MyRepeatSequence2() = + static member Next(other: MyRepeatSequence2) = other + interface IGetNext with + static member Next(other: MyRepeatSequence2) : MyRepeatSequence2 = MyRepeatSequence2.Next(other) """ Fsx fsharpSource |> withLangVersionPreview @@ -117,40 +128,72 @@ type MyRepeatSequence() = |> shouldSucceed |> verifyIL [ """ -.class public abstract auto ansi sealed StaticsTesting +.class auto ansi serializable nested public MyRepeatSequence extends [runtime]System.Object -{ - .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) - .class auto ansi serializable nested public MyRepeatSequence - extends [runtime]System.Object - implements class [csLib]StaticsInInterfaces.IGetNext`1 - { +implements class [csLib]StaticsInInterfaces.IGetNext`1 + { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) .method public specialname rtspecialname - instance void .ctor() cil managed +instance void .ctor() cil managed { - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: callvirt instance void [runtime]System.Object::.ctor() - IL_0006: ldarg.0 - IL_0007: pop - IL_0008: ret + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ret } - + .method public hidebysig static class StaticsTesting/MyRepeatSequence - 'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence other) cil managed +'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence other) cil managed { - .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) - - .maxstack 8 - IL_0000: ldarg.0 - IL_0001: ret + .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret } - - } - -} + + } + + .class auto ansi serializable nested public MyRepeatSequence2 +extends [runtime]System.Object +implements class [csLib]StaticsInInterfaces.IGetNext`1 + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .method public specialname rtspecialname +instance void .ctor() cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ret + } + + .method public static class StaticsTesting/MyRepeatSequence2 +Next(class StaticsTesting/MyRepeatSequence2 other) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret + } + + .method public hidebysig static class StaticsTesting/MyRepeatSequence2 +'StaticsInInterfaces.IGetNext.Next'(class StaticsTesting/MyRepeatSequence2 other) cil managed + { + .override method !0 class [csLib]StaticsInInterfaces.IGetNext`1::Next(!0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ret + } + + } """] #if !NETCOREAPP @@ -168,15 +211,24 @@ open System open StaticsInInterfaces type MyRepeatSequence() = + [] val mutable Text : string + + override this.ToString() = this.Text + + static member Next(other: MyRepeatSequence) = + other.Text <- other.Text + "A" + other + interface IGetNext with - static member Next(other: MyRepeatSequence) : MyRepeatSequence = other + static member Next(other: MyRepeatSequence) : MyRepeatSequence = MyRepeatSequence.Next(other) [] let main _ = let mutable str = MyRepeatSequence () + str.Text <- "A" let res = [ for i in 0..10 do - yield string(str) + yield str.ToString() str <- MyRepeatSequence.Next(str) ] if res <> ["A"; "AA"; "AAA"; "AAAA"; "AAAAA"; "AAAAAA"; "AAAAAAA"; "AAAAAAAA"; "AAAAAAAAA"; "AAAAAAAAAA"; "AAAAAAAAAAA"] then From 40916ee6fc973a3ff3e2d833f06175ea02df2987 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 13 Jun 2022 19:58:56 +0200 Subject: [PATCH 11/91] Fixes to style + indent --- src/Compiler/CodeGen/IlxGen.fs | 164 +++++++++++++++-------- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 16 ++- 2 files changed, 114 insertions(+), 66 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 4e72260563c..a84d17a5f7d 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -5687,14 +5687,29 @@ and GenMethodImpl cenv eenv (useMethodImpl, slotsig) m isInstance = GenGenericParams cenv eenvForOverrideBy methTyparsOfOverridingMethod let ilOverrideMethGenericArgs = mkILFormalGenericArgs 0 ilOverrideMethGenericParams + let ilOverrideBy = if isInstance then - mkILInstanceMethSpecInTy(ilTyForOverriding, nameOfOverridingMethod, typesOfILParams ilParamsOfOverridingMethod, ilReturnOfOverridingMethod.Type, ilOverrideMethGenericArgs) + mkILInstanceMethSpecInTy ( + ilTyForOverriding, + nameOfOverridingMethod, + typesOfILParams ilParamsOfOverridingMethod, + ilReturnOfOverridingMethod.Type, + ilOverrideMethGenericArgs + ) else - mkILStaticMethSpecInTy(ilTyForOverriding, nameOfOverridingMethod, typesOfILParams ilParamsOfOverridingMethod, ilReturnOfOverridingMethod.Type, ilOverrideMethGenericArgs) + mkILStaticMethSpecInTy ( + ilTyForOverriding, + nameOfOverridingMethod, + typesOfILParams ilParamsOfOverridingMethod, + ilReturnOfOverridingMethod.Type, + ilOverrideMethGenericArgs + ) - { Overrides = ilOverridesSpec - OverrideBy = ilOverrideBy }) + { + Overrides = ilOverridesSpec + OverrideBy = ilOverrideBy + }) and bindBaseOrThisVarOpt cenv eenv baseValOpt = match baseValOpt with @@ -5712,8 +5727,7 @@ and fixupMethodImplFlags (mdef: ILMethodDef) = ) .WithNewSlot -and fixupStaticAbstractSlotFlags (mdef: ILMethodDef) = - mdef.WithHideBySig(true) +and fixupStaticAbstractSlotFlags (mdef: ILMethodDef) = mdef.WithHideBySig(true) and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod = let g = cenv.g @@ -5754,7 +5768,8 @@ and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], nameOfOverridenMethod, eenvForMeth, 0, selfArgOpt, methBodyExpr, sequel) - let nameOfOverridingMethod, methodImplGenerator = GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methBodyExpr.Range true + let nameOfOverridingMethod, methodImplGenerator = + GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methBodyExpr.Range true let mdef = mkILGenericVirtualMethod ( @@ -5946,18 +5961,35 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel ] let mimpls = - [ for (_thisVals, _argVals, interfaceTy, imethName, bodyR), mdef in (List.zip methods mdefs) do - let m = bodyR.Range - let implementedMeth = - match InfoReader.TryFindIntrinsicMethInfo infoReader m AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere imethName interfaceTy with - | [meth] when meth.IsInstance -> meth - | _ -> error(InternalError(sprintf "expected method %s not found" imethName, m)) - - let slotsig = implementedMeth.GetSlotSig(amap, m) - let ilOverridesSpec = GenOverridesSpec cenv eenvinner slotsig m mdef.CallingConv.IsInstance - let ilOverrideBy = mkILInstanceMethSpecInTy(ilCloTy, imethName, mdef.ParameterTypes, mdef.Return.Type, []) - { Overrides = ilOverridesSpec - OverrideBy = ilOverrideBy } ] + [ + for (_thisVals, _argVals, interfaceTy, imethName, bodyR), mdef in (List.zip methods mdefs) do + let m = bodyR.Range + + let implementedMeth = + match + InfoReader.TryFindIntrinsicMethInfo + infoReader + m + AccessibilityLogic.AccessorDomain.AccessibleFromSomewhere + imethName + interfaceTy + with + | [ meth ] when meth.IsInstance -> meth + | _ -> error (InternalError(sprintf "expected method %s not found" imethName, m)) + + let slotsig = implementedMeth.GetSlotSig(amap, m) + + let ilOverridesSpec = + GenOverridesSpec cenv eenvinner slotsig m mdef.CallingConv.IsInstance + + let ilOverrideBy = + mkILInstanceMethSpecInTy (ilCloTy, imethName, mdef.ParameterTypes, mdef.Return.Type, []) + + { + Overrides = ilOverridesSpec + OverrideBy = ilOverrideBy + } + ] let fdefs = [ // Fields copied from the template struct @@ -8995,43 +9027,55 @@ and GenMethodForBinding let mdef = match v.MemberInfo with | Some memberInfo when not v.IsExtensionMember -> + let ilMethTypars = ilTypars |> List.skip mspec.DeclaringType.GenericArgs.Length + + if memberInfo.MemberFlags.MemberKind = SynMemberKind.Constructor then + assert (isNil ilMethTypars) + let mdef = mkILCtor (access, ilParams, ilMethodBody) - let ilMethTypars = ilTypars |> List.skip mspec.DeclaringType.GenericArgs.Length - if memberInfo.MemberFlags.MemberKind = SynMemberKind.Constructor then - assert (isNil ilMethTypars) - let mdef = mkILCtor (access, ilParams, ilMethodBody) - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - mdef + let mdef = + mdef.With(customAttrs = mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - elif memberInfo.MemberFlags.MemberKind = SynMemberKind.ClassConstructor then - assert (isNil ilMethTypars) - let mdef = mkILClassCtor ilMethodBody - let mdef = mdef.With(customAttrs= mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) - mdef + mdef - // Generate virtual/override methods + method-impl information if needed - else - let mdef = - if not compileAsInstance then - if not memberInfo.MemberFlags.IsOverrideOrExplicitImpl then - mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) - else // We want to get potential fixups and hidebysig for abstract statics: - let flagFixups = [ fixupStaticAbstractSlotFlags ] - let mdef = mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) - let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups - mdef - elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) || - memberInfo.MemberFlags.IsOverrideOrExplicitImpl then - - let flagFixups = ComputeFlagFixupsForMemberBinding cenv v - let mdef = mkILGenericVirtualMethod (mspec.Name, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) - let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups - - // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary - mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) - mdef - else - mkILGenericNonVirtualMethod (mspec.Name, access, ilMethTypars, ilParams, ilReturn, ilMethodBody) + elif memberInfo.MemberFlags.MemberKind = SynMemberKind.ClassConstructor then + assert (isNil ilMethTypars) + let mdef = mkILClassCtor ilMethodBody + + let mdef = + mdef.With(customAttrs = mkILCustomAttrs (ilAttrsThatGoOnPrimaryItem @ sourceNameAttribs @ ilAttrsCompilerGenerated)) + + mdef + + // Generate virtual/override methods + method-impl information if needed + else + let mdef = + if not compileAsInstance then + if not memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + else // We want to get potential fixups and hidebysig for abstract statics: + let flagFixups = [ fixupStaticAbstractSlotFlags ] + + let mdef = + mkILStaticMethod (ilMethTypars, mspec.Name, access, ilParams, ilReturn, ilMethodBody) + + let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + mdef + elif (memberInfo.MemberFlags.IsDispatchSlot && memberInfo.IsImplemented) + || memberInfo.MemberFlags.IsOverrideOrExplicitImpl then + + let flagFixups = ComputeFlagFixupsForMemberBinding cenv v + + let mdef = + mkILGenericVirtualMethod (mspec.Name, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) + + let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups + + // fixup can potentially change name of reflected definition that was already recorded - patch it if necessary + mgbuf.ReplaceNameOfReflectedDefinition(v, mdef.Name) + mdef + else + mkILGenericNonVirtualMethod (mspec.Name, access, ilMethTypars, ilParams, ilReturn, ilMethodBody) let isAbstract = memberInfo.MemberFlags.IsDispatchSlot @@ -10387,18 +10431,20 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = match vref.ValReprInfo with | Some _ -> - let memberParentTypars, memberMethodTypars = match PartitionValRefTypars g vref with | Some (_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars | None -> [], [] - let useMethodImpl = true - let eenvUnderTypars = EnvForTypars memberParentTypars eenv - let _, methodImplGenerator = GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m memberInfo.MemberFlags.IsInstance - if useMethodImpl then - yield methodImplGenerator (ilThisTy, memberMethodTypars) + let useMethodImpl = true + let eenvUnderTypars = EnvForTypars memberParentTypars eenv + + let _, methodImplGenerator = + GenMethodImpl cenv eenvUnderTypars (useMethodImpl, slotsig) m memberInfo.MemberFlags.IsInstance + + if useMethodImpl then + yield methodImplGenerator (ilThisTy, memberMethodTypars) | _ -> () ] diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 154c2af89f5..64e66218780 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -751,13 +751,15 @@ let StaticMemberFlags trivia k : SynMemberFlags = } let ImplementStaticMemberFlags trivia k : SynMemberFlags = - { MemberKind = k - IsInstance = false - IsDispatchSlot = false - IsOverrideOrExplicitImpl = true - IsFinal = false - Trivia = trivia } - + { + MemberKind = k + IsInstance = false + IsDispatchSlot = false + IsOverrideOrExplicitImpl = true + IsFinal = false + Trivia = trivia + } + let MemberSynMemberFlagsTrivia (mMember: range) : SynMemberFlagsTrivia = { MemberRange = Some mMember From 92fdf2aa42b398d860187ff8ceedbee9c4ac2a67 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 13 Jun 2022 23:02:22 +0200 Subject: [PATCH 12/91] After merge fixes --- src/Compiler/CodeGen/IlxGen.fs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index a84d17a5f7d..54871b94510 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -5597,7 +5597,7 @@ and GenFormalSlotsig m cenv eenv slotsig = let ilRet = GenFormalReturnType m cenv eenvForSlotSig returnTy ilTy, ilParams, ilRet -and GenOverridesSpec cenv eenv slotsig m = +and GenOverridesSpec cenv eenv slotsig m isInstance = let (TSlotSig (nameOfOverridenMethod, _, _, methodTypars, _, _)) = slotsig let ilOverrideTy, ilOverrideParams, ilOverrideRet = @@ -5605,10 +5605,16 @@ and GenOverridesSpec cenv eenv slotsig m = let ilOverrideTyRef = ilOverrideTy.TypeRef + let callingConv = + if isInstance then + ILCallingConv.Instance + else + ILCallingConv.Static + let ilOverrideMethRef = mkILMethRef ( ilOverrideTyRef, - ILCallingConv.Instance, + callingConv, nameOfOverridenMethod, List.length (DropErasedTypars methodTypars), typesOfILParams ilOverrideParams, From f74ecf2354a5f94f6268f749541c45abffcd4d78 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 14 Jun 2022 19:34:25 +0200 Subject: [PATCH 13/91] WIP: add language and runtime feature --- .vscode/launch.json | 4 ++-- src/Compiler/Checking/InfoReader.fs | 8 ++++++-- src/Compiler/Checking/MethodOverrides.fs | 11 ++++++++--- src/Compiler/FSComp.txt | 1 + src/Compiler/Facilities/LanguageFeatures.fs | 4 ++++ src/Compiler/Facilities/LanguageFeatures.fsi | 1 + src/Compiler/xlf/FSComp.txt.cs.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.de.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.es.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.fr.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.it.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ja.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ko.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.pl.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.ru.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.tr.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 +++++ src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 +++++ 19 files changed, 87 insertions(+), 7 deletions(-) diff --git a/.vscode/launch.json b/.vscode/launch.json index d00e32e86bd..9d8255dfbee 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -23,7 +23,7 @@ "internalConsoleOptions": "neverOpen", "suppressJITOptimizations": true, "stopAtEntry": false, - "justMyCode": false, + "justMyCode": true, "enableStepFiltering": true, "symbolOptions": { "searchMicrosoftSymbolServer": true, @@ -73,7 +73,7 @@ "enabled": true } }, - "justMyCode": false, + "justMyCode": true, "enableStepFiltering": false, } ] diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 75a4e9aa897..57eaee5bef6 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -695,10 +695,13 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = let isRuntimeFeatureDefaultImplementationsOfInterfacesSupported = lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" - + + let isRuntimeFeatureVirtualStaticsInInterfacesSupported = + lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" + member _.g = g member _.amap = amap - + /// Read the raw method sets of a type, including inherited ones. Cache the result for monomorphic types member _.GetRawIntrinsicMethodSetsOfType (optFilter, ad, allowMultiIntfInst, m, ty) = methodInfoCache.Apply(((optFilter, ad, allowMultiIntfInst), m, ty)) @@ -759,6 +762,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = match langFeature with // Both default and static interface method consumption features are tied to the runtime support of DIMs. | LanguageFeature.DefaultInterfaceMemberConsumption -> isRuntimeFeatureDefaultImplementationsOfInterfacesSupported.Value + | LanguageFeature.VirtualStaticsInInterfaces -> isRuntimeFeatureVirtualStaticsInInterfacesSupported.Value | _ -> true /// Get the declared constructors of any F# type diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 7ef91000758..432d179a248 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -917,10 +917,15 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv && not tycon.IsFSharpDelegateTycon then DispatchSlotChecking.CheckImplementationRelationAtEndOfInferenceScope (infoReader, denv, nenv, sink, tycon, isImplementation) - + /// Get the methods relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = + + if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then + checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption bindm + checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption bindm + let minfos = match typToSearchForAbstractMembers with | _, Some(SlotImplSet(_, dispatchSlotsKeyed, _, _)) -> @@ -929,7 +934,7 @@ let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: GetIntrinsicMethInfosOfType infoReader (Some memberName.idText) ad AllowMultiIntfInstantiations.Yes IgnoreOverrides bindm ty let dispatchSlots = minfos |> List.filter (fun minfo -> minfo.IsDispatchSlot) let topValSynArities = SynInfo.AritiesOfArgs valSynData - + // We only return everything if it's empty or if it's a non-instance member. // If it's an instance member, we are getting rid of `this` (by only taking tail). let topValSynArities = @@ -938,7 +943,7 @@ let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: else topValSynArities.Tail let dispatchSlotsArityMatch = dispatchSlots |> List.filter (fun minfo -> minfo.NumArgs = topValSynArities) - dispatchSlots, dispatchSlotsArityMatch + dispatchSlots, dispatchSlotsArityMatch /// Get the properties relevant to determining if a uniquely-identified-override exists based on the syntactic information /// at the member signature prior to type inference. This is used to pre-assign type information if it does diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 513117632cc..a7ef1c49edb 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1555,6 +1555,7 @@ featureStructActivePattern,"struct representation for active patterns" featureRelaxWhitespace2,"whitespace relaxation v2" featureReallyLongList,"list literals of any size" featureErrorOnDeprecatedRequireQualifiedAccess,"give error on deprecated access of construct with RequireQualifiedAccess attribute" +featureVirtualStaticsInInterfaces,"static abstract interface members" 3353,fsiInvalidDirective,"Invalid directive '#%s %s'" 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index a0033a5d2b7..ab609449d6a 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -49,6 +49,7 @@ type LanguageFeature = | DelegateTypeNameResolutionFix | ReallyLongLists | ErrorOnDeprecatedRequireQualifiedAccess + | VirtualStaticsInInterfaces /// LanguageVersion management type LanguageVersion(versionText) = @@ -111,6 +112,8 @@ type LanguageVersion(versionText) = LanguageFeature.BetterExceptionPrinting, previewVersion LanguageFeature.ReallyLongLists, previewVersion LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess, previewVersion + LanguageFeature.VirtualStaticsInInterfaces, previewVersion + ] static let defaultLanguageVersion = LanguageVersion("default") @@ -210,6 +213,7 @@ type LanguageVersion(versionText) = | LanguageFeature.DelegateTypeNameResolutionFix -> FSComp.SR.featureDelegateTypeNameResolutionFix () | LanguageFeature.ReallyLongLists -> FSComp.SR.featureReallyLongList () | LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess -> FSComp.SR.featureErrorOnDeprecatedRequireQualifiedAccess () + | LanguageFeature.VirtualStaticsInInterfaces -> FSComp.SR.featureVirtualStaticsInInterfaces () /// Get a version string associated with the given feature. member _.GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index ec884903b49..fe91bae6ae3 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -39,6 +39,7 @@ type LanguageFeature = | DelegateTypeNameResolutionFix | ReallyLongLists | ErrorOnDeprecatedRequireQualifiedAccess + | VirtualStaticsInInterfaces /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index d0a995aa3b0..3c102e6f41d 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -272,6 +272,11 @@ reprezentace struktury aktivních vzorů + + static abstract interface members + static abstract interface members + + wild card in for loop zástupný znak ve smyčce for diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 57d1e5450ea..e1af9f485a5 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -272,6 +272,11 @@ Strukturdarstellung für aktive Muster + + static abstract interface members + static abstract interface members + + wild card in for loop Platzhalter in for-Schleife diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 6a59b872c1b..d47219cce67 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -272,6 +272,11 @@ representación de struct para modelos activos + + static abstract interface members + static abstract interface members + + wild card in for loop carácter comodín en bucle for diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 7b64cc5b780..e31b49af2a1 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -272,6 +272,11 @@ représentation de structure pour les modèles actifs + + static abstract interface members + static abstract interface members + + wild card in for loop caractère générique dans une boucle for diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 8a36ec3b730..7b36c21b568 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -272,6 +272,11 @@ rappresentazione struct per criteri attivi + + static abstract interface members + static abstract interface members + + wild card in for loop carattere jolly nel ciclo for diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 2509bc7585a..8783ec4bdbd 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -272,6 +272,11 @@ アクティブなパターンの構造体表現 + + static abstract interface members + static abstract interface members + + wild card in for loop for ループのワイルド カード diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 8f209c3ada1..de4cb99c3cb 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -272,6 +272,11 @@ 활성 패턴에 대한 구조체 표현 + + static abstract interface members + static abstract interface members + + wild card in for loop for 루프의 와일드카드 diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 9539f9af34f..36ee04d3adf 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -272,6 +272,11 @@ reprezentacja struktury aktywnych wzorców + + static abstract interface members + static abstract interface members + + wild card in for loop symbol wieloznaczny w pętli for diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 29bcce01250..4a086cc220d 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -272,6 +272,11 @@ representação estrutural para padrões ativos + + static abstract interface members + static abstract interface members + + wild card in for loop curinga para loop diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 1fb3a354f86..5acb2e724ea 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -272,6 +272,11 @@ представление структуры для активных шаблонов + + static abstract interface members + static abstract interface members + + wild card in for loop подстановочный знак в цикле for diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index d36bd224b9d..825ceb3d597 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -272,6 +272,11 @@ etkin desenler için yapı gösterimi + + static abstract interface members + static abstract interface members + + wild card in for loop for döngüsünde joker karakter diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index a1b2b225415..b40727e6670 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -272,6 +272,11 @@ 活动模式的结构表示形式 + + static abstract interface members + static abstract interface members + + wild card in for loop for 循环中的通配符 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index b8854a10e66..25fca75e767 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -272,6 +272,11 @@ 現用模式的結構表示法 + + static abstract interface members + static abstract interface members + + wild card in for loop for 迴圈中的萬用字元 From 018bfd05b87a630c3dde9cff0c26c96969ec1ec9 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Thu, 16 Jun 2022 13:42:25 +0200 Subject: [PATCH 14/91] Fixed feature guard --- src/Compiler/Checking/InfoReader.fs | 2 +- src/Compiler/Checking/MethodOverrides.fs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 57eaee5bef6..a4d9f00076c 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -697,7 +697,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" let isRuntimeFeatureVirtualStaticsInInterfacesSupported = - lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" + lazy isRuntimeFeatureSupported this "VirtualStaticsInInterfaces" member _.g = g member _.amap = amap diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 432d179a248..bb093d36f14 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -923,8 +923,8 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then - checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption bindm - checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption bindm + checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.VirtualStaticsInInterfaces bindm + checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.VirtualStaticsInInterfaces bindm let minfos = match typToSearchForAbstractMembers with From 810a51fad6e7927eac927005e9818008ea2315ad Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Fri, 17 Jun 2022 18:54:17 +0200 Subject: [PATCH 15/91] Fixed the immediate members filter --- src/Compiler/Checking/MethodOverrides.fs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index bb093d36f14..9ebf6777bd4 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -764,13 +764,14 @@ module DispatchSlotChecking = let allImpls = List.zip allReqdTys slotImplSets + let isStaticAbstract (overrideBy: ValRef) = (not overrideBy.IsInstanceMember) && overrideBy.IsOverrideOrExplicitImpl + // Find the methods relevant to implementing the abstract slots listed under the reqdType being checked. let allImmediateMembersThatMightImplementDispatchSlots = allImmediateMembers |> List.filter (fun overrideBy -> - (overrideBy.IsInstanceMember // Not static OR - || ((not overrideBy.IsInstanceMember) && overrideBy.IsOverrideOrExplicitImpl) // Static in the interface + (overrideBy.IsInstanceMember || isStaticAbstract overrideBy) // Not static OR Static in the interface && overrideBy.IsVirtualMember // exclude non virtual (e.g. keep override/default). [4469] - && not overrideBy.IsDispatchSlotMember)) + && not overrideBy.IsDispatchSlotMember) let mustOverrideSomething reqdTy (overrideBy: ValRef) = let memberInfo = overrideBy.MemberInfo.Value From 9e8605541d94a041f717ad95883fb2fbeb30a182 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 20 Jun 2022 13:13:52 +0200 Subject: [PATCH 16/91] Fix tests baselines --- tests/fsharp/typecheck/sigs/neg02.bsl | 6 ++---- tests/fsharp/typecheck/sigs/neg02.vsbsl | 10 ++++++++++ 2 files changed, 12 insertions(+), 4 deletions(-) create mode 100644 tests/fsharp/typecheck/sigs/neg02.vsbsl diff --git a/tests/fsharp/typecheck/sigs/neg02.bsl b/tests/fsharp/typecheck/sigs/neg02.bsl index b7119f8e1d4..0ba88e743ea 100644 --- a/tests/fsharp/typecheck/sigs/neg02.bsl +++ b/tests/fsharp/typecheck/sigs/neg02.bsl @@ -1,6 +1,4 @@ -neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for future use by F# + neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for future use by F# -neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition - -neg02.fs(17,7,17,13): parse error FS0010: Unexpected keyword 'static' in member definition. Expected 'member', 'override' or other token. + neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition diff --git a/tests/fsharp/typecheck/sigs/neg02.vsbsl b/tests/fsharp/typecheck/sigs/neg02.vsbsl new file mode 100644 index 00000000000..914fb1c02a6 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg02.vsbsl @@ -0,0 +1,10 @@ + +neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for future use by F# + +neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition + +neg02.fs(17,21,17,26): typecheck error FS3351: Feature 'static abstract interface members' is not supported by target runtime. + +neg02.fs(17,21,17,26): typecheck error FS3350: Feature 'static abstract interface members' is not available in F# 6.0. Please use language version 'PREVIEW' or greater. + +neg02.fs(17,21,17,24): typecheck error FS0855: No abstract or interface member was found that corresponds to this override From d2e96c7f1f68b503f18c18b3028fbdcf5df7ca6b Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 20 Jun 2022 15:18:33 +0200 Subject: [PATCH 17/91] Fix tests baselines --- tests/fsharp/typecheck/sigs/neg02.bsl | 4 ++-- .../LegacyLanguageService/Tests.LanguageService.ErrorList.fs | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/tests/fsharp/typecheck/sigs/neg02.bsl b/tests/fsharp/typecheck/sigs/neg02.bsl index 0ba88e743ea..5e83ca4d14b 100644 --- a/tests/fsharp/typecheck/sigs/neg02.bsl +++ b/tests/fsharp/typecheck/sigs/neg02.bsl @@ -1,4 +1,4 @@ - neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for future use by F# +neg02.fs(6,8,6,15): parse error FS0046: The identifier 'virtual' is reserved for future use by F# - neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition +neg02.fs(6,8,6,15): parse error FS0010: Unexpected identifier in member definition diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index d96d3a16d61..3510ee32fc8 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -396,7 +396,10 @@ type staticInInterface = end""" CheckErrorList fileContent <| function - | [err] -> Assert.IsTrue(err.Message.Contains("Unexpected keyword 'static' in member definition. Expected 'member', 'override' or other token")) + | [err1, err2, err3] -> + Assert.IsTrue(err1.Message.Contains("No abstract or interface member was found that corresponds to this override")) + Assert.IsTrue(err2.Message.Contains("Feature 'static abstract interface members' is not available in F# 6.0. Please use language version 'PREVIEW' or greater")) + Assert.IsTrue(err3.Message.Contains("Feature 'static abstract interface members' is not supported by target runtime")) | x -> Assert.Fail(sprintf "Unexpected errors: %A" x) [] From c0aac0631abd2f9f97e12f989e35a0a02f389ffe Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 20 Jun 2022 15:56:26 +0200 Subject: [PATCH 18/91] fix for list pattern syntax --- .../LegacyLanguageService/Tests.LanguageService.ErrorList.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index 3510ee32fc8..2d0d8c41100 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -396,7 +396,7 @@ type staticInInterface = end""" CheckErrorList fileContent <| function - | [err1, err2, err3] -> + | [err1; err2; err3] -> Assert.IsTrue(err1.Message.Contains("No abstract or interface member was found that corresponds to this override")) Assert.IsTrue(err2.Message.Contains("Feature 'static abstract interface members' is not available in F# 6.0. Please use language version 'PREVIEW' or greater")) Assert.IsTrue(err3.Message.Contains("Feature 'static abstract interface members' is not supported by target runtime")) From 82a079ee8d9bc16b2f08bc7c62890e6e8ebe5ed6 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Mon, 20 Jun 2022 18:59:25 +0200 Subject: [PATCH 19/91] Added operators tests --- .../Interop/StaticsInInterfaces.fs | 72 +++++++++++++++++++ 1 file changed, 72 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index da6e7bdf3bc..e0eab1b6ff1 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -39,6 +39,78 @@ module ``Static Methods In Interfaces`` = }""" |> withCSharpLanguageVersion CSharpLanguageVersion.Preview |> withName "csLib" + let csharpOperators = + CSharp """ + namespace StaticsInInterfaces + { + public interface IAddable where T : IAddable + { + static abstract T operator +(T left, T right); + } + + + public record MyInteger : IAddable + { + public int Value { get; init; } = default; + public MyInteger(int value) + { + Value = value; + } + + public static MyInteger operator +(MyInteger left, MyInteger right) => new MyInteger(left.Value + right.Value); + } + + } + """ |> withCSharpLanguageVersion CSharpLanguageVersion.Preview |> withName "csOpLib" + + #if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can use operators declared in C#`` () = + + let fsharpSource = + """ +open System +open StaticsInInterfaces + +type MyInteger2 = + val Value : int + new(value: int) = { Value = value } + static member op_Addition(left: MyInteger2, right: MyInteger2) : MyInteger2 = MyInteger2(left.Value + right.Value) + interface IAddable with + static member op_Addition(left: MyInteger2, right: MyInteger2) : MyInteger2 = MyInteger2.op_Addition(left, right) + +[] +let main _ = + let mint1 = new MyInteger(1) + let mint2 = new MyInteger(2) + + let sum = mint1 + mint2 + + let mint21 = new MyInteger2(2) + let mint22 = new MyInteger2(4) + + let sum2 = mint21 + mint22 + + if sum.Value <> 3 then + failwith $"Unexpected result: %d{sum.Value}" + + if sum2.Value <> 6 then + failwith $"Unexpected result: %d{sum2.Value}" + + // TODO: Figure out if we allow something like: + // let add (a: IAddable<_>) (b: IAddable<_>) = a + b + 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> withReferences [csharpOperators] + |> compileAndRun + |> shouldSucceed + #if !NETCOREAPP [] #else From e6ad912558ed5762274676120c9c907d37b737b8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 22 Jun 2022 20:12:35 +0100 Subject: [PATCH 20/91] allow authoring and fix abstract slot inference --- src/Compiler/AbstractIL/il.fs | 27 +++++---- src/Compiler/AbstractIL/il.fsi | 5 +- src/Compiler/Checking/CheckDeclarations.fs | 6 +- src/Compiler/Checking/CheckExpressions.fs | 20 +++--- src/Compiler/Checking/ConstraintSolver.fs | 2 +- src/Compiler/Checking/InfoReader.fs | 20 ++---- src/Compiler/Checking/InfoReader.fsi | 8 +-- src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/Checking/MethodOverrides.fs | 6 +- src/Compiler/CodeGen/EraseClosures.fs | 3 +- src/Compiler/CodeGen/IlxGen.fs | 43 ++++++------- src/Compiler/Facilities/LanguageFeatures.fs | 6 +- src/Compiler/Facilities/LanguageFeatures.fsi | 2 +- src/Compiler/SyntaxTree/SyntaxTree.fs | 3 +- src/Compiler/SyntaxTree/SyntaxTree.fsi | 3 +- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 22 ++++++- src/Compiler/SyntaxTree/SyntaxTreeOps.fsi | 6 +- src/Compiler/TypedTree/TypedTreeOps.fs | 11 ++-- src/Compiler/pars.fsy | 64 +++++++++++--------- tests/service/Symbols.fs | 16 ++--- 20 files changed, 144 insertions(+), 131 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index ed951e0a03b..668190e6aad 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -3814,18 +3814,20 @@ let mkILClassCtor impl = let mk_ospec (ty: ILType, callconv, nm, genparams, formal_args, formal_ret) = OverridesSpec(mkILMethRef (ty.TypeRef, callconv, nm, genparams, formal_args, formal_ret), ty) -let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = +let mkILGenericVirtualMethod (nm, callconv: ILCallingConv, access, genparams, actual_args, actual_ret, impl) = + let attributes = + convertMemberAccess access + ||| MethodAttributes.CheckAccessOnOverride + ||| (match impl with + | MethodBody.Abstract -> MethodAttributes.Abstract ||| MethodAttributes.Virtual + | _ -> MethodAttributes.Virtual) + ||| (if callconv.IsInstance then enum 0 else MethodAttributes.Static) ILMethodDef( name = nm, - attributes = - (convertMemberAccess access - ||| MethodAttributes.CheckAccessOnOverride - ||| (match impl with - | MethodBody.Abstract -> MethodAttributes.Abstract ||| MethodAttributes.Virtual - | _ -> MethodAttributes.Virtual)), + attributes = attributes, implAttributes = MethodImplAttributes.Managed, genericParams = genparams, - callingConv = ILCallingConv.Instance, + callingConv = callconv, parameters = actual_args, ret = actual_ret, isEntryPoint = false, @@ -3834,8 +3836,11 @@ let mkILGenericVirtualMethod (nm, access, genparams, actual_args, actual_ret, im body = notlazy impl ) -let mkILNonGenericVirtualMethod (nm, access, args, ret, impl) = - mkILGenericVirtualMethod (nm, access, mkILEmptyGenericParams, args, ret, impl) +let mkILNonGenericVirtualMethod (nm, callconv, access, args, ret, impl) = + mkILGenericVirtualMethod (nm, callconv, access, mkILEmptyGenericParams, args, ret, impl) + +let mkILNonGenericVirtualInstanceMethod (nm, access, args, ret, impl) = + mkILNonGenericVirtualMethod (nm, ILCallingConv.Instance, access, args, ret, impl) let mkILGenericNonVirtualMethod (nm, access, genparams, actual_args, actual_ret, impl) = ILMethodDef( @@ -4258,7 +4263,7 @@ let mkILDelegateMethods access (ilg: ILGlobals) (iltyp_AsyncCallback, iltyp_IAsy let one nm args ret = let mdef = - mkILNonGenericVirtualMethod (nm, access, args, mkILReturn ret, MethodBody.Abstract) + mkILNonGenericVirtualInstanceMethod (nm, access, args, mkILReturn ret, MethodBody.Abstract) mdef.WithAbstract(false).WithHideBySig(true).WithRuntime(true) diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 55c713968e2..f02b36392d8 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -2030,12 +2030,15 @@ val internal mkILNonGenericStaticMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILGenericVirtualMethod: - string * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef + string * ILCallingConv * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILGenericNonVirtualMethod: string * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILNonGenericVirtualMethod: + string * ILCallingConv * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef + +val internal mkILNonGenericVirtualInstanceMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILNonGenericInstanceMethod: diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 5b655c16adc..02bf009ba03 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4875,7 +4875,7 @@ module TcDeclarations = // Convert auto properties to member bindings in the post-list let rec postAutoProps memb = match memb with - | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; xmlDoc=xmlDoc; accessibility=access; getSetRange=mGetSetOpt) -> + | SynMemberDefn.AutoProperty(attributes=Attributes attribs; isStatic=isStatic; ident=id; typeOpt=tyOpt; propKind=propKind; memberFlags=memberFlags; memberFlagsForSet=memberFlagsForSet; xmlDoc=xmlDoc; accessibility=access; getSetRange=mGetSetOpt) -> let mMemberPortion = id.idRange // Only the keep the non-field-targeted attributes let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) @@ -4896,7 +4896,7 @@ module TcDeclarations = let rhsExpr = SynExpr.Ident fldId let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) let attribs = mkAttributeList attribs mMemberPortion - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some (memberFlags SynMemberKind.Member), SynBindingTrivia.Zero) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some memberFlags, SynBindingTrivia.Zero) SynMemberDefn.Member (binding, mMemberPortion) yield getter | _ -> () @@ -4909,7 +4909,7 @@ module TcDeclarations = let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion) let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId) //let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some (memberFlags SynMemberKind.PropertySet), SynBindingTrivia.Zero) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some memberFlagsForSet, SynBindingTrivia.Zero) SynMemberDefn.Member (binding, mMemberPortion) yield setter | _ -> ()] diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 94c64d17cc9..690510cec12 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -10890,7 +10890,7 @@ and ComputeIsComplete enclosingDeclaredTypars declaredTypars ty = /// Determine if a uniquely-identified-abstract-slot exists for an override member (or interface member implementation) based on the information available /// at the syntactic definition of the member (i.e. prior to type inference). If so, we know the expected signature of the override, and the full slotsig /// it implements. Apply the inferred slotsig. -and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, _objTy, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = +and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (argsAndRetTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, _objTy, intfSlotTyOpt, valSynData, memberFlags: SynMemberFlags, attribs) = let g = cenv.g let ad = envinner.eAccessRights @@ -10953,7 +10953,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn let absSlotTy = mkMethodTy g argTysFromAbsSlot retTyFromAbsSlot - UnifyTypes cenv envinner m bindingTy absSlotTy + UnifyTypes cenv envinner m argsAndRetTy absSlotTy declaredTypars | _ -> declaredTypars @@ -11020,7 +11020,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (bindingTy, m, syn error(Error(FSComp.SR.tcInvalidSignatureForSet(), memberId.idRange)) mkFunTy g retTyFromAbsSlot g.unit_ty - UnifyTypes cenv envinner m bindingTy absSlotTy) + UnifyTypes cenv envinner m argsAndRetTy absSlotTy) // What's the type containing the abstract slot we're implementing? Used later on in MakeMemberDataAndMangledNameForMemberVal. // This type must be in terms of the enclosing type's formal type parameters, hence the application of revRenaming. @@ -11087,8 +11087,8 @@ and AnalyzeRecursiveStaticMemberOrValDecl match tcrefContainerInfo, memberFlagsOpt with | Some(MemberOrValContainerInfo(tcref, intfSlotTyOpt, _, _, declaredTyconTypars)), Some memberFlags when memberFlags.MemberKind = SynMemberKind.Member && - memberFlags.IsInstance = false && - memberFlags.IsOverrideOrExplicitImpl = true -> + not memberFlags.IsInstance && + memberFlags.IsOverrideOrExplicitImpl -> CheckMemberFlags intfSlotTyOpt newslotsOK overridesOK memberFlags id.idRange CheckForNonAbstractInterface declKind tcref memberFlags id.idRange @@ -11100,10 +11100,8 @@ and AnalyzeRecursiveStaticMemberOrValDecl let (ExplicitTyparInfo(_, declaredTypars, infer)) = explicitTyparInfo - let domainTy = NewInferenceType g - let optInferredImplSlotTys, declaredTypars = - ApplyAbstractSlotInference cenv envinner (domainTy, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) + ApplyAbstractSlotInference cenv envinner (ty, mBinding, synTyparDecls, declaredTypars, id, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) @@ -11218,8 +11216,8 @@ and AnalyzeRecursiveInstanceMemberDecl let baseValOpt = if tcref.IsFSharpObjectModelTycon then baseValOpt else None // Apply the known type of 'this' - let bindingTy = NewInferenceType g - UnifyTypes cenv envinner mBinding ty (mkFunTy g thisTy bindingTy) + let argsAndRetTy = NewInferenceType g + UnifyTypes cenv envinner mBinding ty (mkFunTy g thisTy argsAndRetTy) CheckForNonAbstractInterface declKind tcref memberFlags memberId.idRange @@ -11227,7 +11225,7 @@ and AnalyzeRecursiveInstanceMemberDecl // at the member signature. If so, we know the type of this member, and the full slotsig // it implements. Apply the inferred slotsig. let optInferredImplSlotTys, declaredTypars = - ApplyAbstractSlotInference cenv envinner (bindingTy, mBinding, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) + ApplyAbstractSlotInference cenv envinner (argsAndRetTy, mBinding, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, objTy, intfSlotTyOpt, valSynInfo, memberFlags, bindingAttribs) // Update the ExplicitTyparInfo to reflect the declaredTypars inferred from the abstract slot let explicitTyparInfo = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 7d7097dc25a..6690918ba30 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2957,7 +2957,7 @@ and ResolveOverloading // Static IL interfaces methods are not supported in lower F# versions. if calledMeth.Method.IsILMethod && not calledMeth.Method.IsInstance && isInterfaceTy g calledMeth.Method.ApparentEnclosingType then - checkLanguageFeatureRuntimeErrorRecover csenv.InfoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeAndRecover csenv.InfoReader LanguageFeature.DefaultInterfaceMemberConsumption m checkLanguageFeatureAndRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m calledMethOpt, diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index a4d9f00076c..f55e1cfc4c9 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -697,7 +697,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" let isRuntimeFeatureVirtualStaticsInInterfacesSupported = - lazy isRuntimeFeatureSupported this "VirtualStaticsInInterfaces" + lazy isRuntimeFeatureSupported this "InterfacesWithAbstractStaticMembers" member _.g = g member _.amap = amap @@ -762,7 +762,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = match langFeature with // Both default and static interface method consumption features are tied to the runtime support of DIMs. | LanguageFeature.DefaultInterfaceMemberConsumption -> isRuntimeFeatureDefaultImplementationsOfInterfacesSupported.Value - | LanguageFeature.VirtualStaticsInInterfaces -> isRuntimeFeatureVirtualStaticsInInterfacesSupported.Value + | LanguageFeature.InterfacesWithAbstractStaticMembers -> isRuntimeFeatureVirtualStaticsInInterfacesSupported.Value | _ -> true /// Get the declared constructors of any F# type @@ -847,22 +847,10 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member _.FindImplicitConversions m ad ty = implicitConversionCache.Apply((ad, m, ty)) -let private tryLanguageFeatureRuntimeErrorAux (infoReader: InfoReader) langFeature m error = +let checkLanguageFeatureRuntimeAndRecover (infoReader: InfoReader) langFeature m = if not (infoReader.IsLanguageFeatureRuntimeSupported langFeature) then let featureStr = infoReader.g.langVersion.GetFeatureString langFeature - error (Error(FSComp.SR.chkFeatureNotRuntimeSupported featureStr, m)) - false - else - true - -let checkLanguageFeatureRuntimeError infoReader langFeature m = - tryLanguageFeatureRuntimeErrorAux infoReader langFeature m error |> ignore - -let checkLanguageFeatureRuntimeErrorRecover infoReader langFeature m = - tryLanguageFeatureRuntimeErrorAux infoReader langFeature m errorR |> ignore - -let tryLanguageFeatureRuntimeErrorRecover infoReader langFeature m = - tryLanguageFeatureRuntimeErrorAux infoReader langFeature m errorR + errorR (Error(FSComp.SR.chkFeatureNotRuntimeSupported featureStr, m)) let GetIntrinsicConstructorInfosOfType (infoReader: InfoReader) m ty = infoReader.GetIntrinsicConstructorInfosOfTypeAux m ty ty diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index 5941702256a..b06b571296a 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -187,15 +187,9 @@ type InfoReader = /// Find the op_Implicit for a type member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list -val checkLanguageFeatureRuntimeError: +val checkLanguageFeatureRuntimeAndRecover: infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> unit -val checkLanguageFeatureRuntimeErrorRecover: - infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> unit - -val tryLanguageFeatureRuntimeErrorRecover: - infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> bool - /// Get the declared constructors of any F# type val GetIntrinsicConstructorInfosOfType: infoReader: InfoReader -> m: range -> ty: TType -> MethInfo list diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index f4338d311df..5de06521fca 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -1155,7 +1155,7 @@ let ILFieldStaticChecks g amap infoReader ad m (finfo : ILFieldInfo) = // Static IL interfaces fields are not supported in lower F# versions. if isInterfaceTy g finfo.ApparentEnclosingType then - checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m checkLanguageFeatureAndRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m CheckILFieldAttributes g finfo m diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 9ebf6777bd4..5ae3b02e01b 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -344,7 +344,7 @@ module DispatchSlotChecking = // Always try to raise a target runtime error if we have a DIM. if reqdSlot.HasDefaultInterfaceImplementation then - checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m + checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.DefaultInterfaceMemberConsumption m let maybeResolvedSlot = NameMultiMap.find dispatchSlot.LogicalName overridesKeyed @@ -924,8 +924,8 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then - checkLanguageFeatureRuntimeErrorRecover infoReader LanguageFeature.VirtualStaticsInInterfaces bindm - checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.VirtualStaticsInInterfaces bindm + checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm + checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm let minfos = match typToSearchForAbstractMembers with diff --git a/src/Compiler/CodeGen/EraseClosures.fs b/src/Compiler/CodeGen/EraseClosures.fs index 6f6646177a5..ae92dcecf0b 100644 --- a/src/Compiler/CodeGen/EraseClosures.fs +++ b/src/Compiler/CodeGen/EraseClosures.fs @@ -571,6 +571,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let nowApplyMethDef = mkILGenericVirtualMethod ( "Specialize", + ILCallingConv.Instance, ILMemberAccess.Public, addedGenParams (* method is generic over added ILGenericParameterDefs *) , [], @@ -703,7 +704,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo = let convil = convILMethodBody (Some nowCloSpec, None) (Lazy.force clo.cloCode) let nowApplyMethDef = - mkILNonGenericVirtualMethod ( + mkILNonGenericVirtualInstanceMethod ( "Invoke", ILMemberAccess.Public, nowParams, diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index a421d8d6eae..8ecfcff5510 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1373,7 +1373,7 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = // Find the 'this' argument type if any let thisTy, flatArgInfos = if isCtor then - (GetFSharpViewOfReturnType g returnTy), flatArgInfos + GetFSharpViewOfReturnType g returnTy, flatArgInfos else match flatArgInfos with | [] -> error (InternalError("This instance method '" + vref.LogicalName + "' has no arguments", m)) @@ -1392,8 +1392,7 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = warning (InternalError(msg, m)) else - List.iter2 - (fun gtp ty2 -> + (ctps, thisArgTys) ||> List.iter2 (fun gtp ty2 -> if not (typeEquiv g (mkTyparTy gtp) ty2) then warning ( InternalError( @@ -1406,8 +1405,6 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = m ) )) - ctps - thisArgTys let methodArgTys, paramInfos = List.unzip flatArgInfos @@ -5741,7 +5738,7 @@ and fixupMethodImplFlags (mdef: ILMethodDef) = and fixupStaticAbstractSlotFlags (mdef: ILMethodDef) = mdef.WithHideBySig(true) -and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod = +and GenObjectExprMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod = let g = cenv.g let (TObjExprMethod (slotsig, attribs, methTyparsOfOverridingMethod, methParams, methBodyExpr, m)) = @@ -5786,6 +5783,7 @@ and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod let mdef = mkILGenericVirtualMethod ( nameOfOverridingMethod, + ILCallingConv.Instance, ILMemberAccess.Public, GenGenericParams cenv eenvUnderTypars methTyparsOfOverridingMethod, ilParamsOfOverridingMethod, @@ -5969,7 +5967,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel (ilArgTys, argVals) ||> List.map2 (fun ty v -> mkILParamNamed (v.LogicalName, ty)) - mkILNonGenericVirtualMethod (imethName, ILMemberAccess.Public, ilParams, mkILReturn ilRetTy, MethodBody.IL(notlazy ilCode)) + mkILNonGenericVirtualInstanceMethod (imethName, ILMemberAccess.Public, ilParams, mkILReturn ilRetTy, MethodBody.IL(notlazy ilCode)) ] let mimpls = @@ -6176,7 +6174,7 @@ and GenObjectExpr cenv cgbuf eenvouter objExpr (baseType, baseValOpt, basecall, let genMethodAndOptionalMethodImpl tmethod useMethodImpl = [ for (useMethodImpl, methodImplGeneratorFunction, methTyparsOfOverridingMethod), mdef in - GenObjectMethod cenv eenvinner cgbuf useMethodImpl tmethod do + GenObjectExprMethod cenv eenvinner cgbuf useMethodImpl tmethod do let mimpl = (if useMethodImpl then Some(methodImplGeneratorFunction (ilTyForOverriding, methTyparsOfOverridingMethod)) @@ -6327,7 +6325,7 @@ and GenSequenceExpr GenSequel cenv eenv.cloc cgbuf Return), m) - mkILNonGenericVirtualMethod ( + mkILNonGenericVirtualInstanceMethod ( "GetFreshEnumerator", ILMemberAccess.Public, [], @@ -6340,13 +6338,13 @@ and GenSequenceExpr let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "Close", eenvinner, 1, None, closeExpr, discardAndReturnVoid) - mkILNonGenericVirtualMethod ("Close", ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ("Close", ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL(lazy ilCode)) let checkCloseMethod = let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "get_CheckClose", eenvinner, 1, None, checkCloseExpr, Return) - mkILNonGenericVirtualMethod ("get_CheckClose", ILMemberAccess.Public, [], mkILReturn g.ilg.typ_Bool, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ("get_CheckClose", ILMemberAccess.Public, [], mkILReturn g.ilg.typ_Bool, MethodBody.IL(lazy ilCode)) let generateNextMethod = // the 'next enumerator' byref arg is at arg position 1 @@ -6359,13 +6357,13 @@ and GenSequenceExpr let ilCode = MethodBody.IL(lazy (CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "GenerateNext", eenvinner, 2, None, generateNextExpr, Return))) - mkILNonGenericVirtualMethod ("GenerateNext", ILMemberAccess.Public, ilParams, ilReturn, ilCode) + mkILNonGenericVirtualInstanceMethod ("GenerateNext", ILMemberAccess.Public, ilParams, ilReturn, ilCode) let lastGeneratedMethod = let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "get_LastGenerated", eenvinner, 1, None, exprForValRef m currvref, Return) - mkILNonGenericVirtualMethod ("get_LastGenerated", ILMemberAccess.Public, [], mkILReturn ilCloSeqElemTy, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ("get_LastGenerated", ILMemberAccess.Public, [], mkILReturn ilCloSeqElemTy, MethodBody.IL(lazy ilCode)) |> AddNonUserCompilerGeneratedAttribs g let ilCtorBody = @@ -6561,6 +6559,7 @@ and GenClosureAsLocalTypeFunction cenv (cgbuf: CodeGenBuffer) eenv thisVars expr [ mkILGenericVirtualMethod ( "DirectInvoke", + ILCallingConv.Instance, ILMemberAccess.Assembly, ilDirectGenericParams, ilDirectWitnessParams, @@ -9078,8 +9077,10 @@ and GenMethodForBinding let flagFixups = ComputeFlagFixupsForMemberBinding cenv v + let cconv = if memberInfo.MemberFlags.IsInstance then ILCallingConv.Instance else ILCallingConv.Static + let mdef = - mkILGenericVirtualMethod (mspec.Name, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) + mkILGenericVirtualMethod (mspec.Name, cconv, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups @@ -10143,7 +10144,7 @@ and GenEqualsOverrideCallingIComparable cenv (tcref: TyconRef, ilThisTy, _ilThat let ilMethodBody = mkMethodBody (true, [], 2, nonBranchingInstrsToCode ilInstrs, None, None) - mkILNonGenericVirtualMethod ( + mkILNonGenericVirtualInstanceMethod ( "Equals", ILMemberAccess.Public, [ mkILParamNamed ("obj", g.ilg.typ_Object) ], @@ -10226,6 +10227,7 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) = let mdef = mkILGenericVirtualMethod ( vref.CompiledName g.CompilerGlobalState, + mspec.CallingConv, ILMemberAccess.Public, ilMethTypars, ilParams, @@ -10235,16 +10237,9 @@ and GenAbstractBinding cenv eenv tref (vref: ValRef) = let mdef = fixupVirtualSlotFlags mdef - let mdef = - if mdef.IsVirtual then - mdef - .WithFinal(memberInfo.MemberFlags.IsFinal) - .WithAbstract(memberInfo.MemberFlags.IsDispatchSlot) - else - mdef - let mdef = mdef + .WithFinal(memberInfo.MemberFlags.IsFinal) .WithPreserveSig(hasPreserveSigImplFlag) .WithSynchronized(hasSynchronizedImplFlag) .WithNoInlining(hasNoInliningFlag) @@ -10346,7 +10341,7 @@ and GenPrintingMethod cenv eenv methName ilThisTy m = mkMethodBody (true, [], 2, nonBranchingInstrsToCode ilInstrs, None, eenv.imports) let mdef = - mkILNonGenericVirtualMethod (methName, ILMemberAccess.Public, [], mkILReturn g.ilg.typ_String, ilMethodBody) + mkILNonGenericVirtualInstanceMethod (methName, ILMemberAccess.Public, [], mkILReturn g.ilg.typ_String, ilMethodBody) let mdef = mdef.With(customAttrs = mkILCustomAttrs [ g.CompilerGeneratedAttribute ]) yield mdef diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index ab609449d6a..5ffd7917e30 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -49,7 +49,7 @@ type LanguageFeature = | DelegateTypeNameResolutionFix | ReallyLongLists | ErrorOnDeprecatedRequireQualifiedAccess - | VirtualStaticsInInterfaces + | InterfacesWithAbstractStaticMembers /// LanguageVersion management type LanguageVersion(versionText) = @@ -112,7 +112,7 @@ type LanguageVersion(versionText) = LanguageFeature.BetterExceptionPrinting, previewVersion LanguageFeature.ReallyLongLists, previewVersion LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess, previewVersion - LanguageFeature.VirtualStaticsInInterfaces, previewVersion + LanguageFeature.InterfacesWithAbstractStaticMembers, previewVersion ] @@ -213,7 +213,7 @@ type LanguageVersion(versionText) = | LanguageFeature.DelegateTypeNameResolutionFix -> FSComp.SR.featureDelegateTypeNameResolutionFix () | LanguageFeature.ReallyLongLists -> FSComp.SR.featureReallyLongList () | LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess -> FSComp.SR.featureErrorOnDeprecatedRequireQualifiedAccess () - | LanguageFeature.VirtualStaticsInInterfaces -> FSComp.SR.featureVirtualStaticsInInterfaces () + | LanguageFeature.InterfacesWithAbstractStaticMembers -> FSComp.SR.featureVirtualStaticsInInterfaces () /// Get a version string associated with the given feature. member _.GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index fe91bae6ae3..ddc2623268c 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -39,7 +39,7 @@ type LanguageFeature = | DelegateTypeNameResolutionFix | ReallyLongLists | ErrorOnDeprecatedRequireQualifiedAccess - | VirtualStaticsInInterfaces + | InterfacesWithAbstractStaticMembers /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index ae00238bb90..f6eea0b4dd0 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -1401,7 +1401,8 @@ type SynMemberDefn = ident: Ident * typeOpt: SynType option * propKind: SynMemberKind * - memberFlags: (SynMemberKind -> SynMemberFlags) * + memberFlags: SynMemberFlags * + memberFlagsForSet: SynMemberFlags * xmlDoc: PreXmlDoc * accessibility: SynAccess option * equalsRange: range * diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 31bf8d19ebc..a7c2b27bbd8 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -1593,7 +1593,8 @@ type SynMemberDefn = ident: Ident * typeOpt: SynType option * propKind: SynMemberKind * - memberFlags: (SynMemberKind -> SynMemberFlags) * + memberFlags: SynMemberFlags * + memberFlagsForSet: SynMemberFlags * xmlDoc: PreXmlDoc * accessibility: SynAccess option * equalsRange: range * diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 64e66218780..150f8198059 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -730,10 +730,10 @@ let OverrideMemberFlags trivia k : SynMemberFlags = Trivia = trivia } -let AbstractMemberFlags trivia k : SynMemberFlags = +let AbstractMemberFlags isInstance trivia k : SynMemberFlags = { MemberKind = k - IsInstance = true + IsInstance = isInstance IsDispatchSlot = true IsOverrideOrExplicitImpl = false IsFinal = false @@ -814,6 +814,24 @@ let AbstractMemberSynMemberFlagsTrivia (mAbstract: range) (mMember: range) : Syn DefaultRange = None } +let StaticAbstractSynMemberFlagsTrivia mStatic mAbstract = + { + MemberRange = None + OverrideRange = None + AbstractRange = Some mAbstract + StaticRange = Some mStatic + DefaultRange = None + } + +let StaticAbstractMemberSynMemberFlagsTrivia mStatic mAbstract mMember = + { + MemberRange = Some mMember + OverrideRange = None + AbstractRange = Some mAbstract + StaticRange = Some mStatic + DefaultRange = None + } + let inferredTyparDecls = SynValTyparDecls(None, true) let noInferredTypars = SynValTyparDecls(None, false) diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index 50037218557..a9831932090 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -296,7 +296,7 @@ val ClassCtorMemberFlags: trivia: SynMemberFlagsTrivia -> SynMemberFlags val OverrideMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags -val AbstractMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags +val AbstractMemberFlags: isInstance: bool -> trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags val StaticMemberFlags: trivia: SynMemberFlagsTrivia -> k: SynMemberKind -> SynMemberFlags @@ -314,6 +314,10 @@ val AbstractSynMemberFlagsTrivia: mAbstract: range -> SynMemberFlagsTrivia val AbstractMemberSynMemberFlagsTrivia: mAbstract: range -> mMember: range -> SynMemberFlagsTrivia +val StaticAbstractSynMemberFlagsTrivia: mStatic: range -> mAbstract: range -> SynMemberFlagsTrivia + +val StaticAbstractMemberSynMemberFlagsTrivia: mStatic: range -> mAbstract: range -> mMember: range -> SynMemberFlagsTrivia + val inferredTyparDecls: SynValTyparDecls val noInferredTypars: SynValTyparDecls diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 92f1bc5719e..f05b4a83333 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -8840,12 +8840,11 @@ let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute att let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberInfo) attrs = // All extension members are compiled as static members - if isExtensionMember then false - // Members implementing a dispatch slot is compiled as an instance member - // Exception is static interface members: - elif not membInfo.MemberFlags.IsInstance && membInfo.MemberFlags.IsOverrideOrExplicitImpl then false - elif membInfo.MemberFlags.IsOverrideOrExplicitImpl then true - elif not (isNil membInfo.ImplementedSlotSigs) then true + if isExtensionMember then + false + // Abstract slots, overrides and interface impls are all true to IsInstance + elif membInfo.MemberFlags.IsDispatchSlot || membInfo.MemberFlags.IsOverrideOrExplicitImpl || not (isNil membInfo.ImplementedSlotSigs) then + membInfo.MemberFlags.IsInstance else // Otherwise check attributes to see if there is an explicit instance or explicit static flag let explicitInstance, explicitStatic = diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 72cc9ccd815..4c2d563926a 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -995,7 +995,9 @@ tyconSpfnRhs: | DELEGATE OF topType { let m = lhs parseState let ty, arity = $3 - let invoke = SynMemberSig.Member(SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero), AbstractMemberFlags SynMemberFlagsTrivia.Zero SynMemberKind.Member, m) + let flags = AbstractMemberFlags true SynMemberFlagsTrivia.Zero SynMemberKind.Member + let valSig = SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero) + let invoke = SynMemberSig.Member(valSig, flags, m) (fun nameRange nameInfo mEquals augmentation -> if not (isNil augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) let mWhole = unionRanges nameRange m @@ -1082,8 +1084,8 @@ classMemberSpfn: | None -> m | Some e -> unionRanges m e.Range let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, optLiteralValue, wholeRange, { ValKeyword = None; WithKeyword = mWith; EqualsRange = mEquals }) - let _, flags = $3 - SynMemberSig.Member(valSpfn, flags (getSetAdjuster arity), wholeRange) } + let flags = $3 (getSetAdjuster arity) + SynMemberSig.Member(valSpfn, flags, wholeRange) } | opt_attributes opt_declVisibility interfaceMember appType { if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2)) @@ -1156,13 +1158,7 @@ classMemberSpfnGetSetElements: memberSpecFlags: | memberFlags { $1 } - | ABSTRACT - { let mAbstract = rhs parseState 1 - (false, AbstractMemberFlags(AbstractSynMemberFlagsTrivia mAbstract)) } - | ABSTRACT MEMBER - { let mAbstract = rhs parseState 1 - let mMember = rhs parseState 2 - (false, AbstractMemberFlags(AbstractMemberSynMemberFlagsTrivia mAbstract mMember)) } + | abstractMemberFlags { $1 } /* Part of an exception definition in a signature file */ @@ -1598,16 +1594,16 @@ memberFlags: | STATIC MEMBER { let mStatic = rhs parseState 1 let mMember = rhs parseState 2 - (true, StaticMemberFlags(StaticMemberSynMemberFlagsTrivia mStatic mMember)) } + StaticMemberFlags(StaticMemberSynMemberFlagsTrivia mStatic mMember) } | MEMBER { let mMember = rhs parseState 1 - (false, NonVirtualMemberFlags(MemberSynMemberFlagsTrivia mMember)) } + NonVirtualMemberFlags(MemberSynMemberFlagsTrivia mMember) } | OVERRIDE { let mOverride = rhs parseState 1 - (false, OverrideMemberFlags(OverrideSynMemberFlagsTrivia mOverride)) } + OverrideMemberFlags(OverrideSynMemberFlagsTrivia mOverride) } | DEFAULT { let mDefault = rhs parseState 1 - (false, OverrideMemberFlags(DefaultSynMemberFlagsTrivia mDefault)) } + OverrideMemberFlags(DefaultSynMemberFlagsTrivia mDefault) } /* The name of a type in a signature or implementation, possibly with type parameters and constraints */ typeNameInfo: @@ -1741,8 +1737,9 @@ tyconDefnRhs: { let m = lhs parseState let ty, arity = $3 (fun nameRange augmentation -> - let valSpfn = SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero) - let invoke = SynMemberDefn.AbstractSlot(valSpfn, AbstractMemberFlags SynMemberFlagsTrivia.Zero SynMemberKind.Member, m) + let valSig = SynValSig([], (SynIdent(mkSynId m "Invoke", None)), inferredTyparDecls, ty, arity, false, false, PreXmlDoc.Empty, None, None, m, SynValSigTrivia.Zero) + let flags = AbstractMemberFlags true SynMemberFlagsTrivia.Zero SynMemberKind.Member + let invoke = SynMemberDefn.AbstractSlot(valSig, flags, m) if not (isNil augmentation) then raiseParseErrorAt m (FSComp.SR.parsAugmentationsIllegalOnDelegateType()) SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Delegate (ty, arity), [invoke], m), []) } @@ -2065,16 +2062,23 @@ memberCore: | _ -> []) } - abstractMemberFlags: | ABSTRACT { let mAbstract = rhs parseState 1 - AbstractSynMemberFlagsTrivia mAbstract } - | ABSTRACT MEMBER + AbstractMemberFlags true (AbstractSynMemberFlagsTrivia mAbstract) } + | ABSTRACT MEMBER { let mAbstract = rhs parseState 1 let mMember = rhs parseState 2 - AbstractMemberSynMemberFlagsTrivia mAbstract mMember } - + AbstractMemberFlags true (AbstractMemberSynMemberFlagsTrivia mAbstract mMember) } + | STATIC ABSTRACT + { let mStatic = rhs parseState 1 + let mAbstract = rhs parseState 2 + AbstractMemberFlags false (StaticAbstractSynMemberFlagsTrivia mStatic mAbstract) } + | STATIC ABSTRACT MEMBER + { let mStatic = rhs parseState 1 + let mAbstract = rhs parseState 2 + let mMember = rhs parseState 3 + AbstractMemberFlags false (StaticAbstractMemberSynMemberFlagsTrivia mStatic mAbstract mMember) } /* A member definition */ classDefnMember: @@ -2090,7 +2094,7 @@ classDefnMember: { let rangeStart = rhs parseState 1 if Option.isSome $2 then errorR (Error (FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier (), rhs parseState 2)) - let _, flags = $3 + let flags = $3 $4 $2 flags $1 rangeStart } | opt_attributes opt_declVisibility interfaceMember appType opt_interfaceImplDefn @@ -2115,7 +2119,7 @@ classDefnMember: |> unionRangeWithXmlDoc doc if Option.isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(), wholeRange)) let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, None, None, wholeRange, { ValKeyword = None; WithKeyword = mWith; EqualsRange = None }) - [ SynMemberDefn.AbstractSlot(valSpfn, AbstractMemberFlags $3 (getSetAdjuster arity), wholeRange) ] } + [ SynMemberDefn.AbstractSlot(valSpfn, $3 (getSetAdjuster arity), wholeRange) ] } | opt_attributes opt_declVisibility inheritsDefn { if not (isNil $1) then errorR(Error(FSComp.SR.parsAttributesIllegalOnInherit(), rhs parseState 1)) @@ -2136,8 +2140,8 @@ classDefnMember: { let rangeStart = rhs parseState 1 if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2)) - let isStatic, flags = $3 - $4 $1 isStatic flags rangeStart } + let flags = $3 + $4 $1 flags rangeStart } | opt_attributes opt_declVisibility NEW atomicPattern optAsSpec EQUALS typedSequentialExprBlock opt_ODECLEND { let mWholeBindLhs = rhs2 parseState 1 (if Option.isSome $5 then 5 else 4) @@ -2177,11 +2181,13 @@ autoPropsDefnDecl: let mEquals = rhs parseState 6 if $2 then errorR (Error (FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSet (), rhs parseState 3)) - (fun attribs isStatic flags rangeStart -> + (fun attribs flags rangeStart -> let xmlDoc = grabXmlDocAtRangeStart(parseState, attribs, rangeStart) let memberRange = unionRanges rangeStart $7.Range |> unionRangeWithXmlDoc xmlDoc - [ SynMemberDefn.AutoProperty(attribs, isStatic, $4, $5, getSet, flags, xmlDoc, $3, mEquals, $7, mWith, mGetSetOpt, memberRange) ]) } - + let memberFlags = flags SynMemberKind.Member + let memberFlagsForSet = flags SynMemberKind.PropertySet + let isStatic = not memberFlags.IsInstance + [ SynMemberDefn.AutoProperty(attribs, isStatic, $4, $5, getSet, memberFlags, memberFlagsForSet, xmlDoc, $3, mEquals, $7, mWith, mGetSetOpt, memberRange) ]) } /* An optional type on an auto-property definition */ opt_typ: @@ -2346,7 +2352,7 @@ objectImplementationMember: | opt_attributes staticMemberOrMemberOrOverride autoPropsDefnDecl opt_ODECLEND { let rangeStart = rhs parseState 1 - $3 $1 false $2 rangeStart } + $3 $1 $2 rangeStart } | opt_attributes staticMemberOrMemberOrOverride error { [] } diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 508221afb6f..5dab3f97ce5 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -3552,25 +3552,25 @@ type Foo = SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ - SynMemberDefn.AutoProperty(memberFlags= mkFlags1) - SynMemberDefn.AutoProperty(memberFlags= mkFlags2) - SynMemberDefn.AutoProperty(memberFlags= mkFlags3) - SynMemberDefn.AutoProperty(memberFlags= mkFlags4) + SynMemberDefn.AutoProperty(memberFlags=flags1) + SynMemberDefn.AutoProperty(memberFlags=flags2) + SynMemberDefn.AutoProperty(memberFlags=flags3) + SynMemberDefn.AutoProperty(memberFlags=flags4) ])) ], _) ]) ])) -> - let ({ Trivia = flagsTrivia1 } : SynMemberFlags) = mkFlags1 SynMemberKind.Member + let ({ Trivia = flagsTrivia1 } : SynMemberFlags) = flags1 assertRange (3, 4) (3, 10) flagsTrivia1.StaticRange.Value assertRange (3, 11) (3, 17) flagsTrivia1.MemberRange.Value - let ({ Trivia = flagsTrivia2 } : SynMemberFlags) = mkFlags2 SynMemberKind.Member + let ({ Trivia = flagsTrivia2 } : SynMemberFlags) = flags2 assertRange (4, 4) (4, 10) flagsTrivia2.MemberRange.Value - let ({ Trivia = flagsTrivia3 } : SynMemberFlags) = mkFlags3 SynMemberKind.Member + let ({ Trivia = flagsTrivia3 } : SynMemberFlags) = flags3 assertRange (5, 4) (5, 12) flagsTrivia3.OverrideRange.Value - let ({ Trivia = flagsTrivia4 } : SynMemberFlags) = mkFlags4 SynMemberKind.Member + let ({ Trivia = flagsTrivia4 } : SynMemberFlags) = flags4 assertRange (6, 4) (6, 11) flagsTrivia4.DefaultRange.Value | _ -> Assert.Fail "Could not get valid AST" From be1909c3b4600e0db61db7e92fd105d09225a0a9 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 23 Jun 2022 13:27:10 +0100 Subject: [PATCH 21/91] add tests --- .../Interop/StaticsInInterfaces.fs | 54 ++++++++++++++++++- 1 file changed, 53 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index e0eab1b6ff1..39653161a07 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -315,4 +315,56 @@ let main _ = |> withLangVersionPreview |> withReferences [csharpLib] |> compileAndRun - |> shouldSucceed \ No newline at end of file + |> shouldSucceed + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can implement interfaces with static abstract methods`` () = + + let fsharpSource = + """ + +type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T + +type C() = + interface IAdditionOperator with + static member op_Addition(x: C, y: C) = C() + +[] +let main _ = 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# supports inference for types of arguments when implementing interfaces`` () = + + let fsharpSource = + """ + +type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T + +type C() = + interface IAdditionOperator with + static member op_Addition(x, y) = C() // no type annotation needed on 'x' and 'y' + +[] +let main _ = 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed From 7262f1fa44cb006bc31fd28d764237f84210bfab Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 23 Jun 2022 14:25:46 +0100 Subject: [PATCH 22/91] fix build --- src/Compiler/Checking/InfoReader.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index f55e1cfc4c9..fc5744b5b80 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -697,7 +697,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" let isRuntimeFeatureVirtualStaticsInInterfacesSupported = - lazy isRuntimeFeatureSupported this "InterfacesWithAbstractStaticMembers" + lazy isRuntimeFeatureSupported this "VirtualStaticsInInterfaces" member _.g = g member _.amap = amap From aa03f8218be64708987b8229a1db88395022a937 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Fri, 24 Jun 2022 11:14:29 +0200 Subject: [PATCH 23/91] Update surface area tests --- ...Sharp.CompilerService.SurfaceArea.netstandard.expected | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index b15a14df85b..45b138b2c8c 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -7352,6 +7352,10 @@ FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.Ident FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.Ident ident FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynExpr get_synExpr() FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynExpr synExpr +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags get_memberFlags() +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags get_memberFlagsForSet() +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags memberFlags +FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberFlags memberFlagsForSet FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberKind get_propKind() FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Syntax.SynMemberKind propKind FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Text.Range equalsRange @@ -7362,8 +7366,6 @@ FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Xml.PreXmlDoc FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: FSharp.Compiler.Xml.PreXmlDoc xmlDoc FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList] attributes FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList] get_attributes() -FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags] get_memberFlags() -FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags] memberFlags FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] accessibility FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess] get_accessibility() FSharp.Compiler.Syntax.SynMemberDefn+AutoProperty: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType] get_typeOpt() @@ -7466,7 +7468,7 @@ FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsNestedType() FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsOpen() FSharp.Compiler.Syntax.SynMemberDefn: Boolean get_IsValField() FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAbstractSlot(FSharp.Compiler.Syntax.SynValSig, FSharp.Compiler.Syntax.SynMemberFlags, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAutoProperty(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], Boolean, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberKind, Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Syntax.SynMemberKind,FSharp.Compiler.Syntax.SynMemberFlags], FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewAutoProperty(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], Boolean, FSharp.Compiler.Syntax.Ident, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberKind, FSharp.Compiler.Syntax.SynMemberFlags, FSharp.Compiler.Syntax.SynMemberFlags, FSharp.Compiler.Xml.PreXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitCtor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.SynAccess], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynAttributeList], FSharp.Compiler.Syntax.SynSimplePats, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Xml.PreXmlDoc, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewImplicitInherit(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynMemberDefn: FSharp.Compiler.Syntax.SynMemberDefn NewInherit(FSharp.Compiler.Syntax.SynType, Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Syntax.Ident], FSharp.Compiler.Text.Range) From 61229233ae1eaf6f8e1d499e497c6b90b6f21b04 Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Fri, 24 Jun 2022 19:08:10 +0200 Subject: [PATCH 24/91] Apply fantomas --- src/Compiler/AbstractIL/il.fs | 6 +- src/Compiler/AbstractIL/il.fsi | 3 +- src/Compiler/CodeGen/IlxGen.fs | 67 +++++++++++++++++------ src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 2 +- src/Compiler/SyntaxTree/SyntaxTreeOps.fsi | 3 +- 5 files changed, 59 insertions(+), 22 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 668190e6aad..831cfccb188 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -3821,7 +3821,11 @@ let mkILGenericVirtualMethod (nm, callconv: ILCallingConv, access, genparams, ac ||| (match impl with | MethodBody.Abstract -> MethodAttributes.Abstract ||| MethodAttributes.Virtual | _ -> MethodAttributes.Virtual) - ||| (if callconv.IsInstance then enum 0 else MethodAttributes.Static) + ||| (if callconv.IsInstance then + enum 0 + else + MethodAttributes.Static) + ILMethodDef( name = nm, attributes = attributes, diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index f02b36392d8..2d7c9d4dc19 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -2030,7 +2030,8 @@ val internal mkILNonGenericStaticMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef val internal mkILGenericVirtualMethod: - string * ILCallingConv * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef + string * ILCallingConv * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> + ILMethodDef val internal mkILGenericNonVirtualMethod: string * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 8ecfcff5510..152e123cca0 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1392,19 +1392,20 @@ let GetMethodSpecForMemberVal cenv (memberInfo: ValMemberInfo) (vref: ValRef) = warning (InternalError(msg, m)) else - (ctps, thisArgTys) ||> List.iter2 (fun gtp ty2 -> - if not (typeEquiv g (mkTyparTy gtp) ty2) then - warning ( - InternalError( - "CodeGen check: type checking did not quantify the correct type variables for this method: generalization list contained " - + gtp.Name - + "#" - + string gtp.Stamp - + " and list from 'this' pointer contained " - + (showL (typeL ty2)), - m - ) - )) + (ctps, thisArgTys) + ||> List.iter2 (fun gtp ty2 -> + if not (typeEquiv g (mkTyparTy gtp) ty2) then + warning ( + InternalError( + "CodeGen check: type checking did not quantify the correct type variables for this method: generalization list contained " + + gtp.Name + + "#" + + string gtp.Stamp + + " and list from 'this' pointer contained " + + (showL (typeL ty2)), + m + ) + )) let methodArgTys, paramInfos = List.unzip flatArgInfos @@ -5967,7 +5968,13 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel (ilArgTys, argVals) ||> List.map2 (fun ty v -> mkILParamNamed (v.LogicalName, ty)) - mkILNonGenericVirtualInstanceMethod (imethName, ILMemberAccess.Public, ilParams, mkILReturn ilRetTy, MethodBody.IL(notlazy ilCode)) + mkILNonGenericVirtualInstanceMethod ( + imethName, + ILMemberAccess.Public, + ilParams, + mkILReturn ilRetTy, + MethodBody.IL(notlazy ilCode) + ) ] let mimpls = @@ -6344,7 +6351,13 @@ and GenSequenceExpr let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "get_CheckClose", eenvinner, 1, None, checkCloseExpr, Return) - mkILNonGenericVirtualInstanceMethod ("get_CheckClose", ILMemberAccess.Public, [], mkILReturn g.ilg.typ_Bool, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ( + "get_CheckClose", + ILMemberAccess.Public, + [], + mkILReturn g.ilg.typ_Bool, + MethodBody.IL(lazy ilCode) + ) let generateNextMethod = // the 'next enumerator' byref arg is at arg position 1 @@ -6363,7 +6376,13 @@ and GenSequenceExpr let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf ([], "get_LastGenerated", eenvinner, 1, None, exprForValRef m currvref, Return) - mkILNonGenericVirtualInstanceMethod ("get_LastGenerated", ILMemberAccess.Public, [], mkILReturn ilCloSeqElemTy, MethodBody.IL(lazy ilCode)) + mkILNonGenericVirtualInstanceMethod ( + "get_LastGenerated", + ILMemberAccess.Public, + [], + mkILReturn ilCloSeqElemTy, + MethodBody.IL(lazy ilCode) + ) |> AddNonUserCompilerGeneratedAttribs g let ilCtorBody = @@ -9077,10 +9096,22 @@ and GenMethodForBinding let flagFixups = ComputeFlagFixupsForMemberBinding cenv v - let cconv = if memberInfo.MemberFlags.IsInstance then ILCallingConv.Instance else ILCallingConv.Static + let cconv = + if memberInfo.MemberFlags.IsInstance then + ILCallingConv.Instance + else + ILCallingConv.Static let mdef = - mkILGenericVirtualMethod (mspec.Name, cconv, ILMemberAccess.Public, ilMethTypars, ilParams, ilReturn, ilMethodBody) + mkILGenericVirtualMethod ( + mspec.Name, + cconv, + ILMemberAccess.Public, + ilMethTypars, + ilParams, + ilReturn, + ilMethodBody + ) let mdef = List.fold (fun mdef f -> f mdef) mdef flagFixups diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 150f8198059..8028cd45816 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -733,7 +733,7 @@ let OverrideMemberFlags trivia k : SynMemberFlags = let AbstractMemberFlags isInstance trivia k : SynMemberFlags = { MemberKind = k - IsInstance = isInstance + IsInstance = isInstance IsDispatchSlot = true IsOverrideOrExplicitImpl = false IsFinal = false diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi index a9831932090..c715cea1c44 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fsi @@ -316,7 +316,8 @@ val AbstractMemberSynMemberFlagsTrivia: mAbstract: range -> mMember: range -> Sy val StaticAbstractSynMemberFlagsTrivia: mStatic: range -> mAbstract: range -> SynMemberFlagsTrivia -val StaticAbstractMemberSynMemberFlagsTrivia: mStatic: range -> mAbstract: range -> mMember: range -> SynMemberFlagsTrivia +val StaticAbstractMemberSynMemberFlagsTrivia: + mStatic: range -> mAbstract: range -> mMember: range -> SynMemberFlagsTrivia val inferredTyparDecls: SynValTyparDecls From b512c93e2317d667ca9118143eea3b37259add0c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 24 Jun 2022 21:42:11 +0100 Subject: [PATCH 25/91] add call syntax and emit constrained prefix --- src/Compiler/Checking/CheckExpressions.fs | 123 +++++++++++------- src/Compiler/Checking/ConstraintSolver.fs | 3 +- src/Compiler/Checking/MethodCalls.fs | 54 ++++---- src/Compiler/Checking/MethodCalls.fsi | 4 +- src/Compiler/Checking/MethodOverrides.fs | 6 +- .../Checking/PatternMatchCompilation.fs | 4 +- src/Compiler/Checking/TypeHierarchy.fs | 2 +- .../Optimize/LowerComputedCollections.fs | 6 +- .../Service/FSharpParseFileResults.fs | 1 + src/Compiler/Service/ServiceParseTreeWalk.fs | 2 + src/Compiler/SyntaxTree/LexFilter.fs | 28 +++- src/Compiler/SyntaxTree/SyntaxTree.fs | 3 + src/Compiler/SyntaxTree/SyntaxTree.fsi | 4 + src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 1 + src/Compiler/pars.fsy | 6 + .../Interop/StaticsInInterfaces.fs | 33 +++++ 16 files changed, 195 insertions(+), 85 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 690510cec12..a9e4bf3f2c0 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -3147,7 +3147,7 @@ let TcStaticUpcast cenv denv m tgtTy srcTy = AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css m NoTrace tgtTy srcTy -let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo valUseFlags minst objArgs args = +let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo valUseFlags minst objArgs args staticTyOpt = let g = cenv.g @@ -3181,7 +3181,7 @@ let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo let _, exprForVal, _, tau, _, _ = TcVal true cenv env emptyUnscopedTyparEnv valref (Some (valUse, (fun x _ -> ttypes, x))) None m exprForVal, tau - BuildMethodCall tcVal g cenv.amap isMutable m isProp minfo valUseFlags minst objArgs args + BuildMethodCall tcVal g cenv.amap isMutable m isProp minfo valUseFlags minst objArgs args staticTyOpt let TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: TcEnv) m ad nm ty = @@ -3224,13 +3224,13 @@ let BuildDisposableCleanup (cenv: cenv) env m (v: Val) = if TypeFeasiblySubsumesType 0 g cenv.amap m g.system_IDisposable_ty CanCoerce v.Type then // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive // copy of it. - let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] None disposeExpr else mkUnit g m else let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty - let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] None let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) mkIsInstConditional g m g.system_IDisposable_ty inputExpr disposeObjVar disposeExpr (mkUnit g m) @@ -3244,7 +3244,7 @@ let BuildOffsetToStringData cenv env m = | [x] -> x | _ -> error(Error(FSComp.SR.tcCouldNotFindOffsetToStringData(), m)) - let offsetExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] + let offsetExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] None offsetExpr let BuildILFieldGet g amap m objExpr (finfo: ILFieldInfo) = @@ -3505,7 +3505,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr mkCompGenLocal m "enumerator" retTypeOfGetEnumerator, retTypeOfGetEnumerator let getEnumExpr, getEnumTy = - let getEnumExpr, getEnumTy as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumerator_minfo NormalValUse getEnumerator_minst [exprToSearchForGetEnumeratorAndItem] [] + let getEnumExpr, getEnumTy as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumerator_minfo NormalValUse getEnumerator_minst [exprToSearchForGetEnumeratorAndItem] [] None if not isEnumeratorTypeStruct || localAlloc then res else // wrap enumerators that are represented as mutable structs into ref cells @@ -3513,8 +3513,8 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr let getEnumTy = mkRefCellTy g getEnumTy getEnumExpr, getEnumTy - let guardExpr, guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] - let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] + let guardExpr, guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] None + let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] None let currentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) let currentExpr, enumElemTy = // Implicitly dereference byref for expr 'for x in ...' @@ -5417,6 +5417,10 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = TcNonControlFlowExpr env <| fun env -> TcExprThen cenv overallTy env tpenv false expr1 ((DelayedDotLookup (longId, synExpr.RangeWithoutAnyExtraDot)) :: delayed) + // 'T.Ident + | SynExpr.TyparDotIdent (typar, ident, _) -> + TcTyparIdentThen cenv overallTy env tpenv typar ident delayed + // expr1.[expr2] // expr1.[e21, ..., e2n] // etc. @@ -5617,8 +5621,16 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = let env = ShrinkContext env mWholeExprIncludingParentheses expr2.Range TcExpr cenv overallTy env tpenv expr2 - | SynExpr.DotIndexedGet _ | SynExpr.DotIndexedSet _ - | SynExpr.TypeApp _ | SynExpr.Ident _ | SynExpr.LongIdent _ | SynExpr.App _ | SynExpr.Dynamic _ | SynExpr.DotGet _ -> error(Error(FSComp.SR.tcExprUndelayed(), synExpr.Range)) + | SynExpr.DotIndexedGet _ + | SynExpr.DotIndexedSet _ + | SynExpr.TyparDotIdent _ + | SynExpr.TypeApp _ + | SynExpr.Ident _ + | SynExpr.LongIdent _ + | SynExpr.App _ + | SynExpr.Dynamic _ + | SynExpr.DotGet _ -> + error(Error(FSComp.SR.tcExprUndelayed(), synExpr.Range)) | SynExpr.Const (SynConst.String (s, _, m), _) -> TcNonControlFlowExpr env <| fun env -> @@ -6304,6 +6316,16 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = conditionallySuppressErrorReporting (not isFirst && synExprContainsError e) (fun () -> TcExpr cenv overallTy env tpenv e) +and TcTyparIdentThen cenv overallTy env tpenv synTypar (synIdent: SynIdent) delayed = + let (SynIdent(ident, _)) = synIdent + let ad = env.eAccessRights + let tp, tpenv = TcTypar cenv env NoNewTypars tpenv synTypar + let mExprAndLongId = unionRanges synTypar.Range ident.idRange + let ty = mkTyparTy tp + let item, _rest = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv LookupKind.Expr ident.idRange ad ident IgnoreOverrides TypeNameResolutionInfo.Default ty + TcItemThen cenv overallTy env tpenv ([], item, mExprAndLongId, [], AfterResolution.DoNothing) (Some ty) delayed + //TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution + and (|IndexArgOptionalFromEnd|) indexArg = match indexArg with | SynExpr.IndexFromEnd (a, m) -> (a, true, m) @@ -6606,7 +6628,7 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite | Some mObjTy, None -> ForNewConstructors cenv.tcSink env mObjTy methodName minfos | None, _ -> AfterResolution.DoNothing - TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed + TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic None delayed | Item.DelegateCtor ty, [arg] -> // Re-record the name resolution since we now know it's a constructor call @@ -6999,7 +7021,7 @@ and TcObjectExpr cenv env tpenv (objTy, realObjTy, argopt, binds, extraImpls, mO let afterResolution = ForNewConstructors cenv.tcSink env mObjTy methodName minfos let ad = env.AccessRights - let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] + let expr, tpenv = TcMethodApplicationThen cenv env (MustEqual objTy) None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic None [] // The 'base' value is always bound let baseIdOpt = (match baseIdOpt with None -> Some(ident("base", mObjTy)) | Some id -> Some id) expr, baseIdOpt, tpenv @@ -7298,7 +7320,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m) // FormattableString are *always* turned into FormattableStringFactory.Create calls, boxing each argument - let createExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false createFormattableStringMethod NormalValUse [] [dotnetFormatStringExpr; argsExpr] [] + let createExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false createFormattableStringMethod NormalValUse [] [dotnetFormatStringExpr; argsExpr] [] None let resultExpr = if typeEquiv g overallTy.Commit g.system_IFormattable_ty then @@ -7716,13 +7738,13 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s let bodyExprFixup elemVar bodyExpr = let elemAddrVar, _ = mkCompGenLocal mIn "addr" elemAddrTy let e = mkInvisibleLet mIn elemVar (mkAddrGet mIn (mkLocalValRef elemAddrVar)) bodyExpr - let getItemCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getItemMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [ idxExpr ] + let getItemCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getItemMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [ idxExpr ] None mkInvisibleLet mIn elemAddrVar getItemCallExpr e // Evaluate the span expression once and put it in spanVar let overallExprFixup overallExpr = mkLet spForBind mFor spanVar enumExpr overallExpr - let getLengthCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLengthMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [] + let getLengthCallExpr, _ = BuildMethodCall tcVal g cenv.amap PossiblyMutates mWholeExpr true getLengthMethInfo ValUseFlag.NormalValUse [] [ spanExpr ] [] None // Ask for a loop over integers for the given range (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero g mFor, mkDecr g mFor getLengthCallExpr)) @@ -8041,7 +8063,7 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = | Item.FakeInterfaceCtor _ -> false | _ -> true) -> let overallTy = match overallTyOpt with None -> MustEqual (NewInferenceType g) | Some t -> t - let _, _ = TcItemThen cenv overallTy env tpenv res delayed + let _, _ = TcItemThen cenv overallTy env tpenv res None delayed true | _ -> false @@ -8249,14 +8271,14 @@ and TcLongIdentThen cenv (overallTy: OverallTy) env tpenv (SynLongIdent(longId, let nameResolutionResult = ResolveLongIdentAsExprAndComputeRange cenv.tcSink cenv.nameResolver (rangeOfLid longId) ad env.eNameResEnv typeNameResInfo longId |> ForceRaise - TcItemThen cenv overallTy env tpenv nameResolutionResult delayed + TcItemThen cenv overallTy env tpenv nameResolutionResult None delayed //------------------------------------------------------------------------- // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) delayed = +and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mItem, rest, afterResolution) staticTyOpt delayed = let delayed = delayRest rest mItem delayed match item with // x where x is a union case or active pattern result tag. @@ -8267,7 +8289,7 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed | Item.MethodGroup (methodName, minfos, _) -> - TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution delayed + TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed | Item.CtorGroup(nm, minfos) -> TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed @@ -8285,7 +8307,7 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed | Item.Property (nm, pinfos) -> - TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution delayed + TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution staticTyOpt delayed | Item.ILField finfo -> TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed @@ -8472,7 +8494,7 @@ and TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed = CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) let typeNameResInfo = GetLongIdentTypeNameInfo otherDelayed let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv ty longId typeNameResInfo IgnoreOverrides true - TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) otherDelayed + TcItemThen cenv overallTy env tpenv ((argsOfAppTy g ty), item, mItem, rest, afterResolution) None otherDelayed | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: _delayed' -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! @@ -8489,13 +8511,13 @@ and TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed = // call to ResolveLongIdentAsExprAndComputeRange error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) -and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution delayed = +and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed = let ad = env.eAccessRights // Static method calls Type.Foo(arg1, ..., argn) let meths = List.map (fun minfo -> minfo, None) minfos match delayed with | DelayedApp (atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> @@ -8509,9 +8531,9 @@ and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem after match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndTypeArgs mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed | None -> #endif @@ -8525,16 +8547,16 @@ and TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem after match otherDelayed with | DelayedApp(atomicFlag, _, _, arg, mExprAndArg) :: otherDelayed -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag staticTyOpt otherDelayed | _ -> - TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndTypeArgs mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt otherDelayed | _ -> #if !NO_TYPEPROVIDERS if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) #endif - TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic delayed + TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic staticTyOpt delayed and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed = let g = cenv.g @@ -8636,6 +8658,7 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = | SynExpr.Null _ | SynExpr.Ident _ | SynExpr.Const _ + | SynExpr.TyparDotIdent _ | SynExpr.LongIdent _ | SynExpr.Dynamic _ -> true @@ -8785,7 +8808,7 @@ and TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) PropagateThenTcDelayed cenv overallTy env tpenv mItem vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic delayed -and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution delayed = +and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution staticTyOpt delayed = let g = cenv.g let ad = env.eAccessRights @@ -8823,19 +8846,19 @@ and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed else let args = if pinfo.IsIndexer then args else [] if isNil meths then errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic otherDelayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic staticTyOpt otherDelayed | _ -> // Static Property Get (possibly indexer) let meths = pinfos |> GettersOfPropInfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) // Note: static calls never mutate a struct object argument - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed and TcILFieldItemThen cenv overallTy env finfo tpenv mItem delayed = let g = cenv.g @@ -8949,9 +8972,14 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight g false objExprTy) let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId TypeNameResolutionInfo.Default findFlag false + TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution + +and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution = + let g = cenv.g + let ad = env.eAccessRights + let objArgs = [objExpr] let mExprAndItem = unionRanges mObjExpr mItem let delayed = delayRest rest mExprAndItem delayed - match item with | Item.MethodGroup (methodName, minfos, _) -> let atomicFlag, tyArgsOpt, args, delayed, tpenv = GetSynMemberApplicationArgs delayed tpenv @@ -8966,7 +8994,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos[0]) CallNameResolutionSinkReplacing cenv.tcSink (mExprAndItem, env.NameEnv, item, [], ItemOccurence.Use, env.eAccessRights) - TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag None delayed | None -> if not minfos.IsEmpty && minfos[0].ProvidedStaticParameterInfo.IsSome then error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) @@ -8975,7 +9003,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let tyArgsOpt, tpenv = TcMemberTyArgsOpt cenv env tpenv tyArgsOpt let meths = minfos |> List.map (fun minfo -> minfo, None) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag None delayed | Item.Property (nm, pinfos) -> // Instance property @@ -9003,16 +9031,16 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // x.P <- ... byref setter if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed else let args = if pinfo.IsIndexer then args else [] let mut = (if isStructTy g (tyOfExpr g objExpr) then DefinitelyMutates else PossiblyMutates) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag [] + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [expr2]) atomicFlag None [] | _ -> // Instance property getter let meths = GettersOfPropInfos pinfos if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem)) - TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag delayed + TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed | Item.RecdField rfinfo -> // Get or set instance F# field or literal @@ -9108,10 +9136,10 @@ and TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einf // EventHelper ((fun d -> e.add_X(d)), (fun d -> e.remove_X(d)), (fun f -> new 'Delegate(f))) mkCallCreateEvent g mItem delTy argsTy (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy - let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.AddMethod NormalValUse [] objVars [de] + let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.AddMethod NormalValUse [] objVars [de] None mkLambda mItem dv (callExpr, g.unit_ty)) (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy - let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.RemoveMethod NormalValUse [] objVars [de] + let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.RemoveMethod NormalValUse [] objVars [de] None mkLambda mItem dv (callExpr, g.unit_ty)) (let fvty = mkFunTy g g.obj_ty (mkFunTy g argsTy g.unit_ty) let fv, fe = mkCompGenLocal mItem "callback" fvty @@ -9148,6 +9176,7 @@ and TcMethodApplicationThen isSuperInit // is this a special invocation, e.g. a super-class constructor call. Passed through to BuildMethodCall args // the _syntactic_ method arguments, not yet type checked. atomicFlag // is the expression atomic or not? + staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed // further lookups and applications that follow this = @@ -9162,7 +9191,7 @@ and TcMethodApplicationThen // Call the helper below to do the real checking let (expr, attributeAssignedNamedItems, delayed), tpenv = - TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy delayed + TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy staticTyOpt delayed // Give errors if some things couldn't be assigned if not (isNil attributeAssignedNamedItems) then @@ -9518,6 +9547,7 @@ and TcMethodApplication isSuperInit curriedCallerArgs (exprTy: OverallTy) + staticTyOpt // is there a static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() delayed = @@ -9676,7 +9706,7 @@ and TcMethodApplication /// STEP 6. Build the call expression, then adjust for byref-returns, out-parameters-as-tuples, post-hoc property assignments, methods-as-first-class-value, let callExpr0, exprTy = - BuildPossiblyConditionalMethodCall cenv env mut mMethExpr isProp finalCalledMethInfo isSuperInit finalCalledMethInst objArgs allArgsCoerced + BuildPossiblyConditionalMethodCall cenv env mut mMethExpr isProp finalCalledMethInfo isSuperInit finalCalledMethInst objArgs allArgsCoerced staticTyOpt // Handle byref returns let callExpr1, exprTy = @@ -9765,21 +9795,22 @@ and TcMethodApplication (callExpr6, finalAttributeAssignedNamedItems, delayed), tpenv /// For Method(X = expr) 'X' can be a property, IL Field or F# record field -and TcSetterArgExpr cenv env denv objExpr ad (AssignedItemSetter(id, setter, CallerArg(callerArgTy, m, isOptCallerArg, argExpr))) = +and TcSetterArgExpr cenv env denv objExpr ad assignedSetter = let g = cenv.g + let (AssignedItemSetter(id, setter, CallerArg(callerArgTy, m, isOptCallerArg, argExpr))) = assignedSetter if isOptCallerArg then error(Error(FSComp.SR.tcInvalidOptionalAssignmentToPropertyOrField(), m)) let argExprPrebinder, action, defnItem = match setter with - | AssignedPropSetter (pinfo, pminfo, pminst) -> + | AssignedPropSetter (propStaticTyOpt, pinfo, pminfo, pminst) -> MethInfoChecks g cenv.amap true None [objExpr] ad m pminfo let calledArgTy = List.head (List.head (pminfo.GetParamTypes(cenv.amap, m, pminst))) let tcVal = LightweightTcValForUsingInBuildMethodCall g let argExprPrebinder, argExpr = MethodCalls.AdjustCallerArgExpr tcVal g cenv.amap cenv.infoReader ad false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr let mut = (if isStructTy g (tyOfExpr g objExpr) then DefinitelyMutates else PossiblyMutates) - let action = BuildPossiblyConditionalMethodCall cenv env mut m true pminfo NormalValUse pminst [objExpr] [argExpr] |> fst + let action = BuildPossiblyConditionalMethodCall cenv env mut m true pminfo NormalValUse pminst [objExpr] [argExpr] propStaticTyOpt |> fst argExprPrebinder, action, Item.Property (pinfo.PropertyName, [pinfo]) | AssignedILFieldSetter finfo -> @@ -10577,7 +10608,7 @@ and TcAttributeEx canFail cenv (env: TcEnv) attrTgt attrEx (synAttr: SynAttribut let meths = minfos |> List.map (fun minfo -> minfo, None) let afterResolution = ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos let (expr, attributeAssignedNamedItems, _), _ = - TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (MustEqual ty) [] + TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (MustEqual ty) None [] UnifyTypes cenv env mAttr ty (tyOfExpr g expr) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 6690918ba30..54c7c0433ec 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2494,12 +2494,11 @@ and CanMemberSigsMatchUpToCheck assignedItemSetters |> MapCombineTDCD (fun (AssignedItemSetter(_, item, caller)) -> let name, calledArgTy = match item with - | AssignedPropSetter(_, pminfo, pminst) -> + | AssignedPropSetter(_, _, pminfo, pminst) -> let calledArgTy = List.head (List.head (pminfo.GetParamTypes(amap, m, pminst))) pminfo.LogicalName, calledArgTy | AssignedILFieldSetter(finfo) -> - (* Get or set instance IL field *) let calledArgTy = finfo.FieldType(amap, m) finfo.FieldName, calledArgTy diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 5de06521fca..af774415eb1 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -101,7 +101,8 @@ type AssignedCalledArg<'T> = /// Represents the possibilities for a named-setter argument (a property, field, or a record field setter) type AssignedItemSetterTarget = - | AssignedPropSetter of PropInfo * MethInfo * TypeInst (* the MethInfo is a non-indexer setter property *) + // the MethInfo is a non-indexer setter property + | AssignedPropSetter of staticTyOpt: TType option * pinfo: PropInfo * minfo: MethInfo * pminst: TypeInst | AssignedILFieldSetter of ILFieldInfo | AssignedRecdFieldSetter of RecdFieldInfo @@ -197,11 +198,13 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT isTyparTy g actualTy && (let ftyvs = freeInType CollectAll reqdTy2 in ftyvs.FreeTypars.Contains(destTyparTy g actualTy))) then let implicits = - infoReader.FindImplicitConversions m ad actualTy @ - infoReader.FindImplicitConversions m ad reqdTy2 + [ for conv in infoReader.FindImplicitConversions m ad actualTy do + (conv, actualTy) + for conv in infoReader.FindImplicitConversions m ad reqdTy2 do + (conv, reqdTy2) ] let implicits = - implicits |> List.filter (fun minfo -> + implicits |> List.filter (fun (minfo, _staticTy) -> not minfo.IsInstance && minfo.FormalMethodTyparInst.IsEmpty && (match minfo.GetParamTypes(amap, m, []) with @@ -212,12 +215,12 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT ) match implicits with - | [minfo] -> - Some (minfo, (reqdTy, reqdTy2, ignore)) - | minfo :: _ -> - Some (minfo, (reqdTy, reqdTy2, fun denv -> + | [(minfo, staticTy) ] -> + Some (minfo, staticTy, (reqdTy, reqdTy2, ignore)) + | (minfo, staticTy) :: _ -> + Some (minfo, staticTy, (reqdTy, reqdTy2, fun denv -> let reqdTy2Text, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes denv reqdTy2 actualTy - let implicitsText = NicePrint.multiLineStringOfMethInfos infoReader m denv implicits + let implicitsText = NicePrint.multiLineStringOfMethInfos infoReader m denv (List.map fst implicits) errorR(Error(FSComp.SR.tcAmbiguousImplicitConversion(actualTyText, reqdTy2Text, implicitsText), m)))) | _ -> None else @@ -289,7 +292,7 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // eliminate articifical constrained type variables. elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn + | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn | None -> reqdTy, TypeDirectedConversionUsed.No, None else reqdTy, TypeDirectedConversionUsed.No, None @@ -617,7 +620,8 @@ type CalledMeth<'T> | [pinfo] when pinfo.HasSetter && not pinfo.IsIndexer -> let pminfo = pinfo.SetterMethod let pminst = freshenMethInfo m pminfo - Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(pinfo, pminfo, pminst), e)) + let propStaticTyOpt = if isTyparTy g returnedObjTy then Some returnedObjTy else None + Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(propStaticTyOpt, pinfo, pminfo, pminst), e)) | _ -> let epinfos = match nameEnv with @@ -636,7 +640,8 @@ type CalledMeth<'T> | Some(TType_app(_, types, _)) -> types | _ -> pminst - Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(pinfo, pminfo, pminst), e)) + let propStaticTyOpt = if isTyparTy g returnedObjTy then Some returnedObjTy else None + Choice1Of2(AssignedItemSetter(id, AssignedPropSetter(propStaticTyOpt, pinfo, pminfo, pminst), e)) | _ -> match infoReader.GetILFieldInfosOfType(Some(nm), ad, m, returnedObjTy) with | finfo :: _ -> @@ -869,9 +874,11 @@ let IsBaseCall objArgs = /// Compute whether we insert a 'coerce' on the 'this' pointer for an object model call /// For example, when calling an interface method on a struct, or a method on a constrained /// variable type. -let ComputeConstrainedCallInfo g amap m (objArgs, minfo: MethInfo) = - match objArgs with - | [objArgExpr] when not minfo.IsExtensionMember -> +let ComputeConstrainedCallInfo g amap m staticTyOpt objArgs (minfo: MethInfo) = + match objArgs, staticTyOpt with + | [], Some staticTy when not minfo.IsExtensionMember && not minfo.IsInstance && minfo.IsAbstract -> Some staticTy + + | [objArgExpr], _ when not minfo.IsExtensionMember -> let methObjTy = minfo.ApparentEnclosingType let objArgTy = tyOfExpr g objArgExpr if TypeDefinitelySubsumesTypeNoCoercion 0 g amap m methObjTy objArgTy @@ -891,8 +898,8 @@ let ComputeConstrainedCallInfo g amap m (objArgs, minfo: MethInfo) = /// Adjust the 'this' pointer before making a call /// Take the address of a struct, and coerce to an interface/base/constraint type if necessary -let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m objArgs f = - let ccallInfo = ComputeConstrainedCallInfo g amap m (objArgs, minfo) +let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m staticTyOpt objArgs f = + let ccallInfo = ComputeConstrainedCallInfo g amap m staticTyOpt objArgs minfo let wrap, objArgs = @@ -1070,10 +1077,10 @@ let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap: Import.ImportMap, m: ra // minst: the instantiation to apply for a generic method // objArgs: the 'this' argument, if any // args: the arguments, if any -let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objArgs args = +let BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst objArgs args staticTyOpt = let direct = IsBaseCall objArgs - TakeObjAddrForMethodCall g amap minfo isMutable m objArgs (fun ccallInfo objArgs -> + TakeObjAddrForMethodCall g amap minfo isMutable m staticTyOpt objArgs (fun ccallInfo objArgs -> let allArgs = objArgs @ args let valUseFlags = if direct && (match valUseFlags with NormalValUse -> true | _ -> false) then @@ -1288,9 +1295,10 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade else match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, _) -> + | Some (minfo, staticTy, _) -> MethInfoChecks g amap false None [] ad m minfo - let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] + let staticTyOpt = if isTyparTy g staticTy then Some staticTy else None + let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] staticTyOpt assert (let resTy = tyOfExpr g callExpr in typeEquiv g reqdTy resTy) callExpr | None -> mkCoerceIfNeeded g reqdTy actualTy expr @@ -1949,7 +1957,7 @@ module ProvidedMethodCalls = let targetMethInfo = ProvidedMeth(amap, ctor.PApply((fun ne -> upcast ne), m), None, m) let objArgs = [] let arguments = [ for ea in args.PApplyArray(id, "GetInvokerExpression", m) -> exprToExpr ea ] - let callExpr = BuildMethodCall tcVal g amap Mutates.PossiblyMutates m false targetMethInfo isSuperInit [] objArgs arguments + let callExpr = BuildMethodCall tcVal g amap Mutates.PossiblyMutates m false targetMethInfo isSuperInit [] objArgs arguments None callExpr and addVar (v: Tainted) = @@ -1984,7 +1992,7 @@ module ProvidedMethodCalls = let mut = if top then mut else PossiblyMutates let isSuperInit = if top then isSuperInit else ValUseFlag.NormalValUse let isProp = if top then isProp else false - let callExpr = BuildMethodCall tcVal g amap mut m isProp targetMethInfo isSuperInit replacementGenericArguments objArgs arguments + let callExpr = BuildMethodCall tcVal g amap mut m isProp targetMethInfo isSuperInit replacementGenericArguments objArgs arguments None Some meth, callExpr and varToExpr (pe: Tainted) = diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index 5a54954eeff..a1d45d7bf27 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -83,7 +83,7 @@ type AssignedCalledArg<'T> = /// Represents the possibilities for a named-setter argument (a property, field, or a record field setter) type AssignedItemSetterTarget = - | AssignedPropSetter of PropInfo * MethInfo * TypeInst + | AssignedPropSetter of staticTyOpt: TType option * pinfo: PropInfo * minfo: MethInfo * pminst: TypeInst | AssignedILFieldSetter of ILFieldInfo | AssignedRecdFieldSetter of RecdFieldInfo @@ -348,6 +348,7 @@ val MakeMethInfoCall: amap: ImportMap -> m: range -> minfo: MethInfo -> minst: T // minst: the instantiation to apply for a generic method // objArgs: the 'this' argument, if any // args: the arguments, if any +// staticTyOpt: the static type that governs the call, different to the nominal type containing the member, e.g. 'T.CallSomeMethod() val BuildMethodCall: tcVal: (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) -> g: TcGlobals -> @@ -360,6 +361,7 @@ val BuildMethodCall: minst: TType list -> objArgs: Expr list -> args: Expr list -> + staticTyOpt: TType option -> Expr * TType /// Build a call to the System.Object constructor taking no arguments, diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 5ae3b02e01b..80064c84d29 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -923,9 +923,9 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv /// at the member signature prior to type inference. This is used to pre-assign type information if it does let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = - if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then - checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm - checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm + //if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then + // checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm + // checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm let minfos = match typToSearchForAbstractMembers with diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index 90bd293deac..1769470497c 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -1065,11 +1065,11 @@ let CompilePatternBasic | Some (ediCaptureMethInfo, ediThrowMethInfo) -> let edi, _ = BuildMethodCall tcVal g amap NeverMutates mMatch false - ediCaptureMethInfo ValUseFlag.NormalValUse [] [] [ (exprForVal mMatch origInputVal) ] + ediCaptureMethInfo ValUseFlag.NormalValUse [] [] [ (exprForVal mMatch origInputVal) ] None let e, _ = BuildMethodCall tcVal g amap NeverMutates mMatch false - ediThrowMethInfo ValUseFlag.NormalValUse [] [edi] [ ] + ediThrowMethInfo ValUseFlag.NormalValUse [] [edi] [ ] None mkCompGenSequential mMatch e (mkDefault (mMatch, resultTy)) diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index 12572e87d10..852ad054cea 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -199,7 +199,7 @@ type AllowMultiIntfInstantiations = Yes | No /// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). /// Visit base types and interfaces first. -let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = +let FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = let seenThisTycon = diff --git a/src/Compiler/Optimize/LowerComputedCollections.fs b/src/Compiler/Optimize/LowerComputedCollections.fs index e3091ec71fe..e3c120d0697 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fs +++ b/src/Compiler/Optimize/LowerComputedCollections.fs @@ -28,13 +28,13 @@ let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive // copy of it. - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] None //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] disposeExpr else let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] None let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) mkIsInstConditional g m g.system_IDisposable_ty inputExpr disposeObjVar disposeExpr (mkUnit g m) @@ -44,7 +44,7 @@ let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with | [x] -> x | _ -> error(InternalError("no " + name + " method found on Collector", m)) - let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args + let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args None expr let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 59a4946c2cb..7d0feb57a40 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -606,6 +606,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynExpr.LibraryOnlyILAssembly _ | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.Null _ + | SynExpr.TyparDotIdent _ | SynExpr.Ident _ | SynExpr.ImplicitZero _ | SynExpr.Const _ diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 4cfc7c99376..404f4c1d9e4 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -644,6 +644,8 @@ module SyntaxTraversal = | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None + | SynExpr.TyparDotIdent (_typar, _ident, _range) -> None + | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index 9b54f1c9976..88a743a6bf2 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -1023,7 +1023,11 @@ type LexFilterImpl ( let peekAdjacentTypars indentation (tokenTup: TokenTup) = let lookaheadTokenTup = peekNextTokenTup() match lookaheadTokenTup.Token with - | INFIX_COMPARE_OP " + | INFIX_COMPARE_OP "", false) + | LESS _ -> let tokenEndPos = tokenTup.LexbufState.EndPos if isAdjacent tokenTup lookaheadTokenTup then let mutable stack = [] @@ -1070,7 +1074,14 @@ type LexFilterImpl ( let dotTokenTup = peekNextTokenTup() stack <- (pool.UseLocation(dotTokenTup, HIGH_PRECEDENCE_PAREN_APP), false) :: stack true - | LPAREN | LESS _ | LBRACK | LBRACK_LESS | INFIX_COMPARE_OP " + | LPAREN + | LESS _ + | LBRACK + | LBRACK_LESS + | INFIX_COMPARE_OP "", false) -> scanAhead (nParen+1) // These tokens CAN occur in non-parenthesized positions in the grammar of types or type parameter definitions @@ -1119,13 +1130,22 @@ type LexFilterImpl ( let res = scanAhead 0 // Put the tokens back on and smash them up if needed - stack |> List.iter (fun (tokenTup, smash) -> + for (tokenTup, smash) in stack do if smash then match tokenTup.Token with | INFIX_COMPARE_OP " delayToken (pool.UseShiftedLocation(tokenTup, INFIX_STAR_DIV_MOD_OP "/", 1, 0)) delayToken (pool.UseShiftedLocation(tokenTup, LESS res, 0, -1)) pool.Return tokenTup + | INFIX_COMPARE_OP "<^" -> + delayToken (pool.UseShiftedLocation(tokenTup, INFIX_AT_HAT_OP "^", 1, 0)) + delayToken (pool.UseShiftedLocation(tokenTup, LESS res, 0, -1)) + pool.Return tokenTup + // NOTE: this is "<@" + | LQUOTE ("<@ @>", false) -> + delayToken (pool.UseShiftedLocation(tokenTup, INFIX_AT_HAT_OP "@", 1, 0)) + delayToken (pool.UseShiftedLocation(tokenTup, LESS res, 0, -1)) + pool.Return tokenTup | GREATER_BAR_RBRACK -> delayToken (pool.UseShiftedLocation(tokenTup, BAR_RBRACK, 1, 0)) delayToken (pool.UseShiftedLocation(tokenTup, GREATER res, 0, -2)) @@ -1146,7 +1166,7 @@ type LexFilterImpl ( pool.Return tokenTup | _ -> delayToken tokenTup else - delayToken tokenTup) + delayToken tokenTup res else false diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index f6eea0b4dd0..be185d6c5b1 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -583,6 +583,8 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia + | TyparDotIdent of typar: SynTypar * ident: SynIdent * range: range + | Ident of ident: Ident | LongIdent of isOptional: bool * longDotId: SynLongIdent * altNameRefCell: SynSimplePatAlternativeIdInfo ref option * range: range @@ -757,6 +759,7 @@ type SynExpr = | SynExpr.InterpolatedString (range = m) | SynExpr.Dynamic (range = m) -> m | SynExpr.Ident id -> id.idRange + | SynExpr.TyparDotIdent(range = m) -> m | SynExpr.DebugPoint (_, _, innerExpr) -> innerExpr.Range member e.RangeWithoutAnyExtraDot = diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index a7c2b27bbd8..e48b8a83c5d 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -727,6 +727,10 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia + /// F# syntax: ^T.ident + /// F# syntax: 'T.ident + | TyparDotIdent of typar: SynTypar * ident: SynIdent * range: range + /// F# syntax: ident /// Optimized representation for SynExpr.LongIdent (false, [id], id.idRange) | Ident of ident: Ident diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 150f8198059..25a438aa7a2 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -872,6 +872,7 @@ let rec synExprContainsError inpExpr = | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.Null _ | SynExpr.Ident _ + | SynExpr.TyparDotIdent _ | SynExpr.ImplicitZero _ | SynExpr.Const _ | SynExpr.Dynamic _ -> false diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 365b9b28987..50c88bfbbd8 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -4010,12 +4010,14 @@ declExpr: { let m = rhs parseState 1 SynExpr.IndexRange(None, m, None, m, m, m) } +/* | INFIX_AT_HAT_OP declExpr { if not (parseState.LexBuffer.SupportsFeature LanguageFeature.FromEndSlicing) then raiseParseErrorAt (rhs parseState 1) (FSComp.SR.fromEndSlicingRequiresVFive()) if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator()) let m = (rhs2 parseState 1 2) SynExpr.IndexFromEnd($2, m) } +*/ | minusExpr %prec expr_prefix_plus_minus { $1 } @@ -4284,6 +4286,10 @@ atomicExpr: if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()) mkSynPrefixPrim (rhs parseState 1) (unionRanges (rhs parseState 1) arg2.Range) $1 arg2, hpa2 } + | typar DOT identOrOp + { let lhsm = rhs2 parseState 1 3 + SynExpr.TyparDotIdent($1, $3, lhsm), false } + | atomicExpr DOT atomicExprQualification { let arg1, hpa1 = $1 $3 arg1 (lhs parseState) (rhs parseState 2), hpa1 } diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 39653161a07..c7b56cfab03 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -368,3 +368,36 @@ let main _ = 0 |> withLangVersionPreview |> compileAndRun |> shouldSucceed + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``F# can call interface with static abstract method`` () = + + let fsharpSource = + """ + +type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T + +type C(c: int) = + member _.Value = c + interface IAdditionOperator with + static member op_Addition(x, y) = C(x.Value + y.Value) + +let f<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + +[] +let main _ = + if f(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + 0 +""" + FSharp fsharpSource + |> asExe + |> withLangVersionPreview + |> compileAndRun + |> shouldSucceed From 335511076b78f9219f8ab97e61ca6961dedcfec4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 28 Jun 2022 02:20:34 +0100 Subject: [PATCH 26/91] fix parsing problems, allow invocation and support name resolution of trait constraints --- src/Compiler/Checking/CheckExpressions.fs | 60 +++- src/Compiler/Checking/ConstraintSolver.fs | 281 ++++++++++-------- src/Compiler/Checking/InfoReader.fs | 27 ++ src/Compiler/Checking/InfoReader.fsi | 1 + src/Compiler/Checking/NameResolution.fs | 12 + src/Compiler/Checking/NameResolution.fsi | 3 + src/Compiler/Checking/NicePrint.fs | 15 + src/Compiler/Checking/NicePrint.fsi | 2 + src/Compiler/FSComp.txt | 4 +- .../Service/FSharpParseFileResults.fs | 2 +- src/Compiler/Service/ItemKey.fs | 10 + .../Service/SemanticClassification.fs | 2 + .../Service/ServiceDeclarationLists.fs | 7 + src/Compiler/Service/ServiceParseTreeWalk.fs | 2 +- src/Compiler/Symbols/SymbolHelpers.fs | 11 + src/Compiler/Symbols/Symbols.fs | 7 + src/Compiler/Symbols/Symbols.fsi | 2 + src/Compiler/SyntaxTree/ParseHelpers.fs | 25 ++ src/Compiler/SyntaxTree/ParseHelpers.fsi | 3 + src/Compiler/SyntaxTree/SyntaxTree.fs | 4 +- src/Compiler/SyntaxTree/SyntaxTree.fsi | 5 +- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 2 +- src/Compiler/TypedTree/TypedTree.fs | 5 +- src/Compiler/TypedTree/TypedTree.fsi | 13 +- src/Compiler/TypedTree/TypedTreeOps.fs | 2 +- src/Compiler/pars.fsy | 39 ++- src/Compiler/xlf/FSComp.txt.cs.xlf | 15 +- src/Compiler/xlf/FSComp.txt.de.xlf | 15 +- src/Compiler/xlf/FSComp.txt.es.xlf | 15 +- src/Compiler/xlf/FSComp.txt.fr.xlf | 15 +- src/Compiler/xlf/FSComp.txt.it.xlf | 15 +- src/Compiler/xlf/FSComp.txt.ja.xlf | 15 +- src/Compiler/xlf/FSComp.txt.ko.xlf | 15 +- src/Compiler/xlf/FSComp.txt.pl.xlf | 15 +- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 15 +- src/Compiler/xlf/FSComp.txt.ru.xlf | 15 +- src/Compiler/xlf/FSComp.txt.tr.xlf | 15 +- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 15 +- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 15 +- tests/adhoc.fsx | 36 +++ 40 files changed, 544 insertions(+), 233 deletions(-) create mode 100644 tests/adhoc.fsx diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index a9e4bf3f2c0..f09c9371822 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5418,8 +5418,8 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = TcExprThen cenv overallTy env tpenv false expr1 ((DelayedDotLookup (longId, synExpr.RangeWithoutAnyExtraDot)) :: delayed) // 'T.Ident - | SynExpr.TyparDotIdent (typar, ident, _) -> - TcTyparIdentThen cenv overallTy env tpenv typar ident delayed + | SynExpr.Typar (typar, m) -> + TcTyparExprThen cenv overallTy env tpenv typar m delayed // expr1.[expr2] // expr1.[e21, ..., e2n] @@ -5623,7 +5623,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = | SynExpr.DotIndexedGet _ | SynExpr.DotIndexedSet _ - | SynExpr.TyparDotIdent _ + | SynExpr.Typar _ | SynExpr.TypeApp _ | SynExpr.Ident _ | SynExpr.LongIdent _ @@ -6316,15 +6316,29 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = conditionallySuppressErrorReporting (not isFirst && synExprContainsError e) (fun () -> TcExpr cenv overallTy env tpenv e) -and TcTyparIdentThen cenv overallTy env tpenv synTypar (synIdent: SynIdent) delayed = - let (SynIdent(ident, _)) = synIdent - let ad = env.eAccessRights - let tp, tpenv = TcTypar cenv env NoNewTypars tpenv synTypar - let mExprAndLongId = unionRanges synTypar.Range ident.idRange - let ty = mkTyparTy tp - let item, _rest = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv LookupKind.Expr ident.idRange ad ident IgnoreOverrides TypeNameResolutionInfo.Default ty - TcItemThen cenv overallTy env tpenv ([], item, mExprAndLongId, [], AfterResolution.DoNothing) (Some ty) delayed - //TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution +and TcTyparExprThen cenv overallTy env tpenv synTypar m delayed = + match delayed with + | DelayedDotLookup (ident :: rest, m2) :: delayed2 -> + let ad = env.eAccessRights + let tp, tpenv = TcTypar cenv env NoNewTypars tpenv synTypar + let mExprAndLongId = unionRanges synTypar.Range ident.idRange + let ty = mkTyparTy tp + let item, _rest = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv LookupKind.Expr ident.idRange ad ident IgnoreOverrides TypeNameResolutionInfo.Default ty + let delayed3 = + match rest with + | [] -> delayed2 + | _ -> DelayedDotLookup (rest, m2) :: delayed2 + TcItemThen cenv overallTy env tpenv ([], item, mExprAndLongId, [], AfterResolution.DoNothing) (Some ty) delayed3 + //TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution + | _ -> + let (SynTypar(_, q, _)) = synTypar + let msg = + match q with + | TyparStaticReq.None -> FSComp.SR.parsIncompleteTyparExpr1() + | TyparStaticReq.HeadType -> FSComp.SR.parsIncompleteTyparExpr2() + errorR (Error(msg, m)) + SolveTypeAsError env.DisplayEnv cenv.css m overallTy.Commit + mkThrow m overallTy.Commit (mkOne cenv.g m), tpenv and (|IndexArgOptionalFromEnd|) indexArg = match indexArg with @@ -8291,6 +8305,9 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte | Item.MethodGroup (methodName, minfos, _) -> TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed + | Item.Trait traitInfo -> + TcTraitItemThen cenv overallTy env traitInfo tpenv mItem delayed + | Item.CtorGroup(nm, minfos) -> TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed @@ -8607,6 +8624,23 @@ and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [] mItem delayed (Some afterResolution) +and TcTraitItemThen cenv overallTy env traitInfo tpenv mItem delayed = + let g = cenv.g + + let retTy = traitInfo.ReturnType |> Option.defaultValue g.unit_ty + + // Build a lambda for the trait call + let vs, ves = traitInfo.ArgumentTypes |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip + let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) + let v, body = MultiLambdaToTupledLambda g vs expr + let expr = mkLambda mItem v (body, retTy) + + // Propagate the types from the known application structure + Propagate cenv overallTy env tpenv (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) delayed + + // Check and apply the arguments + TcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) ExprAtomicFlag.NonAtomic delayed + and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = let g = cenv.g let isPrefix = IsPrefixOperator id.idText @@ -8658,7 +8692,7 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = | SynExpr.Null _ | SynExpr.Ident _ | SynExpr.Const _ - | SynExpr.TyparDotIdent _ + | SynExpr.Typar _ | SynExpr.LongIdent _ | SynExpr.Dynamic _ -> true diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 54c7c0433ec..3bfcaa5643a 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1981,137 +1981,161 @@ and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr } -/// Record a constraint on an inference type variable. -and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint = +// Type variable sets may not have two trait constraints with the same name, nor +// be constrained by different instantiations of the same interface type. +// +// This results in limitations on generic code, especially "inline" code, which +// may require type annotations. +// +// The 'retry' flag is passed when a rigid type variable is about to taise a missing constraint error. +and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace retry tpc1 tpc2 = let g = csenv.g - let aenv = csenv.EquivEnv let amap = csenv.amap - let denv = csenv.DisplayEnv let m = csenv.m + match tpc1, tpc2 with + | (TyparConstraint.MayResolveMember(TTrait(tys1, nm1, memFlags1, argTys1, rty1, _), _), + TyparConstraint.MayResolveMember(TTrait(tys2, nm2, memFlags2, argTys2, rty2, _), _)) + when (memFlags1 = memFlags2 && + nm1 = nm2 && + // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. + // See FSharp 1.0 bug 6477. + not (nm1 = "op_Explicit" || nm1 = "op_Implicit") && + argTys1.Length = argTys2.Length && + (List.lengthsEqAndForall2 (typeEquiv g) tys1 tys2 || retry)) -> - // Type variable sets may not have two trait constraints with the same name, nor - // be constrained by different instantiations of the same interface type. - // - // This results in limitations on generic code, especially "inline" code, which - // may require type annotations. See FSharp 1.0 bug 6477. - let consistent tpc1 tpc2 = - match tpc1, tpc2 with - | (TyparConstraint.MayResolveMember(TTrait(tys1, nm1, memFlags1, argTys1, rty1, _), _), - TyparConstraint.MayResolveMember(TTrait(tys2, nm2, memFlags2, argTys2, rty2, _), _)) - when (memFlags1 = memFlags2 && - nm1 = nm2 && - // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. - // See FSharp 1.0 bug 6477. - not (nm1 = "op_Explicit" || nm1 = "op_Implicit") && - argTys1.Length = argTys2.Length && - List.lengthsEqAndForall2 (typeEquiv g) tys1 tys2) -> - - let rty1 = GetFSharpViewOfReturnType g rty1 - let rty2 = GetFSharpViewOfReturnType g rty2 - trackErrors { - do! Iterate2D (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace) argTys1 argTys2 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty1 rty2 - () - } + trackErrors { + if retry then + match tys1, tys2 with + | [ty1], [ty2] -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 + | [ty1], _ -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1) tys2 + | _, [ty2] -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty2) tys1 + | _ -> () + do! Iterate2D (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace) argTys1 argTys2 + let rty1 = GetFSharpViewOfReturnType g rty1 + let rty2 = GetFSharpViewOfReturnType g rty2 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty1 rty2 + () + } - | (TyparConstraint.CoercesTo(ty1, _), - TyparConstraint.CoercesTo(ty2, _)) -> - // Record at most one subtype constraint for each head type. - // That is, we forbid constraints by both I and I. - // This works because the types on the r.h.s. of subtype - // constraints are head-types and so any further inferences are equational. - let collect ty = - let mutable res = [] - IterateEntireHierarchyOfType (fun x -> res <- x :: res) g amap m AllowMultiIntfInstantiations.No ty - List.rev res - let parents1 = collect ty1 - let parents2 = collect ty2 - trackErrors { - for ty1Parent in parents1 do - for ty2Parent in parents2 do - do! if not (HaveSameHeadType g ty1Parent ty2Parent) then CompleteD else - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1Parent ty2Parent - } - - | (TyparConstraint.IsEnum (u1, _), - TyparConstraint.IsEnum (u2, m2)) -> - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace u1 u2 + | (TyparConstraint.CoercesTo(ty1, _), + TyparConstraint.CoercesTo(ty2, _)) -> + // Record at most one subtype constraint for each head type. + // That is, we forbid constraints by both I and I. + // This works because the types on the r.h.s. of subtype + // constraints are head-types and so any further inferences are equational. + let collect ty = + let mutable res = [] + IterateEntireHierarchyOfType (fun x -> res <- x :: res) g amap m AllowMultiIntfInstantiations.No ty + List.rev res + let parents1 = collect ty1 + let parents2 = collect ty2 + trackErrors { + for ty1Parent in parents1 do + for ty2Parent in parents2 do + do! if not (HaveSameHeadType g ty1Parent ty2Parent) then CompleteD else + SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1Parent ty2Parent + } + + | (TyparConstraint.IsEnum (u1, _), + TyparConstraint.IsEnum (u2, m2)) -> + SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace u1 u2 - | (TyparConstraint.IsDelegate (aty1, bty1, _), - TyparConstraint.IsDelegate (aty2, bty2, m2)) -> trackErrors { - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace aty1 aty2 - return! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bty1 bty2 - } - - | TyparConstraint.SupportsComparison _, TyparConstraint.IsDelegate _ - | TyparConstraint.IsDelegate _, TyparConstraint.SupportsComparison _ - | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _ - | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _ -> - ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) - - - | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ - | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ - | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ - | TyparConstraint.SimpleChoice _, TyparConstraint.SimpleChoice _ -> - CompleteD + | (TyparConstraint.IsDelegate (aty1, bty1, _), + TyparConstraint.IsDelegate (aty2, bty2, m2)) -> trackErrors { + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace aty1 aty2 + return! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bty1 bty2 + } + + | TyparConstraint.SupportsComparison _, TyparConstraint.IsDelegate _ + | TyparConstraint.IsDelegate _, TyparConstraint.SupportsComparison _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _ -> + ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) + + + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ + | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ + | TyparConstraint.SimpleChoice _, TyparConstraint.SimpleChoice _ -> + CompleteD - | _ -> CompleteD + | _ -> CompleteD - // See when one constraint implies implies another. - // 'a :> ty1 implies 'a :> 'ty2 if the head type name of ty2 (say T2) occursCheck anywhere in the hierarchy of ty1 - // If it does occur, e.g. at instantiation T2, then the check above will have enforced that - // T2 = ty2 - let implies tpc1 tpc2 = - match tpc1, tpc2 with - | TyparConstraint.MayResolveMember(trait1, _), - TyparConstraint.MayResolveMember(trait2, _) -> - traitsAEquiv g aenv trait1 trait2 - - | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> - ExistsSameHeadTypeInHierarchy g amap m ty1 ty2 - - | TyparConstraint.IsEnum(u1, _), TyparConstraint.IsEnum(u2, _) -> typeEquiv g u1 u2 - - | TyparConstraint.IsDelegate(aty1, bty1, _), TyparConstraint.IsDelegate(aty2, bty2, _) -> - typeEquiv g aty1 aty2 && typeEquiv g bty1 bty2 - - | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ - // comparison implies equality - | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsEquality _ - | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ - | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ -> true - | TyparConstraint.SimpleChoice (tys1, _), TyparConstraint.SimpleChoice (tys2, _) -> ListSet.isSubsetOf (typeEquiv g) tys1 tys2 - | TyparConstraint.DefaultsTo (priority1, dty1, _), TyparConstraint.DefaultsTo (priority2, dty2, _) -> - (priority1 = priority2) && typeEquiv g dty1 dty2 - | _ -> false +// See when one constraint implies implies another. +// 'a :> ty1 implies 'a :> 'ty2 if the head type name of ty2 (say T2) occursCheck anywhere in the hierarchy of ty1 +// If it does occur, e.g. at instantiation T2, then the check above will have enforced that +// T2 = ty2 +and CheckConstraintImplication (csenv: ConstraintSolverEnv) tpc1 tpc2 = + let g = csenv.g + let aenv = csenv.EquivEnv + let amap = csenv.amap + let m = csenv.m + match tpc1, tpc2 with + | TyparConstraint.MayResolveMember(trait1, _), + TyparConstraint.MayResolveMember(trait2, _) -> + traitsAEquiv g aenv trait1 trait2 + + | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> + ExistsSameHeadTypeInHierarchy g amap m ty1 ty2 + + | TyparConstraint.IsEnum(u1, _), TyparConstraint.IsEnum(u2, _) -> typeEquiv g u1 u2 + + | TyparConstraint.IsDelegate(aty1, bty1, _), TyparConstraint.IsDelegate(aty2, bty2, _) -> + typeEquiv g aty1 aty2 && typeEquiv g bty1 bty2 + + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ + // comparison implies equality + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ + | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ -> true + | TyparConstraint.SimpleChoice (tys1, _), TyparConstraint.SimpleChoice (tys2, _) -> ListSet.isSubsetOf (typeEquiv g) tys1 tys2 + | TyparConstraint.DefaultsTo (priority1, dty1, _), TyparConstraint.DefaultsTo (priority2, dty2, _) -> + (priority1 = priority2) && typeEquiv g dty1 dty2 + | _ -> false +// Ensure constraint conforms with existing constraints +// NOTE: QUADRATIC +and EnforceConstraintSetConsistency csenv ndeep m2 trace retry allCxs i cxs = + match cxs with + | [] -> CompleteD + | cx :: rest -> + trackErrors { + do! IterateIdxD (fun j cx2 -> if i = j then CompleteD else EnforceConstraintConsistency csenv ndeep m2 trace retry cx cx2) allCxs + return! EnforceConstraintSetConsistency csenv ndeep m2 trace retry allCxs (i+1) rest + } + +// Eliminate any constraints where one constraint implies another +// Keep constraints in the left-to-right form according to the order they are asserted. +// NOTE: QUADRATIC +and EliminateRedundantConstraints csenv cxs acc = + match cxs with + | [] -> acc + | cx :: rest -> + let acc = + if List.exists (fun cx2 -> CheckConstraintImplication csenv cx2 cx) acc then acc + else (cx :: acc) + EliminateRedundantConstraints csenv rest acc + +/// Record a constraint on an inference type variable. +and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint = + let denv = csenv.DisplayEnv + let m = csenv.m - // First ensure constraint conforms with existing constraints - // NOTE: QUADRATIC let existingConstraints = tp.Constraints let allCxs = newConstraint :: List.rev existingConstraints trackErrors { - let rec enforceMutualConsistency i cxs = - match cxs with - | [] -> CompleteD - | cx :: rest -> - trackErrors { - do! IterateIdxD (fun j cx2 -> if i = j then CompleteD else consistent cx cx2) allCxs - return! enforceMutualConsistency (i+1) rest - } - do! enforceMutualConsistency 0 allCxs + do! EnforceConstraintSetConsistency csenv ndeep m2 trace false allCxs 0 allCxs - let impliedByExistingConstraints = existingConstraints |> List.exists (fun tpc2 -> implies tpc2 newConstraint) + let impliedByExistingConstraints = existingConstraints |> List.exists (fun tpc2 -> CheckConstraintImplication csenv tpc2 newConstraint) if impliedByExistingConstraints then () // "Default" constraints propagate softly and can be omitted from explicit declarations of type parameters @@ -2120,7 +2144,15 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint | _ -> false) then () elif IsRigid csenv tp then - return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) + // Retry rigid type parameters where the supporting types are forced to be identical, e.g if declared type parameter has this: + // (T : static member Foo: int) + // and the constraint we're adding is this: + // ((T or ?inf) : static member Foo: int) + // then the only logical solution is ?inf = T. So just enforce this and try again. + do! EnforceConstraintSetConsistency csenv ndeep m2 trace true allCxs 0 allCxs + let impliedByExistingConstraints = existingConstraints |> List.exists (fun tpc2 -> CheckConstraintImplication csenv tpc2 newConstraint) + if not impliedByExistingConstraints then + return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else // It is important that we give a warning if a constraint is missing from a // will-be-made-rigid type variable. This is because the existence of these warnings @@ -2129,20 +2161,7 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint if tp.Rigidity.WarnIfMissingConstraint then do! WarnD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) - let newConstraints = - // Eliminate any constraints where one constraint implies another - // Keep constraints in the left-to-right form according to the order they are asserted. - // NOTE: QUADRATIC - let rec eliminateRedundant cxs acc = - match cxs with - | [] -> acc - | cx :: rest -> - let acc = - if List.exists (fun cx2 -> implies cx2 cx) acc then acc - else (cx :: acc) - eliminateRedundant rest acc - - eliminateRedundant allCxs [] + let newConstraints = EliminateRedundantConstraints csenv allCxs [] // Write the constraint into the type variable // Record a entry in the undo trace if one is provided diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index fc5744b5b80..ede041b899f 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -95,6 +95,30 @@ let rec GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m origTy let GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty = GetImmediateIntrinsicMethInfosOfTypeAux (optFilter, ad) g amap m ty ty +/// Query the immediate methods of an F# type, not taking into account inherited methods. The optFilter +/// parameter is an optional name to restrict the set of properties returned. +let GetImmediateTraitsInfosOfType (optFilter, _ad) g ty = + match tryDestTyparTy g ty with + | ValueSome tp -> + let infos = GetTraitConstraintInfosOfTypars g [tp] + let infos = + match optFilter with + | None -> infos + | Some nm -> + infos |> List.filter (fun traitInfo -> + let traitName0 = traitInfo.MemberName + let traitName1 = + match traitInfo.MemberFlags.MemberKind with + | SynMemberKind.PropertyGet -> + match PrettyNaming.TryChopPropertyName traitName0 with + | Some nm -> nm + | None -> traitName0 + | _ -> traitName0 + (nm = traitName0) || (nm = traitName1)) + infos + | _ -> + [] + /// A helper type to help collect properties. /// /// Join up getters and setters which are not associated in the F# data structure @@ -247,6 +271,7 @@ let FilterMostSpecificMethInfoSets g amap m (minfoSets: NameMultiMap<_>) : NameM /// Used to collect sets of virtual methods, protected methods, protected /// properties etc. type HierarchyItem = + | TraitItem of TraitConstraintInfo list | MethodItem of MethInfo list list | PropertyItem of PropInfo list list | RecdFieldItem of RecdFieldInfo @@ -397,12 +422,14 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = if nm = ".ctor" then None else // '.ctor' lookups only ever happen via constructor syntax let optFilter = Some nm FoldPrimaryHierarchyOfType (fun ty acc -> + let qinfos = GetImmediateTraitsInfosOfType (optFilter, ad) g ty let minfos = GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty let pinfos = GetImmediateIntrinsicPropInfosOfType (optFilter, ad) g amap m ty let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter, ad) m ty let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m ty let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, ad) m ty match acc with + | _ when not (isNil qinfos) -> Some(TraitItem (qinfos)) | Some(MethodItem(inheritedMethSets)) when not (isNil minfos) -> Some(MethodItem (minfos :: inheritedMethSets)) | _ when not (isNil minfos) -> Some(MethodItem [minfos]) | Some(PropertyItem(inheritedPropSets)) when not (isNil pinfos) -> Some(PropertyItem(pinfos :: inheritedPropSets)) diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index b06b571296a..d80874218fc 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -73,6 +73,7 @@ val FilterMostSpecificMethInfoSets: /// Used to collect sets of virtual methods, protected methods, protected /// properties etc. type HierarchyItem = + | TraitItem of TraitConstraintInfo list | MethodItem of MethInfo list list | PropertyItem of PropInfo list list | RecdFieldItem of RecdFieldInfo diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index d04f9d0929d..4215bb5eabb 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -174,6 +174,9 @@ type Item = /// Represents the resolution of a name to an F# record or exception field. | RecdField of RecdFieldInfo + /// Represents the resolution of a name to an F# trait + | Trait of TraitConstraintInfo + /// Represents the resolution of a name to a union case field. | UnionCaseField of UnionCaseInfo * fieldIndex: int @@ -268,6 +271,7 @@ type Item = | Item.Types(nm, _) -> nm |> DemangleGenericTypeName | Item.UnqualifiedType(tcref :: _) -> tcref.DisplayNameCore | Item.TypeVar (nm, _) -> nm + | Item.Trait traitInfo -> traitInfo.MemberName | Item.ModuleOrNamespaces(modref :: _) -> modref.DisplayNameCore | Item.ArgName (id, _, _) -> id.idText | Item.SetterArg (id, _) -> id.idText @@ -1772,6 +1776,9 @@ let ItemsAreEffectivelyEqual g orig other = | EntityUse ty1, EntityUse ty2 -> tyconRefDefnEq g ty1 ty2 + | Item.Trait traitInfo1, Item.Trait traitInfo2 -> + traitInfo1.MemberName = traitInfo2.MemberName + | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> nm1 = nm2 && (typeEquiv g (mkTyparTy tp1) (mkTyparTy tp2) || @@ -1841,6 +1848,7 @@ let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = match orig with | EntityUse tcref -> tyconRefDefnHash g tcref | Item.TypeVar (nm, _)-> hash nm + | Item.Trait traitInfo -> hash traitInfo.MemberName | ValUse vref -> valRefDefnHash g vref | ActivePatternCaseUse (_, _, idx)-> hash idx | MethodUse minfo -> minfo.ComputeHashCode() @@ -2128,6 +2136,7 @@ let CheckAllTyparsInferrable amap m item = let free = Zset.diff freeInDeclaringType.FreeTypars freeInArgsAndRetType.FreeTypars free.IsEmpty) + | Item.Trait _ | Item.CtorGroup _ | Item.FakeInterfaceCtor _ | Item.DelegateCtor _ @@ -2508,6 +2517,9 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | None -> let isLookUpExpr = (lookupKind = LookupKind.Expr) match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm, ad) findFlag m ty with + | Some (TraitItem (traitInfo :: _)) when isLookUpExpr -> + success [resInfo, Item.Trait traitInfo, rest] + | Some (PropertyItem psets) when isLookUpExpr -> let pinfos = psets |> ExcludeHiddenOfPropInfos g ncenv.amap m diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 969e22c0207..9066a162b7d 100644 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -68,6 +68,9 @@ type Item = /// Represents the resolution of a name to an F# record or exception field. | RecdField of RecdFieldInfo + /// Represents the resolution of a name to an F# trait + | Trait of TraitConstraintInfo + /// Represents the resolution of a name to a union case field. | UnionCaseField of UnionCaseInfo * fieldIndex: int diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 4d8c55366cb..6447a7ba0b5 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -986,6 +986,9 @@ module PrintTypes = else bracketL coreL --- nmL + let layoutTrait denv traitInfo = + layoutTraitWithInfo denv SimplifyTypes.typeSimplificationInfo0 traitInfo + let layoutTyparConstraint denv (tp, tpc) = match layoutConstraintWithInfo denv SimplifyTypes.typeSimplificationInfo0 (tp, tpc) with | h :: _ -> h @@ -1105,6 +1108,14 @@ module PrintTypes = let cxsL = layoutConstraintsWithInfo denv env env.postfixConstraints layoutTypeWithInfoAndPrec denv env 2 ty --- cxsL + let prettyLayoutOfTrait denv traitInfo = + let compgenId = SyntaxTreeOps.mkSynId Range.range0 unassignedTyparName + let fakeTypar = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, SynTypar(compgenId, TyparStaticReq.None, true), false, TyparDynamicReq.No, [], false, false) + fakeTypar.SetConstraints [TyparConstraint.MayResolveMember(traitInfo, Range.range0)] + let ty, cxs = PrettyTypes.PrettifyType denv.g (mkTyparTy fakeTypar) + let env = SimplifyTypes.CollectInfo true [ty] cxs + layoutConstraintsWithInfo denv env env.postfixConstraints + let prettyLayoutOfTypeNoConstraints denv ty = let ty, _cxs = PrettyTypes.PrettifyType denv.g ty layoutTypeWithInfoAndPrec denv SimplifyTypes.typeSimplificationInfo0 5 ty @@ -1324,6 +1335,8 @@ module PrintTastMemberOrVals = let prettyLayoutOfValOrMemberNoInst denv infoReader v = prettyLayoutOfValOrMember denv infoReader emptyTyparInst v |> snd +let layoutTrait denv x = x |> PrintTypes.layoutTrait denv + let layoutTyparConstraint denv x = x |> PrintTypes.layoutTyparConstraint denv let outputType denv os x = x |> PrintTypes.layoutType denv |> bufferL os @@ -2460,6 +2473,8 @@ let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL let prettyLayoutOfType denv x = x |> PrintTypes.prettyLayoutOfType denv +let prettyLayoutOfTrait denv x = x |> PrintTypes.prettyLayoutOfTrait denv + let prettyLayoutOfTypeNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv let prettyLayoutOfTypar denv x = x |> PrintTypes.layoutTyparRef denv diff --git a/src/Compiler/Checking/NicePrint.fsi b/src/Compiler/Checking/NicePrint.fsi index c9df76a87a7..9534a57e8c0 100644 --- a/src/Compiler/Checking/NicePrint.fsi +++ b/src/Compiler/Checking/NicePrint.fsi @@ -108,6 +108,8 @@ val stringOfTy: denv: DisplayEnv -> x: TType -> string val prettyLayoutOfType: denv: DisplayEnv -> x: TType -> Layout +val prettyLayoutOfTrait: denv: DisplayEnv -> x: TraitConstraintInfo -> Layout + val prettyLayoutOfTypeNoCx: denv: DisplayEnv -> x: TType -> Layout val prettyLayoutOfTypar: denv: DisplayEnv -> x: Typar -> Layout diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index e2ffa1e085f..11af1ad90b2 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -464,11 +464,13 @@ parsMultiArgumentGenericTypeFormDeprecated,"The syntax '(typ,...,typ) ident' is 618,parsInvalidLiteralInType,"Invalid literal in type" 619,parsUnexpectedOperatorForUnitOfMeasure,"Unexpected infix operator in unit-of-measure expression. Legal operators are '*', '/' and '^'." 620,parsUnexpectedIntegerLiteralForUnitOfMeasure,"Unexpected integer literal in unit-of-measure expression" -621,parsUnexpectedTypeParameter,"Syntax error: unexpected type parameter specification" +#621,parsUnexpectedTypeParameter,"Syntax error: unexpected type parameter specification" 622,parsMismatchedQuotationName,"Mismatched quotation operator name, beginning with '%s'" 623,parsActivePatternCaseMustBeginWithUpperCase,"Active pattern case identifiers must begin with an uppercase letter" 624,parsActivePatternCaseContainsPipe,"The '|' character is not permitted in active pattern case identifiers" 625,parsIllegalDenominatorForMeasureExponent,"Denominator must not be 0 in unit-of-measure exponent" +626,parsIncompleteTyparExpr1,"Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name)" +626,parsIncompleteTyparExpr2,"Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name)" parsNoEqualShouldFollowNamespace,"No '=' symbol should follow a 'namespace' declaration" parsSyntaxModuleStructEndDeprecated,"The syntax 'module ... = struct .. end' is not used in F# code. Consider using 'module ... = begin .. end'" parsSyntaxModuleSigEndDeprecated,"The syntax 'module ... : sig .. end' is not used in F# code. Consider using 'module ... = begin .. end'" diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 7d0feb57a40..25d886ed6b0 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -606,7 +606,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | SynExpr.LibraryOnlyILAssembly _ | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.Null _ - | SynExpr.TyparDotIdent _ + | SynExpr.Typar _ | SynExpr.Ident _ | SynExpr.ImplicitZero _ | SynExpr.Const _ diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 2854da14a25..38507adacfc 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -80,6 +80,9 @@ module ItemKeyTags = [] let itemProperty = "p$" + [] + let itemTrait = "T$" + [] let itemTypeVar = "y$" @@ -367,6 +370,13 @@ and [] ItemKeyStoreBuilder() = | Some info -> writeEntityRef info.DeclaringTyconRef | _ -> () + | Item.Trait (info) -> + writeString ItemKeyTags.itemTrait + writeString info.MemberName + info.GoverningTypes |> List.iter (writeType false) + info.ArgumentTypes |> List.iter (writeType false) + info.ReturnType |> Option.iter (writeType false) + | Item.TypeVar (_, typar) -> writeTypar true typar | Item.Types (_, [ ty ]) -> writeType true ty diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index c95195db8ff..14612aeb15b 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -337,6 +337,8 @@ module TcResolutionsExtensions = | Item.UnionCase _, _, m -> add m SemanticClassificationType.UnionCase + | Item.Trait _, _, m -> add m SemanticClassificationType.Method + | Item.ActivePatternResult _, _, m -> add m SemanticClassificationType.UnionCase | Item.UnionCaseField _, _, m -> add m SemanticClassificationType.UnionCaseField diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 82fc0afae36..76737a684af 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -385,6 +385,11 @@ module DeclarationListHelpers = let layout = NicePrint.prettyLayoutOfTypar denv typar ToolTipElement.Single (toArray layout, xml) + // Traits + | Item.Trait traitInfo -> + let layout = NicePrint.prettyLayoutOfTrait denv traitInfo + ToolTipElement.Single (toArray layout, xml) + // F# Modules and namespaces | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> //let os = StringBuilder() @@ -853,6 +858,7 @@ module internal DescriptionListsImpl = | Item.CustomOperation _ -> FSharpGlyph.Method | Item.MethodGroup (_, minfos, _) when minfos |> List.forall (fun minfo -> minfo.IsExtensionMember) -> FSharpGlyph.ExtensionMethod | Item.MethodGroup _ -> FSharpGlyph.Method + | Item.Trait _ -> FSharpGlyph.Method | Item.TypeVar _ -> FSharpGlyph.TypeParameter | Item.Types _ -> FSharpGlyph.Class | Item.UnqualifiedType (tcref :: _) -> @@ -886,6 +892,7 @@ module internal DescriptionListsImpl = match item with | Item.CtorGroup(nm, cinfos) -> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) cinfos | Item.FakeInterfaceCtor _ + | Item.Trait _ | Item.DelegateCtor _ -> [item] | Item.NewDef _ | Item.ILField _ -> [] diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 404f4c1d9e4..f2a1f2ebb60 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -644,7 +644,7 @@ module SyntaxTraversal = | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None - | SynExpr.TyparDotIdent (_typar, _ident, _range) -> None + | SynExpr.Typar (_typar, _range) -> None | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index f65cd4541cc..dc37e93a6b0 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -102,6 +102,7 @@ module internal SymbolHelpers = | Item.Property(_, pinfos) -> rangeOfPropInfo preferFlag pinfos.Head | Item.Types(_, tys) -> tys |> List.tryPick (tryNiceEntityRefOfTyOption >> Option.map (rangeOfEntityRef preferFlag)) | Item.CustomOperation (_, _, Some minfo) -> rangeOfMethInfo g preferFlag minfo + | Item.Trait _ -> None | Item.TypeVar (_, tp) -> Some tp.Range | Item.ModuleOrNamespaces modrefs -> modrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) | Item.MethodGroup(_, minfos, _) @@ -193,6 +194,7 @@ module internal SymbolHelpers = | Item.AnonRecdField (info, _, _, _) -> Some info.Assembly + | Item.Trait _ -> None | Item.TypeVar _ -> None | _ -> None @@ -273,6 +275,8 @@ module internal SymbolHelpers = | Item.CustomOperation (_, _, Some minfo) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) + | Item.Trait _ -> FSharpXmlDoc.None + | Item.TypeVar _ -> FSharpXmlDoc.None | Item.ModuleOrNamespaces(modref :: _) -> @@ -335,6 +339,7 @@ module internal SymbolHelpers = { new IPartialEqualityComparer<_> with member x.InEqualityRelation item = match item with + | Item.Trait _ -> true | Item.Types(_, [_]) -> true | Item.ILField(ILFieldInfo _) -> true | Item.RecdField _ -> true @@ -404,6 +409,8 @@ module internal SymbolHelpers = EventInfo.EventInfosUseIdenticalDefinitions evt1 evt2 | Item.AnonRecdField(anon1, _, i1, _), Item.AnonRecdField(anon2, _, i2, _) -> anonInfoEquiv anon1 anon2 && i1 = i2 + | Item.Trait traitInfo1, Item.Trait traitInfo2 -> + (traitInfo1.MemberName = traitInfo2.MemberName) | Item.CtorGroup(_, meths1), Item.CtorGroup(_, meths2) -> (meths1, meths2) ||> List.forall2 (fun minfo1 minfo2 -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) @@ -438,6 +445,7 @@ module internal SymbolHelpers = | Item.UnionCase(UnionCaseInfo(_, UnionCaseRef(tcref, n)), _) -> hash(tcref.Stamp, n) | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref, n))) -> hash(tcref.Stamp, n) | Item.AnonRecdField(anon, _, i, _) -> hash anon.SortedNames[i] + | Item.Trait traitInfo -> hash traitInfo.MemberName | Item.Event evt -> evt.ComputeHashCode() | Item.Property(_name, pis) -> hash (pis |> List.map (fun pi -> pi.ComputeHashCode())) | Item.UnqualifiedType(tcref :: _) -> hash tcref.LogicalName @@ -514,6 +522,7 @@ module internal SymbolHelpers = match tryTcrefOfAppTy g ty with | ValueSome tcref -> buildString (fun os -> NicePrint.outputTyconRef denv os tcref) | _ -> "" + | Item.Trait traitInfo -> traitInfo.MemberName | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> let definiteNamespace = modrefs |> List.forall (fun modref -> modref.IsNamespace) if definiteNamespace then fullDisplayTextOfModRef modref else modref.DisplayName @@ -828,6 +837,7 @@ module internal SymbolHelpers = | Item.CustomOperation (_, _, None) // "into" | Item.NewDef _ // "let x$yz = ..." - no keyword | Item.ArgName _ // no keyword on named parameters + | Item.Trait _ | Item.UnionCaseField _ | Item.TypeVar _ | Item.ImplicitOp _ @@ -858,6 +868,7 @@ module internal SymbolHelpers = | ItemIsWithStaticArguments m g _ -> [item] // we pretend that provided-types-with-static-args are method-like in order to get ParamInfo for them #endif | Item.CustomOperation(_name, _helpText, _minfo) -> [item] + | Item.Trait _ -> [item] | Item.TypeVar _ -> [] | Item.CustomBuilder _ -> [] | _ -> [] diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 6475f93a08d..02b76eec32f 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -310,6 +310,9 @@ type FSharpSymbol(cenv: SymbolEnv, item: unit -> Item, access: FSharpSymbol -> C | Item.TypeVar (_, tp) -> FSharpGenericParameter(cenv, tp) :> _ + | Item.Trait traitInfo -> + FSharpGenericParameterMemberConstraint(cenv, traitInfo) :> _ + | Item.ActivePatternCase apref -> FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ @@ -1414,6 +1417,10 @@ type FSharpAbstractSignature(cenv, info: SlotSig) = member _.DeclaringType = FSharpType(cenv, info.ImplementedType) type FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = + inherit FSharpSymbol (cenv, + (fun () -> Item.Trait(info)), + (fun _ _ _ad -> true)) + let (TTrait(tys, nm, flags, atys, retTy, _)) = info member _.MemberSources = tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection diff --git a/src/Compiler/Symbols/Symbols.fsi b/src/Compiler/Symbols/Symbols.fsi index 5a296058eb3..8f19a55e446 100644 --- a/src/Compiler/Symbols/Symbols.fsi +++ b/src/Compiler/Symbols/Symbols.fsi @@ -636,6 +636,8 @@ type FSharpStaticParameter = [] type FSharpGenericParameterMemberConstraint = + inherit FSharpSymbol + /// Get the types that may be used to satisfy the constraint member MemberSources: IList diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index bf25d2790c6..c3ec877a26a 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -732,3 +732,28 @@ let mkSynMemberDefnGetSet tryMkSynMemberDefnMember (Option.map PropertyKeyword.And mAnd) s ] | _ -> [] + +let mkQualTypeAccess mFull rightExpr = + let rec take inp = + match inp with + | SynExpr.Ident(typarIdent) + | SynExpr.LongIdent(false, SynLongIdent ([typarIdent], _, _), None, _) -> + let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) + SynExpr.Typar(typar, mFull) + | SynExpr.LongIdent(false, SynLongIdent ((typarIdent :: items), (dotm :: dots), (_ :: itemTrivias)), None, _) -> + let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) + let lookup = SynLongIdent (items, dots, itemTrivias) + SynExpr.DotGet (SynExpr.Typar(typar, mFull), dotm, lookup, mFull) + | SynExpr.App(ExprAtomicFlag.Atomic, false, funcExpr, argExpr, m) -> + let funcExpr2 = take funcExpr + SynExpr.App (ExprAtomicFlag.Atomic, false, funcExpr2, argExpr, unionRanges funcExpr2.Range m) + | SynExpr.DotGet (leftExpr, dotm, lookup, m) -> + let leftExpr2 = take leftExpr + SynExpr.DotGet (leftExpr2, dotm, lookup, m) + | SynExpr.DotIndexedGet(leftExpr, indexArg, dotm, m) -> + let leftExpr2 = take leftExpr + SynExpr.DotIndexedGet (leftExpr2, indexArg, dotm, m) + | _ -> + reportParseErrorAt mFull (FSComp.SR.parsIncompleteTyparExpr2()) + arbExpr("hatExpr1", mFull) + take rightExpr diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi index c240ab124e5..73bc97e28f1 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fsi +++ b/src/Compiler/SyntaxTree/ParseHelpers.fsi @@ -175,3 +175,6 @@ val mkSynMemberDefnGetSet: attrs: SynAttributeList list -> rangeStart: range -> SynMemberDefn list + +/// Incorporate a '^' for an qualified type access +val mkQualTypeAccess: mFull: range -> rightExpr: SynExpr -> SynExpr diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index be185d6c5b1..f68bed5424e 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -583,7 +583,7 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia - | TyparDotIdent of typar: SynTypar * ident: SynIdent * range: range + | Typar of typar: SynTypar * range: range | Ident of ident: Ident @@ -759,7 +759,7 @@ type SynExpr = | SynExpr.InterpolatedString (range = m) | SynExpr.Dynamic (range = m) -> m | SynExpr.Ident id -> id.idRange - | SynExpr.TyparDotIdent(range = m) -> m + | SynExpr.Typar(range = m) -> m | SynExpr.DebugPoint (_, _, innerExpr) -> innerExpr.Range member e.RangeWithoutAnyExtraDot = diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index e48b8a83c5d..1e44f0bc0c5 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -727,9 +727,8 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia - /// F# syntax: ^T.ident - /// F# syntax: 'T.ident - | TyparDotIdent of typar: SynTypar * ident: SynIdent * range: range + /// F# syntax: ^T (for ^T.ident) or (for 'T.ident) + | Typar of typar: SynTypar * range: range /// F# syntax: ident /// Optimized representation for SynExpr.LongIdent (false, [id], id.idRange) diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 91f7ccdf980..d076858044d 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -872,7 +872,7 @@ let rec synExprContainsError inpExpr = | SynExpr.LibraryOnlyStaticOptimization _ | SynExpr.Null _ | SynExpr.Ident _ - | SynExpr.TyparDotIdent _ + | SynExpr.Typar _ | SynExpr.ImplicitZero _ | SynExpr.Const _ | SynExpr.Dynamic _ -> false diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 2213a23778e..3645234338a 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2360,11 +2360,14 @@ type TraitConstraintInfo = /// Indicates the signature of a member constraint. Contains a mutable solution cell /// to store the inferred solution of the constraint. - | TTrait of tys: TTypes * memberName: string * _memFlags: SynMemberFlags * argTys: TTypes * returnTy: TType option * solution: TraitConstraintSln option ref + | TTrait of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * argTys: TTypes * returnTy: TType option * solution: TraitConstraintSln option ref /// Get the key associated with the member constraint. member x.TraitKey = (let (TTrait(a, b, c, d, e, _)) = x in TraitWitnessInfo(a, b, c, d, e)) + /// Get the types that may provide solutions for the traits + member x.GoverningTypes = (let (TTrait(tys, _, _, _, _, _)) = x in tys) + /// Get the member name associated with the member constraint. member x.MemberName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index c51a75643b5..89d0e8a8f24 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1638,26 +1638,29 @@ type TraitConstraintInfo = | TTrait of tys: TTypes * memberName: string * - _memFlags: Syntax.SynMemberFlags * + memberFlags: Syntax.SynMemberFlags * argTys: TTypes * returnTy: TType option * solution: TraitConstraintSln option ref override ToString: unit -> string - /// Get the argument types recorded in the member constraint. This includes the object instance type for - /// instance members. - member ArgumentTypes: TTypes - [] member DebugText: string + /// Get the types that may provide solutions for the traits + member GoverningTypes: TType list + /// Get the member flags associated with the member constraint. member MemberFlags: Syntax.SynMemberFlags /// Get the member name associated with the member constraint. member MemberName: string + /// Get the argument types recorded in the member constraint. This includes the object instance type for + /// instance members. + member ArgumentTypes: TTypes + /// Get the return type recorded in the member constraint. member ReturnType: TType option diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index f05b4a83333..ab04a0b48bd 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -2795,7 +2795,6 @@ module PrettyTypes = // Badly formed code may instantiate rigid declared typars to types. // Hence we double check here that the thing is really a type variable let safeDestAnyParTy orig g ty = match tryAnyParTy g ty with ValueNone -> orig | ValueSome x -> x - let tee f x = f x x let foldUnurriedArgInfos f z (x: UncurriedArgInfos) = List.fold (fold1Of2 f) z x let mapUnurriedArgInfos f (x: UncurriedArgInfos) = List.map (map1Of2 f) x @@ -2921,6 +2920,7 @@ module SimplifyTypes = { singletons = singletons inplaceConstraints = Zmap.ofList typarOrder inplace postfixConstraints = postfix } + let CollectInfo simplify tys cxs = categorizeConstraints simplify (accTyparCountsMulti emptyTyparCounts tys) cxs diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 50c88bfbbd8..2ed05e1a0ee 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -509,7 +509,8 @@ let rangeOfLongIdent(lid:LongIdent) = %nonassoc expr_not %left COLON_GREATER COLON_QMARK_GREATER %left INFIX_COMPARE_OP DOLLAR LESS GREATER EQUALS INFIX_BAR_OP INFIX_AMP_OP -%right INFIX_AT_HAT_OP +%left infix_at_hat_op_prefix +%right INFIX_AT_HAT_OP infix_at_hat_op_binary %right COLON_COLON %nonassoc pat_isinst %left COLON_QMARK @@ -3883,7 +3884,7 @@ declExpr: | declExpr GREATER declExpr { mkSynInfix (rhs parseState 2) $1 ">" $3 } - | declExpr INFIX_AT_HAT_OP declExpr + | declExpr INFIX_AT_HAT_OP declExpr %prec infix_at_hat_op_binary { mkSynInfix (rhs parseState 2) $1 $2 $3 } | declExpr PERCENT_OP declExpr @@ -3957,7 +3958,7 @@ declExpr: { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression(">")) exprFromParseError(mkSynInfix (rhs parseState 2) $1 ">" (arbExpr("declExprInfix", (rhs parseState 3).StartRange))) } - | declExpr INFIX_AT_HAT_OP OBLOCKEND_COMING_SOON + | declExpr INFIX_AT_HAT_OP OBLOCKEND_COMING_SOON %prec infix_at_hat_op_binary { reportParseErrorAt (rhs parseState 2) (FSComp.SR.parsUnfinishedExpression($2)) exprFromParseError(mkSynInfix (rhs parseState 2) $1 $2 (arbExpr("declExprInfix", (rhs parseState 3).StartRange))) } @@ -4247,8 +4248,28 @@ minusExpr: appExpr: | appExpr argExpr %prec expr_app { SynExpr.App (ExprAtomicFlag.NonAtomic, false, $1, $2, unionRanges $1.Range $2.Range) } +/* + | INFIX_AT_HAT_OP atomicExpr + { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnfinishedExpression($1)); + match $2 with + | SynExpr.LongIdent(false, SynLongIdent ([typarIdent; rightIdent], [dotm], [_; rightTrivia]), None, m), _ -> + let rightId = SynIdent (rightIdent, rightTrivia) + let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) + let typarRange = unionRanges (rhs parseState 1) m + SynExpr.TyparDotIdent(typar, dotm, rightId, typarRange) + | _ -> + reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedHatExpr()); + let m = rhs2 parseState 1 2 + arbExpr("hatExpr1", m) } +*/ + + | INFIX_AT_HAT_OP appExpr %prec infix_at_hat_op_prefix + { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnfinishedExpression($1)); + let rightExpr = $2 + let mFull = rhs2 parseState 1 2 + mkQualTypeAccess mFull rightExpr } - | atomicExpr + | atomicExpr { let arg, _ = $1 arg } @@ -4286,9 +4307,11 @@ atomicExpr: if not (IsValidPrefixOperatorUse $1) then reportParseErrorAt arg2.Range (FSComp.SR.parsInvalidPrefixOperator()) mkSynPrefixPrim (rhs parseState 1) (unionRanges (rhs parseState 1) arg2.Range) $1 arg2, hpa2 } - | typar DOT identOrOp - { let lhsm = rhs2 parseState 1 3 - SynExpr.TyparDotIdent($1, $3, lhsm), false } + | QUOTE ident + { let id = mkSynId (lhs parseState) ($2).idText + let typar = SynTypar(id, TyparStaticReq.None, false) + let lhsm = rhs2 parseState 1 2 + SynExpr.Typar(typar, lhsm), false } | atomicExpr DOT atomicExprQualification { let arg1, hpa1 = $1 @@ -5421,7 +5444,7 @@ typar: staticallyKnownHeadTypar: | INFIX_AT_HAT_OP ident - { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedTypeParameter()); + { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.tcUnexpectedSymbolInTypeExpression($1)); let id = mkSynId (lhs parseState) ($2).idText SynTypar(id, TyparStaticReq.HeadType, false) } diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 9044b591488..84a9fb7d2db 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -522,6 +522,16 @@ Neočekávaný token v definici typu. Za typem {0} se očekává =. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' Tento přístup člena je nejednoznačný. Při vytváření objektu použijte závorky, např. (new SomeType(args)).MemberName' @@ -3122,11 +3132,6 @@ Neočekávaný celočíselný literál ve výrazu měrné jednotky - - Syntax error: unexpected type parameter specification - Chyba syntaxe: neočekávaná specifikace parametru typu - - Mismatched quotation operator name, beginning with '{0}' Neshoda v názvu operátoru citace (začíná na {0}) diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index bed4dbcd26e..4b7a9617d1f 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -522,6 +522,16 @@ Unerwartetes Token in Typdefinition. Nach Typ "{0}" wurde "=" erwartet. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' Dieser Memberzugriff ist mehrdeutig. Setzen Sie Klammern um die Objekterstellung, z. B. "(new SomeType(args)). MemberName“ @@ -3122,11 +3132,6 @@ Unerwartetes Integer-Literal in Maßeinheitenausdruck. - - Syntax error: unexpected type parameter specification - Syntaxfehler: Unerwartete Typparameterangabe. - - Mismatched quotation operator name, beginning with '{0}' Anführungszeichen-Operatorname stimmt nicht überein, beginnt mit "{0}". diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 2cdc7fd36c5..bf35169c721 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -522,6 +522,16 @@ Token inesperado en la definición de tipo. Se esperaba "=" después del tipo "{0}". + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' Este acceso de miembro es ambiguo. Use paréntesis alrededor de la creación del objeto, por ejemplo, '(nuevo AlgúnTipo(args)).NombreMiembro' @@ -3122,11 +3132,6 @@ Literal entero inesperado en una expresión de unidad de medida. - - Syntax error: unexpected type parameter specification - Error de sintaxis: especificación de parámetro de tipo inesperada. - - Mismatched quotation operator name, beginning with '{0}' Falta el elemento de clausura en un nombre de operador de expresión de código delimitada que comienza con '{0}'. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index ff8a06dd2b8..2328b01ef17 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -522,6 +522,16 @@ Jeton inattendu dans la définition de type. Signe '=' attendu après le type '{0}'. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' L’accès à ce membre est ambigu. Utilisez des parenthèses autour de la création de l’objet, par exemple' (New SomeType (args)). MemberName @@ -3122,11 +3132,6 @@ Littéral d'entier inattendu dans l'expression de l'unité de mesure - - Syntax error: unexpected type parameter specification - Erreur de syntaxe : spécification du paramètre de type inattendue - - Mismatched quotation operator name, beginning with '{0}' Incompatibilité du nom d'opérateur de quotation, qui commence par '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index b44a0a95e9d..d5b71593023 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -522,6 +522,16 @@ Token imprevisto nella definizione del tipo. Dopo il tipo '{0}' è previsto '='. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' L'accesso ai membri è ambiguo. Utilizzare le parentesi intorno alla creazione oggetto, ad esempio “(New SomeType (args)). MemberName” @@ -3122,11 +3132,6 @@ Valore letterale Integer non previsto in espressione di unità di misura - - Syntax error: unexpected type parameter specification - Errore di sintassi: specifica di parametro di tipo non prevista - - Mismatched quotation operator name, beginning with '{0}' Nome operatore di quotation non corrispondente con '{0}' iniziale diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 8e752f5fee3..b48a8c0201f 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -522,6 +522,16 @@ 型定義に予期しないトークンがあります。型 '{0}' の後には '=' が必要です。 + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' このメンバーへのアクセスはあいまいです。オブジェクト作成の前後にはかっこを使用してください。例: '(new SomeType(args)).MemberName' @@ -3122,11 +3132,6 @@ 単位式に予期しない整数リテラルが見つかりました - - Syntax error: unexpected type parameter specification - 構文エラー: 予期しない型パラメーターが指定されました - - Mismatched quotation operator name, beginning with '{0}' '{0}' で始まる演算子名の引用符が対応しません diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index a12f77b9efa..9a38e145b74 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -522,6 +522,16 @@ 형식 정의에 예기치 않은 토큰이 있습니다. '{0}' 형식 뒤에 '='가 필요합니다. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' 이 구성원 액세스가 모호합니다. 개체 생성 주위에 괄호를 사용하세요. 예: '(새로운 SomeType(인수)).MemberName' @@ -3122,11 +3132,6 @@ 측정 단위 식에 예기치 않은 정수 리터럴이 있습니다. - - Syntax error: unexpected type parameter specification - 구문 오류: 예기치 않은 형식 매개 변수 지정입니다. - - Mismatched quotation operator name, beginning with '{0}' 짝이 맞지 않는 인용구 연산자 이름('{0}'(으)로 시작)입니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index eac245c47b6..902c062834d 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -522,6 +522,16 @@ Nieoczekiwany token w definicji typu. Oczekiwano znaku „=” po typie „{0}”. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' Dostęp tego elementu członkowskiego jest niejednoznaczny. W celu utworzenia obiektu użyj nawiasów, na przykład „(nowy SomeType(args)).MemberName” @@ -3122,11 +3132,6 @@ Nieoczekiwany literał całkowity w wyrażeniu jednostki miary - - Syntax error: unexpected type parameter specification - Błąd składni: nieoczekiwana specyfikacja parametru typu - - Mismatched quotation operator name, beginning with '{0}' Niezgodna nazwa operatora cytatu, począwszy od „{0}” diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 1c0320053ee..555dcb6638e 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -522,6 +522,16 @@ Token inesperado na definição de tipo. Esperava-se '=' após o tipo '{0}'. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' Este acesso de membro é ambíguo. Use parênteses em torno da criação do objeto, por exemplo, '(new SomeType(args)).MemberName''. @@ -3122,11 +3132,6 @@ Literal de inteiro inesperado na expressão de unidade de medida - - Syntax error: unexpected type parameter specification - Erro de sintaxe: especificação de parâmetro de tipo inesperada - - Mismatched quotation operator name, beginning with '{0}' Nome de operador de cotação incompatível, começando com '{0}' diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index d7bafbe7447..8dc76c182da 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -522,6 +522,16 @@ Неожиданный токен в определении типа. После типа "{0}" ожидается "=". + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' Неоднозначный доступ к этому элементу. Заключите операцию создания объекта в круглые скобки, например (new Объект(аргументы)).Элемент @@ -3122,11 +3132,6 @@ Недопустимый целочисленный литерал в выражении единицы измерения - - Syntax error: unexpected type parameter specification - Синтаксическая ошибка: недопустимая спецификация параметра типа - - Mismatched quotation operator name, beginning with '{0}' Несоответствующее имя оператора кавычки, начиная с "{0}" diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index e53eaf5c33b..26b2a81cea6 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -522,6 +522,16 @@ Tür tanımında beklenmeyen belirteç var. '{0}' türünden sonra '=' bekleniyordu. + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' Bu üye erişimi belirsiz. Lütfen nesne oluşturma etrafında parantez kullanın, örneğin '(yeni SomeType (args)).MemberName’ @@ -3122,11 +3132,6 @@ Ölçü birimi ifadesinde beklenmeyen tamsayı sabit değeri - - Syntax error: unexpected type parameter specification - Sözdizimi hatası: beklenmeyen tür parametresi belirtimi - - Mismatched quotation operator name, beginning with '{0}' '{0}' ile başlayan, eşleşmeyen alıntı işleci adı diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index ee256d0551a..b691b1b8cdf 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -522,6 +522,16 @@ 类型定义中出现意外标记。类型“{0}”后应为 "="。 + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' 此成员访问权限不明确。请在对象创建周围使用括号，例如 “(new SomeType(args)).MemberName” @@ -3122,11 +3132,6 @@ 度量单位表达式中意外的整数文本 - - Syntax error: unexpected type parameter specification - 语法错误: 意外的类型参数规范 - - Mismatched quotation operator name, beginning with '{0}' 不匹配的引用运算符名称(以“{0}”开头) diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index b55f68fe764..3b7b2b7d68b 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -522,6 +522,16 @@ 型別定義中出現非預期的權杖。類型 '{0}' 之後應該要有 '='。 + + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) + + + + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) + + This member access is ambiguous. Please use parentheses around the object creation, e.g. '(new SomeType(args)).MemberName' 此成員存取不明確。請在物件建立前後加上括弧，例如「(new SomeType(args)).MemberName」 @@ -3122,11 +3132,6 @@ 測量單位運算式中未預期的整數常值 - - Syntax error: unexpected type parameter specification - 語法錯誤: 未預期的型別參數規格 - - Mismatched quotation operator name, beginning with '{0}' 不相符的引號運算子名稱，以 '{0}' 開頭 diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx new file mode 100644 index 00000000000..df04ed03622 --- /dev/null +++ b/tests/adhoc.fsx @@ -0,0 +1,36 @@ +let legacyConcat1 (x: string) (y: string) = x ^ y +let legacyConcat2 (x: string) (y: string) = x ^y +let legacyConcat3 (x: string) (y: string) = x^ y +let legacyConcat4 (x: string) (y: string) = x^y + +type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T + +type C(c: int) = + member _.Value = c + interface IAdditionOperator with + static member op_Addition(x, y) = C(x.Value + y.Value) + +let f<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + +let f2<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.(+)(x, y) + +if f(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + +let inline f3<^T when ^T :> IAdditionOperator<^T>>(x: ^T, y: ^T) = + ^T.op_Addition(x,y) + +let inline f4<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = + ^T.op_Addition(x,y) + +let inline f5<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = + ^T.(+)(x,y) + +let inline f6<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = + x + y + +//let f7<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = +// x + y From cc574a8b284ad0255b48f62303d134ba9182ca39 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 28 Jun 2022 13:12:37 +0100 Subject: [PATCH 27/91] merge main --- src/Compiler/xlf/FSComp.txt.cs.xlf | 5 ++--- src/Compiler/xlf/FSComp.txt.de.xlf | 5 ++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 06f052c4e2f..4c85a023e07 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -522,7 +522,6 @@ Neočekávaný token v definici typu. Za typem {0} se očekává =. -<<<<<<< HEAD Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -531,11 +530,11 @@ Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) -======= + + Expecting expression Expecting expression ->>>>>>> a901fe2862dce0644ac8104d24e51e664b2d553f diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index dd2e23415e1..e7c136a10fe 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -522,7 +522,6 @@ Unerwartetes Token in Typdefinition. Nach Typ "{0}" wurde "=" erwartet. -<<<<<<< HEAD Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) Incomplete character literal (example: 'Q') or qualified type invocation (example: 'T.Name) @@ -531,11 +530,11 @@ Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) Incomplete operator expression (example a^b) or qualified type invocation (example: ^T.Name) -======= + + Expecting expression Expecting expression ->>>>>>> a901fe2862dce0644ac8104d24e51e664b2d553f From aeade7ab90ffc31c614c1d1f983dfe5efb300110 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 28 Jun 2022 13:52:45 +0100 Subject: [PATCH 28/91] fix from-end-slicing --- src/Compiler/Checking/CheckExpressions.fs | 60 ++++++++++++------- src/Compiler/Checking/MethodOverrides.fs | 6 +- src/Compiler/Facilities/prim-lexing.fs | 2 +- src/Compiler/Facilities/prim-lexing.fsi | 2 +- .../Service/FSharpParseFileResults.fs | 2 +- src/Compiler/Service/ServiceParseTreeWalk.fs | 2 +- src/Compiler/Service/ServiceParsedInputOps.fs | 2 +- src/Compiler/SyntaxTree/ParseHelpers.fs | 27 +++++---- src/Compiler/SyntaxTree/ParseHelpers.fsi | 4 +- src/Compiler/SyntaxTree/SyntaxTree.fs | 6 +- src/Compiler/SyntaxTree/SyntaxTree.fsi | 16 ++++- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 2 +- src/Compiler/pars.fsy | 38 +++--------- tests/adhoc.fsx | 8 +++ 14 files changed, 97 insertions(+), 80 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 2a16bf3950e..b04bb461368 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5417,10 +5417,6 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = TcNonControlFlowExpr env <| fun env -> TcExprThen cenv overallTy env tpenv false expr1 ((DelayedDotLookup (longId, synExpr.RangeWithoutAnyExtraDot)) :: delayed) - // 'T.Ident - | SynExpr.Typar (typar, m) -> - TcTyparExprThen cenv overallTy env tpenv typar m delayed - // expr1.[expr2] // expr1.[e21, ..., e2n] // etc. @@ -5439,6 +5435,16 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = warning(Error(FSComp.SR.tcIndexNotationDeprecated(), mDot)) TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv (Some (expr3, mOfLeftOfSet)) expr1 indexArgs delayed + // 'T.Ident + // ^T.Ident + | SynExpr.Typar (typar, m) -> + TcTyparExprThen cenv overallTy env tpenv typar m delayed + + | SynExpr.HatPrefix (rightExpr, m) -> + // Incorporate the '^' into the rightExpr, producing a nested SynExpr.Typar + let adjustedExpr = ParseHelpers.adjustHatPrefixToTyparLookup m rightExpr + TcExprThen cenv overallTy env tpenv isArg adjustedExpr delayed + | _ -> match delayed with | [] -> TcExprUndelayed cenv overallTy env tpenv synExpr @@ -5861,7 +5867,15 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = | SynExpr.MatchBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) - | SynExpr.IndexFromEnd (range=m) + // 'T.Ident + // ^T.Ident + | SynExpr.Typar (typar, m) -> + TcTyparExprThen cenv overallTy env tpenv typar m [] + + | SynExpr.HatPrefix (rightExpr, m) -> + let adjustedExpr = ParseHelpers.adjustHatPrefixToTyparLookup m rightExpr + TcExprUndelayed cenv overallTy env tpenv adjustedExpr + | SynExpr.IndexRange (range=m) -> error(Error(FSComp.SR.tcInvalidIndexerExpression(), m)) @@ -6340,26 +6354,32 @@ and TcTyparExprThen cenv overallTy env tpenv synTypar m delayed = SolveTypeAsError env.DisplayEnv cenv.css m overallTy.Commit mkThrow m overallTy.Commit (mkOne cenv.g m), tpenv -and (|IndexArgOptionalFromEnd|) indexArg = +and (|IndexArgOptionalFromEnd|) (cenv: cenv) indexArg = match indexArg with - | SynExpr.IndexFromEnd (a, m) -> (a, true, m) + | SynExpr.HatPrefix (a, m) -> + if not (cenv.g.langVersion.SupportsFeature LanguageFeature.FromEndSlicing) then + errorR (Error(FSComp.SR.fromEndSlicingRequiresVFive(), m)) + (a, true, m) | _ -> (indexArg, false, indexArg.Range) -and DecodeIndexArg indexArg = +and DecodeIndexArg cenv indexArg = match indexArg with | SynExpr.IndexRange (info1, _opm, info2, m1, m2, _) -> let info1 = match info1 with - | Some (IndexArgOptionalFromEnd (expr1, isFromEnd1, _)) -> Some (expr1, isFromEnd1) + | Some (IndexArgOptionalFromEnd cenv (expr1, isFromEnd1, _)) -> Some (expr1, isFromEnd1) | None -> None let info2 = match info2 with - | Some (IndexArgOptionalFromEnd (synExpr2, isFromEnd2, _)) -> Some (synExpr2, isFromEnd2) + | Some (IndexArgOptionalFromEnd cenv (synExpr2, isFromEnd2, _)) -> Some (synExpr2, isFromEnd2) | None -> None IndexArgRange (info1, info2, m1, m2) - | IndexArgOptionalFromEnd (expr, isFromEnd, m) -> + | IndexArgOptionalFromEnd cenv (expr, isFromEnd, m) -> IndexArgItem(expr, isFromEnd, m) +and DecodeIndexArgs cenv indexArgs = + indexArgs |> List.map (DecodeIndexArg cenv) + and (|IndexerArgs|) expr = match expr with | SynExpr.Tuple (false, argExprs, _, _) -> argExprs @@ -6367,11 +6387,11 @@ and (|IndexerArgs|) expr = and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv (setInfo: _ option) synLeftExpr indexArgs delayed = let leftExpr, leftExprTy, tpenv = TcExprOfUnknownType cenv env tpenv synLeftExpr - let expandedIndexArgs = ExpandIndexArgs (Some synLeftExpr) indexArgs + let expandedIndexArgs = ExpandIndexArgs cenv (Some synLeftExpr) indexArgs TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo (Some synLeftExpr) leftExpr leftExprTy expandedIndexArgs indexArgs delayed // Eliminate GetReverseIndex from index args -and ExpandIndexArgs (synLeftExprOpt: SynExpr option) indexArgs = +and ExpandIndexArgs cenv (synLeftExprOpt: SynExpr option) indexArgs = // xs.GetReverseIndex rank offset - 1 let rewriteReverseExpr (rank: int) (offset: SynExpr) (range: range) = @@ -6396,7 +6416,7 @@ and ExpandIndexArgs (synLeftExprOpt: SynExpr option) indexArgs = let expandedIndexArgs = indexArgs |> List.mapi ( fun pos indexerArg -> - match DecodeIndexArg indexerArg with + match DecodeIndexArg cenv indexerArg with | IndexArgItem(expr, fromEnd, range) -> [ if fromEnd then rewriteReverseExpr pos expr range else expr ] | IndexArgRange(info1, info2, range1, range2) -> @@ -6428,7 +6448,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO // Find the first type in the effective hierarchy that either has a DefaultMember attribute OR // has a member called 'Item' - let isIndex = indexArgs |> List.forall (fun indexArg -> match DecodeIndexArg indexArg with IndexArgItem _ -> true | _ -> false) + let isIndex = indexArgs |> List.forall (fun indexArg -> match DecodeIndexArg cenv indexArg with IndexArgItem _ -> true | _ -> false) let propName = if isIndex then FoldPrimaryHierarchyOfType (fun ty acc -> @@ -6459,7 +6479,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO let idxRange = indexArgs |> List.map (fun e -> e.Range) |> List.reduce unionRanges let MakeIndexParam setSliceArrayOption = - match List.map DecodeIndexArg indexArgs with + match DecodeIndexArgs cenv indexArgs with | [] -> failwith "unexpected empty index list" | [IndexArgItem _] -> SynExpr.Paren (expandedIndexArgs.Head, range0, None, idxRange) | _ -> SynExpr.Paren (SynExpr.Tuple (false, expandedIndexArgs @ Option.toList setSliceArrayOption, [], idxRange), range0, None, idxRange) @@ -6471,7 +6491,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO let info = if isArray then let fixedIndex3d4dEnabled = g.langVersion.SupportsFeature LanguageFeature.FixedIndexSlice3d4d - let indexArgs = List.map DecodeIndexArg indexArgs + let indexArgs = List.map (DecodeIndexArg cenv) indexArgs match indexArgs, setInfo with | [IndexArgItem _; IndexArgItem _], None -> Some (indexOpPath, "GetArray2D", expandedIndexArgs) | [IndexArgItem _; IndexArgItem _; IndexArgItem _;], None -> Some (indexOpPath, "GetArray3D", expandedIndexArgs) @@ -6539,7 +6559,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO | _ -> None elif isString then - match List.map DecodeIndexArg indexArgs, setInfo with + match DecodeIndexArgs cenv indexArgs, setInfo with | [IndexArgRange _], None -> Some (sliceOpPath, "GetStringSlice", expandedIndexArgs) | [IndexArgItem _], None -> Some (indexOpPath, "GetString", expandedIndexArgs) | _ -> None @@ -8243,7 +8263,7 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE isAdjacentListExpr isSugar atomicFlag synLeftExprOpt synArg && g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot -> - let expandedIndexArgs = ExpandIndexArgs synLeftExprOpt indexArgs + let expandedIndexArgs = ExpandIndexArgs cenv synLeftExprOpt indexArgs let setInfo, delayed = match delayed with | DelayedSet(expr3, _) :: rest -> Some (expr3, unionRanges leftExpr.Range synArg.Range), rest @@ -8742,7 +8762,7 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = | SynExpr.LetOrUseBang _ | SynExpr.DoBang _ | SynExpr.TraitCall _ - | SynExpr.IndexFromEnd _ + | SynExpr.HatPrefix _ | SynExpr.IndexRange _ -> false diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 80064c84d29..e54af657a39 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -741,6 +741,8 @@ module DispatchSlotChecking = yield SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, reqdProperties) ] + let IsStaticAbstractImpl (overrideBy: ValRef) = (not overrideBy.IsInstanceMember) && overrideBy.IsOverrideOrExplicitImpl + /// Check that a type definition implements all its required interfaces after processing all declarations /// within a file. let CheckImplementationRelationAtEndOfInferenceScope (infoReader : InfoReader, denv, nenv, sink, tycon: Tycon, isImplementation) = @@ -764,12 +766,10 @@ module DispatchSlotChecking = let allImpls = List.zip allReqdTys slotImplSets - let isStaticAbstract (overrideBy: ValRef) = (not overrideBy.IsInstanceMember) && overrideBy.IsOverrideOrExplicitImpl - // Find the methods relevant to implementing the abstract slots listed under the reqdType being checked. let allImmediateMembersThatMightImplementDispatchSlots = allImmediateMembers |> List.filter (fun overrideBy -> - (overrideBy.IsInstanceMember || isStaticAbstract overrideBy) // Not static OR Static in the interface + (overrideBy.IsInstanceMember || IsStaticAbstractImpl overrideBy) // Not static OR Static in the interface && overrideBy.IsVirtualMember // exclude non virtual (e.g. keep override/default). [4469] && not overrideBy.IsDispatchSlotMember) diff --git a/src/Compiler/Facilities/prim-lexing.fs b/src/Compiler/Facilities/prim-lexing.fs index 58b57ddace0..dee03bb5f7e 100644 --- a/src/Compiler/Facilities/prim-lexing.fs +++ b/src/Compiler/Facilities/prim-lexing.fs @@ -260,7 +260,7 @@ and [] internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>, reportL member _.SupportsFeature featureId = langVersion.SupportsFeature featureId - member _.CheckLanguageFeatureErrorRecover featureId range = + member _.CheckLanguageFeatureAndRecover featureId range = FSharp.Compiler.DiagnosticsLogger.checkLanguageFeatureAndRecover langVersion featureId range static member FromFunction(reportLibraryOnlyFeatures, langVersion, f: 'Char[] * int * int -> int) : LexBuffer<'Char> = diff --git a/src/Compiler/Facilities/prim-lexing.fsi b/src/Compiler/Facilities/prim-lexing.fsi index 290b48b53e8..e662c1edf37 100644 --- a/src/Compiler/Facilities/prim-lexing.fsi +++ b/src/Compiler/Facilities/prim-lexing.fsi @@ -134,7 +134,7 @@ type internal LexBuffer<'Char> = member SupportsFeature: LanguageFeature -> bool /// Logs a recoverable error if a language feature is unsupported, at the specified range. - member CheckLanguageFeatureErrorRecover: LanguageFeature -> range -> unit + member CheckLanguageFeatureAndRecover: LanguageFeature -> range -> unit /// Create a lex buffer suitable for Unicode lexing that reads characters from the given array. /// Important: does take ownership of the array. diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 25d886ed6b0..e61be0d8371 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -825,7 +825,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | Some e -> yield! walkExpr false e | None -> () - | SynExpr.IndexFromEnd (e, _) -> yield! walkExpr false e + | SynExpr.HatPrefix (e, _) -> yield! walkExpr false e | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> yield! walkExpr false e1 diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 82c73bc950a..9619abb59e0 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -670,7 +670,7 @@ module SyntaxTraversal = ] |> pick expr - | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e + | SynExpr.HatPrefix (e, _) -> traverseSynExpr e | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) -> [ diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index febfa3128f9..a4315115d7c 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -1768,7 +1768,7 @@ module ParsedInput = match expr2 with | Some e -> walkExpr e | None -> () - | SynExpr.IndexFromEnd (e, _) -> walkExpr e + | SynExpr.HatPrefix (e, _) -> walkExpr e | SynExpr.DotIndexedGet (e, args, _, _) -> walkExpr e walkExpr args diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index c3ec877a26a..03cdfe8ab4e 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -733,27 +733,28 @@ let mkSynMemberDefnGetSet ] | _ -> [] -let mkQualTypeAccess mFull rightExpr = +let adjustHatPrefixToTyparLookup mFull rightExpr = let rec take inp = match inp with - | SynExpr.Ident(typarIdent) - | SynExpr.LongIdent(false, SynLongIdent ([typarIdent], _, _), None, _) -> + | SynExpr.Ident (typarIdent) + | SynExpr.LongIdent (false, SynLongIdent ([ typarIdent ], _, _), None, _) -> let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) SynExpr.Typar(typar, mFull) - | SynExpr.LongIdent(false, SynLongIdent ((typarIdent :: items), (dotm :: dots), (_ :: itemTrivias)), None, _) -> + | SynExpr.LongIdent (false, SynLongIdent ((typarIdent :: items), (dotm :: dots), (_ :: itemTrivias)), None, _) -> let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) - let lookup = SynLongIdent (items, dots, itemTrivias) - SynExpr.DotGet (SynExpr.Typar(typar, mFull), dotm, lookup, mFull) - | SynExpr.App(ExprAtomicFlag.Atomic, false, funcExpr, argExpr, m) -> + let lookup = SynLongIdent(items, dots, itemTrivias) + SynExpr.DotGet(SynExpr.Typar(typar, mFull), dotm, lookup, mFull) + | SynExpr.App (isAtomic, false, funcExpr, argExpr, m) -> let funcExpr2 = take funcExpr - SynExpr.App (ExprAtomicFlag.Atomic, false, funcExpr2, argExpr, unionRanges funcExpr2.Range m) + SynExpr.App(isAtomic, false, funcExpr2, argExpr, unionRanges funcExpr2.Range m) | SynExpr.DotGet (leftExpr, dotm, lookup, m) -> let leftExpr2 = take leftExpr - SynExpr.DotGet (leftExpr2, dotm, lookup, m) - | SynExpr.DotIndexedGet(leftExpr, indexArg, dotm, m) -> + SynExpr.DotGet(leftExpr2, dotm, lookup, m) + | SynExpr.DotIndexedGet (leftExpr, indexArg, dotm, m) -> let leftExpr2 = take leftExpr - SynExpr.DotIndexedGet (leftExpr2, indexArg, dotm, m) + SynExpr.DotIndexedGet(leftExpr2, indexArg, dotm, m) | _ -> - reportParseErrorAt mFull (FSComp.SR.parsIncompleteTyparExpr2()) - arbExpr("hatExpr1", mFull) + reportParseErrorAt mFull (FSComp.SR.parsIncompleteTyparExpr2 ()) + arbExpr ("hatExpr1", mFull) + take rightExpr diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi index 73bc97e28f1..5e1826ff34d 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fsi +++ b/src/Compiler/SyntaxTree/ParseHelpers.fsi @@ -176,5 +176,5 @@ val mkSynMemberDefnGetSet: rangeStart: range -> SynMemberDefn list -/// Incorporate a '^' for an qualified type access -val mkQualTypeAccess: mFull: range -> rightExpr: SynExpr -> SynExpr +/// Incorporate a '^' for an qualified access to a generic type parameter +val adjustHatPrefixToTyparLookup: mFull: range -> rightExpr: SynExpr -> SynExpr diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 2179bf3736a..eebe55d311d 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -510,7 +510,7 @@ type SynExpr = | IndexRange of expr1: SynExpr option * opm: range * expr2: SynExpr option * range1: range * range2: range * range: range - | IndexFromEnd of expr: SynExpr * range: range + | HatPrefix of expr: SynExpr * range: range | ComputationExpr of hasSeqBuilder: bool * expr: SynExpr * range: range @@ -738,7 +738,7 @@ type SynExpr = | SynExpr.LibraryOnlyILAssembly (range = m) | SynExpr.LibraryOnlyStaticOptimization (range = m) | SynExpr.IndexRange (range = m) - | SynExpr.IndexFromEnd (range = m) + | SynExpr.HatPrefix (range = m) | SynExpr.TypeTest (range = m) | SynExpr.Upcast (range = m) | SynExpr.AddressOf (range = m) @@ -759,7 +759,7 @@ type SynExpr = | SynExpr.InterpolatedString (range = m) | SynExpr.Dynamic (range = m) -> m | SynExpr.Ident id -> id.idRange - | SynExpr.Typar(range = m) -> m + | SynExpr.Typar (range = m) -> m | SynExpr.DebugPoint (_, _, innerExpr) -> innerExpr.Range member e.RangeWithoutAnyExtraDot = diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 47f5f4fdf8a..c6b7981ca17 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -613,8 +613,13 @@ type SynExpr = range2: range * range: range - /// F# syntax: ^expr - | IndexFromEnd of expr: SynExpr * range: range + /// F# syntax: ^expr, used for from-end-of-collection indexing and ^T.Operation + /// + /// NOTE: In the case of ^T.ident the Typar node is not initially in the tree as produced by the parser, + /// but rather is a HatPrefix node that is then processed using adjustHatPrefixToTyparLookup + /// when in arbitrary expression position. If ^expr occurs in index/slicing position then it is not processed + /// and the node is interpreted as from-the-end-indexing. + | HatPrefix of expr: SynExpr * range: range /// F# syntax: { expr } | ComputationExpr of hasSeqBuilder: bool * expr: SynExpr * range: range @@ -727,7 +732,12 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia - /// F# syntax: ^T (for ^T.ident) or (for 'T.ident) + /// F# syntax: ^T (for ^T.ident) or (for 'T.ident). + /// + /// NOTE: In the case of ^T.ident the Typar node is not initially in the tree as produced by the parser, + /// but rather is a HatPrefix node that is then processed using adjustHatPrefixToTyparLookup + /// when in arbitrary expression position. If ^expr occurs in index/slicing position then it is not processed + /// and the node is interpreted as from-the-end-indexing. | Typar of typar: SynTypar * range: range /// F# syntax: ident diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index d191fab66ea..3060beb31eb 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -968,7 +968,7 @@ let rec synExprContainsError inpExpr = | Some e -> walkExpr e | None -> false) - | SynExpr.IndexFromEnd (e, _) -> walkExpr e + | SynExpr.HatPrefix (e, _) -> walkExpr e | SynExpr.DotIndexedGet (e1, indexArgs, _, _) -> walkExpr e1 || walkExpr indexArgs diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 28257889809..e9ec201571b 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -681,7 +681,7 @@ signatureFile: moduleIntro: | moduleKeyword opt_attributes opt_access opt_rec path { if not (isNil $2) then - parseState.LexBuffer.CheckLanguageFeatureErrorRecover LanguageFeature.AttributesToRightOfModuleKeyword <| rhs parseState 4 + parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.AttributesToRightOfModuleKeyword (rhs parseState 4) let mModule = rhs parseState 1 mModule, $4, $5.LongIdent, $3, $2 } @@ -1875,11 +1875,13 @@ abstractMemberFlags: let mMember = rhs parseState 2 AbstractMemberFlags true (AbstractMemberSynMemberFlagsTrivia mAbstract mMember) } | STATIC ABSTRACT - { let mStatic = rhs parseState 1 + { parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers (rhs2 parseState 1 2) + let mStatic = rhs parseState 1 let mAbstract = rhs parseState 2 AbstractMemberFlags false (StaticAbstractSynMemberFlagsTrivia mStatic mAbstract) } | STATIC ABSTRACT MEMBER - { let mStatic = rhs parseState 1 + { parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers (rhs2 parseState 1 2) + let mStatic = rhs parseState 1 let mAbstract = rhs parseState 2 let mMember = rhs parseState 3 AbstractMemberFlags false (StaticAbstractMemberSynMemberFlagsTrivia mStatic mAbstract mMember) } @@ -4018,14 +4020,10 @@ declExpr: { let m = rhs parseState 1 SynExpr.IndexRange(None, m, None, m, m, m) } -/* - | INFIX_AT_HAT_OP declExpr - { if not (parseState.LexBuffer.SupportsFeature LanguageFeature.FromEndSlicing) then - raiseParseErrorAt (rhs parseState 1) (FSComp.SR.fromEndSlicingRequiresVFive()) - if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator()) + | INFIX_AT_HAT_OP declExpr %prec infix_at_hat_op_prefix + { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator()) let m = (rhs2 parseState 1 2) - SynExpr.IndexFromEnd($2, m) } -*/ + SynExpr.HatPrefix($2, m) } | minusExpr %prec expr_prefix_plus_minus { $1 } @@ -4266,26 +4264,6 @@ minusExpr: appExpr: | appExpr argExpr %prec expr_app { SynExpr.App (ExprAtomicFlag.NonAtomic, false, $1, $2, unionRanges $1.Range $2.Range) } -/* - | INFIX_AT_HAT_OP atomicExpr - { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnfinishedExpression($1)); - match $2 with - | SynExpr.LongIdent(false, SynLongIdent ([typarIdent; rightIdent], [dotm], [_; rightTrivia]), None, m), _ -> - let rightId = SynIdent (rightIdent, rightTrivia) - let typar = SynTypar(typarIdent, TyparStaticReq.HeadType, false) - let typarRange = unionRanges (rhs parseState 1) m - SynExpr.TyparDotIdent(typar, dotm, rightId, typarRange) - | _ -> - reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedHatExpr()); - let m = rhs2 parseState 1 2 - arbExpr("hatExpr1", m) } -*/ - - | INFIX_AT_HAT_OP appExpr %prec infix_at_hat_op_prefix - { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnfinishedExpression($1)); - let rightExpr = $2 - let mFull = rhs2 parseState 1 2 - mkQualTypeAccess mFull rightExpr } | atomicExpr { let arg, _ = $1 diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index df04ed03622..71a5cd0d1a2 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -3,6 +3,14 @@ let legacyConcat2 (x: string) (y: string) = x ^y let legacyConcat3 (x: string) (y: string) = x^ y let legacyConcat4 (x: string) (y: string) = x^y +let testSlicingOne() = + let arr = [| 1;2;3;4;5 |] + arr.[^3..] + +let testSlicingTwo() = + let arr = [| 1;2;3;4;5 |] + arr[^3..] + type IAdditionOperator<'T> = static abstract op_Addition: 'T * 'T -> 'T From 85e3997e7b443d704d09fcfaf40fc02364bbaf93 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 29 Jun 2022 03:09:35 +0100 Subject: [PATCH 29/91] Self constraints; Disallow ^T; Full test matrix for propery SRTP constraints with some fixes; Full review of matching on items --- .../Checking/CheckComputationExpressions.fs | 2 +- src/Compiler/Checking/CheckExpressions.fs | 166 +++++++++--- src/Compiler/Checking/ConstraintSolver.fs | 34 ++- src/Compiler/Checking/InfoReader.fs | 80 ++++-- src/Compiler/Checking/InfoReader.fsi | 9 +- src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/Checking/NameResolution.fs | 56 +++- src/Compiler/Checking/NicePrint.fs | 38 ++- src/Compiler/Checking/QuotationTranslator.fs | 5 +- src/Compiler/Checking/infos.fs | 134 +++++----- src/Compiler/Checking/infos.fsi | 8 +- src/Compiler/CodeGen/IlxGen.fs | 14 +- src/Compiler/Driver/CompilerDiagnostics.fs | 3 +- src/Compiler/FSComp.txt | 10 +- src/Compiler/Facilities/LanguageFeatures.fs | 5 +- src/Compiler/Facilities/LanguageFeatures.fsi | 1 + src/Compiler/Service/FSharpCheckerResults.fs | 61 +++-- .../Service/FSharpParseFileResults.fs | 2 +- src/Compiler/Service/ItemKey.fs | 30 ++- .../Service/SemanticClassification.fs | 143 +++++------ .../Service/ServiceDeclarationLists.fs | 106 ++++++-- src/Compiler/Service/ServiceParseTreeWalk.fs | 2 +- src/Compiler/Service/ServiceParsedInputOps.fs | 5 +- src/Compiler/Symbols/Exprs.fs | 10 +- src/Compiler/Symbols/SymbolHelpers.fs | 228 +++++++++++++---- src/Compiler/Symbols/SymbolHelpers.fsi | 2 +- src/Compiler/SyntaxTree/ParseHelpers.fs | 8 + src/Compiler/SyntaxTree/SyntaxTree.fs | 7 +- src/Compiler/SyntaxTree/SyntaxTree.fsi | 9 +- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 10 +- src/Compiler/TypedTree/TypedTree.fs | 29 +-- src/Compiler/TypedTree/TypedTree.fsi | 29 ++- src/Compiler/TypedTree/TypedTreeOps.fs | 135 +++++++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 18 ++ src/Compiler/pars.fsy | 18 +- src/Compiler/xlf/FSComp.txt.cs.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.de.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.es.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.fr.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.it.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.ja.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.ko.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.pl.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.ru.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.tr.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 40 ++- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 40 ++- tests/adhoc.fsx | 240 +++++++++++++++++- 50 files changed, 1714 insertions(+), 467 deletions(-) diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index ee42cc97fbe..ee05991128f 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -468,7 +468,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol match info with | None -> false | Some args -> - args |> List.exists (fun (isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo) -> isParamArrayArg || isOutArg || optArgInfo.IsOptional)) + args |> List.exists (fun (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo)) -> isParamArrayArg || isOutArg || optArgInfo.IsOptional)) else false diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index b04bb461368..9cf0e5eacd7 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4205,6 +4205,26 @@ let rec TcTyparConstraint ridx cenv newOk checkConstraints occ (env: TcEnv) tpen | SynTypeConstraint.WhereTyparSupportsMember(synSupportTys, synMemberSig, m) -> TcConstraintWhereTyparSupportsMember cenv env newOk tpenv synSupportTys synMemberSig m + | SynTypeConstraint.WhereSelfConstrained(ty, m) -> + checkLanguageFeatureAndRecover g.langVersion LanguageFeature.SelfTypeConstraints m + let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType env tpenv ty + match tyR with + | TType_app(tcref, tinst, _) when (tcref.IsTypeAbbrev && (isTyparTy g tcref.TypeAbbrev.Value) && tinst |> List.forall (isTyparTy g)) -> + match checkConstraints with + | NoCheckCxs -> + //let formalEnclosingTypars = [] + let tpsorig = tcref.Typars(m) //List.map (destTyparTy g) inst //, _, tinst, _ = FreshenTyconRef2 g m tcref + let tps = List.map (destTyparTy g) tinst //, _, tinst, _ = FreshenTyconRef2 g m tcref + let tprefInst, _tptys = mkTyparToTyparRenaming tpsorig tps + //let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming + (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (tp.Constraints @ CopyTyparConstraints m tprefInst tporig)) + | CheckCxs -> () + | AppTy g (_tcref, selfTy :: _rest) when isTyparTy g selfTy && isInterfaceTy g tyR -> + AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace tyR selfTy + | _ -> + errorR(Error(FSComp.SR.tcInvalidSelfConstraint(), m)) + tpenv + and TcConstraintWhereTyparIsEnum cenv env newOk checkConstraints tpenv tp synUnderlingTys m = let tpR, tpenv = TcTypar cenv env newOk tpenv tp let tpenv = @@ -4270,7 +4290,16 @@ and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let argTys = List.concat curriedArgInfos let argTys = List.map fst argTys let logicalCompiledName = ComputeLogicalName id memberFlags - + for argInfos in curriedArgInfos do + for argInfo in argInfos do + let info = CrackParamAttribsInfo g argInfo + let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info + if isParamArrayArg || isInArg || isOutArg || optArgInfo.IsOptional || callerInfo <> CallerInfo.NoCallerInfo || reflArgInfo <> ReflectedArgInfo.None then + if g.langVersion.SupportsFeature(LanguageFeature.InterfacesWithAbstractStaticMembers) then + errorR(Error(FSComp.SR.tcTraitMayNotUseComplexThings(), m)) + else + warning(Error(FSComp.SR.tcTraitMayNotUseComplexThings(), m)) + let item = Item.ArgName (id, memberConstraintTy, None) CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) @@ -5059,7 +5088,7 @@ and TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref pathTypeArgs (sy if checkConstraints = CheckCxs then List.iter2 (UnifyTypes cenv env m) tinst actualArgTys - // Try to decode System.Tuple --> F~ tuple types etc. + // Try to decode System.Tuple --> F# tuple types etc. let ty = g.decompileType tcref actualArgTys ty, tpenv @@ -5435,12 +5464,13 @@ and TcExprThen cenv overallTy env tpenv isArg synExpr delayed = warning(Error(FSComp.SR.tcIndexNotationDeprecated(), mDot)) TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv (Some (expr3, mOfLeftOfSet)) expr1 indexArgs delayed - // 'T.Ident - // ^T.Ident + // Part of 'T.Ident | SynExpr.Typar (typar, m) -> TcTyparExprThen cenv overallTy env tpenv typar m delayed - | SynExpr.HatPrefix (rightExpr, m) -> + // ^expr + | SynExpr.IndexFromEnd (rightExpr, m) -> + errorR(Error(FSComp.SR.tcTraitInvocationShouldUseTick(), m)) // Incorporate the '^' into the rightExpr, producing a nested SynExpr.Typar let adjustedExpr = ParseHelpers.adjustHatPrefixToTyparLookup m rightExpr TcExprThen cenv overallTy env tpenv isArg adjustedExpr delayed @@ -5867,12 +5897,12 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = | SynExpr.MatchBang (range=m) -> error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) - // 'T.Ident - // ^T.Ident + // Part of 'T.Ident | SynExpr.Typar (typar, m) -> TcTyparExprThen cenv overallTy env tpenv typar m [] - | SynExpr.HatPrefix (rightExpr, m) -> + | SynExpr.IndexFromEnd (rightExpr, m) -> + errorR(Error(FSComp.SR.tcTraitInvocationShouldUseTick(), m)) let adjustedExpr = ParseHelpers.adjustHatPrefixToTyparLookup m rightExpr TcExprUndelayed cenv overallTy env tpenv adjustedExpr @@ -6210,11 +6240,11 @@ and TcExprTraitCall cenv overallTy env tpenv (tps, synMemberSig, arg, m) = TcNonPropagatingExprLeafThenConvert cenv overallTy env m (fun () -> let synTypes = tps |> List.map (fun tp -> SynType.Var(tp, m)) let traitInfo, tpenv = TcPseudoMemberSpec cenv NewTyparsOK env synTypes tpenv synMemberSig m - if BakedInTraitConstraintNames.Contains traitInfo.MemberName then - warning(BakedInMemberConstraintName(traitInfo.MemberName, m)) + if BakedInTraitConstraintNames.Contains traitInfo.MemberLogicalName then + warning(BakedInMemberConstraintName(traitInfo.MemberLogicalName, m)) - let argTys = traitInfo.ArgumentTypes - let returnTy = GetFSharpViewOfReturnType g traitInfo.ReturnType + let argTys = traitInfo.CompiledObjectAndArgumentTypes + let returnTy = traitInfo.GetReturnType g let args, namedCallerArgs = GetMethodArgs arg if not (isNil namedCallerArgs) then errorR(Error(FSComp.SR.tcNamedArgumentsCannotBeUsedInMemberTraits(), m)) // Subsumption at trait calls if arguments have nominal type prior to unification of any arguments or return type @@ -6332,6 +6362,8 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = and TcTyparExprThen cenv overallTy env tpenv synTypar m delayed = match delayed with + //'T .Ident + //^T .Ident (args) .. | DelayedDotLookup (ident :: rest, m2) :: delayed2 -> let ad = env.eAccessRights let tp, tpenv = TcTypar cenv env NoNewTypars tpenv synTypar @@ -6350,13 +6382,11 @@ and TcTyparExprThen cenv overallTy env tpenv synTypar m delayed = match q with | TyparStaticReq.None -> FSComp.SR.parsIncompleteTyparExpr1() | TyparStaticReq.HeadType -> FSComp.SR.parsIncompleteTyparExpr2() - errorR (Error(msg, m)) - SolveTypeAsError env.DisplayEnv cenv.css m overallTy.Commit - mkThrow m overallTy.Commit (mkOne cenv.g m), tpenv + error (Error(msg, m)) and (|IndexArgOptionalFromEnd|) (cenv: cenv) indexArg = match indexArg with - | SynExpr.HatPrefix (a, m) -> + | SynExpr.IndexFromEnd (a, m) -> if not (cenv.g.langVersion.SupportsFeature LanguageFeature.FromEndSlicing) then errorR (Error(FSComp.SR.fromEndSlicingRequiresVFive(), m)) (a, true, m) @@ -8326,7 +8356,7 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte TcMethodItemThen cenv overallTy env item methodName minfos tpenv mItem afterResolution staticTyOpt delayed | Item.Trait traitInfo -> - TcTraitItemThen cenv overallTy env traitInfo tpenv mItem delayed + TcTraitItemThen cenv overallTy env None traitInfo tpenv mItem delayed | Item.CtorGroup(nm, minfos) -> TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem afterResolution delayed @@ -8362,7 +8392,19 @@ and TcItemThen cenv (overallTy: OverallTy) env tpenv (tinstEnclosing, item, mIte | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly nm, mItem)) | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm, usageText), mItem)) - | _ -> error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) + // These items are not expected here - they are only used for reporting symbols from name resolution to language service + | Item.ActivePatternCase _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.CustomBuilder _ + | Item.ModuleOrNamespaces _ + | Item.NewDef _ + | Item.SetterArg _ + | Item.TypeVar _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Types(_, []) -> + error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) /// Type check the application of a union case. Also used to cover constructions of F# exception values, and /// applications of active pattern result labels. @@ -8644,22 +8686,57 @@ and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [] mItem delayed (Some afterResolution) -and TcTraitItemThen cenv overallTy env traitInfo tpenv mItem delayed = +and TcTraitItemThen cenv overallTy env objOpt traitInfo tpenv mItem delayed = let g = cenv.g - let retTy = traitInfo.ReturnType |> Option.defaultValue g.unit_ty + let argTys = traitInfo.GetLogicalArgumentTypes(g) + let retTy = traitInfo.GetReturnType(g) + + match objOpt, traitInfo.MemberFlags.IsInstance with + | Some _, false -> error (Error (FSComp.SR.tcTraitIsStatic traitInfo.MemberDisplayNameCore, mItem)) + | None, true -> error (Error (FSComp.SR.tcTraitIsNotStatic traitInfo.MemberDisplayNameCore, mItem)) + | _ -> () + + // If this is an instance trait the object must be evaluated, just in case this is a first-class use of the trait, e.g. + // (Compute()).SomeMethod --> + // let obj = Compute() in (fun arg -> SomeMethod(arg)) + // (Compute()).SomeMethod(3) --> + // let obj = Compute() in (fun arg -> SomeMethod(arg)) 3 + let wrapper, objArgs = + match argTys with + | [] -> + id, Option.toList objOpt + | _ -> + match objOpt with + | None -> + id, [] + | Some objExpr -> + // Evaluate the object first + let objVal, objValExpr = mkCompGenLocal mItem "obj" (tyOfExpr g objExpr) + mkCompGenLet mItem objVal objExpr, [objValExpr] // Build a lambda for the trait call - let vs, ves = traitInfo.ArgumentTypes |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip - let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) - let v, body = MultiLambdaToTupledLambda g vs expr - let expr = mkLambda mItem v (body, retTy) + let expr = + // Empty arguments indicates a non-indexer property constraint + match argTys with + | [] -> + Expr.Op (TOp.TraitCall traitInfo, [], objArgs, mItem) + | _ -> + let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip + let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) + let v, body = MultiLambdaToTupledLambda g vs expr + mkLambda mItem v (body, retTy) // Propagate the types from the known application structure - Propagate cenv overallTy env tpenv (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) delayed + let applicableExpr = MakeApplicableExprNoFlex cenv expr + + Propagate cenv overallTy env tpenv applicableExpr (tyOfExpr g expr) delayed // Check and apply the arguments - TcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) (tyOfExpr g expr) ExprAtomicFlag.NonAtomic delayed + let resExpr, tpenv = TcDelayed cenv overallTy env tpenv mItem applicableExpr (tyOfExpr g expr) ExprAtomicFlag.NonAtomic delayed + + // Aply the wrapper to pre-evaluate the object if any + wrapper resExpr, tpenv and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = let g = cenv.g @@ -8762,7 +8839,7 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = | SynExpr.LetOrUseBang _ | SynExpr.DoBang _ | SynExpr.TraitCall _ - | SynExpr.HatPrefix _ + | SynExpr.IndexFromEnd _ | SynExpr.IndexRange _ -> false @@ -9153,8 +9230,31 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed // Instance IL event (fake up event-as-value) TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem (Some(objExpr, objExprTy)) einfo delayed + | Item.Trait traitInfo -> + TcTraitItemThen cenv overallTy env (Some objExpr) traitInfo tpenv mItem delayed + | Item.FakeInterfaceCtor _ | Item.DelegateCtor _ -> error (Error (FSComp.SR.tcConstructorsCannotBeFirstClassValues(), mItem)) - | _ -> error (Error (FSComp.SR.tcSyntaxFormUsedOnlyWithRecordLabelsPropertiesAndFields(), mItem)) + + // These items are not expected here - they can't be the result of a instance member dot-lookup "expr.Ident" + | Item.ActivePatternResult _ + | Item.CustomOperation _ + | Item.CtorGroup _ + | Item.ExnCase _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.TypeVar _ + | Item.Types _ + | Item.UnionCase _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Value _ + // These items are not expected here - they are only used for reporting symbols from name resolution to language service + | Item.NewDef _ + | Item.SetterArg _ + | Item.CustomBuilder _ + | Item.ArgName _ + | Item.ActivePatternCase _ -> + error (Error (FSComp.SR.tcSyntaxFormUsedOnlyWithRecordLabelsPropertiesAndFields(), mItem)) // Instance IL event (fake up event-as-value) and TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einfo: EventInfo) delayed = @@ -9280,7 +9380,8 @@ and CalledMethHasSingleArgumentGroupOfThisLength n (calledMeth: MethInfo) = | [argAttribs] -> argAttribs = n | _ -> false -and isSimpleFormalArg (isParamArrayArg, _isInArg, isOutArg, optArgInfo: OptionalArgInfo, callerInfo: CallerInfo, _reflArgInfo: ReflectedArgInfo) = +and isSimpleFormalArg info = + let (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, callerInfo, _reflArgInfo)) = info not isParamArrayArg && not isOutArg && not optArgInfo.IsOptional && callerInfo = NoCallerInfo and GenerateMatchingSimpleArgumentTypes cenv (calledMeth: MethInfo) mItem = @@ -11171,7 +11272,12 @@ and AnalyzeRecursiveStaticMemberOrValDecl match tcrefContainerInfo, memberFlagsOpt with | Some(MemberOrValContainerInfo(tcref, intfSlotTyOpt, _, _, declaredTyconTypars)), Some memberFlags - when memberFlags.MemberKind = SynMemberKind.Member && + when (match memberFlags.MemberKind with + | SynMemberKind.Member -> true + | SynMemberKind.PropertyGet -> true + | SynMemberKind.PropertySet -> true + | SynMemberKind.PropertyGetSet -> true + | _ -> false) && not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl -> diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 3bfcaa5643a..dd89b76c6be 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1370,11 +1370,13 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let (TTrait(tys, nm, memFlags, traitObjAndArgTys, retTy, sln)) = traitInfo // Do not re-solve if already solved if sln.Value.IsSome then return true else + let g = csenv.g let m = csenv.m let amap = csenv.amap let aenv = csenv.EquivEnv let denv = csenv.DisplayEnv + let ndeep = ndeep + 1 do! DepthCheck ndeep m @@ -1390,10 +1392,27 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload match tys, traitObjAndArgTys with | [ty], h :: _ -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) + // Trait calls are only supported on pseudo type (variables) for e in tys do do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType e + // SRTP constraints on rigid type parameters do not need to be solved - they are simply declared + let isRigid = + tys |> List.forall (fun ty -> + match tryDestTyparTy g ty with + | ValueSome tp -> + match tp.Rigidity with + | TyparRigidity.Rigid + | TyparRigidity.WillBeRigid -> true + | _ -> false + | ValueNone -> false) + + if isRigid then + do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo CompleteD + return false + else + let argTys = if memFlags.IsInstance then List.tail traitObjAndArgTys else traitObjAndArgTys let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo @@ -1650,7 +1669,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let propName = nm[4..] let props = tys |> List.choose (fun ty -> - match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere) FindMemberFlag.IgnoreOverrides m ty with + match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty with | Some (RecdFieldItem rfinfo) when (isGetProp || rfinfo.RecdField.IsMutable) && (rfinfo.IsStatic = not memFlags.IsInstance) && @@ -1760,6 +1779,15 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitSolved (minfo, calledMeth.CalledTyArgs) | _ -> + do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors + return TTraitUnsolved + } + return! RecordMemberConstraintSolution csenv.SolverState m trace traitInfo res + } + +and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors = + trackErrors { + let nm = traitInfo.MemberLogicalName let support = GetSupportOfMemberConstraint csenv traitInfo let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo @@ -1780,9 +1808,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload (not (nm = "op_Explicit" || nm = "op_Implicit")) -> return! ErrorD AbortForFailedMemberConstraintResolution | _ -> - return TTraitUnsolved - } - return! RecordMemberConstraintSolution csenv.SolverState m trace traitInfo res + () } /// Record the solution to a member constraint in the mutable reference cell attached to diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index ede041b899f..b206d77157c 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -97,25 +97,46 @@ let GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty = /// Query the immediate methods of an F# type, not taking into account inherited methods. The optFilter /// parameter is an optional name to restrict the set of properties returned. -let GetImmediateTraitsInfosOfType (optFilter, _ad) g ty = +let GetImmediateTraitsInfosOfType optFilter g ty = match tryDestTyparTy g ty with | ValueSome tp -> let infos = GetTraitConstraintInfosOfTypars g [tp] - let infos = - match optFilter with - | None -> infos - | Some nm -> - infos |> List.filter (fun traitInfo -> - let traitName0 = traitInfo.MemberName - let traitName1 = - match traitInfo.MemberFlags.MemberKind with - | SynMemberKind.PropertyGet -> - match PrettyNaming.TryChopPropertyName traitName0 with - | Some nm -> nm - | None -> traitName0 - | _ -> traitName0 - (nm = traitName0) || (nm = traitName1)) - infos + match optFilter with + | None -> + [ for traitInfo in infos do + match traitInfo.MemberFlags.MemberKind with + | SynMemberKind.PropertySet -> + // A setter property trait only can be utilized via + // ^T.set_Property(v) + traitInfo.WithMemberKind(SynMemberKind.Member) + | _ -> + traitInfo ] + | Some nm -> + [ for traitInfo in infos do + match traitInfo.MemberFlags.MemberKind with + | SynMemberKind.PropertyGet -> + // A getter property trait can be utilized via + // ^T.Property + // ^T.get_Property() + // The latter doesn't appear in intellisense + if nm = traitInfo.MemberDisplayNameCore then + traitInfo + let traitInfo2 = traitInfo.WithMemberKind(SynMemberKind.Member) + if nm = traitInfo2.MemberDisplayNameCore then + traitInfo2 + | SynMemberKind.PropertySet -> + // A setter property trait only can be utilized via + // ^T.set_Property(v) + let traitInfo2 = traitInfo.WithMemberKind(SynMemberKind.Member) + if nm = traitInfo2.MemberDisplayNameCore then + traitInfo2 + | _ -> + // Method traits can be utilized via + // ^T.Member(v) + if nm = traitInfo.MemberDisplayNameCore then + traitInfo + ] + | _ -> [] @@ -418,11 +439,11 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = FoldPrimaryHierarchyOfType (fun ty acc -> ty :: acc) g amap m allowMultiIntfInst ty [] /// The primitive reader for the named items up a hierarchy - let GetIntrinsicNamedItemsUncached ((nm, ad), m, ty) = + let GetIntrinsicNamedItemsUncached ((nm, ad, includeConstraints), m, ty) = if nm = ".ctor" then None else // '.ctor' lookups only ever happen via constructor syntax let optFilter = Some nm FoldPrimaryHierarchyOfType (fun ty acc -> - let qinfos = GetImmediateTraitsInfosOfType (optFilter, ad) g ty + let qinfos = if includeConstraints then GetImmediateTraitsInfosOfType optFilter g ty else [] let minfos = GetImmediateIntrinsicMethInfosOfType (optFilter, ad) g amap m ty let pinfos = GetImmediateIntrinsicPropInfosOfType (optFilter, ad) g amap m ty let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter, ad) m ty @@ -689,9 +710,11 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member _.Equals((filter1, ad1), (filter2, ad2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g, ad1, ad2) } let hashFlags2 = - { new System.Collections.Generic.IEqualityComparer with - member _.GetHashCode((nm: string, ad: AccessorDomain)) = hash nm + AccessorDomain.CustomGetHashCode ad - member _.Equals((nm1, ad1), (nm2, ad2)) = (nm1 = nm2) && AccessorDomain.CustomEquals(g, ad1, ad2) } + { new System.Collections.Generic.IEqualityComparer with + member _.GetHashCode((nm: string, ad: AccessorDomain, includeConstraints)) = + hash nm + AccessorDomain.CustomGetHashCode ad + hash includeConstraints + member _.Equals((nm1, ad1, includeConstraints1), (nm2, ad2, includeConstraints2)) = + (nm1 = nm2) && AccessorDomain.CustomEquals(g, ad1, ad2) && (includeConstraints1 = includeConstraints2) } let hashFlags3 = { new System.Collections.Generic.IEqualityComparer with @@ -769,8 +792,8 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = | _ -> failwith "unexpected multiple fields with same name" // Because it should have been already reported as duplicate fields /// Try and find an item with the given name in a type. - member _.TryFindNamedItemOfType (nm, ad, m, ty) = - namedItemsCache.Apply(((nm, ad), m, ty)) + member _.TryFindNamedItemOfType ((nm, ad, includeConstraints), m, ty) = + namedItemsCache.Apply(((nm, ad, includeConstraints), m, ty)) /// Read the raw method sets of a type that are the most specific overrides. Cache the result for monomorphic types member _.GetIntrinsicMostSpecificOverrideMethodSetsOfType (optFilter, ad, allowMultiIntfInst, m, ty) = @@ -853,8 +876,11 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member infoReader.GetIntrinsicPropInfosOfType optFilter ad allowMultiIntfInst findFlag m ty = infoReader.GetIntrinsicPropInfoSetsOfType optFilter ad allowMultiIntfInst findFlag m ty |> List.concat - member infoReader.TryFindIntrinsicNamedItemOfType (nm, ad) findFlag m ty = - match infoReader.TryFindNamedItemOfType(nm, ad, m, ty) with + member _.GetTraitInfosInType optFilter ty = + GetImmediateTraitsInfosOfType optFilter g ty + + member infoReader.TryFindIntrinsicNamedItemOfType (nm, ad, includeConstraints) findFlag m ty = + match infoReader.TryFindNamedItemOfType((nm, ad, includeConstraints), m, ty) with | Some item -> match item with | PropertyItem psets -> Some(PropertyItem (psets |> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m)) @@ -900,8 +926,8 @@ let GetIntrinsicMethInfosOfType (infoReader: InfoReader) optFilter ad allowMulti let GetIntrinsicPropInfosOfType (infoReader: InfoReader) optFilter ad allowMultiIntfInst findFlag m ty = infoReader.GetIntrinsicPropInfosOfType optFilter ad allowMultiIntfInst findFlag m ty -let TryFindIntrinsicNamedItemOfType (infoReader: InfoReader) (nm, ad) findFlag m ty = - infoReader.TryFindIntrinsicNamedItemOfType (nm, ad) findFlag m ty +let TryFindIntrinsicNamedItemOfType (infoReader: InfoReader) (nm, ad, includeConstraints) findFlag m ty = + infoReader.TryFindIntrinsicNamedItemOfType (nm, ad, includeConstraints) findFlag m ty let TryFindIntrinsicMethInfo (infoReader: InfoReader) m ad nm ty = infoReader.TryFindIntrinsicMethInfo m ad nm ty diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index d80874218fc..e9d233e4488 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -151,7 +151,10 @@ type InfoReader = ty: TType -> MethInfo list list - /// Get the sets intrinsic properties in the hierarchy (not including extension properties) + /// Get the trait infos for a type variable (empty for everything else) + member GetTraitInfosInType: optFilter: string option -> ty: TType -> TraitConstraintInfo list + + /// Get the sets of intrinsic properties in the hierarchy (not including extension properties) member GetIntrinsicPropInfoSetsOfType: optFilter: string option -> ad: AccessorDomain -> @@ -183,7 +186,7 @@ type InfoReader = /// Perform type-directed name resolution of a particular named member in an F# type member TryFindIntrinsicNamedItemOfType: - nm: string * ad: AccessorDomain -> findFlag: FindMemberFlag -> m: range -> ty: TType -> HierarchyItem option + nm: string * ad: AccessorDomain * includeConstraints: bool -> findFlag: FindMemberFlag -> m: range -> ty: TType -> HierarchyItem option /// Find the op_Implicit for a type member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list @@ -247,7 +250,7 @@ val GetIntrinsicPropInfosOfType: /// Perform type-directed name resolution of a particular named member in an F# type val TryFindIntrinsicNamedItemOfType: infoReader: InfoReader -> - nm: string * ad: AccessorDomain -> + nm: string * ad: AccessorDomain * includeConstraints: bool -> findFlag: FindMemberFlag -> m: range -> ty: TType -> diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index af774415eb1..ba7eeeac219 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -2216,7 +2216,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = /// Generate a lambda expression for the given solved trait. let GenWitnessExprLambda amap g m (traitInfo: TraitConstraintInfo) = - let witnessInfo = traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() let argTysl = GenWitnessArgTys g witnessInfo let vse = argTysl |> List.mapiSquared (fun i j ty -> mkCompGenLocal m ("arg" + string i + "_" + string j) ty) let vsl = List.mapSquared fst vse diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 4215bb5eabb..f1f19cebaa2 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -266,18 +266,26 @@ type Item = | Item.MethodGroup(_, FSMeth(_, _, v, _) :: _, _) -> v.DisplayNameCore | Item.MethodGroup(nm, _, _) -> nm |> DecompileOpName | Item.CtorGroup(nm, _) -> nm |> DemangleGenericTypeName - | Item.FakeInterfaceCtor (AbbrevOrAppTy tcref) - | Item.DelegateCtor (AbbrevOrAppTy tcref) -> tcref.DisplayNameCore - | Item.Types(nm, _) -> nm |> DemangleGenericTypeName + | Item.FakeInterfaceCtor ty + | Item.DelegateCtor ty -> + match ty with + | AbbrevOrAppTy tcref -> tcref.DisplayNameCore + // This case is not expected + | _ -> "" | Item.UnqualifiedType(tcref :: _) -> tcref.DisplayNameCore + | Item.Types(nm, _) -> nm |> DemangleGenericTypeName | Item.TypeVar (nm, _) -> nm - | Item.Trait traitInfo -> traitInfo.MemberName + | Item.Trait traitInfo -> traitInfo.MemberDisplayNameCore | Item.ModuleOrNamespaces(modref :: _) -> modref.DisplayNameCore | Item.ArgName (id, _, _) -> id.idText | Item.SetterArg (id, _) -> id.idText | Item.CustomOperation (customOpName, _, _) -> customOpName | Item.CustomBuilder (nm, _) -> nm - | _ -> "" + | Item.ImplicitOp (id, _) -> id.idText + //| _ -> "" + // These singleton cases are not expected + | Item.ModuleOrNamespaces [] -> "" + | Item.UnqualifiedType [] -> "" member d.DisplayName = match d with @@ -1776,9 +1784,6 @@ let ItemsAreEffectivelyEqual g orig other = | EntityUse ty1, EntityUse ty2 -> tyconRefDefnEq g ty1 ty2 - | Item.Trait traitInfo1, Item.Trait traitInfo2 -> - traitInfo1.MemberName = traitInfo2.MemberName - | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> nm1 = nm2 && (typeEquiv g (mkTyparTy tp1) (mkTyparTy tp2) || @@ -1841,6 +1846,9 @@ let ItemsAreEffectivelyEqual g orig other = | Item.ModuleOrNamespaces modrefs1, Item.ModuleOrNamespaces modrefs2 -> modrefs1 |> List.exists (fun modref1 -> modrefs2 |> List.exists (fun r -> tyconRefDefnEq g modref1 r || fullDisplayTextOfModRef modref1 = fullDisplayTextOfModRef r)) + | Item.Trait traitInfo1, Item.Trait traitInfo2 -> + traitInfo1.MemberLogicalName = traitInfo2.MemberLogicalName + | _ -> false /// Given the Item 'orig' - returns function 'other: Item -> bool', that will yield true if other and orig represents the same item and false - otherwise @@ -1848,7 +1856,7 @@ let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = match orig with | EntityUse tcref -> tyconRefDefnHash g tcref | Item.TypeVar (nm, _)-> hash nm - | Item.Trait traitInfo -> hash traitInfo.MemberName + | Item.Trait traitInfo -> hash traitInfo.MemberLogicalName | ValUse vref -> valRefDefnHash g vref | ActivePatternCaseUse (_, _, idx)-> hash idx | MethodUse minfo -> minfo.ComputeHashCode() @@ -2516,7 +2524,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf OneResult (success(resInfo, item, rest)) | None -> let isLookUpExpr = (lookupKind = LookupKind.Expr) - match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm, ad) findFlag m ty with + match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm, ad, true) findFlag m ty with | Some (TraitItem (traitInfo :: _)) when isLookUpExpr -> success [resInfo, Item.Trait traitInfo, rest] @@ -3920,6 +3928,11 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso x.IsStatic = statics && IsILFieldInfoAccessible g amap m ad x) + let qinfos = + ncenv.InfoReader.GetTraitInfosInType None ty + |> List.filter (fun x -> + x.MemberFlags.IsInstance = not statics) + let pinfosIncludingUnseen = AllPropInfosOfTypeInScope ResultCollectionSettings.AllResults ncenv.InfoReader nenv None ad PreferOverrides m ty |> List.filter (fun x -> @@ -4083,6 +4096,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso List.map Item.RecdField rfinfos @ pinfoItems @ anonFields @ + List.map Item.Trait qinfos @ List.map Item.ILField finfos @ List.map Item.Event einfos @ List.map (ItemOfTy g) nestedTypes @ @@ -4439,7 +4453,15 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m let ty = FreshenTycon ncenv m tcref - yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty ] + yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty + + // 'T.Ident: lookup a static something in a type parameter + // ^T.Ident: lookup a static something in a type parameter + match nenv.eTypars.TryGetValue id with + | true, tp -> + let ty = mkTyparTy tp + yield! ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest ty + | _ -> () ] namespaces @ values @ staticSomethingInType @@ -4599,6 +4621,8 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: | _-> [] modsOrNs @ qualifiedFields +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty (item: Item) : seq = seq { let g = ncenv.g @@ -4788,6 +4812,8 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( | _ -> () } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad statics plid (item: Item) ty = seq { let g = ncenv.g @@ -4836,6 +4862,8 @@ let rec ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad sta yield! finfo.FieldType(amap, m) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) nenv m ad (modref: ModuleOrNamespaceRef) plid (item: Item) = let g = ncenv.g let mty = modref.ModuleOrNamespaceType @@ -4926,6 +4954,8 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item ty } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f plid (modref: ModuleOrNamespaceRef) = let mty = modref.ModuleOrNamespaceType match plid with @@ -4936,6 +4966,8 @@ let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f pli PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) | _ -> Seq.empty +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let PartialResolveLongIdentAsModuleOrNamespaceThenLazy (nenv: NameResolutionEnv) plid f = seq { match plid with @@ -4948,6 +4980,8 @@ let PartialResolveLongIdentAsModuleOrNamespaceThenLazy (nenv: NameResolutionEnv) | [] -> () } +// This is "on-demand" reimplementation of completion logic that is only used along one +// pathway - `IsRelativeNameResolvableFromSymbol` - in the editor support for simplifying names let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : seq = seq { let g = ncenv.g diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 7bf79b436d3..a512df64cb3 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -780,23 +780,49 @@ module PrintTypes = WordL.arrow ^^ (layoutTyparRefWithInfo denv env tp)) |> longConstraintPrefix] - and layoutTraitWithInfo denv env (TTrait(tys, nm, memFlags, argTys, retTy, _)) = + and layoutTraitWithInfo denv env traitInfo = + let g = denv.g + let (TTrait(tys, _, memFlags, _, _, _)) = traitInfo + let nm = traitInfo.MemberDisplayNameCore let nameL = ConvertValNameToDisplayLayout false (tagMember >> wordL) nm if denv.shortConstraints then WordL.keywordMember ^^ nameL else - let retTy = GetFSharpViewOfReturnType denv.g retTy + let retTy = traitInfo.GetReturnType(g) + let argTys = traitInfo.GetLogicalArgumentTypes(g) + let argTys, retTy = + match memFlags.MemberKind with + | SynMemberKind.PropertySet -> + match List.tryFrontAndBack argTys with + | Some res -> res + | None -> argTys, retTy + | _ -> + argTys, retTy + let stat = layoutMemberFlags memFlags - let tys = ListSet.setify (typeEquiv denv.g) tys + let tys = ListSet.setify (typeEquiv g) tys let tysL = match tys with | [ty] -> layoutTypeWithInfo denv env ty | tys -> bracketL (layoutTypesWithInfoAndPrec denv env 2 (wordL (tagKeyword "or")) tys) - let argTysL = layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argTys let retTyL = layoutReturnType denv env retTy - let sigL = curriedLayoutsL "->" [argTysL] retTyL - (tysL |> addColonL) --- bracketL (stat ++ (nameL |> addColonL) --- sigL) + let sigL = + match argTys with + // Empty arguments indicates a non-indexer property constraint + | [] -> retTyL + | _ -> + let argTysL = layoutTypesWithInfoAndPrec denv env 2 (wordL (tagPunctuation "*")) argTys + curriedLayoutsL "->" [argTysL] retTyL + let getterSetterL = + match memFlags.MemberKind with + | SynMemberKind.PropertyGet when not argTys.IsEmpty -> + wordL (tagKeyword "with") ^^ wordL (tagText "get") + | SynMemberKind.PropertySet -> + wordL (tagKeyword "with") ^^ wordL (tagText "set") + | _ -> + emptyL + (tysL |> addColonL) --- bracketL (stat ++ (nameL |> addColonL) --- sigL --- getterSetterL) /// Layout a unit of measure expression and layoutMeasure denv unt = diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index fe05b73ac0a..8adaef2c164 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -260,7 +260,7 @@ and GetWitnessArgs cenv (env : QuotationTranslationEnv) m tps tyargs = and ConvWitnessInfo cenv env m traitInfo = let g = cenv.g - let witnessInfo = traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() let env = { env with suppressWitnesses = true } // First check if this is a witness in ReflectedDefinition code if env.witnessesInScope.ContainsKey witnessInfo then @@ -712,7 +712,8 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. let inWitnessPassingScope = not env.witnessesInScope.IsEmpty let witnessArgInfo = if g.generateWitnesses && inWitnessPassingScope then - match env.witnessesInScope.TryGetValue traitInfo.TraitKey with + let witnessInfo = traitInfo.GetWitnessInfo() + match env.witnessesInScope.TryGetValue witnessInfo with | true, storage -> Some storage | _ -> None else diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 28c4382f918..b05cba7ec5f 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -266,6 +266,70 @@ type ParamData = reflArgInfo: ReflectedArgInfo * ttype: TType +type ParamAttribs = ParamAttribs of isParamArrayArg: bool * isInArg: bool * isOutArg: bool * optArgInfo: OptionalArgInfo * callerInfo: CallerInfo * reflArgInfo: ReflectedArgInfo + +let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = + let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute argInfo.Attribs + let reflArgInfo = + match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.Attribs with + | Some b -> ReflectedArgInfo.Quote b + | None -> ReflectedArgInfo.None + let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute argInfo.Attribs && isByrefTy g ty) || isOutByrefTy g ty + let isInArg = (HasFSharpAttribute g g.attrib_InAttribute argInfo.Attribs && isByrefTy g ty) || isInByrefTy g ty + let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs + let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute argInfo.Attribs + let optArgInfo = + if isCalleeSideOptArg then + CalleeSide + elif isCallerSideOptArg then + let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute argInfo.Attribs + match defaultParameterValueAttribute with + | None -> + // Do a type-directed analysis of the type to determine the default value to pass. + // Similar rules as OptionalArgInfo.FromILParameter are applied here, except for the COM and byref-related stuff. + CallerSide (if isObjTy g ty then MissingValue else DefaultValue) + | Some attr -> + let defaultValue = OptionalArgInfo.ValueOfDefaultParameterValueAttrib attr + match defaultValue with + | Some (Expr.Const (_, m, ty2)) when not (typeEquiv g ty2 ty) -> + // the type of the default value does not match the type of the argument. + // Emit a warning, and ignore the DefaultParameterValue argument altogether. + warning(Error(FSComp.SR.DefaultParameterValueNotAppropriateForArgument(), m)) + NotOptional + | Some (Expr.Const (ConstToILFieldInit fi, _, _)) -> + // Good case - all is well. + CallerSide (Constant fi) + | _ -> + // Default value is not appropriate, i.e. not a constant. + // Compiler already gives an error in that case, so just ignore here. + NotOptional + else NotOptional + + let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs + let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute argInfo.Attribs + let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs + + let callerInfo = + match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with + | false, false, false -> NoCallerInfo + | true, false, false -> CallerLineNumber + | false, true, false -> CallerFilePath + | false, false, true -> CallerMemberName + | false, true, true -> + match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with + | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> + warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) + CallerFilePath + | _ -> failwith "Impossible" + | _, _, _ -> + // if multiple caller info attributes are specified, pick the "wrong" one here + // so that we get an error later + match tryDestOptionTy g ty with + | ValueSome optTy when typeEquiv g g.int32_ty optTy -> CallerFilePath + | _ -> CallerLineNumber + + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) + #if !NO_TYPEPROVIDERS type ILFieldInit with @@ -1086,72 +1150,11 @@ type MethInfo = if p.Type.TypeRef.FullName = "System.Int32" then CallerFilePath else CallerLineNumber - yield (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) ] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) ] ] | FSMeth(g, _, vref, _) -> GetArgInfosOfMember x.IsCSharpStyleExtensionMember g vref - |> List.mapSquared (fun (ty, argInfo) -> - let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute argInfo.Attribs - let reflArgInfo = - match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.Attribs with - | Some b -> ReflectedArgInfo.Quote b - | None -> ReflectedArgInfo.None - let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute argInfo.Attribs && isByrefTy g ty) || isOutByrefTy g ty - let isInArg = (HasFSharpAttribute g g.attrib_InAttribute argInfo.Attribs && isByrefTy g ty) || isInByrefTy g ty - let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs - let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute argInfo.Attribs - let optArgInfo = - if isCalleeSideOptArg then - CalleeSide - elif isCallerSideOptArg then - let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute argInfo.Attribs - match defaultParameterValueAttribute with - | None -> - // Do a type-directed analysis of the type to determine the default value to pass. - // Similar rules as OptionalArgInfo.FromILParameter are applied here, except for the COM and byref-related stuff. - CallerSide (if isObjTy g ty then MissingValue else DefaultValue) - | Some attr -> - let defaultValue = OptionalArgInfo.ValueOfDefaultParameterValueAttrib attr - match defaultValue with - | Some (Expr.Const (_, m, ty2)) when not (typeEquiv g ty2 ty) -> - // the type of the default value does not match the type of the argument. - // Emit a warning, and ignore the DefaultParameterValue argument altogether. - warning(Error(FSComp.SR.DefaultParameterValueNotAppropriateForArgument(), m)) - NotOptional - | Some (Expr.Const (ConstToILFieldInit fi, _, _)) -> - // Good case - all is well. - CallerSide (Constant fi) - | _ -> - // Default value is not appropriate, i.e. not a constant. - // Compiler already gives an error in that case, so just ignore here. - NotOptional - else NotOptional - - let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs - let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute argInfo.Attribs - let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs - - let callerInfo = - match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with - | false, false, false -> NoCallerInfo - | true, false, false -> CallerLineNumber - | false, true, false -> CallerFilePath - | false, false, true -> CallerMemberName - | false, true, true -> - match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with - | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> - warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) - CallerFilePath - | _ -> failwith "Impossible" - | _, _, _ -> - // if multiple caller info attributes are specified, pick the "wrong" one here - // so that we get an error later - match tryDestOptionTy g ty with - | ValueSome optTy when typeEquiv g g.int32_ty optTy -> CallerFilePath - | _ -> CallerLineNumber - - (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) - + |> List.mapSquared (CrackParamAttribsInfo g) | DefaultStructCtor _ -> [[]] @@ -1168,7 +1171,7 @@ type MethInfo = | None -> ReflectedArgInfo.None let isOutArg = p.PUntaint((fun p -> p.IsOut && not p.IsIn), m) let isInArg = p.PUntaint((fun p -> p.IsIn && not p.IsOut), m) - yield (isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo)] ] + ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, NoCallerInfo, reflArgInfo)] ] #endif /// Get the signature of an abstract method slot. @@ -1269,7 +1272,8 @@ type MethInfo = #endif let paramAttribs = x.GetParamAttribs(amap, m) - (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun (isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo) (ParamNameAndType(nmOpt, pty)) -> + (paramAttribs, paramNamesAndTypes) ||> List.map2 (List.map2 (fun info (ParamNameAndType(nmOpt, pty)) -> + let (ParamAttribs(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, reflArgInfo)) = info ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, callerInfo, nmOpt, reflArgInfo, pty))) /// Get the ParamData objects for the parameters of a MethInfo diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index dba5200afb7..ae6076c89a0 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -136,6 +136,11 @@ type ParamData = reflArgInfo: ReflectedArgInfo * ttype: TType +// Adhoc information - could be unified with ParamData +type ParamAttribs = ParamAttribs of isParamArrayArg: bool * isInArg: bool * isOutArg: bool * optArgInfo: OptionalArgInfo * callerInfo: CallerInfo * reflArgInfo: ReflectedArgInfo + +val CrackParamAttribsInfo: TcGlobals -> ty: TType * argInfo: ArgReprInfo -> ParamAttribs + /// Describes an F# use of an IL type, including the type instantiation associated with the type at a particular usage point. [] type ILTypeInfo = @@ -494,8 +499,7 @@ type MethInfo = member GetObjArgTypes: amap: ImportMap * m: range * minst: TypeInst -> TType list /// Get the parameter attributes of a method info, which get combined with the parameter names and types - member GetParamAttribs: - amap: ImportMap * m: range -> (bool * bool * bool * OptionalArgInfo * CallerInfo * ReflectedArgInfo) list list + member GetParamAttribs: amap: ImportMap * m: range -> ParamAttribs list list /// Get the ParamData objects for the parameters of a MethInfo member GetParamDatas: amap: ImportMap * m: range * minst: TType list -> ParamData list list diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 152e123cca0..6a39496ad51 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -3924,7 +3924,8 @@ and GenUntupledArgExpr cenv cgbuf eenv m argInfos expr = and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = let g = cenv.g - let storage = TryStorageForWitness g eenv traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + let storage = TryStorageForWitness g eenv witnessInfo match storage with | None -> @@ -3940,7 +3941,8 @@ and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = let eenv = { eenv with suppressWitnesses = true } GenExpr cenv cgbuf eenv arg Continue | Some storage -> - let ty = GenWitnessTy g traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + let ty = GenWitnessTy g witnessInfo GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv m eenv.tyenv ty) storage None and GenWitnessArgFromWitnessInfo cenv cgbuf eenv m witnessInfo = @@ -5340,14 +5342,16 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp let witness = if generateWitnesses then - TryStorageForWitness g eenv traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + TryStorageForWitness g eenv witnessInfo else None match witness with | Some storage -> - let ty = GenWitnessTy g traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() + let ty = GenWitnessTy g witnessInfo let argExprs = if argExprs.Length = 0 then [ mkUnit g m ] else argExprs GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv m eenv.tyenv ty) storage (Some([], argExprs, m, sequel)) @@ -5362,7 +5366,7 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp match minfoOpt with | None -> let exnArg = - mkString g m (FSComp.SR.ilDynamicInvocationNotSupported (traitInfo.MemberName)) + mkString g m (FSComp.SR.ilDynamicInvocationNotSupported (traitInfo.MemberLogicalName)) let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) let replacementExpr = mkThrow m (tyOfExpr g expr) exnExpr diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 755b080ae9f..0bc2095adf8 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -782,12 +782,13 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | UnresolvedOverloading (denv, callerArgs, failure, m) -> + let g = denv.g // extract eventual information (return type and type parameters) // from ConstraintTraitInfo let knownReturnType, genericParameterTypes = match failure with | NoOverloadsFound(cx = Some cx) - | PossibleCandidates(cx = Some cx) -> cx.ReturnType, cx.ArgumentTypes + | PossibleCandidates(cx = Some cx) -> Some (cx.GetReturnType(g)), cx.GetCompiledArgumentTypes() | _ -> None, [] // prepare message parts (known arguments, known return type, known generic parameters) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 40b98321c0b..dde2237e3d0 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1558,7 +1558,8 @@ featureStructActivePattern,"struct representation for active patterns" featureRelaxWhitespace2,"whitespace relaxation v2" featureReallyLongList,"list literals of any size" featureErrorOnDeprecatedRequireQualifiedAccess,"give error on deprecated access of construct with RequireQualifiedAccess attribute" -featureVirtualStaticsInInterfaces,"static abstract interface members" +featureInterfacesWithAbstractStaticMembers,"static abstract interface members" +featureSelfTypeConstraints,"self type constraints" 3353,fsiInvalidDirective,"Invalid directive '#%s %s'" 3354,tcNotAFunctionButIndexerNamedIndexingNotYetEnabled,"This value supports indexing, e.g. '%s.[index]'. The syntax '%s[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." 3354,tcNotAFunctionButIndexerIndexingNotYetEnabled,"This expression supports indexing, e.g. 'expr.[index]'. The syntax 'expr[index]' requires /langversion:preview. See https://aka.ms/fsharp-index-notation." @@ -1648,4 +1649,9 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3521,tcInvalidMemberDeclNameMissingOrHasParen,"Invalid member declaration. The name of the member is missing or has parentheses." 3522,tcAnonRecdDuplicateFieldId,"The field '%s' appears multiple times in this record expression." 3523,tcAnonRecdTypeDuplicateFieldId,"The field '%s' appears multiple times in this anonymous record type." -3524,parsExpectingExpressionInTuple,"Expecting expression" \ No newline at end of file +3524,parsExpectingExpressionInTuple,"Expecting expression" +3530,tcTraitIsStatic,"Trait '%s' is static" +3531,tcTraitIsNotStatic,"Trait '%s' is not static" +3532,tcTraitMayNotUseComplexThings,"A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" +3533,tcInvalidSelfConstraint,"Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax" +3534,tcTraitInvocationShouldUseTick,"Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters." diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index 5ffd7917e30..f0601277fea 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -50,6 +50,7 @@ type LanguageFeature = | ReallyLongLists | ErrorOnDeprecatedRequireQualifiedAccess | InterfacesWithAbstractStaticMembers + | SelfTypeConstraints /// LanguageVersion management type LanguageVersion(versionText) = @@ -113,6 +114,7 @@ type LanguageVersion(versionText) = LanguageFeature.ReallyLongLists, previewVersion LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess, previewVersion LanguageFeature.InterfacesWithAbstractStaticMembers, previewVersion + LanguageFeature.SelfTypeConstraints, previewVersion ] @@ -213,7 +215,8 @@ type LanguageVersion(versionText) = | LanguageFeature.DelegateTypeNameResolutionFix -> FSComp.SR.featureDelegateTypeNameResolutionFix () | LanguageFeature.ReallyLongLists -> FSComp.SR.featureReallyLongList () | LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess -> FSComp.SR.featureErrorOnDeprecatedRequireQualifiedAccess () - | LanguageFeature.InterfacesWithAbstractStaticMembers -> FSComp.SR.featureVirtualStaticsInInterfaces () + | LanguageFeature.InterfacesWithAbstractStaticMembers -> FSComp.SR.featureInterfacesWithAbstractStaticMembers () + | LanguageFeature.SelfTypeConstraints -> FSComp.SR.featureSelfTypeConstraints () /// Get a version string associated with the given feature. member _.GetFeatureVersionString feature = diff --git a/src/Compiler/Facilities/LanguageFeatures.fsi b/src/Compiler/Facilities/LanguageFeatures.fsi index ddc2623268c..d319cb354fe 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fsi +++ b/src/Compiler/Facilities/LanguageFeatures.fsi @@ -40,6 +40,7 @@ type LanguageFeature = | ReallyLongLists | ErrorOnDeprecatedRequireQualifiedAccess | InterfacesWithAbstractStaticMembers + | SelfTypeConstraints /// LanguageVersion management type LanguageVersion = diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index d11ae3d895b..1ba70f26a65 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -46,6 +46,7 @@ open FSharp.Compiler.Text.Layout open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.AbstractIL open System.Reflection.PortableExecutable @@ -814,14 +815,39 @@ type internal TypeCheckInfo let CompletionItem (ty: ValueOption) (assemblySymbol: ValueOption) (item: ItemWithInst) = let kind = match item.Item with - | Item.MethodGroup (_, minfo :: _, _) -> CompletionItemKind.Method minfo.IsExtensionMember + | Item.FakeInterfaceCtor _ + | Item.DelegateCtor _ + | Item.CtorGroup _ -> CompletionItemKind.Method false + | Item.MethodGroup (_, minfos, _) -> + match minfos with + | [] -> CompletionItemKind.Method false + | minfo :: _ -> CompletionItemKind.Method minfo.IsExtensionMember | Item.RecdField _ | Item.Property _ -> CompletionItemKind.Property | Item.Event _ -> CompletionItemKind.Event | Item.ILField _ | Item.Value _ -> CompletionItemKind.Field | Item.CustomOperation _ -> CompletionItemKind.CustomOperation - | _ -> CompletionItemKind.Other + // These items are not given a completion kind. This could be reviewed + | Item.AnonRecdField _ + | Item.ActivePatternResult _ + | Item.CustomOperation _ + | Item.CtorGroup _ + | Item.ExnCase _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.Trait _ + | Item.TypeVar _ + | Item.Types _ + | Item.UnionCase _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Value _ + | Item.NewDef _ + | Item.SetterArg _ + | Item.CustomBuilder _ + | Item.ArgName _ + | Item.ActivePatternCase _ -> CompletionItemKind.Other let isUnresolved = match assemblySymbol with @@ -1796,7 +1822,8 @@ type internal TypeCheckInfo | Some ([], _, _, _) -> None | Some (items, denv, _, m) -> let allItems = - items |> List.collect (fun item -> FlattenItems g m item.ItemWithInst) + items + |> List.collect (fun item -> SelectMethodGroupItems2 g m item.ItemWithInst) let symbols = allItems |> List.map (fun item -> FSharpSymbol.Create(cenv, item.Item), item) @@ -1838,6 +1865,8 @@ type internal TypeCheckInfo let methodTypeParams = ilinfo.FormalMethodTypars |> List.map (fun ty -> ty.Name) classTypeParams @ methodTypeParams |> Array.ofList + // Detect external references. Currently this only labels references to .NET assemblies as external - F# + // references from nuget packages are not labelled as external. let result = match item.Item with | Item.CtorGroup (_, ILMeth (_, ilinfo, _) :: _) -> @@ -1906,21 +1935,19 @@ type internal TypeCheckInfo Some(FindDeclResult.ExternalDecl(assemblyRef.Name, externalSym)) | _ -> None - | Item.ImplicitOp (_, - { - contents = Some (TraitConstraintSln.FSMethSln (_, _vref, _)) - }) -> - //Item.Value(vref) - None - - | Item.Types (_, TType_app (tr, _, _) :: _) when tr.IsLocalRef && tr.IsTypeAbbrev -> None - - | Item.Types (_, [ AppTy g (tr, _) ]) when not tr.IsLocalRef -> - match tr.TypeReprInfo, tr.PublicPath with - | TILObjectRepr (TILObjectReprData (ILScopeRef.Assembly assemblyRef, _, _)), Some (PubPath parts) -> - let fullName = parts |> String.concat "." - Some(FindDeclResult.ExternalDecl(assemblyRef.Name, FindDeclExternalSymbol.Type fullName)) + | Item.Types (_, ty :: _) -> + match stripTyparEqns ty with + | TType_app (tr, _, _) -> + if tr.IsLocalRef then + None + else + match tr.TypeReprInfo, tr.PublicPath with + | TILObjectRepr (TILObjectReprData (ILScopeRef.Assembly assemblyRef, _, _)), Some (PubPath parts) -> + let fullName = parts |> String.concat "." + Some(FindDeclResult.ExternalDecl(assemblyRef.Name, FindDeclExternalSymbol.Type fullName)) + | _ -> None | _ -> None + | _ -> None match result with diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index e61be0d8371..25d886ed6b0 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -825,7 +825,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | Some e -> yield! walkExpr false e | None -> () - | SynExpr.HatPrefix (e, _) -> yield! walkExpr false e + | SynExpr.IndexFromEnd (e, _) -> yield! walkExpr false e | SynExpr.DotIndexedSet (e1, es, e2, _, _, _) -> yield! walkExpr false e1 diff --git a/src/Compiler/Service/ItemKey.fs b/src/Compiler/Service/ItemKey.fs index 38507adacfc..9ac84ba0949 100644 --- a/src/Compiler/Service/ItemKey.fs +++ b/src/Compiler/Service/ItemKey.fs @@ -372,10 +372,10 @@ and [] ItemKeyStoreBuilder() = | Item.Trait (info) -> writeString ItemKeyTags.itemTrait - writeString info.MemberName - info.GoverningTypes |> List.iter (writeType false) - info.ArgumentTypes |> List.iter (writeType false) - info.ReturnType |> Option.iter (writeType false) + writeString info.MemberLogicalName + info.SupportTypes |> List.iter (writeType false) + info.CompiledObjectAndArgumentTypes |> List.iter (writeType false) + info.CompiledReturnType |> Option.iter (writeType false) | Item.TypeVar (_, typar) -> writeTypar true typar @@ -411,17 +411,27 @@ and [] ItemKeyStoreBuilder() = writeString ItemKeyTags.itemDelegateCtor writeType false ty - | Item.MethodGroup _ -> () - | Item.CtorGroup _ -> () + // We should consider writing ItemKey for each of these + | Item.ArgName _ -> () | Item.FakeInterfaceCtor _ -> () - | Item.Types _ -> () | Item.CustomOperation _ -> () | Item.CustomBuilder _ -> () - | Item.ModuleOrNamespaces _ -> () | Item.ImplicitOp _ -> () - | Item.ArgName _ -> () | Item.SetterArg _ -> () - | Item.UnqualifiedType _ -> () + + // Empty lists do not occur + | Item.Types (_, []) -> () + | Item.UnqualifiedType [] -> () + | Item.MethodGroup (_, [], _) -> () + | Item.CtorGroup (_, []) -> () + | Item.ModuleOrNamespaces [] -> () + + // Items are flattened so multiples are not expected + | Item.Types (_, _ :: _ :: _) -> () + | Item.UnqualifiedType (_ :: _ :: _) -> () + | Item.MethodGroup (_, (_ :: _ :: _), _) -> () + | Item.CtorGroup (_, (_ :: _ :: _)) -> () + | Item.ModuleOrNamespaces (_ :: _ :: _) -> () let postCount = b.Count diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index 14612aeb15b..272d7736ba6 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -70,6 +70,69 @@ module TcResolutionsExtensions = let (|CNR|) (cnr: CapturedNameResolution) = (cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.NameResolutionEnv, cnr.AccessorDomain, cnr.Range) + let isDisposableTy g amap (ty: TType) = + not (typeEquiv g ty g.system_IDisposable_ty) + && protectAssemblyExplorationNoReraise false false (fun () -> + ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) + + let isDiscard (str: string) = str.StartsWith("_") + + let isValRefDisposable g amap (vref: ValRef) = + not (isDiscard vref.DisplayName) + && + // For values, we actually do want to color things if they literally are IDisposables + protectAssemblyExplorationNoReraise false false (fun () -> + ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable) + + let isStructTyconRef g (tyconRef: TyconRef) = + let ty = generalizedTyconRef g tyconRef + let underlyingTy = stripTyEqnsAndMeasureEqns g ty + isStructTy g underlyingTy + + let isValRefMutable g (vref: ValRef) = + // Mutable values, ref cells, and non-inref byrefs are mutable. + vref.IsMutable + || isRefCellTy g vref.Type + || (isByrefTy g vref.Type && not (isInByrefTy g vref.Type)) + + let isRecdFieldMutable g (rfinfo: RecdFieldInfo) = + (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) + || isRefCellTy g rfinfo.RecdField.FormalType + + let reprToClassificationType g repr tcref = + match repr with + | TFSharpObjectRepr om -> + match om.fsobjmodel_kind with + | TFSharpClass -> SemanticClassificationType.ReferenceType + | TFSharpInterface -> SemanticClassificationType.Interface + | TFSharpStruct -> SemanticClassificationType.ValueType + | TFSharpDelegate _ -> SemanticClassificationType.Delegate + | TFSharpEnum _ -> SemanticClassificationType.Enumeration + | TFSharpRecdRepr _ + | TFSharpUnionRepr _ -> + if isStructTyconRef g tcref then + SemanticClassificationType.ValueType + else + SemanticClassificationType.Type + | TILObjectRepr (TILObjectReprData (_, _, td)) -> + if td.IsClass then + SemanticClassificationType.ReferenceType + elif td.IsStruct then + SemanticClassificationType.ValueType + elif td.IsInterface then + SemanticClassificationType.Interface + elif td.IsEnum then + SemanticClassificationType.Enumeration + else + SemanticClassificationType.Delegate + | TAsmRepr _ -> SemanticClassificationType.TypeDef + | TMeasureableRepr _ -> SemanticClassificationType.TypeDef +#if !NO_TYPEPROVIDERS + | TProvidedTypeRepr _ -> SemanticClassificationType.TypeDef + | TProvidedNamespaceRepr _ -> SemanticClassificationType.TypeDef +#endif + | TNoRepr -> SemanticClassificationType.ReferenceType + type TcResolutions with member sResolutions.GetSemanticClassification @@ -136,35 +199,6 @@ module TcResolutionsExtensions = |> Array.concat | None -> sResolutions.CapturedNameResolutions.ToArray() - let isDisposableTy (ty: TType) = - not (typeEquiv g ty g.system_IDisposable_ty) - && protectAssemblyExplorationNoReraise false false (fun () -> - ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_IDisposable) - - let isDiscard (str: string) = str.StartsWith("_") - - let isValRefDisposable (vref: ValRef) = - not (isDiscard vref.DisplayName) - && - // For values, we actually do want to color things if they literally are IDisposables - protectAssemblyExplorationNoReraise false false (fun () -> - ExistsHeadTypeInEntireHierarchy g amap range0 vref.Type g.tcref_System_IDisposable) - - let isStructTyconRef (tyconRef: TyconRef) = - let ty = generalizedTyconRef g tyconRef - let underlyingTy = stripTyEqnsAndMeasureEqns g ty - isStructTy g underlyingTy - - let isValRefMutable (vref: ValRef) = - // Mutable values, ref cells, and non-inref byrefs are mutable. - vref.IsMutable - || isRefCellTy g vref.Type - || (isByrefTy g vref.Type && not (isInByrefTy g vref.Type)) - - let isRecdFieldMutable (rfinfo: RecdFieldInfo) = - (rfinfo.RecdField.IsMutable && rfinfo.LiteralValue.IsNone) - || isRefCellTy g rfinfo.RecdField.FormalType - let duplicates = HashSet(comparer) let results = ImmutableArray.CreateBuilder() @@ -181,7 +215,7 @@ module TcResolutionsExtensions = ItemOccurence.Use, m -> add m SemanticClassificationType.ComputationExpression - | Item.Value vref, _, m when isValRefMutable vref -> add m SemanticClassificationType.MutableVar + | Item.Value vref, _, m when isValRefMutable g vref -> add m SemanticClassificationType.MutableVar | Item.Value KeywordIntrinsicValue, ItemOccurence.Use, m -> add m SemanticClassificationType.IntrinsicFunction @@ -200,7 +234,7 @@ module TcResolutionsExtensions = add m SemanticClassificationType.Function | Item.Value vref, _, m -> - if isValRefDisposable vref then + if isValRefDisposable g amap vref then if vref.IsCompiledAsTopLevel then add m SemanticClassificationType.DisposableTopLevelValue else @@ -216,7 +250,7 @@ module TcResolutionsExtensions = match rfinfo with | EnumCaseFieldInfo -> add m SemanticClassificationType.Enumeration | _ -> - if isRecdFieldMutable rfinfo then + if isRecdFieldMutable g rfinfo then add m SemanticClassificationType.MutableRecordField elif isFunTy g rfinfo.FieldType then add m SemanticClassificationType.RecordFieldAsFunction @@ -242,7 +276,8 @@ module TcResolutionsExtensions = match minfos with | [] -> add m SemanticClassificationType.ConstructorForReferenceType | _ -> - if minfos |> List.forall (fun minfo -> isDisposableTy minfo.ApparentEnclosingType) then + if minfos + |> List.forall (fun minfo -> isDisposableTy g amap minfo.ApparentEnclosingType) then add m SemanticClassificationType.DisposableType elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then add m SemanticClassificationType.ConstructorForValueType @@ -265,52 +300,18 @@ module TcResolutionsExtensions = // Special case measures for struct types | Item.Types (_, AppTy g (tyconRef, TType_measure _ :: _) :: _), LegitTypeOccurence, m when - isStructTyconRef tyconRef + isStructTyconRef g tyconRef -> add m SemanticClassificationType.ValueType | Item.Types (_, ty :: _), LegitTypeOccurence, m -> - let reprToClassificationType repr tcref = - match repr with - | TFSharpObjectRepr om -> - match om.fsobjmodel_kind with - | TFSharpClass -> SemanticClassificationType.ReferenceType - | TFSharpInterface -> SemanticClassificationType.Interface - | TFSharpStruct -> SemanticClassificationType.ValueType - | TFSharpDelegate _ -> SemanticClassificationType.Delegate - | TFSharpEnum _ -> SemanticClassificationType.Enumeration - | TFSharpRecdRepr _ - | TFSharpUnionRepr _ -> - if isStructTyconRef tcref then - SemanticClassificationType.ValueType - else - SemanticClassificationType.Type - | TILObjectRepr (TILObjectReprData (_, _, td)) -> - if td.IsClass then - SemanticClassificationType.ReferenceType - elif td.IsStruct then - SemanticClassificationType.ValueType - elif td.IsInterface then - SemanticClassificationType.Interface - elif td.IsEnum then - SemanticClassificationType.Enumeration - else - SemanticClassificationType.Delegate - | TAsmRepr _ -> SemanticClassificationType.TypeDef - | TMeasureableRepr _ -> SemanticClassificationType.TypeDef -#if !NO_TYPEPROVIDERS - | TProvidedTypeRepr _ -> SemanticClassificationType.TypeDef - | TProvidedNamespaceRepr _ -> SemanticClassificationType.TypeDef -#endif - | TNoRepr -> SemanticClassificationType.ReferenceType - let ty = stripTyEqns g ty - if isDisposableTy ty then + if isDisposableTy g amap ty then add m SemanticClassificationType.DisposableType else match tryTcrefOfAppTy g ty with - | ValueSome tcref -> add m (reprToClassificationType tcref.TypeReprInfo tcref) + | ValueSome tcref -> add m (reprToClassificationType g tcref.TypeReprInfo tcref) | ValueNone -> if isStructTupleTy g ty then add m SemanticClassificationType.ValueType @@ -369,7 +370,7 @@ module TcResolutionsExtensions = elif tcref.IsNamespace then add m SemanticClassificationType.Namespace elif tcref.IsUnionTycon || tcref.IsRecordTycon then - if isStructTyconRef tcref then + if isStructTyconRef g tcref then add m SemanticClassificationType.ValueType else add m SemanticClassificationType.UnionCase diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 76737a684af..f88b31f14f3 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -459,8 +459,43 @@ module DeclarationListHelpers = | Item.SetterArg (_, item) -> FormatItemDescriptionToToolTipElement displayFullName infoReader ad m denv (ItemWithNoInst item) - | _ -> - ToolTipElement.None + + // TODO: give a decent tooltip for implicit operators that include the resolution of the operator + // + //type C() = + // static member (++++++) (x: C, y: C) = C() + // + //let f (x: C) = + // x ++++++ x + // + // Here hovering over "++++++" in "f" could give a tooltip saying what the thing is and what it has resolved to. + // + // + | Item.ImplicitOp _ + + // TODO: consider why we aren't getting Item.Types for generic type parameters + // let F<'T>() = new System.Collections.Generic.List<'T>() + | Item.Types (_, [TType_var _]) + + // TODO: consider why we aren't getting Item.Types for units of measure + | Item.Types (_, [TType_measure _]) + + // TODO: consider whether we ever get Item.Types with more than one element + | Item.Types (_, _ :: _ :: _) + + // We don't expect Item.Types with an anonymous record type, function types etc. + | Item.Types (_, [TType_anon _]) + | Item.Types (_, [TType_fun _]) + | Item.Types (_, [TType_forall _]) + | Item.Types (_, [TType_tuple _]) + | Item.Types (_, [TType_ucase _]) + + // We don't expect these cases + | Item.Types (_, []) + | Item.Property (_, []) + | Item.UnqualifiedType [] + | Item.ModuleOrNamespaces [] + | Item.CustomOperation (_, _, None) -> ToolTipElement.None /// Format the structured version of a tooltip for an item let FormatStructuredDescriptionOfItem isDecl infoReader ad m denv item = @@ -752,6 +787,14 @@ module internal DescriptionListsImpl = // for display as part of the method group prettyParams, prettyRetTyL + | Item.Trait traitInfo -> + let paramDatas = + [ for pty in traitInfo.GetLogicalArgumentTypes(g) do + ParamData(false, false, false, OptionalArgInfo.NotOptional, CallerInfo.NoCallerInfo, None, ReflectedArgInfo.None, pty) ] + let retTy = traitInfo.GetReturnType(g) + let _prettyTyparInst, prettyParams, prettyRetTyL, _prettyConstraintsL = PrettyParamsOfParamDatas g denv item.TyparInstantiation paramDatas retTy + prettyParams, prettyRetTyL + | Item.CustomBuilder (_, vref) -> PrettyParamsAndReturnTypeOfItem infoReader m denv { item with Item = Item.Value vref } @@ -790,7 +833,19 @@ module internal DescriptionListsImpl = // for display as part of the method group prettyParams, prettyRetTyL - | _ -> + | Item.CustomOperation _ // TODO: consider whether this should report parameter help + | Item.ActivePatternResult _ // TODO: consider whether this should report parameter help + | Item.UnqualifiedType _ + | Item.UnionCaseField _ + | Item.Types _ + | Item.SetterArg _ + | Item.NewDef _ + | Item.ModuleOrNamespaces _ + | Item.ImplicitOp _ + | Item.ArgName _ + | Item.MethodGroup(_, [], _) + | Item.CtorGroup(_,[]) + | Item.Property(_,[]) -> [], emptyL @@ -844,7 +899,9 @@ module internal DescriptionListsImpl = else FSharpGlyph.Variable | Item.Types(_, ty :: _) -> typeToGlyph (stripTyEqns denv.g ty) | Item.UnionCase _ - | Item.ActivePatternCase _ -> FSharpGlyph.EnumMember + | Item.ActivePatternResult _ + | Item.ImplicitOp _ + | Item.ActivePatternCase _ -> FSharpGlyph.EnumMember | Item.ExnCase _ -> FSharpGlyph.Exception | Item.AnonRecdField _ -> FSharpGlyph.Field | Item.RecdField _ -> FSharpGlyph.Field @@ -880,19 +937,25 @@ module internal DescriptionListsImpl = else FSharpGlyph.Class | Item.ModuleOrNamespaces(modref :: _) -> if modref.IsNamespace then FSharpGlyph.NameSpace else FSharpGlyph.Module - | Item.ArgName _ -> FSharpGlyph.Variable + | Item.NewDef _ + | Item.ArgName _ | Item.SetterArg _ -> FSharpGlyph.Variable - | _ -> FSharpGlyph.Error) + // These empty lists are not expected to occur + | Item.ModuleOrNamespaces [] + | Item.UnqualifiedType [] -> + FSharpGlyph.Error + ) - /// Get rid of groups of overloads an replace them with single items. - /// (This looks like it is doing the a similar thing as FlattenItems, this code - /// duplication could potentially be removed) - let AnotherFlattenItems g m item = + + /// Select the items that participate in a MethodGroup. This is almost identical to SelectMethodGroupItems and + // should be merged, and indeed is only used on the + let SelectMethodGroupItems g m item = match item with | Item.CtorGroup(nm, cinfos) -> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) cinfos + | Item.Trait traitInfo -> + if traitInfo.GetLogicalArgumentTypes(g).IsEmpty then [] else [item] | Item.FakeInterfaceCtor _ - | Item.Trait _ | Item.DelegateCtor _ -> [item] | Item.NewDef _ | Item.ILField _ -> [] @@ -914,11 +977,20 @@ module internal DescriptionListsImpl = [item] #endif | Item.MethodGroup(nm, minfos, orig) -> minfos |> List.map (fun minfo -> Item.MethodGroup(nm, [minfo], orig)) - | Item.CustomOperation(_name, _helpText, _minfo) -> [item] - | Item.TypeVar _ -> [] - | Item.CustomBuilder _ -> [] - | _ -> [] - + | Item.CustomOperation _ -> [item] + // These are not items that can participate in a method group + | Item.TypeVar _ + | Item.CustomBuilder _ + | Item.ActivePatternCase _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.SetterArg _ + | Item.Types _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.ActivePatternResult _ -> [] /// An intellisense declaration [] @@ -1185,7 +1257,7 @@ type MethodGroup( name: string, unsortedMethods: MethodGroupItem[] ) = | true, res -> yield! res | false, _ -> #endif - let flatItems = AnotherFlattenItems g m item.Item + let flatItems = SelectMethodGroupItems g m item.Item let methods = flatItems |> Array.ofList |> Array.map (fun flatItem -> diff --git a/src/Compiler/Service/ServiceParseTreeWalk.fs b/src/Compiler/Service/ServiceParseTreeWalk.fs index 9619abb59e0..82c73bc950a 100755 --- a/src/Compiler/Service/ServiceParseTreeWalk.fs +++ b/src/Compiler/Service/ServiceParseTreeWalk.fs @@ -670,7 +670,7 @@ module SyntaxTraversal = ] |> pick expr - | SynExpr.HatPrefix (e, _) -> traverseSynExpr e + | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) -> [ diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index a4315115d7c..fd4bfd210a7 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -611,6 +611,7 @@ module ParsedInput = List.tryPick walkType ts |> Option.orElseWith (fun () -> walkMemberSig sign) | SynTypeConstraint.WhereTyparIsEnum (t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) | SynTypeConstraint.WhereTyparIsDelegate (t, ts, _) -> walkTypar t |> Option.orElseWith (fun () -> List.tryPick walkType ts) + | SynTypeConstraint.WhereSelfConstrained (ts, _) -> walkType ts and walkPatWithKind (kind: EntityKind option) pat = match pat with @@ -1606,6 +1607,8 @@ module ParsedInput = | SynTypeConstraint.WhereTyparSupportsMember (ts, sign, _) -> List.iter walkType ts walkMemberSig sign + | SynTypeConstraint.WhereSelfConstrained (ty, _) -> + walkType ty and walkPat pat = match pat with @@ -1768,7 +1771,7 @@ module ParsedInput = match expr2 with | Some e -> walkExpr e | None -> () - | SynExpr.HatPrefix (e, _) -> walkExpr e + | SynExpr.IndexFromEnd (e, _) -> walkExpr e | SynExpr.DotIndexedGet (e, args, _, _) -> walkExpr e walkExpr args diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index e2416af351e..f508d7267da 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -917,7 +917,7 @@ module FSharpExprConvert = | _ -> wfail (sprintf "unhandled construct in AST", m) | Expr.WitnessArg (traitInfo, _m) -> - ConvWitnessInfoPrim cenv env traitInfo + ConvWitnessInfoPrim env traitInfo | Expr.DebugPoint (_, innerExpr) -> ConvExprPrim cenv env innerExpr @@ -925,8 +925,8 @@ module FSharpExprConvert = | _ -> wfail (sprintf "unhandled construct in AST", expr.Range) - and ConvWitnessInfoPrim _cenv env traitInfo : E = - let witnessInfo = traitInfo.TraitKey + and ConvWitnessInfoPrim env traitInfo : E = + let witnessInfo = traitInfo.GetWitnessInfo() let env = { env with suppressWitnesses = true } // First check if this is a witness in ReflectedDefinition code if env.witnessesInScope.ContainsKey witnessInfo then @@ -939,9 +939,9 @@ module FSharpExprConvert = and ConvWitnessInfo cenv env m traitInfo : FSharpExpr = let g = cenv.g - let witnessInfo = traitInfo.TraitKey + let witnessInfo = traitInfo.GetWitnessInfo() let witnessTy = GenWitnessTy g witnessInfo - let traitInfoR = ConvWitnessInfoPrim cenv env traitInfo + let traitInfoR = ConvWitnessInfoPrim env traitInfo Mk cenv m witnessTy traitInfoR and ConvLetBind cenv env (bind : Binding) = diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index dc37e93a6b0..d26e4e3e5ad 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -168,21 +168,27 @@ module internal SymbolHelpers = |> Option.bind ccuOfValRef |> Option.orElseWith (fun () -> pinfo.DeclaringTyconRef |> computeCcuOfTyconRef)) - | Item.ArgName (_, _, Some (ArgumentContainer.Method minfo)) -> - ccuOfMethInfo g minfo + | Item.ArgName (_, _, meth) -> + match meth with + | None -> None + | Some (ArgumentContainer.Method minfo) -> ccuOfMethInfo g minfo + | Some (ArgumentContainer.Type eref) -> computeCcuOfTyconRef eref | Item.MethodGroup(_, minfos, _) | Item.CtorGroup(_, minfos) -> minfos |> List.tryPick (ccuOfMethInfo g) - | Item.CustomOperation (_, _, Some minfo) -> - ccuOfMethInfo g minfo + | Item.CustomOperation (_, _, meth) -> + match meth with + | None -> None + | Some minfo -> ccuOfMethInfo g minfo | Item.Types(_, tys) -> tys |> List.tryPick (tryNiceEntityRefOfTyOption >> Option.bind computeCcuOfTyconRef) - | Item.ArgName (_, _, Some (ArgumentContainer.Type eref)) -> - computeCcuOfTyconRef eref + | Item.FakeInterfaceCtor(ty) + | Item.DelegateCtor(ty) -> + ty |> tryNiceEntityRefOfTyOption |> Option.bind computeCcuOfTyconRef | Item.ModuleOrNamespaces erefs | Item.UnqualifiedType erefs -> @@ -194,9 +200,20 @@ module internal SymbolHelpers = | Item.AnonRecdField (info, _, _, _) -> Some info.Assembly + // This is not expected: you can't directly refer to trait constraints in other assemblies | Item.Trait _ -> None + + // This is not expected: you can't directly refer to type variables in other assemblies | Item.TypeVar _ -> None - | _ -> None + + // This is not expected: you can't directly refer to active pattern result tags in other assemblies + | Item.ActivePatternResult _ -> None + + // This is not expected: implicit operator references only occur in the current assembly + | Item.ImplicitOp _ -> None + + // This is not expected: NewDef only occurs within checking + | Item.NewDef _ -> None /// Work out the source file for an item and fix it up relative to the CCU if it is relative. let fileNameOfItem (g: TcGlobals) qualProjectDir (m: range) h = @@ -248,7 +265,7 @@ module internal SymbolHelpers = |> Option.defaultValue xmlDoc /// This function gets the signature to pass to Visual Studio to use its lookup functions for .NET stuff. - let GetXmlDocHelpSigOfItemForLookup (infoReader: InfoReader) m d = + let rec GetXmlDocHelpSigOfItemForLookup (infoReader: InfoReader) m d = let g = infoReader.g match d with | Item.ActivePatternCase (APElemRef(_, vref, _, _)) @@ -258,6 +275,7 @@ module internal SymbolHelpers = | Item.UnionCase (ucinfo, _) -> mkXmlComment (GetXmlDocSigOfUnionCaseRef ucinfo.UnionCaseRef) + | Item.UnqualifiedType (tcref :: _) | Item.ExnCase tcref -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) @@ -269,8 +287,13 @@ module internal SymbolHelpers = | Item.ILField finfo -> mkXmlComment (GetXmlDocSigOfILFieldInfo infoReader m finfo) - | Item.Types(_, TType_app(tcref, _, _) :: _) -> - mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) + | Item.FakeInterfaceCtor ty + | Item.DelegateCtor ty + | Item.Types(_, ty :: _) -> + match ty with + | AbbrevOrAppTy tcref -> + mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) + | _ -> FSharpXmlDoc.None | Item.CustomOperation (_, _, Some minfo) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) @@ -302,7 +325,24 @@ module internal SymbolHelpers = | Item.UnionCaseField (ucinfo, _) -> mkXmlComment (GetXmlDocSigOfUnionCaseRef ucinfo.UnionCaseRef) - | _ -> FSharpXmlDoc.None + | Item.SetterArg (_, item) -> + GetXmlDocHelpSigOfItemForLookup infoReader m item + + // These do not have entires in XML doc files + | Item.CustomOperation _ + | Item.ArgName _ + | Item.ActivePatternResult _ + | Item.AnonRecdField _ + | Item.ImplicitOp _ + + // These empty lists are not expected to occur + | Item.CtorGroup (_, []) + | Item.MethodGroup (_, [], _) + | Item.Property (_, []) + | Item.ModuleOrNamespaces [] + | Item.UnqualifiedType [] + | Item.Types(_, []) -> + FSharpXmlDoc.None |> GetXmlDocFromLoader infoReader @@ -340,8 +380,8 @@ module internal SymbolHelpers = member x.InEqualityRelation item = match item with | Item.Trait _ -> true - | Item.Types(_, [_]) -> true - | Item.ILField(ILFieldInfo _) -> true + | Item.Types(_, _ :: _) -> true + | Item.ILField(_) -> true | Item.RecdField _ -> true | Item.SetterArg _ -> true | Item.TypeVar _ -> true @@ -357,7 +397,21 @@ module internal SymbolHelpers = | Item.Property _ -> true | Item.CtorGroup _ -> true | Item.UnqualifiedType _ -> true - | _ -> false + + // These are never expected to have duplicates in declaration lists etc + | Item.ActivePatternResult _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.FakeInterfaceCtor _ + | Item.ImplicitOp _ + | Item.NewDef _ + | Item.UnionCaseField _ + + // These are not expected to occur + | Item.Types(_, []) + | Item.ModuleOrNamespaces [] -> false + + //| _ -> false member x.Equals(item1, item2) = // This may explore assemblies that are not in the reference set. @@ -376,7 +430,7 @@ module internal SymbolHelpers = // Much of this logic is already covered by 'ItemsAreEffectivelyEqual' match item1, item2 with | Item.DelegateCtor ty1, Item.DelegateCtor ty2 -> equalHeadTypes(ty1, ty2) - | Item.Types(dn1, [ty1]), Item.Types(dn2, [ty2]) -> + | Item.Types(dn1, ty1 :: _), Item.Types(dn2, ty2 :: _) -> // Bug 4403: We need to compare names as well, because 'int' and 'Int32' are physically the same type, but we want to show both dn1 = dn2 && equalHeadTypes(ty1, ty2) @@ -384,8 +438,8 @@ module internal SymbolHelpers = | ItemWhereTypIsPreferred ty1, ItemWhereTypIsPreferred ty2 -> equalHeadTypes(ty1, ty2) | Item.ExnCase tcref1, Item.ExnCase tcref2 -> tyconRefEq g tcref1 tcref2 - | Item.ILField(ILFieldInfo(_, fld1)), Item.ILField(ILFieldInfo(_, fld2)) -> - fld1 === fld2 // reference equality on the object identity of the AbstractIL metadata blobs for the fields + | Item.ILField(fld1), Item.ILField(fld2) -> + ILFieldInfo.ILFieldInfosUseIdenticalDefinitions fld1 fld2 | Item.CustomOperation (_, _, Some minfo1), Item.CustomOperation (_, _, Some minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2 | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> @@ -410,15 +464,15 @@ module internal SymbolHelpers = | Item.AnonRecdField(anon1, _, i1, _), Item.AnonRecdField(anon2, _, i2, _) -> anonInfoEquiv anon1 anon2 && i1 = i2 | Item.Trait traitInfo1, Item.Trait traitInfo2 -> - (traitInfo1.MemberName = traitInfo2.MemberName) + (traitInfo1.MemberLogicalName = traitInfo2.MemberLogicalName) | Item.CtorGroup(_, meths1), Item.CtorGroup(_, meths2) -> (meths1, meths2) ||> List.forall2 (fun minfo1 minfo2 -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) | Item.UnqualifiedType tcrefs1, Item.UnqualifiedType tcrefs2 -> (tcrefs1, tcrefs2) ||> List.forall2 (fun tcref1 tcref2 -> tyconRefEq g tcref1 tcref2) - | Item.Types(_, [TType_app(tcref1, _, _)]), Item.UnqualifiedType([tcref2]) -> tyconRefEq g tcref1 tcref2 - | Item.UnqualifiedType([tcref1]), Item.Types(_, [TType_app(tcref2, _, _)]) -> tyconRefEq g tcref1 tcref2 + | Item.Types(_, [AbbrevOrAppTy tcref1]), Item.UnqualifiedType([tcref2]) -> tyconRefEq g tcref1 tcref2 + | Item.UnqualifiedType([tcref1]), Item.Types(_, [AbbrevOrAppTy tcref2]) -> tyconRefEq g tcref1 tcref2 | _ -> false) member x.GetHashCode item = @@ -430,8 +484,8 @@ module internal SymbolHelpers = match tryTcrefOfAppTy g ty with | ValueSome tcref -> hash tcref.LogicalName | _ -> 1010 - | Item.ILField(ILFieldInfo(_, fld)) -> - System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode fld // hash on the object identity of the AbstractIL metadata blob for the field + | Item.ILField(fld) -> + fld.ComputeHashCode() | Item.TypeVar (nm, _tp) -> hash nm | Item.CustomOperation (_, _, Some minfo) -> minfo.ComputeHashCode() | Item.CustomOperation (_, _, None) -> 1 @@ -445,11 +499,24 @@ module internal SymbolHelpers = | Item.UnionCase(UnionCaseInfo(_, UnionCaseRef(tcref, n)), _) -> hash(tcref.Stamp, n) | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref, n))) -> hash(tcref.Stamp, n) | Item.AnonRecdField(anon, _, i, _) -> hash anon.SortedNames[i] - | Item.Trait traitInfo -> hash traitInfo.MemberName + | Item.Trait traitInfo -> hash traitInfo.MemberLogicalName | Item.Event evt -> evt.ComputeHashCode() | Item.Property(_name, pis) -> hash (pis |> List.map (fun pi -> pi.ComputeHashCode())) | Item.UnqualifiedType(tcref :: _) -> hash tcref.LogicalName - | _ -> failwith "unreachable") } + + // These are not expected to occur, see InEqualityRelation and ItemWhereTypIsPreferred + | Item.ActivePatternResult _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.FakeInterfaceCtor _ + | Item.ImplicitOp _ + | Item.NewDef _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.Types _ + | Item.DelegateCtor _ + | Item.ModuleOrNamespaces [] -> 0 + ) } let ItemWithTypeDisplayPartialEquality g = let itemComparer = ItemDisplayPartialEquality g @@ -522,7 +589,7 @@ module internal SymbolHelpers = match tryTcrefOfAppTy g ty with | ValueSome tcref -> buildString (fun os -> NicePrint.outputTyconRef denv os tcref) | _ -> "" - | Item.Trait traitInfo -> traitInfo.MemberName + | Item.Trait traitInfo -> traitInfo.MemberLogicalName | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> let definiteNamespace = modrefs |> List.forall (fun modref -> modref.IsNamespace) if definiteNamespace then fullDisplayTextOfModRef modref else modref.DisplayName @@ -539,28 +606,41 @@ module internal SymbolHelpers = | Item.ModuleOrNamespaces [] | Item.Property(_, []) -> "" - /// Output a the description of a language item + /// Output the description of a language item let rec GetXmlCommentForItem (infoReader: InfoReader) m item = let g = infoReader.g match item with - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) -> - GetXmlCommentForItem infoReader m (Item.Value vref) + | Item.ImplicitOp(_, sln) -> + match sln.Value with + | Some(TraitConstraintSln.FSMethSln(_, vref, _)) -> + GetXmlCommentForItem infoReader m (Item.Value vref) + | Some (TraitConstraintSln.ILMethSln _) + | Some (TraitConstraintSln.FSRecdFieldSln _) + | Some (TraitConstraintSln.FSAnonRecdFieldSln _) + | Some (TraitConstraintSln.ClosedExprSln _) + | Some TraitConstraintSln.BuiltInSln + | None -> + GetXmlCommentForItemAux None infoReader m item | Item.Value vref | Item.CustomBuilder (_, vref) -> - GetXmlCommentForItemAux (if valRefInThisAssembly g.compilingFSharpCore vref || vref.XmlDoc.NonEmpty then Some vref.XmlDoc else None) infoReader m item + let doc = if valRefInThisAssembly g.compilingFSharpCore vref || vref.XmlDoc.NonEmpty then Some vref.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.UnionCase(ucinfo, _) -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None) infoReader m item + let doc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.ActivePatternCase apref -> - GetXmlCommentForItemAux (Some apref.ActivePatternVal.XmlDoc) infoReader m item + let doc = Some apref.ActivePatternVal.XmlDoc + GetXmlCommentForItemAux doc infoReader m item | Item.ExnCase ecref -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ecref || ecref.XmlDoc.NonEmpty then Some ecref.XmlDoc else None) infoReader m item + let doc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ecref || ecref.XmlDoc.NonEmpty then Some ecref.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.RecdField rfinfo -> let tcref = rfinfo.TyconRef - let xmldoc = + let doc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then if tcref.IsFSharpException then Some tcref.XmlDoc @@ -568,55 +648,89 @@ module internal SymbolHelpers = Some rfinfo.RecdField.XmlDoc else None - GetXmlCommentForItemAux xmldoc infoReader m item + GetXmlCommentForItemAux doc infoReader m item | Item.Event einfo -> - GetXmlCommentForItemAux (if einfo.HasDirectXmlComment || einfo.XmlDoc.NonEmpty then Some einfo.XmlDoc else None) infoReader m item + let doc = if einfo.HasDirectXmlComment || einfo.XmlDoc.NonEmpty then Some einfo.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.Property(_, pinfos) -> let pinfo = pinfos.Head - GetXmlCommentForItemAux (if pinfo.HasDirectXmlComment || pinfo.XmlDoc.NonEmpty then Some pinfo.XmlDoc else None) infoReader m item + let doc = if pinfo.HasDirectXmlComment || pinfo.XmlDoc.NonEmpty then Some pinfo.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item | Item.CustomOperation (_, _, Some minfo) | Item.CtorGroup(_, minfo :: _) | Item.MethodGroup(_, minfo :: _, _) -> GetXmlCommentForMethInfoItem infoReader m item minfo - | Item.Types(_, TType_app(tcref, _, _) :: _) -> - GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then Some tcref.XmlDoc else None) infoReader m item + | Item.Types(_, tys) -> + let doc = + match tys with + | AbbrevOrAppTy tcref :: _ -> + if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then + Some tcref.XmlDoc + else + None + | _ -> None + GetXmlCommentForItemAux doc infoReader m item + + | Item.UnqualifiedType(tcrefs) -> + let doc = + match tcrefs with + | tcref :: _ -> + if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then + Some tcref.XmlDoc + else + None + | _ -> None + GetXmlCommentForItemAux doc infoReader m item | Item.ModuleOrNamespaces(modref :: _ as modrefs) -> let definiteNamespace = modrefs |> List.forall (fun modref -> modref.IsNamespace) if not definiteNamespace then - GetXmlCommentForItemAux (if entityRefInThisAssembly g.compilingFSharpCore modref || modref.XmlDoc.NonEmpty then Some modref.XmlDoc else None) infoReader m item + let doc = if entityRefInThisAssembly g.compilingFSharpCore modref || modref.XmlDoc.NonEmpty then Some modref.XmlDoc else None + GetXmlCommentForItemAux doc infoReader m item else GetXmlCommentForItemAux None infoReader m item | Item.ArgName (_, _, argContainer) -> - let xmldoc = + let doc = match argContainer with | Some(ArgumentContainer.Method minfo) -> if minfo.HasDirectXmlComment || minfo.XmlDoc.NonEmpty then Some minfo.XmlDoc else None | Some(ArgumentContainer.Type tcref) -> if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then Some tcref.XmlDoc else None | _ -> None - GetXmlCommentForItemAux xmldoc infoReader m item + GetXmlCommentForItemAux doc infoReader m item | Item.UnionCaseField (ucinfo, _) -> - let xmldoc = - if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then Some ucinfo.UnionCase.XmlDoc else None - GetXmlCommentForItemAux xmldoc infoReader m item + let doc = + if tyconRefUsesLocalXmlDoc g.compilingFSharpCore ucinfo.TyconRef || ucinfo.UnionCase.XmlDoc.NonEmpty then + Some ucinfo.UnionCase.XmlDoc + else + None + GetXmlCommentForItemAux doc infoReader m item | Item.SetterArg (_, item) -> GetXmlCommentForItem infoReader m item // In all these cases, there is no direct XML documentation from F# comments + | Item.MethodGroup (_, [], _) + | Item.CtorGroup (_, []) + | Item.ModuleOrNamespaces [] + | Item.Types (_, []) + | Item.CustomOperation (_, _, None) + | Item.UnqualifiedType [] + | Item.TypeVar _ + | Item.Trait _ + | Item.AnonRecdField _ | Item.ActivePatternResult _ | Item.NewDef _ | Item.ILField _ | Item.FakeInterfaceCtor _ - | Item.DelegateCtor _ - | _ -> + | Item.DelegateCtor _ -> + //| _ -> GetXmlCommentForItemAux None infoReader m item |> GetXmlDocFromLoader infoReader @@ -844,8 +958,12 @@ module internal SymbolHelpers = | Item.ActivePatternResult _ // "let (|Foo|Bar|) = .. Fo$o ..." - no keyword -> None - /// Get rid of groups of overloads an replace them with single items. - let FlattenItems g (m: range) (item: ItemWithInst) : ItemWithInst list = + /// Select the items that participate in a MethodGroup. + // + // NOTE: This is almost identical to SelectMethodGroupItems and + // should be merged, and indeed is only used on the TypeCheckInfo::GetMethodsAsSymbols path, which is unused by + // the VS integration. + let SelectMethodGroupItems2 g (m: range) (item: ItemWithInst) : ItemWithInst list = ignore m match item.Item with | Item.MethodGroup(nm, minfos, orig) -> @@ -871,5 +989,17 @@ module internal SymbolHelpers = | Item.Trait _ -> [item] | Item.TypeVar _ -> [] | Item.CustomBuilder _ -> [] - | _ -> [] + // These are not items that can participate in a method group + | Item.TypeVar _ + | Item.CustomBuilder _ + | Item.ActivePatternCase _ + | Item.AnonRecdField _ + | Item.ArgName _ + | Item.ImplicitOp _ + | Item.ModuleOrNamespaces _ + | Item.SetterArg _ + | Item.Types _ + | Item.UnionCaseField _ + | Item.UnqualifiedType _ + | Item.ActivePatternResult _ -> [] diff --git a/src/Compiler/Symbols/SymbolHelpers.fsi b/src/Compiler/Symbols/SymbolHelpers.fsi index e862ba3dee6..b25bf18d60f 100755 --- a/src/Compiler/Symbols/SymbolHelpers.fsi +++ b/src/Compiler/Symbols/SymbolHelpers.fsi @@ -56,7 +56,7 @@ module internal SymbolHelpers = val IsExplicitlySuppressed: TcGlobals -> Item -> bool - val FlattenItems: TcGlobals -> range -> ItemWithInst -> ItemWithInst list + val SelectMethodGroupItems2: TcGlobals -> range -> ItemWithInst -> ItemWithInst list #if !NO_TYPEPROVIDERS val (|ItemIsProvidedType|_|): TcGlobals -> Item -> TyconRef option diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index 03cdfe8ab4e..9a25ad6877c 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -733,6 +733,14 @@ let mkSynMemberDefnGetSet ] | _ -> [] +// Input Text Precedence by Parser Adjustment +// +// ^T.Ident ^(T.Ident) (^T).Ident +// ^T.Ident[idx] ^(T.Ident[idx]) (^T).Ident[idx] +// ^T.Ident.[idx] ^(T.Ident.[idx]) (^T).Ident.[idx] +// ^T.Ident.Ident2 ^(T.Ident.Ident2) (^T).Ident.Ident2 +// ^T.Ident(args).Ident3 ^(T.Ident(args).Ident3) (^T).Ident(args).Ident3 +// ^T.(+)(args) ^(T.(+)(args)) (^T).(+)(args).Ident3 let adjustHatPrefixToTyparLookup mFull rightExpr = let rec take inp = match inp with diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index eebe55d311d..ace1c64d35b 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -332,6 +332,8 @@ type SynTypeConstraint = | WhereTyparIsDelegate of typar: SynTypar * typeArgs: SynType list * range: range + | WhereSelfConstrained of selfConstraint: SynType * range: range + member x.Range = match x with | WhereTyparIsValueType (range = range) @@ -345,6 +347,7 @@ type SynTypeConstraint = | WhereTyparSupportsMember (range = range) | WhereTyparIsEnum (range = range) | WhereTyparIsDelegate (range = range) -> range + | WhereSelfConstrained (range = range) -> range [] type SynTyparDecls = @@ -510,7 +513,7 @@ type SynExpr = | IndexRange of expr1: SynExpr option * opm: range * expr2: SynExpr option * range1: range * range2: range * range: range - | HatPrefix of expr: SynExpr * range: range + | IndexFromEnd of expr: SynExpr * range: range | ComputationExpr of hasSeqBuilder: bool * expr: SynExpr * range: range @@ -738,7 +741,7 @@ type SynExpr = | SynExpr.LibraryOnlyILAssembly (range = m) | SynExpr.LibraryOnlyStaticOptimization (range = m) | SynExpr.IndexRange (range = m) - | SynExpr.HatPrefix (range = m) + | SynExpr.IndexFromEnd (range = m) | SynExpr.TypeTest (range = m) | SynExpr.Upcast (range = m) | SynExpr.AddressOf (range = m) diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index c6b7981ca17..92002ca5a46 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -413,6 +413,9 @@ type SynTypeConstraint = /// F# syntax is 'typar: delegate<'Args, unit> | WhereTyparIsDelegate of typar: SynTypar * typeArgs: SynType list * range: range + /// F# syntax is SomeThing<'T> + | WhereSelfConstrained of selfConstraint: SynType * range: range + member Range: range /// List of type parameter declarations with optional type constraints, @@ -616,10 +619,10 @@ type SynExpr = /// F# syntax: ^expr, used for from-end-of-collection indexing and ^T.Operation /// /// NOTE: In the case of ^T.ident the Typar node is not initially in the tree as produced by the parser, - /// but rather is a HatPrefix node that is then processed using adjustHatPrefixToTyparLookup + /// but rather is a IndexFromEnd node that is then processed using adjustHatPrefixToTyparLookup /// when in arbitrary expression position. If ^expr occurs in index/slicing position then it is not processed /// and the node is interpreted as from-the-end-indexing. - | HatPrefix of expr: SynExpr * range: range + | IndexFromEnd of expr: SynExpr * range: range /// F# syntax: { expr } | ComputationExpr of hasSeqBuilder: bool * expr: SynExpr * range: range @@ -735,7 +738,7 @@ type SynExpr = /// F# syntax: ^T (for ^T.ident) or (for 'T.ident). /// /// NOTE: In the case of ^T.ident the Typar node is not initially in the tree as produced by the parser, - /// but rather is a HatPrefix node that is then processed using adjustHatPrefixToTyparLookup + /// but rather is a IndexFromEnd node that is then processed using adjustHatPrefixToTyparLookup /// when in arbitrary expression position. If ^expr occurs in index/slicing position then it is not processed /// and the node is interpreted as from-the-end-indexing. | Typar of typar: SynTypar * range: range diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 3060beb31eb..d191fab66ea 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -968,7 +968,7 @@ let rec synExprContainsError inpExpr = | Some e -> walkExpr e | None -> false) - | SynExpr.HatPrefix (e, _) -> walkExpr e + | SynExpr.IndexFromEnd (e, _) -> walkExpr e | SynExpr.DotIndexedGet (e1, indexArgs, _, _) -> walkExpr e1 || walkExpr indexArgs diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 51060755e80..6033b98e2f5 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1766,15 +1766,16 @@ type TcGlobals( /// AdditionDynamic for op_Addition. Also work out the type instantiation of the dynamic function. member _.MakeBuiltInWitnessInfo (t: TraitConstraintInfo) = let memberName = - let nm = t.MemberName + let nm = t.MemberLogicalName let coreName = if nm.StartsWith "op_" then nm[3..] elif nm = "get_Zero" then "GenericZero" elif nm = "get_One" then "GenericOne" else nm coreName + "Dynamic" + let gtps, argTys, retTy, tinst = - match memberName, t.ArgumentTypes, t.ReturnType with + match memberName, t.CompiledObjectAndArgumentTypes, t.CompiledReturnType with | ("AdditionDynamic" | "MultiplyDynamic" | "SubtractionDynamic"| "DivisionDynamic" | "ModulusDynamic" | "CheckedAdditionDynamic" | "CheckedMultiplyDynamic" | "CheckedSubtractionDynamic" | "LeftShiftDynamic" | "RightShiftDynamic" | "BitwiseAndDynamic" | "BitwiseOrDynamic" | "ExclusiveOrDynamic" | "LessThanDynamic" | "GreaterThanDynamic" | "LessThanOrEqualDynamic" | "GreaterThanOrEqualDynamic" | "EqualityDynamic" | "InequalityDynamic"), [ arg0Ty; arg1Ty ], Some retTy -> @@ -1788,13 +1789,14 @@ type TcGlobals( | ("GenericZeroDynamic" | "GenericOneDynamic"), [], Some retTy -> [vara], [ ], varaTy, [ retTy ] | _ -> failwithf "unknown builtin witness '%s'" memberName + let vref = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, memberName, None, None, gtps, (List.map List.singleton argTys, retTy)) vref, tinst /// Find an FSharp.Core operator that corresponds to a trait witness member g.TryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy (t: TraitConstraintInfo) argExprs = - match t.MemberName, t.ArgumentTypes, t.ReturnType, argExprs with + match t.MemberLogicalName, t.CompiledObjectAndArgumentTypes, t.CompiledReturnType, argExprs with | "get_Sign", [aty], _, objExpr :: _ -> // Call Operators.sign let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "sign", None, Some "Sign", [vara], ([[varaTy]], v_int32_ty)) @@ -1827,7 +1829,7 @@ type TcGlobals( Some (info, tyargs, []) | ("Abs" | "Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10"| "Log"), [aty], _, [_] -> // Call corresponding Operators.* - let nm = t.MemberName + let nm = t.MemberLogicalName let lower = if nm = "Ceiling" then "ceil" else nm.ToLowerInvariant() let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, lower, None, Some nm, [vara], ([[varaTy]], varaTy)) let tyargs = [aty] diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 3645234338a..828dec9ef78 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2341,7 +2341,7 @@ type TyparConstraint = [] type TraitWitnessInfo = - | TraitWitnessInfo of TTypes * string * SynMemberFlags * TTypes * TType option + | TraitWitnessInfo of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTy: TType option /// Get the member name associated with the member constraint. member x.MemberName = (let (TraitWitnessInfo(_, b, _, _, _)) = x in b) @@ -2352,7 +2352,7 @@ type TraitWitnessInfo = [] member x.DebugText = x.ToString() - override x.ToString() = "TTrait(" + x.MemberName + ")" + override x.ToString() = "TraitWitnessInfo(" + x.MemberName + ")" /// The specification of a member constraint that must be solved [] @@ -2360,26 +2360,23 @@ type TraitConstraintInfo = /// Indicates the signature of a member constraint. Contains a mutable solution cell /// to store the inferred solution of the constraint. - | TTrait of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * argTys: TTypes * returnTy: TType option * solution: TraitConstraintSln option ref - - /// Get the key associated with the member constraint. - member x.TraitKey = (let (TTrait(a, b, c, d, e, _)) = x in TraitWitnessInfo(a, b, c, d, e)) + | TTrait of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTyOpt: TType option * solution: TraitConstraintSln option ref /// Get the types that may provide solutions for the traits - member x.GoverningTypes = (let (TTrait(tys, _, _, _, _, _)) = x in tys) + member x.SupportTypes = (let (TTrait(tys, _, _, _, _, _)) = x in tys) - /// Get the member name associated with the member constraint. - member x.MemberName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) + /// Get the logical member name associated with the member constraint. + member x.MemberLogicalName = (let (TTrait(_, nm, _, _, _, _)) = x in nm) /// Get the member flags associated with the member constraint. member x.MemberFlags = (let (TTrait(_, _, flags, _, _, _)) = x in flags) - /// Get the argument types recorded in the member constraint. This includes the object instance type for - /// instance members. - member x.ArgumentTypes = (let (TTrait(_, _, _, argTys, _, _)) = x in argTys) + member x.CompiledObjectAndArgumentTypes = (let (TTrait(_, _, _, objAndArgTys, _, _)) = x in objAndArgTys) - /// Get the return type recorded in the member constraint. - member x.ReturnType = (let (TTrait(_, _, _, _, ty, _)) = x in ty) + member x.WithMemberKind(kind) = (let (TTrait(a, b, c, d, e, f)) = x in TTrait(a, b, { c with MemberKind=kind }, d, e, f)) + + /// Get the optional return type recorded in the member constraint. + member x.CompiledReturnType = (let (TTrait(_, _, _, _, retTy, _)) = x in retTy) /// Get or set the solution of the member constraint during inference member x.Solution @@ -2389,7 +2386,7 @@ type TraitConstraintInfo = [] member x.DebugText = x.ToString() - override x.ToString() = "TTrait(" + x.MemberName + ")" + override x.ToString() = "TTrait(" + x.MemberLogicalName + ")" /// Represents the solution of a member constraint during inference. [] @@ -4927,7 +4924,7 @@ type TOp = | Return -> "Return" | Goto n -> "Goto(" + string n + ")" | Label n -> "Label(" + string n + ")" - | TraitCall info -> "TraitCall(" + info.MemberName + ")" + | TraitCall info -> "TraitCall(" + info.MemberLogicalName + ")" | LValueOp (op, vref) -> sprintf "%+A(%s)" op vref.LogicalName | ILCall (_,_,_,_,_,_,_,ilMethRef,_,_,_) -> "ILCall(" + ilMethRef.ToString() + ",..)" diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 89d0e8a8f24..120d2d3e92f 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1616,7 +1616,7 @@ type TyparConstraint = [] type TraitWitnessInfo = - | TraitWitnessInfo of TTypes * string * Syntax.SynMemberFlags * TTypes * TType option + | TraitWitnessInfo of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTy: TType option override ToString: unit -> string @@ -1639,8 +1639,8 @@ type TraitConstraintInfo = tys: TTypes * memberName: string * memberFlags: Syntax.SynMemberFlags * - argTys: TTypes * - returnTy: TType option * + objAndArgTys: TTypes * + returnTyOpt: TType option * solution: TraitConstraintSln option ref override ToString: unit -> string @@ -1649,26 +1649,31 @@ type TraitConstraintInfo = member DebugText: string /// Get the types that may provide solutions for the traits - member GoverningTypes: TType list + member SupportTypes: TType list /// Get the member flags associated with the member constraint. member MemberFlags: Syntax.SynMemberFlags - /// Get the member name associated with the member constraint. - member MemberName: string + /// Get the member name associated with the member constraint. For preop + member MemberLogicalName: string - /// Get the argument types recorded in the member constraint. This includes the object instance type for - /// instance members. - member ArgumentTypes: TTypes + /// Get the raw object and argument types recorded in the member constraint. This includes the object instance type + /// instance members. This may be empty for property traits e.g. + /// "(static member Zero: ^T)" + /// or unit-taking methods + /// "(static member get_Zero: unit -> ^T)" + /// See also extension members GetCompiledArgumentTypes and GetLogicalArgumentTypes + member CompiledObjectAndArgumentTypes: TTypes /// Get the return type recorded in the member constraint. - member ReturnType: TType option + member CompiledReturnType: TType option /// Get or set the solution of the member constraint during inference member Solution: TraitConstraintSln option with get, set - /// Get the key associated with the member constraint. - member TraitKey: TraitWitnessInfo + /// The member kind is irrelevant to the logical properties of a trait. However it adjusts + /// the extension property MemberDisplayNameCore + member WithMemberKind: SynMemberKind -> TraitConstraintInfo /// Represents the solution of a member constraint during inference. [] diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index ab04a0b48bd..1bca2cc2b2b 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -11,7 +11,6 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open Internal.Utilities.Rational -open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.DiagnosticsLogger @@ -972,7 +971,7 @@ type TypeEquivEnv with let rec traitsAEquivAux erasureFlag g aenv traitInfo1 traitInfo2 = let (TTrait(tys1, nm, mf1, argTys, retTy, _)) = traitInfo1 let (TTrait(tys2, nm2, mf2, argTys2, retTy2, _)) = traitInfo2 - mf1 = mf2 && + mf1.IsInstance = mf2.IsInstance && nm = nm2 && ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 && returnTypesAEquivAux erasureFlag g aenv retTy retTy2 && @@ -981,7 +980,7 @@ let rec traitsAEquivAux erasureFlag g aenv traitInfo1 traitInfo2 = and traitKeysAEquivAux erasureFlag g aenv witnessInfo1 witnessInfo2 = let (TraitWitnessInfo(tys1, nm, mf1, argTys, retTy)) = witnessInfo1 let (TraitWitnessInfo(tys2, nm2, mf2, argTys2, retTy2)) = witnessInfo2 - mf1 = mf2 && + mf1.IsInstance = mf2.IsInstance && nm = nm2 && ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 && returnTypesAEquivAux erasureFlag g aenv retTy retTy2 && @@ -2486,6 +2485,117 @@ let checkMemberVal membInfo arity m = let checkMemberValRef (vref: ValRef) = checkMemberVal vref.MemberInfo vref.ValReprInfo vref.Range +let GetFSharpViewOfReturnType (g: TcGlobals) retTy = + match retTy with + | None -> g.unit_ty + | Some retTy -> retTy + +type TraitConstraintInfo with + member traitInfo.GetReturnType(g: TcGlobals) = + GetFSharpViewOfReturnType g traitInfo.CompiledReturnType + + member traitInfo.GetObjectType() = + match traitInfo.MemberFlags.IsInstance, traitInfo.CompiledObjectAndArgumentTypes with + | true, objTy :: _ -> + Some objTy + | _ -> + None + + // For static property traits: + // ^T: (static member Zero: ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, Property, Static, [], ^T) + // and this returns + // [] + // + // For the logically equivalent static get_property traits (i.e. the property as a get_ method) + // ^T: (static member get_Zero: unit -> ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, Member, Static, [], ^T) + // and this returns + // [] + // + // For instance property traits + // ^T: (member Length: int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, Property, Instance, [], int) + // and this returns + // [] + // + // For the logically equivalent instance get_property traits (i.e. the property as a get_ method) + // ^T: (member get_Length: unit -> int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, Method, Instance, [^T], int) + // and this returns + // [] + // + // For index property traits + // ^T: (member Item: int -> int with get) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Item, Property, Instance, [^T; int], int) + // and this returns + // [int] + member traitInfo.GetCompiledArgumentTypes() = + match traitInfo.MemberFlags.IsInstance, traitInfo.CompiledObjectAndArgumentTypes with + | true, _ :: argTys -> + argTys + | _, argTys -> + argTys + + // For static property traits: + // ^T: (static member Zero: ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, PropertyGet, Static, [], ^T) + // and this returns + // [] + // + // For the logically equivalent static get_property traits (i.e. the property as a get_ method) + // ^T: (static member get_Zero: unit -> ^T) + // The inner representation is + // TraitConstraintInfo([^T], get_Zero, Member, Static, [], ^T) + // and this returns + // [unit] + // + // For instance property traits + // ^T: (member Length: int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, PropertyGet, Instance, [^T], int) + // and this views the constraint as if it were + // [] + // + // For the logically equivalent instance get_property traits (i.e. the property as a get_ method) + // ^T: (member get_Length: unit -> int) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Length, Member, Instance, [^T], int) + // and this returns + // [unit] + // + // For index property traits + // (member Item: int -> int with get) + // The inner TraitConstraintInfo representation is + // TraitConstraintInfo([^T], get_Item, PropertyGet, [^T; int], int) + // and this returns + // [int] + member traitInfo.GetLogicalArgumentTypes(g: TcGlobals) = + match traitInfo.GetCompiledArgumentTypes(), traitInfo.MemberFlags.MemberKind with + | [], SynMemberKind.Member -> [g.unit_ty] + | argTys, _ -> argTys + + member traitInfo.MemberDisplayNameCore = + let traitName0 = traitInfo.MemberLogicalName + match traitInfo.MemberFlags.MemberKind with + | SynMemberKind.PropertyGet + | SynMemberKind.PropertySet -> + match PrettyNaming.TryChopPropertyName traitName0 with + | Some nm -> nm + | None -> traitName0 + | _ -> traitName0 + + /// Get the key associated with the member constraint. + member traitInfo.GetWitnessInfo() = + let (TTrait(tys, nm, memFlags, objAndArgTys, rty, _)) = traitInfo + TraitWitnessInfo(tys, nm, memFlags, objAndArgTys, rty) + /// Get information about the trait constraints for a set of typars. /// Put these in canonical order. let GetTraitConstraintInfosOfTypars g (tps: Typars) = @@ -2495,13 +2605,13 @@ let GetTraitConstraintInfosOfTypars g (tps: Typars) = | TyparConstraint.MayResolveMember(traitInfo, _) -> yield traitInfo | _ -> () ] |> ListSet.setify (traitsAEquiv g TypeEquivEnv.Empty) - |> List.sortBy (fun traitInfo -> traitInfo.MemberName, traitInfo.ArgumentTypes.Length) + |> List.sortBy (fun traitInfo -> traitInfo.MemberLogicalName, traitInfo.GetCompiledArgumentTypes().Length) /// Get information about the runtime witnesses needed for a set of generalized typars let GetTraitWitnessInfosOfTypars g numParentTypars typars = let typs = typars |> List.skip numParentTypars let cxs = GetTraitConstraintInfosOfTypars g typs - cxs |> List.map (fun cx -> cx.TraitKey) + cxs |> List.map (fun cx -> cx.GetWitnessInfo()) /// Count the number of type parameters on the enclosing type let CountEnclosingTyparsOfActualParentOfVal (v: Val) = @@ -2606,12 +2716,6 @@ let ArgInfosOfMemberVal g (v: Val) = let ArgInfosOfMember g (vref: ValRef) = ArgInfosOfMemberVal g vref.Deref -let GetFSharpViewOfReturnType (g: TcGlobals) retTy = - match retTy with - | None -> g.unit_ty - | Some retTy -> retTy - - /// Get the property "type" (getter return type) for an F# value that represents a getter or setter /// of an object model property. let ReturnTypeOfPropertyVal g (v: Val) = @@ -2673,7 +2777,7 @@ let isTTyparCoercesToType = function TyparConstraint.CoercesTo _ -> true | _ -> let prefixOfStaticReq s = match s with | TyparStaticReq.None -> "'" - | TyparStaticReq.HeadType -> " ^" + | TyparStaticReq.HeadType -> "^" let prefixOfInferenceTypar (typar: Typar) = if typar.Rigidity <> TyparRigidity.Rigid then "_" else "" @@ -6326,14 +6430,16 @@ let rec tyOfExpr g expr = | TOp.LValueOp (LByrefGet, v) -> destByrefTy g v.Type | TOp.LValueOp (LAddrOf readonly, v) -> mkByrefTyWithFlag g readonly v.Type | TOp.RefAddrGet readonly -> (match tinst with [ty] -> mkByrefTyWithFlag g readonly ty | _ -> failwith "bad TOp.RefAddrGet node") - | TOp.TraitCall traitInfo -> GetFSharpViewOfReturnType g traitInfo.ReturnType + | TOp.TraitCall traitInfo -> traitInfo.GetReturnType(g) | TOp.Reraise -> (match tinst with [rtn_ty] -> rtn_ty | _ -> failwith "bad TOp.Reraise node") | 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 g.unit_ty - | Expr.WitnessArg (traitInfo, _m) -> GenWitnessTy g traitInfo.TraitKey + | Expr.WitnessArg (traitInfo, _m) -> + let witnessInfo = traitInfo.GetWitnessInfo() + GenWitnessTy g witnessInfo //-------------------------------------------------------------------------- // Make applications @@ -10151,3 +10257,4 @@ let isFSharpExceptionTy g ty = match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.IsFSharpException | _ -> false + diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index a7ad47779dc..a004a2651b4 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2647,3 +2647,21 @@ val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option /// Indicates if an F# type is the type associated with an F# exception declaration val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool + +type TraitConstraintInfo with + /// Get the argument types recorded in the member constraint suitable for building a TypedTree call. + member GetCompiledArgumentTypes: unit -> TType list + + /// Get the argument types when the trait is used as a first-class value "^T.TraitName" which can then be applied + member GetLogicalArgumentTypes: g: TcGlobals -> TType list + + member GetObjectType: unit -> TType option + + member GetReturnType: g: TcGlobals -> TType + + /// Get the name of the trait for textual call. + member MemberDisplayNameCore: string + + /// Get the key associated with the member constraint. + member GetWitnessInfo: unit -> TraitWitnessInfo + diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index e9ec201571b..d49557a06b1 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -509,8 +509,7 @@ let rangeOfLongIdent(lid:LongIdent) = %nonassoc expr_not %left COLON_GREATER COLON_QMARK_GREATER %left INFIX_COMPARE_OP DOLLAR LESS GREATER EQUALS INFIX_BAR_OP INFIX_AMP_OP -%left infix_at_hat_op_prefix -%right INFIX_AT_HAT_OP infix_at_hat_op_binary +%right INFIX_AT_HAT_OP %right COLON_COLON %nonassoc pat_isinst %left COLON_QMARK @@ -2394,6 +2393,9 @@ typeConstraint: | "unmanaged" -> SynTypeConstraint.WhereTyparIsUnmanaged($1, lhs parseState) | nm -> raiseParseErrorAt (rhs parseState 3) (FSComp.SR.parsUnexpectedIdentifier(nm)) } + | appType + { SynTypeConstraint.WhereSelfConstrained($1, lhs parseState) } + typarAlts: | typarAlts OR appType { $3 :: $1 } @@ -3893,7 +3895,7 @@ declExpr: | declExpr GREATER declExpr { mkSynInfix (rhs parseState 2) $1 ">" $3 } - | declExpr INFIX_AT_HAT_OP declExpr %prec infix_at_hat_op_binary + | declExpr INFIX_AT_HAT_OP declExpr { mkSynInfix (rhs parseState 2) $1 $2 $3 } | declExpr PERCENT_OP declExpr @@ -4020,11 +4022,6 @@ declExpr: { let m = rhs parseState 1 SynExpr.IndexRange(None, m, None, m, m, m) } - | INFIX_AT_HAT_OP declExpr %prec infix_at_hat_op_prefix - { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator()) - let m = (rhs2 parseState 1 2) - SynExpr.HatPrefix($2, m) } - | minusExpr %prec expr_prefix_plus_minus { $1 } dynamicArg: @@ -4217,6 +4214,11 @@ tupleExpr: [(arbExpr("tupleExpr4", zeroWidthAtNextToken)); arbExpr ("tupleExpr5", commaRange.StartRange)], [commaRange] } minusExpr: + | INFIX_AT_HAT_OP minusExpr + { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator()) + let m = (rhs2 parseState 1 2) + SynExpr.IndexFromEnd($2, m) } + | MINUS minusExpr %prec expr_prefix_plus_minus { mkSynPrefix (rhs parseState 1) (unionRanges (rhs parseState 1) $2.Range) "~-" $2 } diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 4c85a023e07..703ab1137ad 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -187,6 +187,11 @@ Notace expr[idx] pro indexování a vytváření řezů + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation rozhraní s vícenásobným obecným vytvářením instancí @@ -257,6 +262,11 @@ obnovitelné stavové stroje + + self type constraints + self type constraints + + single underscore pattern vzor s jedním podtržítkem @@ -272,11 +282,6 @@ reprezentace struktury aktivních vzorů - - static abstract interface members - static abstract interface members - - wild card in for loop zástupný znak ve smyčce for @@ -737,6 +742,11 @@ Konstruktor {0} je možné použít jenom v platném obnovitelném kódu. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Použití [<Struct>] u hodnot, funkcí a metod je povolené jenom u částečných aktivních definic vzorů. @@ -862,6 +872,26 @@ Tento výraz implicitně převede typ {0} na typ {1}. Přečtěte si téma https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Neplatný interpolovaný řetězec. {0} diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index e7c136a10fe..301c15063cc 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -187,6 +187,11 @@ expr[idx]-Notation zum Indizieren und Aufteilen + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation Schnittstellen mit mehrfacher generischer Instanziierung @@ -257,6 +262,11 @@ Fortsetzbarer Zustand-Maschinen + + self type constraints + self type constraints + + single underscore pattern Muster mit einzelnem Unterstrich @@ -272,11 +282,6 @@ Strukturdarstellung für aktive Muster - - static abstract interface members - static abstract interface members - - wild card in for loop Platzhalter in for-Schleife @@ -737,6 +742,11 @@ Das Konstrukt "{0}" darf nur in einem gültigen fortsetzbaren Code verwendet werden. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Die Verwendung von "[<Struct>]" für Werte, Funktionen und Methoden ist nur für partielle aktive Musterdefinitionen zulässig. @@ -862,6 +872,26 @@ Dieser Ausdruck konvertiert den Typ "{0}" implizit in den Typ "{1}". Siehe https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Ungültige interpolierte Zeichenfolge. {0} diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 2dc664eb89c..18834182e1b 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -187,6 +187,11 @@ Notación para indexación y segmentación expr[idx] + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation interfaces con creación de instancias genéricas múltiples @@ -257,6 +262,11 @@ máquinas de estado reanudables + + self type constraints + self type constraints + + single underscore pattern patrón de subrayado simple @@ -272,11 +282,6 @@ representación de struct para modelos activos - - static abstract interface members - static abstract interface members - - wild card in for loop carácter comodín en bucle for @@ -737,6 +742,11 @@ La construcción "{0}" solo se puede usar en un código reanudable válido. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions El uso de «[<Struct>]» en valores, funciones y métodos solo se permite en definiciones de modelos activos parciales. @@ -862,6 +872,26 @@ Esta expresión convierte implícitamente el tipo '{0}' al tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Cadena interpolada no válida. {0} diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 1431fd23c22..07484dff037 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -187,6 +187,11 @@ Notation expr[idx] pour l’indexation et le découpage + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation interfaces avec plusieurs instanciations génériques @@ -257,6 +262,11 @@ ordinateurs d’état pouvant être repris + + self type constraints + self type constraints + + single underscore pattern modèle de trait de soulignement unique @@ -272,11 +282,6 @@ représentation de structure pour les modèles actifs - - static abstract interface members - static abstract interface members - - wild card in for loop caractère générique dans une boucle for @@ -737,6 +742,11 @@ La construction «{0}» ne peut être utilisée que dans un code pouvant être repris valide. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions L’utilisation de' [<Struct>] 'sur les valeurs, les fonctions et les méthodes n’est autorisée que sur les définitions de modèle actif partiel @@ -862,6 +872,26 @@ Cette expression convertit implicitement le type « {0} » en type « {1} ». Voir https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Chaîne interpolée non valide. {0} diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 3295cd781aa..771a794a425 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -187,6 +187,11 @@ Notazione expr[idx] per l'indicizzazione e il sezionamento + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation interfacce con più creazioni di istanze generiche @@ -257,6 +262,11 @@ macchine a stati ripristinabili + + self type constraints + self type constraints + + single underscore pattern criterio per carattere di sottolineatura singolo @@ -272,11 +282,6 @@ rappresentazione struct per criteri attivi - - static abstract interface members - static abstract interface members - - wild card in for loop carattere jolly nel ciclo for @@ -737,6 +742,11 @@ Il costrutto '{0}' può essere usato solo in codice ripristinabile valido. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions L'utilizzo di '[<Struct>]' su valori, funzioni e metodi è consentito solo per definizioni di criteri attivi parziali @@ -862,6 +872,26 @@ Questa espressione converte in modo implicito il tipo '{0}' nel tipo '{1}'. Vedere https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} La stringa interpolata non è valida. {0} diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 63e74db8ed0..50460b16ddb 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -187,6 +187,11 @@ インデックス作成とスライス用の expr[idx] 表記 + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation 複数のジェネリックのインスタンス化を含むインターフェイス @@ -257,6 +262,11 @@ 再開可能なステート マシン + + self type constraints + self type constraints + + single underscore pattern 単一のアンダースコア パターン @@ -272,11 +282,6 @@ アクティブなパターンの構造体表現 - - static abstract interface members - static abstract interface members - - wild card in for loop for ループのワイルド カード @@ -737,6 +742,11 @@ コンストラクト '{0}' は、有効な再開可能コードでのみ使用できます。 + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 値、関数、およびメソッドでの '[<Struct>]' は、部分的なアクティブ パターンの定義でのみ使うことができます @@ -862,6 +872,26 @@ この式は、型 '{0}' を型 '{1}' に暗黙的に変換します。https://aka.ms/fsharp-implicit-convs を参照してください。 + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 補間された文字列が無効です。{0} diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index cf6e4076aaf..94cd310f3bf 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -187,6 +187,11 @@ 인덱싱 및 슬라이싱을 위한 expr[idx] 표기법 + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation 여러 제네릭 인스턴스화가 포함된 인터페이스 @@ -257,6 +262,11 @@ 다시 시작 가능한 상태 시스템 + + self type constraints + self type constraints + + single underscore pattern 단일 밑줄 패턴 @@ -272,11 +282,6 @@ 활성 패턴에 대한 구조체 표현 - - static abstract interface members - static abstract interface members - - wild card in for loop for 루프의 와일드카드 @@ -737,6 +742,11 @@ '{0}' 구문은 유효한 다시 시작 가능한 코드에서만 사용할 수 있습니다. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 값, 함수 및 메서드에 '[<Struct>]'을(를) 사용하는 것은 부분 활성 패턴 정의에서만 허용됩니다. @@ -862,6 +872,26 @@ 이 식은 암시적으로 '{0}' 형식을 '{1}' 형식으로 변환 합니다. https://aka.ms/fsharp-implicit-convs 참조 + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 잘못된 보간 문자열. {0} diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index c855935136b..5dc3f8ee344 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -187,6 +187,11 @@ notacja wyrażenia expr[idx] do indeksowania i fragmentowania + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation interfejsy z wieloma ogólnymi wystąpieniami @@ -257,6 +262,11 @@ automaty stanów z możliwością wznowienia + + self type constraints + self type constraints + + single underscore pattern wzorzec z pojedynczym podkreśleniem @@ -272,11 +282,6 @@ reprezentacja struktury aktywnych wzorców - - static abstract interface members - static abstract interface members - - wild card in for loop symbol wieloznaczny w pętli for @@ -737,6 +742,11 @@ Konstrukcji "{0}" można używać tylko w prawidłowym kodzie z możliwością wznowienia. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Używanie elementu "[<Struct>]" na wartościach, funkcjach i metodach jest dozwolone tylko w definicjach częściowo aktywnego wzorca @@ -862,6 +872,26 @@ To wyrażenie bezwzględnie konwertuje typ "{0}" na typ "{1}". Zobacz https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Nieprawidłowy ciąg interpolowany. {0} diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 353b1dad8fb..b816fd6e3d1 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -187,6 +187,11 @@ notação expr[idx] para indexação e fatia + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation interfaces com várias instanciações genéricas @@ -257,6 +262,11 @@ máquinas de estado retomável + + self type constraints + self type constraints + + single underscore pattern padrão de sublinhado simples @@ -272,11 +282,6 @@ representação estrutural para padrões ativos - - static abstract interface members - static abstract interface members - - wild card in for loop curinga para loop @@ -737,6 +742,11 @@ A construção '{0}' só pode ser usada em código válido e retomável. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions O uso de '[<Struct>]' em valores, funções e métodos somente é permitido em definições de padrões ativos parciais @@ -862,6 +872,26 @@ Essa expressão converte implicitamente o tipo '{0}' ao tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Cadeia de caracteres interpolada inválida. {0} diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 6b813eef9d9..739610684b6 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -187,6 +187,11 @@ expr[idx] для индексации и среза + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation интерфейсы с множественным универсальным созданием экземпляра @@ -257,6 +262,11 @@ возобновляемые конечные автоматы + + self type constraints + self type constraints + + single underscore pattern шаблон с одним подчеркиванием @@ -272,11 +282,6 @@ представление структуры для активных шаблонов - - static abstract interface members - static abstract interface members - - wild card in for loop подстановочный знак в цикле for @@ -737,6 +742,11 @@ Конструкция "{0}" может использоваться только в допустимом возобновляемом коде. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Использование "[<Struct>]" для значений, функций и методов разрешено только для определений частичных активных шаблонов @@ -862,6 +872,26 @@ Это выражение неявно преобразует тип "{0}" в тип "{1}". См. сведения на странице https://aka.ms/fsharp-implicit-convs. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Недопустимая интерполированная строка. {0} diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index c9861e14475..f6715efa464 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -187,6 +187,11 @@ Dizin oluşturma ve dilimleme için expr[idx] gösterimi + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation birden çok genel örnek oluşturma içeren arabirimler @@ -257,6 +262,11 @@ sürdürülebilir durum makineleri + + self type constraints + self type constraints + + single underscore pattern tek alt çizgi deseni @@ -272,11 +282,6 @@ etkin desenler için yapı gösterimi - - static abstract interface members - static abstract interface members - - wild card in for loop for döngüsünde joker karakter @@ -737,6 +742,11 @@ '{0}' yapısı yalnızca geçerli sürdürülebilir kodda kullanılabilir. + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions Değerlerde, işlevlerde ve yöntemlerde '[<Struct>]' kullanımına yalnızca kısmi etkin desen tanımlarında izin veriliyor @@ -862,6 +872,26 @@ Bu ifade '{0}' türünü örtülü olarak '{1}' türüne dönüştürür. https://aka.ms/fsharp-implicit-convs adresine bakın. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} Geçersiz düz metin arasına kod eklenmiş dize. {0} diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 103737b770e..db277e7528b 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -187,6 +187,11 @@ 用于索引和切片的 expr[idx] 表示法 + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation 具有多个泛型实例化的接口 @@ -257,6 +262,11 @@ 可恢复状态机 + + self type constraints + self type constraints + + single underscore pattern 单下划线模式 @@ -272,11 +282,6 @@ 活动模式的结构表示形式 - - static abstract interface members - static abstract interface members - - wild card in for loop for 循环中的通配符 @@ -737,6 +742,11 @@ 构造 "{0}" 只能在有效的可恢复代码中使用。 + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 只允许在部分活动模式定义中对值、函数和方法使用 "[<Struct>]" @@ -862,6 +872,26 @@ 此表达式将类型“{0}”隐式转换为类型“{1}”。请参阅 https://aka.ms/fsharp-implicit-convs。 + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 内插字符串无效。{0} diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index f3c07baff97..67fc93ff1d2 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -187,6 +187,11 @@ 用於編製索引和分割的 expr[idx] 註釋 + + static abstract interface members + static abstract interface members + + interfaces with multiple generic instantiation 具有多個泛型具現化的介面 @@ -257,6 +262,11 @@ 可繼續的狀態機器 + + self type constraints + self type constraints + + single underscore pattern 單一底線模式 @@ -272,11 +282,6 @@ 現用模式的結構表示法 - - static abstract interface members - static abstract interface members - - wild card in for loop for 迴圈中的萬用字元 @@ -737,6 +742,11 @@ 建構 '{0}' 只能用於有效的可繼續程式碼。 + + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + + The use of '[<Struct>]' on values, functions and methods is only allowed on partial active pattern definitions 只允許在部分現用模式定義上對值、函式和方法使用 '[<Struct>]' @@ -862,6 +872,26 @@ 此運算式將類型 '{0}' 隱含轉換為類型 '{1}'。請參閱 https://aka.ms/fsharp-implicit-convs。 + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. + + + + Trait '{0}' is not static + Trait '{0}' is not static + + + + Trait '{0}' is static + Trait '{0}' is static + + + + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments + + Invalid interpolated string. {0} 插補字串無效。{0} diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 71a5cd0d1a2..7ac521723f3 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -1,3 +1,5 @@ +open System + let legacyConcat1 (x: string) (y: string) = x ^ y let legacyConcat2 (x: string) (y: string) = x ^y let legacyConcat3 (x: string) (y: string) = x^ y @@ -11,34 +13,256 @@ let testSlicingTwo() = let arr = [| 1;2;3;4;5 |] arr[^3..] -type IAdditionOperator<'T> = +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +type IStaticMethod<'T when 'T :> IStaticMethod<'T>> = + static abstract StaticMethod: 'T -> 'T + +type IUnitMethod<'T when 'T :> IUnitMethod<'T>> = + static abstract UnitMethod: unit -> unit + +type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = static abstract op_Addition: 'T * 'T -> 'T type C(c: int) = member _.Value = c interface IAdditionOperator with static member op_Addition(x, y) = C(x.Value + y.Value) + interface IStaticProperty with + static member StaticProperty = C(7) + interface IStaticMethod with + static member StaticMethod(x) = C(x.Value + 4) + interface IUnitMethod with + static member UnitMethod() = () -let f<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = +let f_IWSAM_explicit_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = 'T.op_Addition(x, y) -let f2<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = +let f_IWSAM_pretty_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = 'T.(+)(x, y) -if f(C(3), C(4)).Value <> 7 then - failwith "incorrect value" +let f_IWSAM_StaticProperty<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty + +let f_IWSAM_declared_StaticMethod<'T when 'T :> IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) + +let f_IWSAM_declared_UnitMethod<'T when 'T :> IUnitMethod<'T>>() = + 'T.UnitMethod() + +let f_IWSAM_declared_UnitMethod_list<'T when 'T :> IUnitMethod<'T>>() = + let v = 'T.UnitMethod() + [ v ] + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty + +let f_IWSAM_flex_StaticMethod(x: #IStaticMethod<'T>) = + 'T.StaticMethod(x) + let inline f3<^T when ^T :> IAdditionOperator<^T>>(x: ^T, y: ^T) = - ^T.op_Addition(x,y) + 'T.op_Addition(x,y) let inline f4<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = - ^T.op_Addition(x,y) + 'T.op_Addition(x,y) let inline f5<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = - ^T.(+)(x,y) + 'T.(+)(x,y) let inline f6<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = x + y +let inline f_StaticProperty_IWSAM<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty + +let inline f_StaticProperty_SRTP<^T when ^T : (static member StaticProperty: ^T) >() = + 'T.StaticProperty + +let inline f_StaticProperty_BOTH<^T when ^T :> IStaticProperty<^T> and ^T : (static member StaticProperty: ^T) >() = + 'T.StaticProperty + +module CheckExecution = + if f_IWSAM_explicit_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + + if f_IWSAM_pretty_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + + if f_IWSAM_StaticProperty().Value <> 7 then + failwith "incorrect value" + +module EquivalenceOfPropertiesAndGetters = + // Check that "property" and "get_ method" constraints are considered logically equivalent + let inline f_StaticProperty<^T when ^T : (static member StaticProperty: int) >() = (^T : (static member StaticProperty: int) ()) + let inline f_StaticProperty_explicit<^T when ^T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) + let inline f_StaticProperty_mixed<^T when ^T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member StaticProperty: int) ()) + let inline f_StaticProperty_mixed2<^T when ^T : (static member StaticProperty: int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) + + let inline f_set_StaticProperty<^T when ^T : (static member StaticProperty: int with set) >() = (^T : (static member StaticProperty: int with set) (3)) + let inline f_set_StaticProperty_explicit<^T when ^T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) + let inline f_set_StaticProperty_mixed<^T when ^T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member StaticProperty: int with set) (3)) + let inline f_set_StaticProperty_mixed2<^T when ^T : (static member StaticProperty: int with set) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) + + let inline f_Length<^T when ^T : (member Length: int) >(x: ^T) = (^T : (member Length: int) (x)) + let inline f_Length_explicit<^T when ^T : (member get_Length: unit -> int) >(x: ^T) = (^T : (member get_Length: unit -> int) (x)) + let inline f_Length_mixed<^T when ^T : (member get_Length: unit -> int) >(x: ^T) = (^T : (member Length: int) (x)) + let inline f_Length_mixed2<^T when ^T : (member Length: int) >(x: ^T) = (^T : (member get_Length: unit -> int) (x)) + + let inline f_set_Length<^T when ^T : (member Length: int with set) >(x: ^T) = (^T : (member Length: int with set) (x, 3)) + let inline f_set_Length_explicit<^T when ^T : (member set_Length: int -> unit) >(x: ^T) = (^T : (member set_Length: int -> unit) (x, 3)) + let inline f_set_Length_mixed<^T when ^T : (member set_Length: int -> unit) >(x: ^T) = (^T : (member Length: int with set) (x, 3)) + let inline f_set_Length_mixed2<^T when ^T : (member Length: int with set) >(x: ^T) = (^T : (member set_Length: int -> unit) (x, 3)) + + let inline f_Item<^T when ^T : (member Item: int -> string with get) >(x: ^T) = (^T : (member Item: int -> string with get) (x, 3)) + let inline f_Item_explicit<^T when ^T : (member get_Item: int -> string) >(x: ^T) = (^T : (member get_Item: int -> string) (x, 3)) + let inline f_Item_mixed<^T when ^T : (member get_Item: int -> string) >(x: ^T) = (^T : (member Item: int -> string with get) (x, 3)) + let inline f_Item_mixed2<^T when ^T : (member Item: int -> string with get) >(x: ^T) = (^T : (member get_Item: int -> string) (x, 3)) + + //let inline f_set_Item<^T when ^T : (member Item: int -> string with set) >(x: ^T) = (^T : (member Item: int -> string with set) (x, 3, "a")) + //let inline f_set_Item_explicit<^T when ^T : (member set_Item: int * string -> int) >(x: ^T) = (^T : (member set_Item: int * string -> int) (x, 3, "a")) + + +module CheckSelfConstrainedSRTP = + type WithStaticProperty<^T when ^T : (static member StaticProperty: int)> = ^T + type WithStaticMethod<^T when ^T : (static member StaticMethod: int -> int)> = ^T + type WithBoth<^T when WithStaticProperty<^T> and WithStaticMethod<^T>> = ^T + + let inline f_StaticProperty<^T when WithStaticProperty<^T>>() = 'T.StaticProperty + let inline f_StaticMethod<^T when WithStaticMethod<^T>>() = 'T.StaticMethod(3) + let inline f_Both<^T when WithBoth<^T> >() = + let v1 = 'T.StaticProperty + let v2 = 'T.StaticMethod(3) + v1 + v2 + + type AverageOps<^T when ^T: (static member (+): ^T * ^T -> ^T) + and ^T: (static member DivideByInt : ^T*int -> ^T) + and ^T: (static member Zero : ^T)> = ^T + + let inline f_OK1<^T when WithBoth<^T>>() = + 'T.StaticMethod(3) + 'T.StaticMethod(3) + + let inline f_OK2<^T when WithBoth<^T>>() = + 'T.StaticMethod(3) + 'T.StaticMethod(3) + + let inline f_Bug1<^T when WithBoth<^T>>() = + printfn "" + 'T.StaticMethod(3) + //let inline f_Bug1<^T when WithBoth<^T>>() = + // 'T.StaticMethod(3) + // 'T.StaticMethod(3) + //let inline f_Bug2<^T when WithBoth<^T>>() = + // 'T.StaticMethod(3) + // 'T.StaticMethod(3) +// BUG + //let inline f_Both<^T when WithBoth<^T>>() = + // 'T.StaticMethod(3) + // 'T.StaticMethod(3) + + //'T.StaticMethod(3) |> ignore + +module CheckSelfSRTP = + type IStaticProperty<'T when IStaticProperty<'T>> = + static abstract StaticProperty: 'T + + type IStaticMethod<'T when IStaticMethod<'T>> = + static abstract StaticMethod: 'T -> 'T + + type IUnitMethod<'T when IUnitMethod<'T>> = + static abstract UnitMethod: unit -> unit + + type IAdditionOperator<'T when IAdditionOperator<'T>> = + static abstract op_Addition: 'T * 'T -> 'T + + type C(c: int) = + member _.Value = c + interface IAdditionOperator with + static member op_Addition(x, y) = C(x.Value + y.Value) + interface IStaticProperty with + static member StaticProperty = C(7) + interface IStaticMethod with + static member StaticMethod(x) = C(x.Value + 4) + interface IUnitMethod with + static member UnitMethod() = () + + let f_IWSAM_explicit_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + + let f_IWSAM_pretty_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.(+)(x, y) + + let f_IWSAM_StaticProperty<'T when IStaticProperty<'T>>() = + 'T.StaticProperty + + let f_IWSAM_declared_StaticMethod<'T when IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) + + let f_IWSAM_declared_UnitMethod<'T when IUnitMethod<'T>>() = + 'T.UnitMethod() + + let f_IWSAM_declared_UnitMethod_list<'T when IUnitMethod<'T>>() = + let v = 'T.UnitMethod() + [ v ] + + let inline f3<^T when IAdditionOperator<^T>>(x: ^T, y: ^T) = + 'T.op_Addition(x,y) + + let inline f_StaticProperty_IWSAM<'T when IStaticProperty<'T>>() = + 'T.StaticProperty + +module CheckNewSyntax = + // Check that "property" and "get_ method" constraints are considered logically equivalent + let inline f_StaticProperty<^T when ^T : (static member StaticProperty: int) >() : int = 'T.StaticProperty + + let inline f_StaticMethod<^T when ^T : (static member StaticMethod: int -> int) >() : int = 'T.StaticMethod(3) + + let inline f_set_StaticProperty<^T when ^T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3) + + let inline f_Length<^T when ^T : (member Length: int) >(x: ^T) = x.Length + + let inline f_set_Length<^T when ^T : (member Length: int with set) >(x: ^T) = x.set_Length(3) + + let inline f_Item1<^T when ^T : (member Item: int -> string with get) >(x: ^T) = x.get_Item(3) + + // Limitation: As yet the syntax "'T.StaticProperty <- 3" can't be used + // Limitation: As yet the syntax "x.Length <- 3" can't be used + // Limitation: As yet the syntax "x[3]" can't be used, nor can any slicing syntax + // Limitation: The disposal pattern can't be used with "use" + + //let inline f_set_StaticProperty2<^T when ^T : (static member StaticProperty: int with set) >() = 'T.StaticProperty <- 3 + //let inline f_set_Length2<^T when ^T : (member Length: int with set) >(x: ^T) = x.Length <- 3 + //let inline f_Item2<^T when ^T : (member Item: int -> string with get) >(x: ^T) = x[3] + +let f_StaticMethod_IWSAM<'T when 'T :> IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) + +let inline f_StaticMethod_SRTP<^T when ^T : (static member StaticMethod: ^T -> ^T) >(x: ^T) = + 'T.StaticMethod(x) + +let inline f_StaticMethod_BOTH<^T when ^T :> IStaticMethod<^T> and ^T : (static member StaticMethod: ^T -> ^T) >(x: ^T) = + 'T.StaticMethod(x) + + +#if NEGATIVE +module Negative = + let inline f_TraitWithOptional<^T when ^T : (static member StaticMethod: ?x: int -> int) >() = () + let inline f_TraitWithIn<^T when ^T : (static member StaticMethod: x: inref -> int) >() = () + let inline f_TraitWithOut<^T when ^T : (static member StaticMethod: x: outref -> int) >() = () + let inline f_TraitWithParamArray<^T when ^T : (static member StaticMethod: [] x: int[] -> int) >() = () + let inline f_TraitWithCallerName<^T when ^T : (static member StaticMethod: [] x: int[] -> int) >() = () + let inline f_TraitWithExpression<^T when ^T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = () +#endif + + //let f7<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = // x + y + +(* +let inline f_SRTP_GoToDefinition_FindAllReferences (x: ^T) = + let y = x + x // implicitly adds constraint to type inference variable ^T + let z = 'T.op_Addition(x, x) // where would go-to-definition go? what does find-all-references do? + y + z +*) From c038f9c1efad18fdad90fd7a5dd847d50ef9fd5f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 29 Jun 2022 15:44:56 +0100 Subject: [PATCH 30/91] update samples --- src/Compiler/Checking/ConstraintSolver.fs | 6 +- tests/adhoc.fsx | 154 +++++++++++----------- 2 files changed, 80 insertions(+), 80 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index dd89b76c6be..cf3c366d936 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -996,12 +996,12 @@ and SolveTyparEqualsTypePart2 (csenv: ConstraintSolverEnv) ndeep m2 (trace: Opti do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep PermitWeakResolution.No trace r) // Re-solve the other constraints associated with this type variable - return! solveTypMeetsTyparConstraints csenv ndeep m2 trace ty r + return! SolveTypMeetsTyparConstraints csenv ndeep m2 trace ty r } /// Apply the constraints on 'typar' to the type 'ty' -and solveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty (r: Typar) = trackErrors { +and SolveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty (r: Typar) = trackErrors { let g = csenv.g // Propagate compat flex requirements from 'tp' to 'ty' @@ -1424,7 +1424,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload when // This simulates the existence of // float * float -> float - // float32 * float32 -> float32 + // float32 * float32 -> float32 // float<'u> * float<'v> -> float<'u 'v> // float32<'u> * float32<'v> -> float32<'u 'v> // decimal<'u> * decimal<'v> -> decimal<'u 'v> diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 7ac521723f3..85d2a3e5de6 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -62,25 +62,25 @@ let f_IWSAM_flex_StaticMethod(x: #IStaticMethod<'T>) = 'T.StaticMethod(x) -let inline f3<^T when ^T :> IAdditionOperator<^T>>(x: ^T, y: ^T) = +let inline f3<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = 'T.op_Addition(x,y) -let inline f4<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = +let inline f4<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = 'T.op_Addition(x,y) -let inline f5<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = +let inline f5<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = 'T.(+)(x,y) -let inline f6<^T when ^T : (static member (+): ^T * ^T -> ^T)>(x: ^T, y: ^T) = +let inline f6<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = x + y let inline f_StaticProperty_IWSAM<'T when 'T :> IStaticProperty<'T>>() = 'T.StaticProperty -let inline f_StaticProperty_SRTP<^T when ^T : (static member StaticProperty: ^T) >() = +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = 'T.StaticProperty -let inline f_StaticProperty_BOTH<^T when ^T :> IStaticProperty<^T> and ^T : (static member StaticProperty: ^T) >() = +let inline f_StaticProperty_BOTH<'T when 'T :> IStaticProperty<'T> and 'T : (static member StaticProperty: 'T) >() = 'T.StaticProperty module CheckExecution = @@ -95,70 +95,70 @@ module CheckExecution = module EquivalenceOfPropertiesAndGetters = // Check that "property" and "get_ method" constraints are considered logically equivalent - let inline f_StaticProperty<^T when ^T : (static member StaticProperty: int) >() = (^T : (static member StaticProperty: int) ()) - let inline f_StaticProperty_explicit<^T when ^T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) - let inline f_StaticProperty_mixed<^T when ^T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member StaticProperty: int) ()) - let inline f_StaticProperty_mixed2<^T when ^T : (static member StaticProperty: int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) + let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() = (^T : (static member StaticProperty: int) ()) + let inline f_StaticProperty_explicit<'T when 'T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) + let inline f_StaticProperty_mixed<'T when 'T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member StaticProperty: int) ()) + let inline f_StaticProperty_mixed2<'T when 'T : (static member StaticProperty: int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) - let inline f_set_StaticProperty<^T when ^T : (static member StaticProperty: int with set) >() = (^T : (static member StaticProperty: int with set) (3)) - let inline f_set_StaticProperty_explicit<^T when ^T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) - let inline f_set_StaticProperty_mixed<^T when ^T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member StaticProperty: int with set) (3)) - let inline f_set_StaticProperty_mixed2<^T when ^T : (static member StaticProperty: int with set) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) + let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = (^T : (static member StaticProperty: int with set) (3)) + let inline f_set_StaticProperty_explicit<'T when 'T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) + let inline f_set_StaticProperty_mixed<'T when 'T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member StaticProperty: int with set) (3)) + let inline f_set_StaticProperty_mixed2<'T when 'T : (static member StaticProperty: int with set) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) - let inline f_Length<^T when ^T : (member Length: int) >(x: ^T) = (^T : (member Length: int) (x)) - let inline f_Length_explicit<^T when ^T : (member get_Length: unit -> int) >(x: ^T) = (^T : (member get_Length: unit -> int) (x)) - let inline f_Length_mixed<^T when ^T : (member get_Length: unit -> int) >(x: ^T) = (^T : (member Length: int) (x)) - let inline f_Length_mixed2<^T when ^T : (member Length: int) >(x: ^T) = (^T : (member get_Length: unit -> int) (x)) + let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = (^T : (member Length: int) (x)) + let inline f_Length_explicit<'T when 'T : (member get_Length: unit -> int) >(x: 'T) = (^T : (member get_Length: unit -> int) (x)) + let inline f_Length_mixed<'T when 'T : (member get_Length: unit -> int) >(x: 'T) = (^T : (member Length: int) (x)) + let inline f_Length_mixed2<'T when 'T : (member Length: int) >(x: 'T) = (^T : (member get_Length: unit -> int) (x)) - let inline f_set_Length<^T when ^T : (member Length: int with set) >(x: ^T) = (^T : (member Length: int with set) (x, 3)) - let inline f_set_Length_explicit<^T when ^T : (member set_Length: int -> unit) >(x: ^T) = (^T : (member set_Length: int -> unit) (x, 3)) - let inline f_set_Length_mixed<^T when ^T : (member set_Length: int -> unit) >(x: ^T) = (^T : (member Length: int with set) (x, 3)) - let inline f_set_Length_mixed2<^T when ^T : (member Length: int with set) >(x: ^T) = (^T : (member set_Length: int -> unit) (x, 3)) + let inline f_set_Length<'T when 'T : (member Length: int with set) >(x: 'T) = (^T : (member Length: int with set) (x, 3)) + let inline f_set_Length_explicit<'T when 'T : (member set_Length: int -> unit) >(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3)) + let inline f_set_Length_mixed<'T when 'T : (member set_Length: int -> unit) >(x: 'T) = (^T : (member Length: int with set) (x, 3)) + let inline f_set_Length_mixed2<'T when 'T : (member Length: int with set) >(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3)) - let inline f_Item<^T when ^T : (member Item: int -> string with get) >(x: ^T) = (^T : (member Item: int -> string with get) (x, 3)) - let inline f_Item_explicit<^T when ^T : (member get_Item: int -> string) >(x: ^T) = (^T : (member get_Item: int -> string) (x, 3)) - let inline f_Item_mixed<^T when ^T : (member get_Item: int -> string) >(x: ^T) = (^T : (member Item: int -> string with get) (x, 3)) - let inline f_Item_mixed2<^T when ^T : (member Item: int -> string with get) >(x: ^T) = (^T : (member get_Item: int -> string) (x, 3)) + let inline f_Item<'T when 'T : (member Item: int -> string with get) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3)) + let inline f_Item_explicit<'T when 'T : (member get_Item: int -> string) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3)) + let inline f_Item_mixed<'T when 'T : (member get_Item: int -> string) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3)) + let inline f_Item_mixed2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3)) - //let inline f_set_Item<^T when ^T : (member Item: int -> string with set) >(x: ^T) = (^T : (member Item: int -> string with set) (x, 3, "a")) - //let inline f_set_Item_explicit<^T when ^T : (member set_Item: int * string -> int) >(x: ^T) = (^T : (member set_Item: int * string -> int) (x, 3, "a")) + //let inline f_set_Item<'T when 'T : (member Item: int -> string with set) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, "a")) + //let inline f_set_Item_explicit<'T when 'T : (member set_Item: int * string -> int) >(x: 'T) = (^T : (member set_Item: int * string -> int) (x, 3, "a")) module CheckSelfConstrainedSRTP = - type WithStaticProperty<^T when ^T : (static member StaticProperty: int)> = ^T - type WithStaticMethod<^T when ^T : (static member StaticMethod: int -> int)> = ^T - type WithBoth<^T when WithStaticProperty<^T> and WithStaticMethod<^T>> = ^T - - let inline f_StaticProperty<^T when WithStaticProperty<^T>>() = 'T.StaticProperty - let inline f_StaticMethod<^T when WithStaticMethod<^T>>() = 'T.StaticMethod(3) - let inline f_Both<^T when WithBoth<^T> >() = - let v1 = 'T.StaticProperty - let v2 = 'T.StaticMethod(3) - v1 + v2 - - type AverageOps<^T when ^T: (static member (+): ^T * ^T -> ^T) - and ^T: (static member DivideByInt : ^T*int -> ^T) - and ^T: (static member Zero : ^T)> = ^T - - let inline f_OK1<^T when WithBoth<^T>>() = - 'T.StaticMethod(3) - 'T.StaticMethod(3) - - let inline f_OK2<^T when WithBoth<^T>>() = - 'T.StaticMethod(3) - 'T.StaticMethod(3) - - let inline f_Bug1<^T when WithBoth<^T>>() = - printfn "" - 'T.StaticMethod(3) - //let inline f_Bug1<^T when WithBoth<^T>>() = + type WithStaticProperty<'T when 'T : (static member StaticProperty: int)> = 'T + type WithStaticMethod<'T when 'T : (static member StaticMethod: int -> int)> = 'T + //type WithBoth<'T when WithStaticProperty<'T> and WithStaticMethod<'T>> = 'T + + let inline f_StaticProperty<'T when WithStaticProperty<'T>>() = 'T.StaticProperty + let inline f_StaticMethod<'T when WithStaticMethod<'T>>() = 'T.StaticMethod(3) + //let inline f_Both<'T when WithBoth<'T> >() = + // let v1 = 'T.StaticProperty + // let v2 = 'T.StaticMethod(3) + // v1 + v2 + + type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) + and 'T: (static member DivideByInt : 'T*int -> 'T) + and 'T: (static member Zero : 'T)> = 'T + + //let inline f_OK1<'T when WithBoth<'T>>() = // 'T.StaticMethod(3) // 'T.StaticMethod(3) - //let inline f_Bug2<^T when WithBoth<^T>>() = + + //let inline f_OK2<'T when WithBoth<'T>>() = + // 'T.StaticMethod(3) + // 'T.StaticMethod(3) + + //let inline f_Bug1<'T when WithBoth<'T>>() = + // printfn "" + // 'T.StaticMethod(3) + //let inline f_Bug1<'T when WithBoth<'T>>() = + // 'T.StaticMethod(3) + // 'T.StaticMethod(3) + //let inline f_Bug2<'T when WithBoth<'T>>() = // 'T.StaticMethod(3) // 'T.StaticMethod(3) // BUG - //let inline f_Both<^T when WithBoth<^T>>() = + //let inline f_Both<'T when WithBoth<'T>>() = // 'T.StaticMethod(3) // 'T.StaticMethod(3) @@ -207,7 +207,7 @@ module CheckSelfSRTP = let v = 'T.UnitMethod() [ v ] - let inline f3<^T when IAdditionOperator<^T>>(x: ^T, y: ^T) = + let inline f3<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = 'T.op_Addition(x,y) let inline f_StaticProperty_IWSAM<'T when IStaticProperty<'T>>() = @@ -215,45 +215,45 @@ module CheckSelfSRTP = module CheckNewSyntax = // Check that "property" and "get_ method" constraints are considered logically equivalent - let inline f_StaticProperty<^T when ^T : (static member StaticProperty: int) >() : int = 'T.StaticProperty + let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() : int = 'T.StaticProperty - let inline f_StaticMethod<^T when ^T : (static member StaticMethod: int -> int) >() : int = 'T.StaticMethod(3) + let inline f_StaticMethod<'T when 'T : (static member StaticMethod: int -> int) >() : int = 'T.StaticMethod(3) - let inline f_set_StaticProperty<^T when ^T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3) + let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3) - let inline f_Length<^T when ^T : (member Length: int) >(x: ^T) = x.Length + let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = x.Length - let inline f_set_Length<^T when ^T : (member Length: int with set) >(x: ^T) = x.set_Length(3) + let inline f_set_Length<'T when 'T : (member Length: int with set) >(x: 'T) = x.set_Length(3) - let inline f_Item1<^T when ^T : (member Item: int -> string with get) >(x: ^T) = x.get_Item(3) + let inline f_Item1<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x.get_Item(3) // Limitation: As yet the syntax "'T.StaticProperty <- 3" can't be used // Limitation: As yet the syntax "x.Length <- 3" can't be used // Limitation: As yet the syntax "x[3]" can't be used, nor can any slicing syntax // Limitation: The disposal pattern can't be used with "use" - //let inline f_set_StaticProperty2<^T when ^T : (static member StaticProperty: int with set) >() = 'T.StaticProperty <- 3 - //let inline f_set_Length2<^T when ^T : (member Length: int with set) >(x: ^T) = x.Length <- 3 - //let inline f_Item2<^T when ^T : (member Item: int -> string with get) >(x: ^T) = x[3] + //let inline f_set_StaticProperty2<'T when 'T : (static member StaticProperty: int with set) >() = 'T.StaticProperty <- 3 + //let inline f_set_Length2<'T when 'T : (member Length: int with set) >(x: 'T) = x.Length <- 3 + //let inline f_Item2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x[3] let f_StaticMethod_IWSAM<'T when 'T :> IStaticMethod<'T>>(x: 'T) = 'T.StaticMethod(x) -let inline f_StaticMethod_SRTP<^T when ^T : (static member StaticMethod: ^T -> ^T) >(x: ^T) = +let inline f_StaticMethod_SRTP<'T when 'T : (static member StaticMethod: 'T -> 'T) >(x: 'T) = 'T.StaticMethod(x) -let inline f_StaticMethod_BOTH<^T when ^T :> IStaticMethod<^T> and ^T : (static member StaticMethod: ^T -> ^T) >(x: ^T) = +let inline f_StaticMethod_BOTH<'T when 'T :> IStaticMethod<'T> and 'T : (static member StaticMethod: 'T -> 'T) >(x: 'T) = 'T.StaticMethod(x) #if NEGATIVE module Negative = - let inline f_TraitWithOptional<^T when ^T : (static member StaticMethod: ?x: int -> int) >() = () - let inline f_TraitWithIn<^T when ^T : (static member StaticMethod: x: inref -> int) >() = () - let inline f_TraitWithOut<^T when ^T : (static member StaticMethod: x: outref -> int) >() = () - let inline f_TraitWithParamArray<^T when ^T : (static member StaticMethod: [] x: int[] -> int) >() = () - let inline f_TraitWithCallerName<^T when ^T : (static member StaticMethod: [] x: int[] -> int) >() = () - let inline f_TraitWithExpression<^T when ^T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = () + let inline f_TraitWithOptional<'T when 'T : (static member StaticMethod: ?x: int -> int) >() = () + let inline f_TraitWithIn<'T when 'T : (static member StaticMethod: x: inref -> int) >() = () + let inline f_TraitWithOut<'T when 'T : (static member StaticMethod: x: outref -> int) >() = () + let inline f_TraitWithParamArray<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () + let inline f_TraitWithCallerName<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () + let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = () #endif @@ -261,8 +261,8 @@ module Negative = // x + y (* -let inline f_SRTP_GoToDefinition_FindAllReferences (x: ^T) = - let y = x + x // implicitly adds constraint to type inference variable ^T +let inline f_SRTP_GoToDefinition_FindAllReferences (x: 'T) = + let y = x + x // implicitly adds constraint to type inference variable 'T let z = 'T.op_Addition(x, x) // where would go-to-definition go? what does find-all-references do? y + z *) From 7dcd4659578941e05c6946a2e5c02a7343b3dd50 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 30 Jun 2022 14:17:49 +0100 Subject: [PATCH 31/91] fix tests --- .../Tests.LanguageService.ErrorList.fs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index 2d0d8c41100..a31538cd201 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -395,12 +395,11 @@ type staticInInterface = end end""" - CheckErrorList fileContent <| function - | [err1; err2; err3] -> - Assert.IsTrue(err1.Message.Contains("No abstract or interface member was found that corresponds to this override")) - Assert.IsTrue(err2.Message.Contains("Feature 'static abstract interface members' is not available in F# 6.0. Please use language version 'PREVIEW' or greater")) - Assert.IsTrue(err3.Message.Contains("Feature 'static abstract interface members' is not supported by target runtime")) - | x -> Assert.Fail(sprintf "Unexpected errors: %A" x) + CheckErrorList fileContent (function + | [err1] -> + Assert.IsTrue(err1.Message.Contains("No abstract or interface member was found that corresponds to this override")) + | x -> + Assert.Fail(sprintf "Unexpected errors: %A" x)) [] [] From 273e206b2950da34c03a8e04331aaf929c6c66e6 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 30 Jun 2022 17:37:10 +0100 Subject: [PATCH 32/91] git first execution test working --- src/Compiler/AbstractIL/il.fs | 7 ++----- src/Compiler/AbstractIL/il.fsi | 3 +-- src/Compiler/AbstractIL/ilmorph.fs | 2 +- src/Compiler/AbstractIL/ilprint.fs | 4 ++-- src/Compiler/AbstractIL/ilread.fs | 16 +++++++++++----- src/Compiler/AbstractIL/ilreflect.fs | 5 +++-- src/Compiler/AbstractIL/ilwrite.fs | 5 +++-- src/Compiler/CodeGen/EraseClosures.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 10 +++++----- .../FSharp.Compiler.ComponentTests.fsproj | 1 + .../Interop/StaticsInInterfaces.fs | 7 ++++++- tests/FSharp.Test.Utilities/CompilerAssert.fs | 8 ++++++-- 12 files changed, 42 insertions(+), 28 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 831cfccb188..40b50d49ad0 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1364,7 +1364,7 @@ type ILInstr = | I_call of ILTailcall * ILMethodSpec * ILVarArgs | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs - | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs + | I_callconstraint of callvirt: bool * ILTailcall * ILType * ILMethodSpec * ILVarArgs | I_calli of ILTailcall * ILCallingSignature * ILVarArgs | I_ldftn of ILMethodSpec | I_newobj of ILMethodSpec * ILVarArgs @@ -3402,9 +3402,6 @@ let mkNormalCall mspec = I_call(Normalcall, mspec, None) let mkNormalCallvirt mspec = I_callvirt(Normalcall, mspec, None) -let mkNormalCallconstraint (ty, mspec) = - I_callconstraint(Normalcall, ty, mspec, None) - let mkNormalNewobj mspec = I_newobj(mspec, None) /// Comment on common object cache sizes: @@ -5291,7 +5288,7 @@ and refsOfILInstr s x = | I_callvirt (_, mr, varargs) -> refsOfILMethodSpec s mr refsOfILVarArgs s varargs - | I_callconstraint (_, tr, mr, varargs) -> + | I_callconstraint (_, _, tr, mr, varargs) -> refsOfILType s tr refsOfILMethodSpec s mr refsOfILVarArgs s varargs diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 2d7c9d4dc19..b8d1e18d30b 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -523,7 +523,7 @@ type internal ILInstr = // Method call | I_call of ILTailcall * ILMethodSpec * ILVarArgs | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs - | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs + | I_callconstraint of callvirt: bool * ILTailcall * ILType * ILMethodSpec * ILVarArgs | I_calli of ILTailcall * ILCallingSignature * ILVarArgs | I_ldftn of ILMethodSpec | I_newobj of ILMethodSpec * ILVarArgs @@ -1975,7 +1975,6 @@ type internal ILLocalsAllocator = /// Derived functions for making some common patterns of instructions. val internal mkNormalCall: ILMethodSpec -> ILInstr val internal mkNormalCallvirt: ILMethodSpec -> ILInstr -val internal mkNormalCallconstraint: ILType * ILMethodSpec -> ILInstr val internal mkNormalNewobj: ILMethodSpec -> ILInstr val internal mkCallBaseConstructor: ILType * ILType list -> ILInstr list val internal mkNormalStfld: ILFieldSpec -> ILInstr diff --git a/src/Compiler/AbstractIL/ilmorph.fs b/src/Compiler/AbstractIL/ilmorph.fs index 08bd3a292c6..a87e72c6fb3 100644 --- a/src/Compiler/AbstractIL/ilmorph.fs +++ b/src/Compiler/AbstractIL/ilmorph.fs @@ -212,7 +212,7 @@ let morphILTypesInILInstr ((factualTy, fformalTy)) i = | I_calli (a, mref, varargs) -> I_calli(a, callsig_ty2ty factualTy mref, morphILVarArgs factualTy varargs) | I_call (a, mr, varargs) -> I_call(a, conv_mspec mr, morphILVarArgs factualTy varargs) | I_callvirt (a, mr, varargs) -> I_callvirt(a, conv_mspec mr, morphILVarArgs factualTy varargs) - | I_callconstraint (a, ty, mr, varargs) -> I_callconstraint(a, factualTy ty, conv_mspec mr, morphILVarArgs factualTy varargs) + | I_callconstraint (callvirt, a, ty, mr, varargs) -> I_callconstraint(callvirt, a, factualTy ty, conv_mspec mr, morphILVarArgs factualTy varargs) | I_newobj (mr, varargs) -> I_newobj(conv_mspec mr, morphILVarArgs factualTy varargs) | I_ldftn mr -> I_ldftn(conv_mspec mr) | I_ldvirtftn mr -> I_ldvirtftn(conv_mspec mr) diff --git a/src/Compiler/AbstractIL/ilprint.fs b/src/Compiler/AbstractIL/ilprint.fs index a9f95cbc1b0..4fb429571bc 100644 --- a/src/Compiler/AbstractIL/ilprint.fs +++ b/src/Compiler/AbstractIL/ilprint.fs @@ -888,11 +888,11 @@ let rec goutput_instr env os inst = output_string os "callvirt " goutput_vararg_mspec env os (mspec, varargs) output_after_tailcall os tl - | I_callconstraint (tl, ty, mspec, varargs) -> + | I_callconstraint (callvirt, tl, ty, mspec, varargs) -> output_tailness os tl output_string os "constraint. " goutput_typ env os ty - output_string os " callvirt " + output_string os (if callvirt then " callvirt " else " call") goutput_vararg_mspec env os (mspec, varargs) output_after_tailcall os tl | I_castclass ty -> diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 3b536d891fd..aa31cf3271c 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -626,17 +626,23 @@ let instrs () = i_stsfld, I_field_instr(volatilePrefix (fun x fspec -> I_stsfld(x, fspec))) i_ldflda, I_field_instr(noPrefixes I_ldflda) i_ldsflda, I_field_instr(noPrefixes I_ldsflda) - i_call, I_method_instr(tailPrefix (fun tl (mspec, y) -> I_call(tl, mspec, y))) + (i_call, + I_method_instr( + constraintOrTailPrefix (fun (c, tl) (mspec, y) -> + match c with + | Some ty -> I_callconstraint(false, tl, ty, mspec, y) + | None -> I_call(tl, mspec, y)) + )) i_ldftn, I_method_instr(noPrefixes (fun (mspec, _y) -> I_ldftn mspec)) i_ldvirtftn, I_method_instr(noPrefixes (fun (mspec, _y) -> I_ldvirtftn mspec)) i_newobj, I_method_instr(noPrefixes I_newobj) - i_callvirt, - I_method_instr( + (i_callvirt, + I_method_instr( constraintOrTailPrefix (fun (c, tl) (mspec, y) -> match c with - | Some ty -> I_callconstraint(tl, ty, mspec, y) + | Some ty -> I_callconstraint(true, tl, ty, mspec, y) | None -> I_callvirt(tl, mspec, y)) - ) + )) i_leave_s, I_unconditional_i8_instr(noPrefixes (fun x -> I_leave x)) i_br_s, I_unconditional_i8_instr(noPrefixes I_br) i_leave, I_unconditional_i32_instr(noPrefixes (fun x -> I_leave x)) diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs index 06e2fc67a35..4d8727e8339 100644 --- a/src/Compiler/AbstractIL/ilreflect.fs +++ b/src/Compiler/AbstractIL/ilreflect.fs @@ -1473,9 +1473,10 @@ let rec emitInstr cenv (modB: ModuleBuilder) emEnv (ilG: ILGenerator) instr = emitSilverlightCheck ilG emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs - | I_callconstraint (tail, ty, mspec, varargs) -> + | I_callconstraint (callvirt, tail, ty, mspec, varargs) -> ilG.Emit(OpCodes.Constrained, convType cenv emEnv ty) - emitInstrCall cenv emEnv ilG OpCodes.Callvirt tail mspec varargs + let instr = if callvirt then OpCodes.Callvirt else OpCodes.Call + emitInstrCall cenv emEnv ilG instr tail mspec varargs | I_calli (tail, callsig, None) -> emitInstrTail cenv ilG tail (fun () -> diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs index 44292305bd9..e857d204b8e 100644 --- a/src/Compiler/AbstractIL/ilwrite.fs +++ b/src/Compiler/AbstractIL/ilwrite.fs @@ -1919,10 +1919,11 @@ module Codebuf = emitTailness cenv codebuf tl emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) //emitAfterTailcall codebuf tl - | I_callconstraint (tl, ty, mspec, varargs) -> + | I_callconstraint (callvirt, tl, ty, mspec, varargs) -> emitTailness cenv codebuf tl emitConstrained cenv codebuf env ty - emitMethodSpecInstr cenv codebuf env i_callvirt (mspec, varargs) + let instr = if callvirt then i_callvirt else i_call + emitMethodSpecInstr cenv codebuf env instr (mspec, varargs) //emitAfterTailcall codebuf tl | I_newobj (mspec, varargs) -> emitMethodSpecInstr cenv codebuf env i_newobj (mspec, varargs) diff --git a/src/Compiler/CodeGen/EraseClosures.fs b/src/Compiler/CodeGen/EraseClosures.fs index ae92dcecf0b..dacb975dc09 100644 --- a/src/Compiler/CodeGen/EraseClosures.fs +++ b/src/Compiler/CodeGen/EraseClosures.fs @@ -366,7 +366,7 @@ let convReturnInstr ty instr = | I_ret -> [ I_box ty; I_ret ] | I_call (_, mspec, varargs) -> [ I_call(Normalcall, mspec, varargs) ] | I_callvirt (_, mspec, varargs) -> [ I_callvirt(Normalcall, mspec, varargs) ] - | I_callconstraint (_, ty, mspec, varargs) -> [ I_callconstraint(Normalcall, ty, mspec, varargs) ] + | I_callconstraint (callvirt, _, ty, mspec, varargs) -> [ I_callconstraint(callvirt, Normalcall, ty, mspec, varargs) ] | I_calli (_, csig, varargs) -> [ I_calli(Normalcall, csig, varargs) ] | _ -> [ instr ] diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 6a39496ad51..2c686c7b08c 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -4224,13 +4224,13 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = else Normalcall - let useICallVirt = virtualCall || useCallVirt cenv boxity mspec isBaseCall + let useICallVirt = (virtualCall || useCallVirt cenv boxity mspec isBaseCall) && mspec.MethodRef.CallingConv.IsInstance let callInstr = match valUseFlags with | PossibleConstrainedCall ty -> let ilThisTy = GenType cenv m eenv.tyenv ty - I_callconstraint(isTailCall, ilThisTy, mspec, None) + I_callconstraint(useICallVirt, isTailCall, ilThisTy, mspec, None) | _ -> if newobj then I_newobj(mspec, None) elif useICallVirt then I_callvirt(isTailCall, mspec, None) @@ -5291,7 +5291,7 @@ and GenILCall let ilMethArgTys = GenTypeArgs cenv m eenv.tyenv methArgTys let ilReturnTys = GenTypes cenv m eenv.tyenv returnTys let ilMethSpec = mkILMethSpec (ilMethRef, boxity, ilEnclArgTys, ilMethArgTys) - let useICallVirt = virt || useCallVirt cenv boxity ilMethSpec isBaseCall + let useICallVirt = (virt || useCallVirt cenv boxity ilMethSpec isBaseCall) && ilMethRef.CallingConv.IsInstance // Load the 'this' pointer to pass to the superclass constructor. This argument is not // in the expression tree since it can't be treated like an ordinary value @@ -5307,7 +5307,7 @@ and GenILCall match ccallInfo with | Some objArgTy -> let ilObjArgTy = GenType cenv m eenv.tyenv objArgTy - I_callconstraint(tail, ilObjArgTy, ilMethSpec, None) + I_callconstraint(useICallVirt, tail, ilObjArgTy, ilMethSpec, None) | None -> if useICallVirt then I_callvirt(tail, ilMethSpec, None) @@ -10169,7 +10169,7 @@ and GenEqualsOverrideCallingIComparable cenv (tcref: TyconRef, ilThisTy, _ilThat mkLdarg0 mkLdarg 1us if tcref.IsStructOrEnumTycon then - I_callconstraint(Normalcall, ilThisTy, mspec, None) + I_callconstraint(true, Normalcall, ilThisTy, mspec, None) else I_callvirt(Normalcall, mspec, None) mkLdcInt32 0 diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 562fbb40a88..641239474f0 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -15,6 +15,7 @@ false $(OtherFlags) --warnon:1182 $(NoWarn);FS0988 + true diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index c7b56cfab03..56303f360a2 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -376,9 +376,14 @@ let main _ = 0 #endif let ``F# can call interface with static abstract method`` () = + let inputFilePath = CompilerAssert.GenerateFsInputPath() + let outputFilePath = CompilerAssert.GenerateDllOutputPath() let fsharpSource = """ +[] +do() + type IAdditionOperator<'T> = static abstract op_Addition: 'T * 'T -> 'T @@ -396,7 +401,7 @@ let main _ = failwith "incorrect value" 0 """ - FSharp fsharpSource + FSharpWithInputAndOutputPath fsharpSource inputFilePath outputFilePath |> asExe |> withLangVersionPreview |> compileAndRun diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index c3cb5e0cc5c..81c4e4cc0f8 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -624,10 +624,14 @@ Updated automatically, please check diffs in your pull request, changes must be static member DefaultProjectOptions = defaultProjectOptions static member GenerateFsInputPath() = - Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".fs")) + let path = Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".fs")) + printfn $"input path = {path}" + path static member GenerateDllOutputPath() = - Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".dll")) + let path = Path.Combine(Path.GetTempPath(), Path.ChangeExtension(Path.GetRandomFileName(), ".dll")) + printfn $"output path = {path}" + path static member CompileWithErrors(cmpl: Compilation, expectedErrors, ?ignoreWarnings) = let ignoreWarnings = defaultArg ignoreWarnings false From 555fbbec9780ff1c0e0a65c9375490b4efce8848 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 1 Jul 2022 11:30:08 +0100 Subject: [PATCH 33/91] update formating --- src/Compiler/AbstractIL/ilmorph.fs | 3 ++- src/Compiler/AbstractIL/ilread.fs | 22 +++++++++---------- src/Compiler/Checking/InfoReader.fsi | 6 ++++- src/Compiler/Checking/infos.fsi | 9 +++++++- src/Compiler/CodeGen/IlxGen.fs | 9 ++++++-- src/Compiler/Driver/CompilerDiagnostics.fs | 2 +- src/Compiler/Service/ServiceParsedInputOps.fs | 3 +-- src/Compiler/TypedTree/TypedTree.fsi | 9 ++++++-- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 +- 9 files changed, 43 insertions(+), 22 deletions(-) diff --git a/src/Compiler/AbstractIL/ilmorph.fs b/src/Compiler/AbstractIL/ilmorph.fs index a87e72c6fb3..a10fd6c8d7e 100644 --- a/src/Compiler/AbstractIL/ilmorph.fs +++ b/src/Compiler/AbstractIL/ilmorph.fs @@ -212,7 +212,8 @@ let morphILTypesInILInstr ((factualTy, fformalTy)) i = | I_calli (a, mref, varargs) -> I_calli(a, callsig_ty2ty factualTy mref, morphILVarArgs factualTy varargs) | I_call (a, mr, varargs) -> I_call(a, conv_mspec mr, morphILVarArgs factualTy varargs) | I_callvirt (a, mr, varargs) -> I_callvirt(a, conv_mspec mr, morphILVarArgs factualTy varargs) - | I_callconstraint (callvirt, a, ty, mr, varargs) -> I_callconstraint(callvirt, a, factualTy ty, conv_mspec mr, morphILVarArgs factualTy varargs) + | I_callconstraint (callvirt, a, ty, mr, varargs) -> + I_callconstraint(callvirt, a, factualTy ty, conv_mspec mr, morphILVarArgs factualTy varargs) | I_newobj (mr, varargs) -> I_newobj(conv_mspec mr, morphILVarArgs factualTy varargs) | I_ldftn mr -> I_ldftn(conv_mspec mr) | I_ldvirtftn mr -> I_ldvirtftn(conv_mspec mr) diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index aa31cf3271c..be18adde880 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -626,23 +626,23 @@ let instrs () = i_stsfld, I_field_instr(volatilePrefix (fun x fspec -> I_stsfld(x, fspec))) i_ldflda, I_field_instr(noPrefixes I_ldflda) i_ldsflda, I_field_instr(noPrefixes I_ldsflda) - (i_call, + (i_call, I_method_instr( - constraintOrTailPrefix (fun (c, tl) (mspec, y) -> - match c with - | Some ty -> I_callconstraint(false, tl, ty, mspec, y) - | None -> I_call(tl, mspec, y)) - )) + constraintOrTailPrefix (fun (c, tl) (mspec, y) -> + match c with + | Some ty -> I_callconstraint(false, tl, ty, mspec, y) + | None -> I_call(tl, mspec, y)) + )) i_ldftn, I_method_instr(noPrefixes (fun (mspec, _y) -> I_ldftn mspec)) i_ldvirtftn, I_method_instr(noPrefixes (fun (mspec, _y) -> I_ldvirtftn mspec)) i_newobj, I_method_instr(noPrefixes I_newobj) (i_callvirt, I_method_instr( - constraintOrTailPrefix (fun (c, tl) (mspec, y) -> - match c with - | Some ty -> I_callconstraint(true, tl, ty, mspec, y) - | None -> I_callvirt(tl, mspec, y)) - )) + constraintOrTailPrefix (fun (c, tl) (mspec, y) -> + match c with + | Some ty -> I_callconstraint(true, tl, ty, mspec, y) + | None -> I_callvirt(tl, mspec, y)) + )) i_leave_s, I_unconditional_i8_instr(noPrefixes (fun x -> I_leave x)) i_br_s, I_unconditional_i8_instr(noPrefixes I_br) i_leave, I_unconditional_i32_instr(noPrefixes (fun x -> I_leave x)) diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index e9d233e4488..e05055223d2 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -186,7 +186,11 @@ type InfoReader = /// Perform type-directed name resolution of a particular named member in an F# type member TryFindIntrinsicNamedItemOfType: - nm: string * ad: AccessorDomain * includeConstraints: bool -> findFlag: FindMemberFlag -> m: range -> ty: TType -> HierarchyItem option + nm: string * ad: AccessorDomain * includeConstraints: bool -> + findFlag: FindMemberFlag -> + m: range -> + ty: TType -> + HierarchyItem option /// Find the op_Implicit for a type member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index ae6076c89a0..2ada1895954 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -137,7 +137,14 @@ type ParamData = ttype: TType // Adhoc information - could be unified with ParamData -type ParamAttribs = ParamAttribs of isParamArrayArg: bool * isInArg: bool * isOutArg: bool * optArgInfo: OptionalArgInfo * callerInfo: CallerInfo * reflArgInfo: ReflectedArgInfo +type ParamAttribs = + | ParamAttribs of + isParamArrayArg: bool * + isInArg: bool * + isOutArg: bool * + optArgInfo: OptionalArgInfo * + callerInfo: CallerInfo * + reflArgInfo: ReflectedArgInfo val CrackParamAttribsInfo: TcGlobals -> ty: TType * argInfo: ArgReprInfo -> ParamAttribs diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 2c686c7b08c..a2c63dea7a3 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -4224,7 +4224,9 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = else Normalcall - let useICallVirt = (virtualCall || useCallVirt cenv boxity mspec isBaseCall) && mspec.MethodRef.CallingConv.IsInstance + let useICallVirt = + (virtualCall || useCallVirt cenv boxity mspec isBaseCall) + && mspec.MethodRef.CallingConv.IsInstance let callInstr = match valUseFlags with @@ -5291,7 +5293,10 @@ and GenILCall let ilMethArgTys = GenTypeArgs cenv m eenv.tyenv methArgTys let ilReturnTys = GenTypes cenv m eenv.tyenv returnTys let ilMethSpec = mkILMethSpec (ilMethRef, boxity, ilEnclArgTys, ilMethArgTys) - let useICallVirt = (virt || useCallVirt cenv boxity ilMethSpec isBaseCall) && ilMethRef.CallingConv.IsInstance + + let useICallVirt = + (virt || useCallVirt cenv boxity ilMethSpec isBaseCall) + && ilMethRef.CallingConv.IsInstance // Load the 'this' pointer to pass to the superclass constructor. This argument is not // in the expression tree since it can't be treated like an ordinary value diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 0bc2095adf8..1558dea20ca 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -788,7 +788,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu let knownReturnType, genericParameterTypes = match failure with | NoOverloadsFound(cx = Some cx) - | PossibleCandidates(cx = Some cx) -> Some (cx.GetReturnType(g)), cx.GetCompiledArgumentTypes() + | PossibleCandidates(cx = Some cx) -> Some(cx.GetReturnType(g)), cx.GetCompiledArgumentTypes() | _ -> None, [] // prepare message parts (known arguments, known return type, known generic parameters) diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index fd4bfd210a7..9934911cb37 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -1607,8 +1607,7 @@ module ParsedInput = | SynTypeConstraint.WhereTyparSupportsMember (ts, sign, _) -> List.iter walkType ts walkMemberSig sign - | SynTypeConstraint.WhereSelfConstrained (ty, _) -> - walkType ty + | SynTypeConstraint.WhereSelfConstrained (ty, _) -> walkType ty and walkPat pat = match pat with diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 120d2d3e92f..2acd91ee114 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1616,7 +1616,12 @@ type TyparConstraint = [] type TraitWitnessInfo = - | TraitWitnessInfo of tys: TTypes * memberName: string * memberFlags: SynMemberFlags * objAndArgTys: TTypes * returnTy: TType option + | TraitWitnessInfo of + tys: TTypes * + memberName: string * + memberFlags: SynMemberFlags * + objAndArgTys: TTypes * + returnTy: TType option override ToString: unit -> string @@ -1657,7 +1662,7 @@ type TraitConstraintInfo = /// Get the member name associated with the member constraint. For preop member MemberLogicalName: string - /// Get the raw object and argument types recorded in the member constraint. This includes the object instance type + /// Get the raw object and argument types recorded in the member constraint. This includes the object instance type /// instance members. This may be empty for property traits e.g. /// "(static member Zero: ^T)" /// or unit-taking methods diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index a004a2651b4..5d649029f0e 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2649,6 +2649,7 @@ val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool type TraitConstraintInfo with + /// Get the argument types recorded in the member constraint suitable for building a TypedTree call. member GetCompiledArgumentTypes: unit -> TType list @@ -2664,4 +2665,3 @@ type TraitConstraintInfo with /// Get the key associated with the member constraint. member GetWitnessInfo: unit -> TraitWitnessInfo - From 3874fa5235dfa2f9c9eb1cbcd83e8f7c36ecaf07 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 4 Jul 2022 11:44:38 +0100 Subject: [PATCH 34/91] fix tests --- ...lerService.SurfaceArea.netstandard.expected | 18 ++++++++++++++++++ .../E_MalformedShortUnicode01.fs | 4 ++-- .../CheckingSyntacticTypes/ByRef04.fsx | 6 +++--- 3 files changed, 23 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index cdf8bac9bd7..3fe27c995d6 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -6707,6 +6707,7 @@ FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Sequential FSharp.Compiler.Syntax.SynExpr+Tags: Int32 SequentialOrImplicitYield FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Set FSharp.Compiler.Syntax.SynExpr+Tags: Int32 TraitCall +FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Typar FSharp.Compiler.Syntax.SynExpr+Tags: Int32 TryFinally FSharp.Compiler.Syntax.SynExpr+Tags: Int32 TryWith FSharp.Compiler.Syntax.SynExpr+Tags: Int32 Tuple @@ -6757,6 +6758,10 @@ FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[ FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr] get_exprs() FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range] commaRanges FSharp.Compiler.Syntax.SynExpr+Tuple: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range] get_commaRanges() +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Syntax.SynTypar get_typar() +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Syntax.SynTypar typar +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynExpr+Typar: FSharp.Compiler.Text.Range range FSharp.Compiler.Syntax.SynExpr+TypeApp: FSharp.Compiler.Syntax.SynExpr expr FSharp.Compiler.Syntax.SynExpr+TypeApp: FSharp.Compiler.Syntax.SynExpr get_expr() FSharp.Compiler.Syntax.SynExpr+TypeApp: FSharp.Compiler.Text.Range get_lessRange() @@ -6867,6 +6872,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean IsSequential FSharp.Compiler.Syntax.SynExpr: Boolean IsSequentialOrImplicitYield FSharp.Compiler.Syntax.SynExpr: Boolean IsSet FSharp.Compiler.Syntax.SynExpr: Boolean IsTraitCall +FSharp.Compiler.Syntax.SynExpr: Boolean IsTypar FSharp.Compiler.Syntax.SynExpr: Boolean IsTryFinally FSharp.Compiler.Syntax.SynExpr: Boolean IsTryWith FSharp.Compiler.Syntax.SynExpr: Boolean IsTuple @@ -6938,6 +6944,7 @@ FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTraitCall() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTryFinally() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTryWith() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTuple() +FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTypar() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTypeApp() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTypeTest() FSharp.Compiler.Syntax.SynExpr: Boolean get_IsTyped() @@ -7002,6 +7009,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSequential(FSh FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSequentialOrImplicitYield(FSharp.Compiler.Syntax.DebugPointAtSequential, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSet(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTraitCall(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar], FSharp.Compiler.Syntax.SynMemberSig, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTypar(FSharp.Compiler.Syntax.SynTypar, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryFinally(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtFinally, FSharp.Compiler.SyntaxTrivia.SynExprTryFinallyTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryWith(FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtWith, FSharp.Compiler.SyntaxTrivia.SynExprTryWithTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTuple(Boolean, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynExpr], Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.Range], FSharp.Compiler.Text.Range) @@ -7073,6 +7081,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TraitCall FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TryFinally FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TryWith FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Tuple +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Typar FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TypeApp FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+TypeTest FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr+Typed @@ -8570,6 +8579,7 @@ FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsDelegate FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsEnum FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsEquatable FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsReferenceType +FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereSelfConstrained FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsUnmanaged FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparIsValueType FSharp.Compiler.Syntax.SynTypeConstraint+Tags: Int32 WhereTyparSubtypeOfType @@ -8629,6 +8639,11 @@ FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler.Syntax.SynTypar typar FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynTypeConstraint+WhereTyparSupportsNull: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Syntax.SynType get_selfConstraint() +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Syntax.SynType selfConstraint +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Text.Range get_range() +FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained: FSharp.Compiler.Text.Range range +FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereSelfConstrained FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereTyparDefaultsToType FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereTyparIsComparable FSharp.Compiler.Syntax.SynTypeConstraint: Boolean IsWhereTyparIsDelegate @@ -8679,6 +8694,9 @@ FSharp.Compiler.Syntax.SynTypeConstraint: FSharp.Compiler.Text.Range get_Range() FSharp.Compiler.Syntax.SynTypeConstraint: Int32 Tag FSharp.Compiler.Syntax.SynTypeConstraint: Int32 get_Tag() FSharp.Compiler.Syntax.SynTypeConstraint: System.String ToString() +FSharp.Compiler.Syntax.SynTypeConstraint: Boolean get_IsWhereSelfConstrained() +FSharp.Compiler.Syntax.SynTypeConstraint: FSharp.Compiler.Syntax.SynTypeConstraint NewWhereSelfConstrained(FSharp.Compiler.Syntax.SynType, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynTypeConstraint: FSharp.Compiler.Syntax.SynTypeConstraint+WhereSelfConstrained FSharp.Compiler.Syntax.SynTypeDefn FSharp.Compiler.Syntax.SynTypeDefn: FSharp.Compiler.Syntax.SynComponentInfo get_typeInfo() FSharp.Compiler.Syntax.SynTypeDefn: FSharp.Compiler.Syntax.SynComponentInfo typeInfo diff --git a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs index 943ef86b14a..8cfbdf32924 100644 --- a/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs +++ b/tests/fsharpqa/Source/Conformance/LexicalAnalysis/StringsAndCharacters/E_MalformedShortUnicode01.fs @@ -4,8 +4,8 @@ // Verify error with malformed short unicode character // NOTE: I've jazzed up the error messages since they will be interprited as RegExs... -//Unexpected quote symbol in binding -//Unexpected quote symbol in binding +//Unexpected character '\\' in expression. Expected identifier or other token +//Unexpected character '\\' in expression. Expected identifier or other token //Unexpected character '\\' in binding let tooShort = '\u266' diff --git a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx index 99363967af9..f399c1a6144 100644 --- a/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx +++ b/tests/fsharpqa/Source/Conformance/TypesAndTypeConstraints/CheckingSyntacticTypes/ByRef04.fsx @@ -1,9 +1,9 @@ // #ByRef #Regression #inline // Regression test for DevDiv:122445 ("Internal compiler error when evaluating code with inline/byref") //val inline f: -// x: string -> y: nativeptr< \^a> -> bool -// when \^a: unmanaged and -// \^a: \(static member TryParse: string \* nativeptr< \^a> -> bool\) +// x: string -> y: nativeptr<\^a> -> bool +// when \^a: unmanaged and +// \^a: \(static member TryParse: string \* nativeptr<\^a> -> bool\) // Should compile just fine let inline f x (y:_ nativeptr) = (^a : (static member TryParse : string * ^a nativeptr -> bool)(x,y)) From 28bea4a1db95fd736305bbe4b17168af8ebcef22 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 4 Jul 2022 12:33:06 +0100 Subject: [PATCH 35/91] fix tests --- .../Microsoft.FSharp.Control/TasksDynamic.fs | 28 +++++++++---------- .../Language/DefaultInterfaceMemberTests.fs | 16 +++++------ .../E_LessThanDotOpenParen001.bsl | 2 +- tests/fsharp/core/members/ops/test.fsx | 2 +- tests/fsharp/core/subtype/test.fsx | 2 +- tests/fsharp/core/syntax/test.fsx | 4 +-- tests/fsharp/regression/5531/test.fs | 2 +- .../neg_generic_known_argument_types.bsl | 2 +- ...n_return_type_and_known_type_arguments.bsl | 16 +++++------ ...n_return_type_and_known_type_arguments.fsx | 2 +- tests/fsharp/typecheck/sigs/neg112.bsl | 6 ++-- tests/fsharp/typecheck/sigs/neg112.fs | 4 +-- tests/fsharp/typecheck/sigs/neg116.bsl | 2 +- tests/fsharp/typecheck/sigs/neg117.bsl | 4 +-- tests/fsharp/typecheck/sigs/neg119.bsl | 2 +- tests/fsharp/typecheck/sigs/neg129.bsl | 4 +-- tests/fsharp/typecheck/sigs/neg131.bsl | 2 +- tests/fsharp/typecheck/sigs/neg132.bsl | 2 +- tests/fsharp/typecheck/sigs/neg61.bsl | 2 +- tests/fsharp/typecheck/sigs/pos35.fs | 2 +- tests/service/ExprTests.fs | 10 +++---- 21 files changed, 58 insertions(+), 58 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs index 81919c25ef3..ebf57856db3 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs @@ -92,34 +92,34 @@ module Value = module TaskLowProrityExtensions = type TaskBuilderDynamic with - member inline _.ReturnFrom< ^TaskLike, ^Awaiter, ^T - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.ReturnFrom<^TaskLike, ^Awaiter, ^T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^T)> - (t: ^TaskLike) : TaskCode< ^T, ^T> = + and ^Awaiter: (member GetResult: unit -> ^T)> + (t: ^TaskLike) : TaskCode<^T, ^T> = task.ReturnFrom(t) - member inline _.Bind< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.Bind<^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^TResult1)> + and ^Awaiter: (member GetResult: unit -> ^TResult1)> (t: ^TaskLike, continuation: (^TResult1 -> TaskCode<'TOverall, 'TResult2>)) : TaskCode<'TOverall, 'TResult2> = task.Bind(t, continuation) type BackgroundTaskBuilderDynamic with - member inline _.ReturnFrom< ^TaskLike, ^Awaiter, ^T - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.ReturnFrom<^TaskLike, ^Awaiter, ^T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^T)> - (t: ^TaskLike) : TaskCode< ^T, ^T> = + and ^Awaiter: (member GetResult: unit -> ^T)> + (t: ^TaskLike) : TaskCode<^T, ^T> = backgroundTask.ReturnFrom(t) - member inline _.Bind< ^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + member inline _.Bind<^TaskLike, ^TResult1, 'TResult2, ^Awaiter , 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) and ^Awaiter :> ICriticalNotifyCompletion and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> ^TResult1)> + and ^Awaiter: (member GetResult: unit -> ^TResult1)> (t: ^TaskLike, continuation: (^TResult1 -> TaskCode<'TOverall, 'TResult2>)) : TaskCode<'TOverall, 'TResult2> = backgroundTask.Bind(t, continuation) diff --git a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs index 1c89e249e8f..289d171226e 100644 --- a/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs +++ b/tests/fsharp/Compiler/Language/DefaultInterfaceMemberTests.fs @@ -561,8 +561,8 @@ namespace CSharpTest open System open CSharpTest -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + (^T : (static member StaticMethod : int * int -> int) (x, y)) let f1 () = callStatic 1 2 @@ -4726,8 +4726,8 @@ open CSharpTest type I3 = inherit I2 -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - let value = ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + let value = (^T : (static member StaticMethod : int * int -> int) (x, y)) Console.Write value let f1 () = @@ -4882,8 +4882,8 @@ namespace CSharpTest open System open CSharpTest -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + (^T : (static member StaticMethod : int * int -> int) (x, y)) let f () = callStatic 1 2 @@ -4935,8 +4935,8 @@ type FSharpClass() = interface I1 interface I2 -let inline callStatic< ^T when ^T : (static member StaticMethod : int * int -> int)> x y = - ( ^T : (static member StaticMethod : int * int -> int) (x, y)) +let inline callStatic<^T when ^T : (static member StaticMethod : int * int -> int)> x y = + (^T : (static member StaticMethod : int * int -> int) (x, y)) let f () = callStatic 1 2 diff --git a/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl b/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl index fa5c8fbaf67..1bd18780642 100644 --- a/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl +++ b/tests/fsharp/conformance/lexicalanalysis/E_LessThanDotOpenParen001.bsl @@ -1,7 +1,7 @@ E_LessThanDotOpenParen001.fsx(23,12,23,15): typecheck error FS0043: No overloads match for method 'op_PlusPlusPlus'. -Known return type: ^a +Known return type: ^a Known type parameters: < (string -> int) , TestType > diff --git a/tests/fsharp/core/members/ops/test.fsx b/tests/fsharp/core/members/ops/test.fsx index 60d2570355f..4c0581d42ca 100644 --- a/tests/fsharp/core/members/ops/test.fsx +++ b/tests/fsharp/core/members/ops/test.fsx @@ -359,7 +359,7 @@ module MiscOperatorOverloadTests = module OperatorConstraintsWithExplicitRigidTypeParameters = type M() = class end - let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = + let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = let m = M() Unchecked.defaultof< ^R> $ m: ^R diff --git a/tests/fsharp/core/subtype/test.fsx b/tests/fsharp/core/subtype/test.fsx index 8ca98d0f472..a0bae709394 100644 --- a/tests/fsharp/core/subtype/test.fsx +++ b/tests/fsharp/core/subtype/test.fsx @@ -1838,7 +1838,7 @@ module SRTPFix = let inline fmap (f : ^a -> ^b) (a : ^c) = fmap_instance (f, a) - let inline replace (a : ^a) (f : ^b) : ^a0 when (CFunctor or ^b) : (static member replace : ^a * ^b -> ^a0) = + let inline replace (a : ^a) (f : ^b) : ^a0 when (CFunctor or ^b) : (static member replace : ^a * ^b -> ^a0) = replace_instance (a, f) (* diff --git a/tests/fsharp/core/syntax/test.fsx b/tests/fsharp/core/syntax/test.fsx index e26783d7f31..8ca6dbc98e1 100644 --- a/tests/fsharp/core/syntax/test.fsx +++ b/tests/fsharp/core/syntax/test.fsx @@ -89,7 +89,7 @@ module MoreDynamicOpTests = static member ($) (x:int , M) = 0 static member ($) (x:float , M) = 0.0 - let inline empty< ^R, ^M when (^R or ^M) : (static member ($) : ^R * M -> ^R) and ^M :> M> = + let inline empty< ^R, ^M when (^R or ^M) : (static member ($) : ^R * M -> ^R) and ^M :> M> = let m = M() ((^R or ^M) : (static member ($): ^R * M -> ^R ) (Unchecked.defaultof<'R>, m)) @@ -102,7 +102,7 @@ module MoreDynamicOpTests = static member ($) (x:int , M) = 0 static member ($) (x:float , M) = 0.0 - let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = + let inline empty< ^R when ( ^R or M) : (static member ( $ ) : ^R * M -> ^R)> = let m = M() Unchecked.defaultof< ^R> $ m: ^R diff --git a/tests/fsharp/regression/5531/test.fs b/tests/fsharp/regression/5531/test.fs index 4059b772bfd..a8dfbdc5429 100644 --- a/tests/fsharp/regression/5531/test.fs +++ b/tests/fsharp/regression/5531/test.fs @@ -6,7 +6,7 @@ type Derived() = inherit Base() member this.Foo() = printfn "Derived" -let inline callFoo< ^T when ^T : (member Foo: unit -> unit) > (t: ^T) = +let inline callFoo<^T when ^T : (member Foo: unit -> unit) > (t: ^T) = (^T : (member Foo: unit -> unit) (t)) let b = Base() diff --git a/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl b/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl index ee9b9d3dde2..7993b054461 100644 --- a/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl +++ b/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl @@ -1,7 +1,7 @@ neg_generic_known_argument_types.fsx(9,16,9,49): typecheck error FS0041: A unique overload for method 'Foo' could not be determined based on type information prior to this program point. A type annotation may be needed. -Known types of arguments: ^fa * 'fb * 'a * argD: 'c when ^fa: (member X: ^fa * ^b -> ^b) and ^b: (member BBBB: ^b -> unit) +Known types of arguments: ^fa * 'fb * 'a * argD: 'c when ^fa: (member X: ^fa * ^b -> ^b) and ^b: (member BBBB: ^b -> unit) Candidates: - static member A.Foo: argA1: 'a * argB1: ('a -> 'b) * argC1: ('a -> 'b) * argD: ('a -> 'b) * argZ1: 'zzz -> 'b diff --git a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl index 9dadb19ee6e..cb7a1e3dad6 100644 --- a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl +++ b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl @@ -6,17 +6,17 @@ Known return type: MonoidSample Known type parameters: < MonoidSample , Zero > Available overloads: - - static member Zero.Zero: ^t * Default1 -> ^t when ^t: (static member get_Zero: -> ^t) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default1 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ^t when (FromInt32 or ^t) : (static member FromInt32: ^t * FromInt32 -> (int32 -> ^t)) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default3 -> ^t when ^t: (static member get_Empty: -> ^t) // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default1 -> ^t when ^t: (static member get_Zero: -> ^t) // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default1 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default2 -> ^t when (FromInt32 or ^t) : (static member FromInt32: ^t * FromInt32 -> (int32 -> ^t)) // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default2 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default3 -> ^t when ^t: (static member get_Empty: -> ^t) // Argument at index 1 doesn't match - static member Zero.Zero: 'a array * Zero -> 'a array // Argument at index 1 doesn't match - static member Zero.Zero: 'a list * Zero -> 'a list // Argument at index 1 doesn't match - static member Zero.Zero: 'a option * Zero -> 'a option // Argument at index 1 doesn't match - - static member Zero.Zero: ('T -> ^Monoid) * Zero -> ('T -> ^Monoid) when (Zero or ^Monoid) : (static member Zero: ^Monoid * Zero -> ^Monoid) // Argument at index 1 doesn't match - - static member Zero.Zero: Async< ^a> * Zero -> Async< ^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match - - static member Zero.Zero: Lazy< ^a> * Zero -> Lazy< ^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match + - static member Zero.Zero: ('T -> ^Monoid) * Zero -> ('T -> ^Monoid) when (Zero or ^Monoid) : (static member Zero: ^Monoid * Zero -> ^Monoid) // Argument at index 1 doesn't match + - static member Zero.Zero: Async<^a> * Zero -> Async<^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match + - static member Zero.Zero: Lazy<^a> * Zero -> Lazy<^a> when (Zero or ^a) : (static member Zero: ^a * Zero -> ^a) // Argument at index 1 doesn't match - static member Zero.Zero: Map<'a,'b> * Zero -> Map<'a,'b> when 'a: comparison // Argument at index 1 doesn't match - static member Zero.Zero: ResizeArray<'a> * Zero -> ResizeArray<'a> // Argument at index 1 doesn't match - static member Zero.Zero: Set<'a> * Zero -> Set<'a> when 'a: comparison // Argument at index 1 doesn't match diff --git a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx index db2b2ae297c..947735d0e84 100644 --- a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx +++ b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.fsx @@ -74,7 +74,7 @@ type Zero with static member Zero (_: seq<'a> , _: Zero) = Seq.empty : seq<'a> let inline (++) (x: 'Monoid) (y: 'Monoid) : 'Monoid = Plus.Invoke x y -let inline zero< ^Monoid when (Zero or ^Monoid) : (static member Zero : ^Monoid * Zero -> ^Monoid) > : ^Monoid = Zero.Invoke () +let inline zero<^Monoid when (Zero or ^Monoid) : (static member Zero : ^Monoid * Zero -> ^Monoid) > : ^Monoid = Zero.Invoke () type MonoidSample = | MonoidSample of int diff --git a/tests/fsharp/typecheck/sigs/neg112.bsl b/tests/fsharp/typecheck/sigs/neg112.bsl index e6d4ed7bc8e..23711fb3b4d 100644 --- a/tests/fsharp/typecheck/sigs/neg112.bsl +++ b/tests/fsharp/typecheck/sigs/neg112.bsl @@ -1,6 +1,6 @@ -neg112.fs(20,49,20,62): typecheck error FS0001: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' +neg112.fs(20,49,20,62): typecheck error FS0001: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' -neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' +neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' -neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' +neg112.fs(20,31,20,39): typecheck error FS0043: A type parameter is missing a constraint 'when (Tuple or ^options) : (static member TupleMap: ^options * Tuple -> (('item -> ^value) -> ^values))' diff --git a/tests/fsharp/typecheck/sigs/neg112.fs b/tests/fsharp/typecheck/sigs/neg112.fs index b544ee5834b..9fe032348cd 100644 --- a/tests/fsharp/typecheck/sigs/neg112.fs +++ b/tests/fsharp/typecheck/sigs/neg112.fs @@ -13,8 +13,8 @@ type IOption<'T> = let inline tupleMap f x = Tuple.Map f x -let inline addOptionValues< ^value, ^options, ^values, 'item when - 'item :> IOption< ^value>> +let inline addOptionValues<^value, ^options, ^values, 'item when + 'item :> IOption<^value>> (addUp : ^values -> ^value, sourceOptions : ^options) = let getValue (i : 'item) = i.Value let allValues : ^values = tupleMap getValue sourceOptions diff --git a/tests/fsharp/typecheck/sigs/neg116.bsl b/tests/fsharp/typecheck/sigs/neg116.bsl index e5225d4225e..9bd22489ddc 100644 --- a/tests/fsharp/typecheck/sigs/neg116.bsl +++ b/tests/fsharp/typecheck/sigs/neg116.bsl @@ -1,7 +1,7 @@ neg116.fs(10,44,10,45): typecheck error FS0043: No overloads match for method 'op_Multiply'. -Known return type: ^a +Known return type: ^a Known type parameters: < float , Polynomial > diff --git a/tests/fsharp/typecheck/sigs/neg117.bsl b/tests/fsharp/typecheck/sigs/neg117.bsl index 8dd725f4721..44484072f2a 100644 --- a/tests/fsharp/typecheck/sigs/neg117.bsl +++ b/tests/fsharp/typecheck/sigs/neg117.bsl @@ -6,5 +6,5 @@ Known return type: ('a -> Neg117.TargetA.M1 Microsoft.FSharp.Core.[]) Known type parameters: < Neg117.TargetA.M1 Microsoft.FSharp.Core.[] , Microsoft.FSharp.Core.obj , Neg117.Superpower.Transformer > Available overloads: - - static member Neg117.Superpower.Transformer.Transform: ^f * Neg117.TargetB.TargetB * Neg117.Superpower.Transformer -> (Neg117.TargetB.TransformerKind -> ^f) when (Neg117.TargetB.TargetB or ^f) : (static member Transform: ^f * Neg117.TargetB.TargetB -> (Neg117.TargetB.TransformerKind -> ^f)) // Argument at index 1 doesn't match - - static member Neg117.Superpower.Transformer.Transform: ^r * Neg117.TargetA.TargetA * Neg117.Superpower.Transformer -> (Neg117.TargetA.TransformerKind -> ^r) when (Neg117.TargetA.TargetA or ^r) : (static member Transform: ^r * Neg117.TargetA.TargetA -> (Neg117.TargetA.TransformerKind -> ^r)) // Argument at index 1 doesn't match + - static member Neg117.Superpower.Transformer.Transform: ^f * Neg117.TargetB.TargetB * Neg117.Superpower.Transformer -> (Neg117.TargetB.TransformerKind -> ^f) when (Neg117.TargetB.TargetB or ^f) : (static member Transform: ^f * Neg117.TargetB.TargetB -> (Neg117.TargetB.TransformerKind -> ^f)) // Argument at index 1 doesn't match + - static member Neg117.Superpower.Transformer.Transform: ^r * Neg117.TargetA.TargetA * Neg117.Superpower.Transformer -> (Neg117.TargetA.TransformerKind -> ^r) when (Neg117.TargetA.TargetA or ^r) : (static member Transform: ^r * Neg117.TargetA.TargetA -> (Neg117.TargetA.TransformerKind -> ^r)) // Argument at index 1 doesn't match diff --git a/tests/fsharp/typecheck/sigs/neg119.bsl b/tests/fsharp/typecheck/sigs/neg119.bsl index 9bbdf9ccdaa..ffd7087e301 100644 --- a/tests/fsharp/typecheck/sigs/neg119.bsl +++ b/tests/fsharp/typecheck/sigs/neg119.bsl @@ -8,5 +8,5 @@ Known type parameters: < obj , Applicatives.Ap > Available overloads: - static member Applicatives.Ap.Return: ('r -> 'a) * Ap: Applicatives.Ap -> (('a -> 'r -> 'a2) -> 'a3 -> 'a -> 'r -> 'a2) // Argument at index 1 doesn't match - static member Applicatives.Ap.Return: System.Tuple<'a> * Ap: Applicatives.Ap -> ('a -> System.Tuple<'a>) // Argument at index 1 doesn't match - - static member Applicatives.Ap.Return: r: ^R * obj -> ('a1 -> ^R) when ^R: (static member Return: 'a1 -> ^R) // Argument 'r' doesn't match + - static member Applicatives.Ap.Return: r: ^R * obj -> ('a1 -> ^R) when ^R: (static member Return: 'a1 -> ^R) // Argument 'r' doesn't match - static member Applicatives.Ap.Return: seq<'a> * Ap: Applicatives.Ap -> ('a -> seq<'a>) // Argument at index 1 doesn't match Consider adding further type constraints diff --git a/tests/fsharp/typecheck/sigs/neg129.bsl b/tests/fsharp/typecheck/sigs/neg129.bsl index 82773932a9f..e15fe4a71a4 100644 --- a/tests/fsharp/typecheck/sigs/neg129.bsl +++ b/tests/fsharp/typecheck/sigs/neg129.bsl @@ -1,9 +1,9 @@ neg129.fs(67,47,67,54): typecheck error FS0043: A unique overload for method 'convert_witness' could not be determined based on type information prior to this program point. A type annotation may be needed. -Known return type: ^output +Known return type: ^output -Known type parameters: < bigint , ^output > +Known type parameters: < bigint , ^output > Candidates: - static member witnesses.convert_witness: x: bigint * _output: Complex -> Complex diff --git a/tests/fsharp/typecheck/sigs/neg131.bsl b/tests/fsharp/typecheck/sigs/neg131.bsl index 7015901cf41..2319a3914d4 100644 --- a/tests/fsharp/typecheck/sigs/neg131.bsl +++ b/tests/fsharp/typecheck/sigs/neg131.bsl @@ -4,5 +4,5 @@ neg131.fs(15,9,15,55): typecheck error FS0041: A unique overload for method 'Som Known types of arguments: 'a * ('b -> int) Candidates: - - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: ( ^T -> int) -> int when ^T: (member get_Length: ^T -> int) - static member OverloadsWithSrtp.SomeMethod: x: 'T list * f: ('T list -> int) -> int + - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: (^T -> int) -> int when ^T: (member Length: int) diff --git a/tests/fsharp/typecheck/sigs/neg132.bsl b/tests/fsharp/typecheck/sigs/neg132.bsl index ed2b768854a..5bed67dbd41 100644 --- a/tests/fsharp/typecheck/sigs/neg132.bsl +++ b/tests/fsharp/typecheck/sigs/neg132.bsl @@ -6,5 +6,5 @@ neg132.fs(15,9,15,55): typecheck error FS0041: A unique overload for method 'Som Known types of arguments: 'a * ('b -> int) Candidates: - - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: ( ^T -> int) -> int when ^T: (member get_Length: ^T -> int) - static member OverloadsWithSrtp.SomeMethod: x: 'T list * f: ('T list -> int) -> int + - static member OverloadsWithSrtp.SomeMethod: x: ^T * f: (^T -> int) -> int when ^T: (member Length: int) diff --git a/tests/fsharp/typecheck/sigs/neg61.bsl b/tests/fsharp/typecheck/sigs/neg61.bsl index 1493d479a29..b1ba15a77ad 100644 --- a/tests/fsharp/typecheck/sigs/neg61.bsl +++ b/tests/fsharp/typecheck/sigs/neg61.bsl @@ -45,7 +45,7 @@ neg61.fs(56,16,56,19): typecheck error FS0039: The value or constructor 'zip' is neg61.fs(60,13,60,21): typecheck error FS3145: This is not a known query operator. Query operators are identifiers such as 'select', 'where', 'sortBy', 'thenBy', 'groupBy', 'groupValBy', 'join', 'groupJoin', 'sumBy' and 'averageBy', defined using corresponding methods on the 'QueryBuilder' type. -neg61.fs(60,13,60,21): typecheck error FS0193: This expression is a function value, i.e. is missing arguments. Its type is ^a -> ^a. +neg61.fs(60,13,60,21): typecheck error FS0193: This expression is a function value, i.e. is missing arguments. Its type is ^a -> ^a. neg61.fs(64,13,64,20): typecheck error FS3145: This is not a known query operator. Query operators are identifiers such as 'select', 'where', 'sortBy', 'thenBy', 'groupBy', 'groupValBy', 'join', 'groupJoin', 'sumBy' and 'averageBy', defined using corresponding methods on the 'QueryBuilder' type. diff --git a/tests/fsharp/typecheck/sigs/pos35.fs b/tests/fsharp/typecheck/sigs/pos35.fs index 8848c965cd5..ed7c76a5617 100644 --- a/tests/fsharp/typecheck/sigs/pos35.fs +++ b/tests/fsharp/typecheck/sigs/pos35.fs @@ -138,7 +138,7 @@ module SelectOverloadedWitnessBasedOnReturnTypeByPassingDummyArgumentAndUsingOut // // The resulting type is like this: // - // val inline inst : num:bigint -> ^output when (witnesses or bigint or ^output) : (static member convert_witness : bigint * ^output -> ^output) + // val inline inst : num:bigint -> ^output when (witnesses or bigint or ^output) : (static member convert_witness : bigint * ^output -> ^output) let inline inst (num: bigint) : ^output = convert num let i1 : int32 = inst 777I let i2 : int64 = inst 777I diff --git a/tests/service/ExprTests.fs b/tests/service/ExprTests.fs index 05b42f7a67d..91b2dc34631 100644 --- a/tests/service/ExprTests.fs +++ b/tests/service/ExprTests.fs @@ -3334,7 +3334,7 @@ let ``Test ProjectForWitnesses1 GetWitnessPassingInfo`` () = nm |> shouldEqual "callX$W" argTypes.Count |> shouldEqual 1 let argText = argTypes[0].Type.ToString() - argText |> shouldEqual "type ^T -> ^U -> ^V" + argText |> shouldEqual "type ^T -> ^U -> ^V" end @@ -3356,8 +3356,8 @@ let ``Test ProjectForWitnesses1 GetWitnessPassingInfo`` () = let argText1 = argTypes[0].Type.ToString() let argName2 = argTypes[1].Name let argText2 = argTypes[1].Type.ToString() - argText1 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" - argText2 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" + argText1 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" + argText2 |> shouldEqual "type ^T -> ^U -> Microsoft.FSharp.Core.unit" end @@ -3504,9 +3504,9 @@ let ``Test ProjectForWitnesses3 GetWitnessPassingInfo`` () = let argName2 = argTypes[1].Name let argText2 = argTypes[1].Type.ToString() argName1 |> shouldEqual (Some "get_Zero") - argText1 |> shouldEqual "type Microsoft.FSharp.Core.unit -> ^T" + argText1 |> shouldEqual "type Microsoft.FSharp.Core.unit -> ^T" argName2 |> shouldEqual (Some "op_Addition") - argText2 |> shouldEqual "type ^T -> ^T -> ^T" + argText2 |> shouldEqual "type ^T -> ^T -> ^T" end //--------------------------------------------------------------------------------------------------------- From 3432f30c7b01e8df413b47079de5f6bde2714fe2 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 4 Jul 2022 23:08:25 +0100 Subject: [PATCH 36/91] allow IWSAM constraints to solve SRTP traits --- src/Compiler/Checking/CheckExpressions.fs | 25 +- src/Compiler/Checking/ConstraintSolver.fs | 278 +++++++++++------- src/Compiler/Checking/ConstraintSolver.fsi | 4 + src/Compiler/Checking/InfoReader.fs | 27 +- src/Compiler/Checking/InfoReader.fsi | 3 + src/Compiler/Checking/MethodCalls.fs | 44 ++- src/Compiler/Checking/MethodCalls.fsi | 7 +- src/Compiler/Checking/NameResolution.fs | 10 +- src/Compiler/Checking/NameResolution.fsi | 4 - src/Compiler/Checking/PostInferenceChecks.fs | 2 +- src/Compiler/Checking/infos.fs | 7 +- src/Compiler/CodeGen/IlxGen.fs | 62 ++-- src/Compiler/Optimize/Optimizer.fs | 22 +- .../Service/ServiceDeclarationLists.fs | 2 +- src/Compiler/Symbols/SymbolHelpers.fs | 6 +- src/Compiler/Symbols/Symbols.fs | 2 +- src/Compiler/TypedTree/TypedTree.fs | 6 +- src/Compiler/TypedTree/TypedTree.fsi | 6 +- src/Compiler/TypedTree/TypedTreeBasics.fs | 6 + src/Compiler/TypedTree/TypedTreeBasics.fsi | 3 + src/Compiler/TypedTree/TypedTreeOps.fs | 48 +-- src/Compiler/TypedTree/TypedTreeOps.fsi | 10 +- src/Compiler/TypedTree/TypedTreePickle.fs | 18 +- tests/adhoc.fsx | 36 ++- 24 files changed, 414 insertions(+), 224 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 3202139b33d..9077ed1a14d 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7367,7 +7367,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn let tyExprs = percentATys |> Array.map (mkCallTypeOf g m) |> Array.toList mkArray (g.system_Type_ty, tyExprs, m) - let fmtExpr = MakeMethInfoCall cenv.amap m newFormatMethod [] [mkString g m printfFormatString; argsExpr; percentATysExpr] + let fmtExpr = MakeMethInfoCall cenv.amap m newFormatMethod [] [mkString g m printfFormatString; argsExpr; percentATysExpr] None if isString then TcPropagatingExprLeafThenConvert cenv overallTy g.string_ty env (* true *) m (fun () -> @@ -8753,16 +8753,16 @@ and TcImplicitOpItemThen cenv overallTy env id sln tpenv mItem delayed = let argData = if isPrefix then - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) ] elif isTernary then - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) ] else - [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) - SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) ] + [ SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) + SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) ] - let retTyData = SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.HeadType, true) + let retTyData = SynTypar(mkSynId mItem (cenv.synArgNameGenerator.New()), TyparStaticReq.None, true) let argTypars = argData |> List.map (fun d -> Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, d, false, TyparDynamicReq.Yes, [], false, false)) let retTypar = Construct.NewTypar (TyparKind.Type, TyparRigidity.Flexible, retTyData, false, TyparDynamicReq.Yes, [], false, false) let argTys = argTypars |> List.map mkTyparTy @@ -9510,7 +9510,8 @@ and TcMethodApplication_UniqueOverloadInference candidateMethsAndProps candidates mMethExpr - mItem = + mItem + staticTyOpt = let g = cenv.g let denv = env.DisplayEnv @@ -9568,7 +9569,7 @@ and TcMethodApplication_UniqueOverloadInference match tyArgsOpt with | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers tyargs | None -> minst - CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt, staticTyOpt) let preArgumentTypeCheckingCalledMethGroup = [ for minfo, pinfoOpt in candidateMethsAndProps do @@ -9749,7 +9750,7 @@ and TcMethodApplication // Extract what we know about the caller arguments, either type-directed if // no arguments are given or else based on the syntax of the arguments. let uniquelyResolved, preArgumentTypeCheckingCalledMethGroup = - TcMethodApplication_UniqueOverloadInference cenv env exprTy tyArgsOpt ad objTyOpt isCheckingAttributeCall callerObjArgTys methodName curriedCallerArgsOpt candidateMethsAndProps candidates mMethExpr mItem + TcMethodApplication_UniqueOverloadInference cenv env exprTy tyArgsOpt ad objTyOpt isCheckingAttributeCall callerObjArgTys methodName curriedCallerArgsOpt candidateMethsAndProps candidates mMethExpr mItem staticTyOpt // STEP 2. Check arguments let unnamedCurriedCallerArgs, namedCurriedCallerArgs, lambdaVars, returnTy, tpenv = @@ -9780,7 +9781,7 @@ and TcMethodApplication match tyArgsOpt with | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers tyargs | None -> minst - CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt)) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt, staticTyOpt)) // Commit unassociated constraints prior to member overload resolution where there is ambiguity // about the possible target of the call. diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index cf3c366d936..e6741d92951 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -465,9 +465,9 @@ let IsSignType g ty = type TraitConstraintSolution = | TTraitUnsolved | TTraitBuiltIn - | TTraitSolved of MethInfo * TypeInst - | TTraitSolvedRecdProp of RecdFieldInfo * bool - | TTraitSolvedAnonRecdProp of AnonRecdTypeInfo * TypeInst * int + | TTraitSolved of minfo: MethInfo * minst: TypeInst * staticTyOpt: TType option + | TTraitSolvedRecdProp of fieldInfo: RecdFieldInfo * isSetProp: bool + | TTraitSolvedAnonRecdProp of anonRecdTypeInfo: AnonRecdTypeInfo * typeInst: TypeInst * index: int let BakedInTraitConstraintNames = [ "op_Division" ; "op_Multiply"; "op_Addition" @@ -1010,9 +1010,6 @@ and SolveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty // Propagate dynamic requirements from 'tp' to 'ty' do! SolveTypDynamicReq csenv trace r.DynamicReq ty - // Propagate static requirements from 'tp' to 'ty' - do! SolveTypStaticReq csenv trace r.StaticReq ty - // Solve constraints on 'tp' w.r.t. 'ty' for e in r.Constraints do do! @@ -1367,7 +1364,7 @@ and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty /// /// 2. Some additional solutions are forced prior to generalization (permitWeakResolution= Yes or YesDuringCodeGen). See above and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace traitInfo : OperationResult = trackErrors { - let (TTrait(tys, nm, memFlags, traitObjAndArgTys, retTy, sln)) = traitInfo + let (TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln)) = traitInfo // Do not re-solve if already solved if sln.Value.IsSome then return true else @@ -1381,25 +1378,21 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! DepthCheck ndeep m // Remove duplicates from the set of types in the support - let tys = ListSet.setify (typeAEquiv g aenv) tys + let supportTys = ListSet.setify (typeAEquiv g aenv) supportTys // Rebuild the trait info after removing duplicates - let traitInfo = TTrait(tys, nm, memFlags, traitObjAndArgTys, retTy, sln) + let traitInfo = TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, sln) let retTy = GetFSharpViewOfReturnType g retTy // Assert the object type if the constraint is for an instance member if memFlags.IsInstance then - match tys, traitObjAndArgTys with + match supportTys, traitObjAndArgTys with | [ty], h :: _ -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) - // Trait calls are only supported on pseudo type (variables) - for e in tys do - do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType e - - // SRTP constraints on rigid type parameters do not need to be solved - they are simply declared + // SRTP constraints on rigid type parameters do not need to be solved let isRigid = - tys |> List.forall (fun ty -> + supportTys |> List.forall (fun ty -> match tryDestTyparTy g ty with | ValueSome tp -> match tp.Rigidity with @@ -1408,18 +1401,13 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _ -> false | ValueNone -> false) - if isRigid then - do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo CompleteD - return false - else - let argTys = if memFlags.IsInstance then List.tail traitObjAndArgTys else traitObjAndArgTys let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo let! res = trackErrors { - match minfos, tys, memFlags.IsInstance, nm, argTys with + match minfos, supportTys, memFlags.IsInstance, nm, argTys with | _, _, false, ("op_Division" | "op_Multiply"), [argTy1;argTy2] when // This simulates the existence of @@ -1483,7 +1471,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argTy1;argTy2] when // Ignore any explicit +/- overloads from any basic integral types - (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.ApparentEnclosingType ) && + (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && ( IsAddSubModType nm g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 || IsAddSubModType nm g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 @@ -1492,7 +1480,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argTy1;argTy2] when // Ignore any explicit overloads from any basic integral types - (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.ApparentEnclosingType ) && + (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && ( IsRelationalType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 || IsRelationalType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 @@ -1583,7 +1571,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn | _, _, true, "get_Sign", [] - when IsSignType g tys.Head -> + when IsSignType g supportTys.Head -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.int32_ty return TTraitBuiltIn @@ -1665,10 +1653,10 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let recdPropSearch = let isGetProp = nm.StartsWithOrdinal("get_") let isSetProp = nm.StartsWithOrdinal("set_") - if argTys.IsEmpty && isGetProp || isSetProp then + if not isRigid && ((argTys.IsEmpty && isGetProp) || isSetProp) then let propName = nm[4..] let props = - tys |> List.choose (fun ty -> + supportTys |> List.choose (fun ty -> match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty with | Some (RecdFieldItem rfinfo) when (isGetProp || rfinfo.RecdField.IsMutable) && @@ -1686,10 +1674,10 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let anonRecdPropSearch = let isGetProp = nm.StartsWith "get_" - if isGetProp && memFlags.IsInstance then + if not isRigid && isGetProp && memFlags.IsInstance then let propName = nm[4..] let props = - tys |> List.choose (fun ty -> + supportTys |> List.choose (fun ty -> match NameResolution.TryFindAnonRecdFieldOfType g ty propName with | Some (NameResolution.Item.AnonRecdField(anonInfo, tinst, i, _)) -> Some (anonInfo, tinst, i) | _ -> None) @@ -1702,9 +1690,9 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // Now check if there are no feasible solutions at all match minfos, recdPropSearch, anonRecdPropSearch with | [], None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo -> - if tys |> List.exists (isFunTy g) then + if supportTys |> List.exists (isFunTy g) then return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(DecompileOpName nm), m, m2)) - elif tys |> List.exists (isAnyTupleTy g) then + elif supportTys |> List.exists (isAnyTupleTy g) then return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(DecompileOpName nm), m, m2)) else match nm, argTys with @@ -1714,19 +1702,19 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion(argTyString, rtyString), m, m2)) | _ -> let tyString = - match tys with + match supportTys with | [ty] -> NicePrint.minimalStringOfType denv ty - | _ -> tys |> List.map (NicePrint.minimalStringOfType denv) |> String.concat ", " + | _ -> supportTys |> List.map (NicePrint.minimalStringOfType denv) |> String.concat ", " let opName = DecompileOpName nm let err = match opName with | "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>" | ">=?" | ">?" | "<=?" | "?" | "?>=?" | "?>?" | "?<=?" | "??" -> - if List.isSingleton tys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) + if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) | _ -> - if List.isSingleton tys then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) else FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) return! ErrorD(ConstraintSolverError(err, m, m2)) @@ -1735,14 +1723,14 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let calledMethGroup = minfos // curried members may not be used to satisfy constraints - |> List.choose (fun minfo -> + |> List.choose (fun (staticTy, minfo) -> if minfo.IsCurried then None else let callerArgs = { Unnamed = [ (argTys |> List.map (fun argTy -> CallerArg(argTy, m, false, dummyExpr))) ] Named = [ [ ] ] } let minst = FreshenMethInfo m minfo let objtys = minfo.GetObjArgTypes(amap, m, minst) - Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, callerArgs, false, false, None))) + Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, callerArgs, false, false, None, Some staticTy))) let methOverloadResult, errors = trace.CollectThenUndoOrCommit @@ -1776,7 +1764,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (DecompileOpName nm), nm), m, m2 )) else do! CheckMethInfoAttributes g m None minfo - return TTraitSolved (minfo, calledMeth.CalledTyArgs) + return TTraitSolved (minfo, calledMeth.CalledTyArgs, calledMeth.OptionalStaticType) | _ -> do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors @@ -1787,39 +1775,44 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors = trackErrors { - let nm = traitInfo.MemberLogicalName - let support = GetSupportOfMemberConstraint csenv traitInfo - let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo - - // If there's nothing left to learn then raise the errors. - // Note: we should likely call MemberConstraintIsReadyForResolution here when permitWeakResolution=false but for stability - // reasons we use the more restrictive isNil frees. - if (permitWeakResolution.Permit && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then - do! errors - // Otherwise re-record the trait waiting for canonicalization - else - do! AddMemberConstraint csenv ndeep m2 trace traitInfo support frees - - match errors with - | ErrorResult (_, UnresolvedOverloading _) - when - not ignoreUnresolvedOverload && - csenv.ErrorOnFailedMemberConstraintResolution && - (not (nm = "op_Explicit" || nm = "op_Implicit")) -> - return! ErrorD AbortForFailedMemberConstraintResolution - | _ -> - () + // Trait calls are only supported on pseudo type (variables) unless supported by IWSAM constraints + for supportTy in traitInfo.SupportTypes do + if not (SupportTypeOfMemberConstraintIsSolved csenv traitInfo supportTy) then + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType supportTy + + let nm = traitInfo.MemberLogicalName + let support = GetTyparSupportOfMemberConstraint csenv traitInfo + let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo + + // If there's nothing left to learn then raise the errors. + // Note: we should likely call MemberConstraintIsReadyForResolution here when permitWeakResolution=false but for stability + // reasons we use the more restrictive isNil frees. + if (permitWeakResolution.Permit && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then + do! errors + // Otherwise re-record the trait waiting for canonicalization + else + do! AddMemberConstraint csenv ndeep m2 trace traitInfo support frees + + match errors with + | ErrorResult (_, UnresolvedOverloading _) + when + not ignoreUnresolvedOverload && + csenv.ErrorOnFailedMemberConstraintResolution && + (not (nm = "op_Explicit" || nm = "op_Implicit")) -> + return! ErrorD AbortForFailedMemberConstraintResolution + | _ -> + () } /// Record the solution to a member constraint in the mutable reference cell attached to /// each member constraint. -and RecordMemberConstraintSolution css m trace traitInfo res = - match res with +and RecordMemberConstraintSolution css m trace traitInfo traitConstraintSln = + match traitConstraintSln with | TTraitUnsolved -> ResultD false - | TTraitSolved (minfo, minst) -> - let sln = MemberConstraintSolutionOfMethInfo css m minfo minst + | TTraitSolved (minfo, minst, staticTyOpt) -> + let sln = MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt TransactMemberConstraintSolution traitInfo trace sln ResultD true @@ -1838,7 +1831,7 @@ and RecordMemberConstraintSolution css m trace traitInfo res = ResultD true /// Convert a MethInfo into the data we save in the TAST -and MemberConstraintSolutionOfMethInfo css m minfo minst = +and MemberConstraintSolutionOfMethInfo css m minfo minst staticTyOpt = #if !NO_TYPEPROVIDERS #else // to prevent unused parameter warning @@ -1848,10 +1841,10 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = | ILMeth(_, ilMeth, _) -> let mref = IL.mkRefToILMethod (ilMeth.DeclaringTyconRef.CompiledRepresentationForNamedType, ilMeth.RawMetadata) let iltref = ilMeth.ILExtensionMethodDeclaringTyconRef |> Option.map (fun tcref -> tcref.CompiledRepresentationForNamedType) - ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst) + ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst, staticTyOpt) | FSMeth(_, ty, vref, _) -> - FSMethSln(ty, vref, minst) + FSMethSln(ty, vref, minst, staticTyOpt) | MethInfo.DefaultStructCtor _ -> error(InternalError("the default struct constructor was the unexpected solution to a trait constraint", m)) @@ -1874,7 +1867,7 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = let declaringType = ImportProvidedType amap m (methInfo.PApply((fun x -> x.DeclaringType), m)) if isILAppTy g declaringType then let extOpt = None // EXTENSION METHODS FROM TYPE PROVIDERS: for extension methods coming from the type providers we would have something here. - ILMethSln(declaringType, extOpt, ilMethRef, methInst) + ILMethSln(declaringType, extOpt, ilMethRef, methInst, staticTyOpt) else closedExprSln | _ -> @@ -1889,45 +1882,88 @@ and TransactMemberConstraintSolution traitInfo (trace: OptionalTrace) sln = /// Only consider overload resolution if canonicalizing or all the types are now nominal. /// That is, don't perform resolution if more nominal information may influence the set of available overloads -and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolution: PermitWeakResolution) nm (TTrait(tys, _, memFlags, argTys, retTy, soln) as traitInfo): MethInfo list = +and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolution: PermitWeakResolution) nm traitInfo : (TType * MethInfo) list = + let (TTrait(_, _, memFlags, _, _, _)) = traitInfo let results = if permitWeakResolution.Permit || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then let m = csenv.m + + let nominalTys = GetNominalSupportOfMemberConstraint csenv nm traitInfo + let minfos = - match memFlags.MemberKind with - | SynMemberKind.Constructor -> - tys |> List.map (GetIntrinsicConstructorInfosOfType csenv.SolverState.InfoReader m) - | _ -> - tys |> List.map (GetIntrinsicMethInfosOfType csenv.SolverState.InfoReader (Some nm) AccessibleFromSomeFSharpCode AllowMultiIntfInstantiations.Yes IgnoreOverrides m) + [ for (supportTy, nominalTy) in nominalTys do + let infos = + match memFlags.MemberKind with + | SynMemberKind.Constructor -> + GetIntrinsicConstructorInfosOfType csenv.SolverState.InfoReader m nominalTy + | _ -> + GetIntrinsicMethInfosOfType csenv.SolverState.InfoReader (Some nm) AccessibleFromSomeFSharpCode AllowMultiIntfInstantiations.Yes IgnoreOverrides m nominalTy + for info in infos do + supportTy, info ] // Merge the sets so we don't get the same minfo from each side // We merge based on whether minfos use identical metadata or not. - let minfos = List.reduce (ListSet.unionFavourLeft MethInfo.MethInfosUseIdenticalDefinitions) minfos + let minfos = ListSet.setify (fun (_,minfo1) (_, minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) minfos /// Check that the available members aren't hiding a member from the parent (depth 1 only) - let relevantMinfos = minfos |> List.filter(fun minfo -> not minfo.IsDispatchSlot && not minfo.IsVirtual && minfo.IsInstance) + let relevantMinfos = minfos |> List.filter(fun (_, minfo) -> not minfo.IsDispatchSlot && not minfo.IsVirtual && minfo.IsInstance) minfos - |> List.filter(fun minfo1 -> + |> List.filter(fun (_, minfo1) -> not(minfo1.IsDispatchSlot && relevantMinfos - |> List.exists (fun minfo2 -> MethInfosEquivByNameAndSig EraseAll true csenv.g csenv.amap m minfo2 minfo1))) + |> List.exists (fun (_, minfo2) -> MethInfosEquivByNameAndSig EraseAll true csenv.g csenv.amap m minfo2 minfo1))) else [] // The trait name "op_Explicit" also covers "op_Implicit", so look for that one too. if nm = "op_Explicit" then - results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" (TTrait(tys, "op_Implicit", memFlags, argTys, retTy, soln)) + let (TTrait(supportTys, _, memFlags, argTys, retTy, soln)) = traitInfo + let traitInfo2 = TTrait(supportTys, "op_Implicit", memFlags, argTys, retTy, soln) + results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" traitInfo2 else results -/// The nominal support of the member constraint -and GetSupportOfMemberConstraint (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = - tys |> List.choose (tryAnyParTyOption csenv.g) +/// The typar support of the member constraint. +and GetTyparSupportOfMemberConstraint csenv traitInfo = + traitInfo.SupportTypes |> List.choose (tryAnyParTyOption csenv.g) -/// Check if the support is fully solved. -and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = - tys |> List.forall (isAnyParTy csenv.g >> not) +/// The nominal types supporting the solution of a particular named SRTP constraint. +/// Constraints providing interfaces with static abstract methods can be +/// used to solve SRTP static member constraints on type parameters. +and GetNominalSupportOfMemberConstraint csenv nm traitInfo = + let m = csenv.m + let g = csenv.g + let infoReader = csenv.InfoReader + [ for supportTy in traitInfo.SupportTypes do + if isTyparTy g supportTy then + let mutable replaced = false + for cx in (destTyparTy g supportTy).Constraints do + match cx with + | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceWithStaticAbstractMemberTy m nm AccessibleFromSomeFSharpCode interfaceTy -> + replaced <- true + (supportTy, interfaceTy) + | _ -> () + if not replaced then + (supportTy, supportTy) + else + (supportTy, supportTy) ] + +and SupportTypeHasInterfaceWithMatchingStaticAbstractMember (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) (supportTyPar: Typar) = + let m = csenv.m + let infoReader = csenv.InfoReader + let mutable found = false + for cx in supportTyPar.Constraints do + match cx with + | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceWithStaticAbstractMemberTy m traitInfo.MemberLogicalName AccessibleFromSomeFSharpCode interfaceTy -> + found <- true + | _ -> () + found + +and SupportTypeOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) supportTy = + let g = csenv.g + not (isAnyParTy g supportTy) || + SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo (destAnyParTy g supportTy) // This may be relevant to future bug fixes, see https://github.com/dotnet/fsharp/issues/3814 // /// Check if some part of the support is solved. @@ -1935,17 +1971,27 @@ and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) (TTrait( // tys |> List.exists (isAnyParTy csenv.g >> not) /// Get all the unsolved typars (statically resolved or not) relevant to the member constraint -and GetFreeTyparsOfMemberConstraint (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, argTys, retTy, _)) = - freeInTypesLeftToRightSkippingConstraints csenv.g (tys @ argTys @ Option.toList retTy) +and GetFreeTyparsOfMemberConstraint (csenv: ConstraintSolverEnv) traitInfo = + let (TTrait(supportTys, _, _, argTys, retTy, _)) = traitInfo + freeInTypesLeftToRightSkippingConstraints csenv.g (supportTys @ argTys @ Option.toList retTy) and MemberConstraintIsReadyForWeakResolution csenv traitInfo = - SupportOfMemberConstraintIsFullySolved csenv traitInfo + SupportOfMemberConstraintIsSolved csenv traitInfo and MemberConstraintIsReadyForStrongResolution csenv traitInfo = - SupportOfMemberConstraintIsFullySolved csenv traitInfo + SupportOfMemberConstraintIsSolved csenv traitInfo and MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo = - SupportOfMemberConstraintIsFullySolved csenv traitInfo + SupportOfMemberConstraintIsSolved csenv traitInfo || + // Left-bias for SRTP constraints where the first is constrained by an IWSAM type. This is because typical IWSAM hierarchies + // such as System.Numerics hierarchy math are left-biased. + (match traitInfo.SupportTypes with + | firstSupportTy :: _ -> isTyparTy csenv.g firstSupportTy && SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo (destAnyParTy csenv.g firstSupportTy) + | _ -> false) + +/// Check if the support is fully solved. +and SupportOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) traitInfo = + traitInfo.SupportTypes |> List.forall (SupportTypeOfMemberConstraintIsSolved csenv traitInfo) /// Re-solve the global constraints involving any of the given type variables. /// Trait constraints can't always be solved using the pessimistic rules. We only canonicalize @@ -2014,6 +2060,7 @@ and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr // may require type annotations. // // The 'retry' flag is passed when a rigid type variable is about to taise a missing constraint error. +// In this case the support types are all first forced to be equal. and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace retry tpc1 tpc2 = let g = csenv.g let amap = csenv.amap @@ -2021,7 +2068,8 @@ and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace ret match tpc1, tpc2 with | (TyparConstraint.MayResolveMember(TTrait(tys1, nm1, memFlags1, argTys1, rty1, _), _), TyparConstraint.MayResolveMember(TTrait(tys2, nm2, memFlags2, argTys2, rty2, _), _)) - when (memFlags1 = memFlags2 && + when + (memFlags1.IsInstance = memFlags2.IsInstance && nm1 = nm2 && // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. // See FSharp 1.0 bug 6477. @@ -2101,8 +2149,7 @@ and CheckConstraintImplication (csenv: ConstraintSolverEnv) tpc1 tpc2 = let amap = csenv.amap let m = csenv.m match tpc1, tpc2 with - | TyparConstraint.MayResolveMember(trait1, _), - TyparConstraint.MayResolveMember(trait2, _) -> + | TyparConstraint.MayResolveMember(trait1, _), TyparConstraint.MayResolveMember(trait2, _) -> traitsAEquiv g aenv trait1 trait2 | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> @@ -2361,19 +2408,22 @@ and SolveTypeIsUnmanaged (csenv: ConstraintSolverEnv) ndeep m2 trace ty = ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalStringOfType denv ty), m, m2)) -and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty tys = - let g = csenv.g - let m = csenv.m - let denv = csenv.DisplayEnv - match tryDestTyparTy g ty with - | ValueSome destTypar -> - AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(tys, m)) - | _ -> - if List.exists (typeEquivAux Erasure.EraseMeasures g ty) tys then CompleteD - else - let tyString = NicePrint.minimalStringOfType denv ty - let tysString = tys |> List.map (NicePrint.prettyStringOfTy denv) |> String.concat "," - ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf(tyString, tysString), m, m2)) +and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty choiceTys = + trackErrors { + let g = csenv.g + let m = csenv.m + let denv = csenv.DisplayEnv + match tryDestTyparTy g ty with + | ValueSome destTypar -> + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType ty + + return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(choiceTys, m)) + | _ -> + if not (choiceTys |> List.exists (typeEquivAux Erasure.EraseMeasures g ty)) then + let tyString = NicePrint.minimalStringOfType denv ty + let tysString = choiceTys |> List.map (NicePrint.prettyStringOfTy denv) |> String.concat "," + return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf(tyString, tysString), m, m2)) + } and SolveTypeIsReferenceType (csenv: ConstraintSolverEnv) ndeep m2 trace ty = let g = csenv.g @@ -2855,7 +2905,8 @@ and ReportNoCandidatesErrorSynExpr csenv callerArgCounts methodName ad calledMet and AssumeMethodSolvesTrait (csenv: ConstraintSolverEnv) (cx: TraitConstraintInfo option) m trace (calledMeth: CalledMeth<_>) = match cx with | Some traitInfo when traitInfo.Solution.IsNone -> - let traitSln = MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs + let staticTyOpt = if calledMeth.Method.IsInstance then None else calledMeth.OptionalStaticType + let traitSln = MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs staticTyOpt #if TRAIT_CONSTRAINT_CORRECTIONS if csenv.g.langVersion.SupportsFeature LanguageFeature.TraitConstraintCorrections then TransactMemberConstraintSolution traitInfo trace traitSln @@ -3517,6 +3568,19 @@ let CreateCodegenState tcVal g amap = PostInferenceChecksPreDefaults = ResizeArray() PostInferenceChecksFinal = ResizeArray() } +/// Determine if a codegen witness for a trait will require witness args to be available, e.g. in generic code +let CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs tcVal g amap m (traitInfo:TraitConstraintInfo) = trackErrors { + let css = CreateCodegenState tcVal g amap + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo + let res = + match traitInfo.Solution with + | None + | Some BuiltInSln -> true + | _ -> false + return res + } + /// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { let css = CreateCodegenState tcVal g amap diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index 7891763dd44..b9d3bba048f 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -304,6 +304,10 @@ val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority val CodegenWitnessExprForTraitConstraint: TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult +/// Determine if a codegen witness for a trait will require witness args to be available, e.g. in generic code +val CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs: + TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> OperationResult + /// Generate the arguments passed when using a generic construct that accepts traits witnesses val CodegenWitnessesForTyparInst: TcValF -> diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index b206d77157c..f6f3d45ef77 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.InfoReader open System.Collections.Concurrent +open System.Collections.Generic open Internal.Utilities.Library open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL @@ -663,7 +664,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = /// Make a cache for function 'f' keyed by type (plus some additional 'flags') that only /// caches computations for monomorphic types. - let MakeInfoCache f (flagsEq : System.Collections.Generic.IEqualityComparer<_>) = + let MakeInfoCache f (flagsEq : IEqualityComparer<_>) = MemoizationTable<_, _> (compute=f, // Only cache closed, monomorphic types (closed = all members for the type @@ -675,7 +676,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = | _ -> false), keyComparer= - { new System.Collections.Generic.IEqualityComparer<_> with + { new IEqualityComparer<_> with member _.Equals((flags1, _, typ1), (flags2, _, typ2)) = // Ignoring the ranges - that's OK. flagsEq.Equals(flags1, flags2) && @@ -698,29 +699,39 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = else this.TryFindIntrinsicMethInfo m ad "op_Implicit" ty + let IsInterfaceWithStaticAbstractMemberTyUncached ((ad, nm), m, ty) = + ExistsInEntireHierarchyOfType (fun parentTy -> + this.TryFindIntrinsicMethInfo m ad nm parentTy |> List.isEmpty |> not) + g amap m AllowMultiIntfInstantiations.Yes ty + let hashFlags0 = - { new System.Collections.Generic.IEqualityComparer with + { new IEqualityComparer with member _.GetHashCode((filter: string option, ad: AccessorDomain, _allowMultiIntfInst1)) = hash filter + AccessorDomain.CustomGetHashCode ad member _.Equals((filter1, ad1, allowMultiIntfInst1), (filter2, ad2, allowMultiIntfInst2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g, ad1, ad2) && allowMultiIntfInst1 = allowMultiIntfInst2 } let hashFlags1 = - { new System.Collections.Generic.IEqualityComparer with + { new IEqualityComparer with member _.GetHashCode((filter: string option, ad: AccessorDomain)) = hash filter + AccessorDomain.CustomGetHashCode ad member _.Equals((filter1, ad1), (filter2, ad2)) = (filter1 = filter2) && AccessorDomain.CustomEquals(g, ad1, ad2) } let hashFlags2 = - { new System.Collections.Generic.IEqualityComparer with + { new IEqualityComparer with member _.GetHashCode((nm: string, ad: AccessorDomain, includeConstraints)) = hash nm + AccessorDomain.CustomGetHashCode ad + hash includeConstraints member _.Equals((nm1, ad1, includeConstraints1), (nm2, ad2, includeConstraints2)) = (nm1 = nm2) && AccessorDomain.CustomEquals(g, ad1, ad2) && (includeConstraints1 = includeConstraints2) } let hashFlags3 = - { new System.Collections.Generic.IEqualityComparer with + { new IEqualityComparer with member _.GetHashCode((ad: AccessorDomain)) = AccessorDomain.CustomGetHashCode ad member _.Equals((ad1), (ad2)) = AccessorDomain.CustomEquals(g, ad1, ad2) } + let hashFlags4 = + { new IEqualityComparer with + member _.GetHashCode((ad, nm)) = AccessorDomain.CustomGetHashCode ad + hash nm + member _.Equals((ad1, nm1), (ad2, nm2)) = AccessorDomain.CustomEquals(g, ad1, ad2) && (nm1 = nm2) } + let methodInfoCache = MakeInfoCache GetIntrinsicMethodSetsUncached hashFlags0 let propertyInfoCache = MakeInfoCache GetIntrinsicPropertySetsUncached hashFlags0 let recdOrClassFieldInfoCache = MakeInfoCache GetIntrinsicRecdOrClassFieldInfosUncached hashFlags1 @@ -732,6 +743,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = let entireTypeHierarchyCache = MakeInfoCache GetEntireTypeHierarchyUncached HashIdentity.Structural let primaryTypeHierarchyCache = MakeInfoCache GetPrimaryTypeHierarchyUncached HashIdentity.Structural let implicitConversionCache = MakeInfoCache FindImplicitConversionsUncached hashFlags3 + let isInterfaceWithStaticAbstractMethodCache = MakeInfoCache IsInterfaceWithStaticAbstractMemberTyUncached hashFlags4 // Runtime feature support @@ -900,6 +912,9 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member _.FindImplicitConversions m ad ty = implicitConversionCache.Apply((ad, m, ty)) + member _.IsInterfaceWithStaticAbstractMemberTy m nm ad ty = + isInterfaceWithStaticAbstractMethodCache.Apply((ad, nm), m, ty) + let checkLanguageFeatureRuntimeAndRecover (infoReader: InfoReader) langFeature m = if not (infoReader.IsLanguageFeatureRuntimeSupported langFeature) then let featureStr = infoReader.g.langVersion.GetFeatureString langFeature diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index e05055223d2..ba1a3747954 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -195,6 +195,9 @@ type InfoReader = /// Find the op_Implicit for a type member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list + /// Determine if a type has a static abstract method with the given name somewhere in its hierarchy + member IsInterfaceWithStaticAbstractMemberTy: m: range -> nm: string -> ad: AccessorDomain -> ty: TType -> bool + val checkLanguageFeatureRuntimeAndRecover: infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> unit diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 5e44c22bcc2..950b3224335 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -12,6 +12,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features +open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.IO @@ -491,6 +492,7 @@ let MakeCalledArgs amap m (minfo: MethInfo) minst = /// Do we allow the use of a param args method in its "expanded" form? /// Do we allow the use of the transformation that converts out arguments as tuple returns? /// Method parameters +/// The optional static type governing a constrained static virtual interface call type CalledMeth<'T> (infoReader: InfoReader, nameEnv: NameResolutionEnv option, @@ -506,7 +508,8 @@ type CalledMeth<'T> callerArgs: CallerArgs<'T>, allowParamArgs: bool, allowOutAndOptArgs: bool, - tyargsOpt: TType option) + tyargsOpt: TType option, + staticTyOpt: TType option) = let g = infoReader.g let methodRetTy = if minfo.IsConstructor then minfo.ApparentEnclosingType else minfo.GetFSharpReturnType(infoReader.amap, m, calledTyArgs) @@ -797,6 +800,8 @@ type CalledMeth<'T> member x.TotalNumAssignedNamedArgs = x.ArgSets |> List.sumBy (fun x -> x.NumAssignedNamedArgs) + member x.OptionalStaticType = staticTyOpt + override x.ToString() = "call to " + minfo.ToString() let NamesOfCalledArgs (calledArgs: CalledArg list) = @@ -874,11 +879,11 @@ let IsBaseCall objArgs = /// Compute whether we insert a 'coerce' on the 'this' pointer for an object model call /// For example, when calling an interface method on a struct, or a method on a constrained /// variable type. -let ComputeConstrainedCallInfo g amap m staticTyOpt objArgs (minfo: MethInfo) = - match objArgs, staticTyOpt with - | [], Some staticTy when not minfo.IsExtensionMember && not minfo.IsInstance && minfo.IsAbstract -> Some staticTy +let ComputeConstrainedCallInfo g amap m staticTyOpt args (minfo: MethInfo) = + match args, staticTyOpt with + | _, Some staticTy when not minfo.IsExtensionMember && not minfo.IsInstance && minfo.IsAbstract -> Some staticTy - | [objArgExpr], _ when not minfo.IsExtensionMember -> + | (objArgExpr :: _), _ when minfo.IsInstance && not minfo.IsExtensionMember -> let methObjTy = minfo.ApparentEnclosingType let objArgTy = tyOfExpr g objArgExpr if TypeDefinitelySubsumesTypeNoCoercion 0 g amap m methObjTy objArgTy @@ -1014,11 +1019,18 @@ let BuildFSharpMethodCall g m (ty, vref: ValRef) valUseFlags minst args = /// Make a call to a method info. Used by the optimizer and code generator to build /// calls to the type-directed solutions to member constraints. -let MakeMethInfoCall amap m minfo minst args = - let valUseFlags = NormalValUse // correct unless if we allow wild trait constraints like "T has a ctor and can be used as a parent class" +let MakeMethInfoCall (amap: ImportMap) m (minfo: MethInfo) minst args staticTyOpt = + let g = amap.g + let ccallInfo = ComputeConstrainedCallInfo g amap m staticTyOpt args minfo + let valUseFlags = + match ccallInfo with + | Some ty -> + // printfn "possible constrained call to '%s' at %A" minfo.LogicalName m + PossibleConstrainedCall ty + | None -> + NormalValUse match minfo with - | ILMeth(g, ilminfo, _) -> let direct = not minfo.IsVirtual let isProp = false // not necessarily correct, but this is only used post-creflect where this flag is irrelevant @@ -1446,7 +1458,7 @@ let MakeNullableExprIfNeeded (infoReader: InfoReader) calledArgTy callerArgTy ca let calledNonOptTy = destNullableTy g calledArgTy let minfo = GetIntrinsicConstructorInfosOfType infoReader m calledArgTy |> List.head let callerArgExprCoerced = mkCoerceIfNeeded g calledNonOptTy callerArgTy callerArgExpr - MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] + MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None // Adjust all the optional arguments, filling in values for defaults, let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) = @@ -2088,7 +2100,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = // Given the solution information, reconstruct the MethInfo for the solution match sln with - | ILMethSln(origTy, extOpt, mref, minst) -> + | ILMethSln(origTy, extOpt, mref, minst, staticTyOpt) -> let metadataTy = convertToTypeWithMetadataIfPossible g origTy let tcref = tcrefOfAppTy g metadataTy let mdef = resolveILMethodRef tcref.ILTyconRawMetadata mref @@ -2098,10 +2110,10 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = | Some ilActualTypeRef -> let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef) - Choice1Of5 (ilMethInfo, minst) + Choice1Of5 (ilMethInfo, minst, staticTyOpt) - | FSMethSln(ty, vref, minst) -> - Choice1Of5 (FSMeth(g, ty, vref, None), minst) + | FSMethSln(ty, vref, minst, staticTyOpt) -> + Choice1Of5 (FSMeth(g, ty, vref, None), minst, staticTyOpt) | FSRecdFieldSln(tinst, rfref, isSetProp) -> Choice2Of5 (tinst, rfref, isSetProp) @@ -2116,7 +2128,7 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = Choice5Of5 () match sln with - | Choice1Of5(minfo, methArgTys) -> + | Choice1Of5(minfo, methArgTys, staticTyOpt) -> let argExprs = // FIX for #421894 - typechecker assumes that coercion can be applied for the trait // calls arguments but codegen doesn't emit coercion operations @@ -2156,9 +2168,9 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m Some (wrap (Expr.Op (TOp.TraitCall traitInfo, [], (h' :: t), m))) | _ -> - Some (MakeMethInfoCall amap m minfo methArgTys argExprs) + Some (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) else - Some (MakeMethInfoCall amap m minfo methArgTys argExprs) + Some (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) | Choice2Of5 (tinst, rfref, isSet) -> match isSet, rfref.RecdField.IsStatic, argExprs.Length with diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index a1d45d7bf27..18a43c7e424 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -205,7 +205,8 @@ type CalledMeth<'T> = callerArgs: CallerArgs<'T> * allowParamArgs: bool * allowOutAndOptArgs: bool * - tyargsOpt: TType option -> + tyargsOpt: TType option * + staticTyOpt: TType option -> CalledMeth<'T> static member GetMethod: x: CalledMeth<'T> -> MethInfo @@ -302,6 +303,8 @@ type CalledMeth<'T> = member UsesParamArrayConversion: bool + member OptionalStaticType: TType option + member amap: ImportMap member infoReader: InfoReader @@ -338,7 +341,7 @@ val BuildILMethInfoCall: /// Make a call to a method info. Used by the optimizer and code generator to build /// calls to the type-directed solutions to member constraints. -val MakeMethInfoCall: amap: ImportMap -> m: range -> minfo: MethInfo -> minst: TType list -> args: Exprs -> Expr +val MakeMethInfoCall: amap: ImportMap -> m: range -> minfo: MethInfo -> minst: TType list -> args: Exprs -> staticTyOpt: TType option -> Expr /// Build an expression that calls a given method info. /// This is called after overload resolution, and also to call other diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index f1f19cebaa2..c86466a3801 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -128,14 +128,6 @@ let ActivePatternElemsOfModuleOrNamespace g (modref: ModuleOrNamespaceRef) : Nam // Name Resolution Items //------------------------------------------------------------------------- -/// Detect a use of a nominal type, including type abbreviations. -/// -/// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols -let (|AbbrevOrAppTy|_|) (ty: TType) = - match stripTyparEqns ty with - | TType_app (tcref, _, _) -> Some tcref - | _ -> None - /// Represents the item with which a named argument is associated. [] type ArgumentContainer = @@ -3655,7 +3647,7 @@ let NeedsWorkAfterResolution namedItem = | Item.MethodGroup(_, minfos, _) | Item.CtorGroup(_, minfos) -> minfos.Length > 1 || minfos |> List.exists (fun minfo -> not (isNil minfo.FormalMethodInst)) | Item.Property(_, pinfos) -> pinfos.Length > 1 - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) | Item.Value vref | Item.CustomBuilder (_, vref) -> not (List.isEmpty vref.Typars) | Item.CustomOperation (_, _, Some minfo) -> not (isNil minfo.FormalMethodInst) | Item.ActivePatternCase apref -> not (List.isEmpty apref.ActivePatternVal.Typars) diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index 9066a162b7d..55968c885f9 100644 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -41,10 +41,6 @@ type ArgumentContainer = /// The named argument is a static parameter to a provided type. | Type of TyconRef -/// Detect a use of a nominal type, including type abbreviations. -/// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols. -val (|AbbrevOrAppTy|_|): TType -> TyconRef option - type EnclosingTypeInst = TypeInst /// Represents an item that results from name resolution diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 87eb68c7d80..9206b15d3fe 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -651,7 +651,7 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError = let visitTraitSolution info = match info with - | FSMethSln(_, vref, _) -> + | FSMethSln(_, vref, _, _) -> //printfn "considering %s..." vref.DisplayName if valRefInThisAssembly cenv.g.compilingFSharpCore vref && not (cenv.boundVals.ContainsKey(vref.Stamp)) then //printfn "recording %s..." vref.DisplayName diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index b05cba7ec5f..41fb4d50281 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -689,8 +689,9 @@ type MethInfo = /// Get the method name in DebuggerDisplayForm member x.DebuggerDisplayName = match x with - | ILMeth(_, y, _) -> "ILMeth: " + y.ILName - | FSMeth(_, _, vref, _) -> "FSMeth: " + vref.LogicalName + | ILMeth(_, y, _) -> y.DeclaringTyconRef.DisplayNameWithStaticParametersAndUnderscoreTypars + "::" + y.ILName + | FSMeth(_, AbbrevOrAppTy tcref, vref, _) -> tcref.DisplayNameWithStaticParametersAndUnderscoreTypars + "::" + vref.LogicalName + | FSMeth(_, _, vref, _) -> "??::" + vref.LogicalName #if !NO_TYPEPROVIDERS | ProvidedMeth(_, mi, _, m) -> "ProvidedMeth: " + mi.PUntaint((fun mi -> mi.Name), m) #endif @@ -727,7 +728,7 @@ type MethInfo = #endif | _ -> false - override x.ToString() = x.ApparentEnclosingType.ToString() + x.LogicalName + override x.ToString() = x.ApparentEnclosingType.ToString() + "::" + x.LogicalName /// Get the actual type instantiation of the declaring type associated with this use of the method. /// diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 74e6ccc615a..6b08f19aa04 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -5382,10 +5382,10 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp // If witnesses are available, we should now always find trait witnesses in scope assert not generateWitnesses - let minfoOpt = + let exprOpt = CommitOperationResult(ConstraintSolver.CodegenWitnessExprForTraitConstraint cenv.tcVal g cenv.amap m traitInfo argExprs) - match minfoOpt with + match exprOpt with | None -> let exnArg = mkString g m (FSComp.SR.ilDynamicInvocationNotSupported (traitInfo.MemberLogicalName)) @@ -7092,26 +7092,52 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod (slotsig, _attribs CG.EmitInstr cgbuf (pop 2) (Push [ ilCtxtDelTy ]) (I_newobj(ilDelegeeCtorMethOuter, None)) GenSequel cenv eenvouter.cloc cgbuf sequel -/// Generate statically-resolved conditionals used for type-directed optimizations. -and GenStaticOptimization cenv cgbuf eenv (constraints, e2, e3, _m) sequel = - // Note: during IlxGen, even if answer is StaticOptimizationAnswer.Unknown we discard the static optimization - // This means 'when ^T : ^T' is discarded if not resolved. - // - // This doesn't apply when witnesses are available. In that case, "when ^T : ^T" is resolved as 'Yes', - // this is because all the uses of "when ^T : ^T" in FSharp.Core (e.g. for are for deciding between the - // witness-based implementation and the legacy dynamic implementation, e.g. - // - // let inline ( * ) (x: ^T) (y: ^U) : ^V = - // MultiplyDynamic<(^T),(^U),(^V)> x y - // ... - // when ^T : ^T = ((^T or ^U): (static member (*) : ^T * ^U -> ^V) (x,y)) - // - // When witnesses are not available we use the dynamic implementation. +/// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates +and ExprIsTraitCall expr = + match expr with + | Expr.Op(TOp.TraitCall _, _, _, _) -> true + | _ -> false + +/// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates +and ExprIndicatesGenericStaticConstrainedCall g expr = + match expr with + | Expr.Val(vref, PossibleConstrainedCall ty, _) -> vref.IsMember && not vref.MemberInfo.Value.MemberFlags.IsInstance && isTyparTy g ty + | Expr.Op(TOp.ILCall (valUseFlag=PossibleConstrainedCall ty; ilMethRef=ilMethRef), _, _, _) -> not ilMethRef.CallingConv.IsInstance && isTyparTy g ty + | _ -> false + +/// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates +and ExprRequiresWitness cenv m expr = + let g = cenv.g + match expr with + | Expr.Op(TOp.TraitCall(traitInfo), _, _, _) -> + ConstraintSolver.CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs cenv.tcVal g cenv.amap m traitInfo + |> CommitOperationResult + | _ -> false +/// Generate statically-resolved conditionals used for type-directed optimizations in FSharp.Core only. +and GenStaticOptimization cenv cgbuf eenv (staticConditions, e2, e3, m) sequel = + let g = cenv.g let e = + // See 'decideStaticOptimizationConstraint' + // + // For ^T : ^T we can additionally decide the conditional positively if either + // 1. we're in code generating witnesses + // 2. e2 uses a trait call of some kind + // 2. e2 doesn't require a witness let generateWitnesses = ComputeGenerateWitnesses cenv.g eenv - if DecideStaticOptimizations cenv.g constraints generateWitnesses = StaticOptimizationAnswer.Yes then + let canDecideTyparEqn = + let usesTraitOrConstrainedCall = (false, e2) ||> FoldExpr { ExprFolder0 with exprIntercept = (fun _exprF noInterceptF z expr -> z || ExprIsTraitCall expr || ExprIndicatesGenericStaticConstrainedCall g expr || noInterceptF false expr) } + if usesTraitOrConstrainedCall then + if generateWitnesses then + true + else + let requiresWitness = (false, e2) ||> FoldExpr { ExprFolder0 with exprIntercept = (fun _exprF noInterceptF z expr -> z || ExprRequiresWitness cenv m expr || noInterceptF false expr) } + not requiresWitness + else + false + + if DecideStaticOptimizations cenv.g staticConditions canDecideTyparEqn = StaticOptimizationAnswer.Yes then e2 else e3 diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 162b0f93c49..d8320201f33 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -2385,15 +2385,19 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr = | Expr.LetRec (binds, bodyExpr, m, _) -> OptimizeLetRec cenv env (binds, bodyExpr, m) - | Expr.StaticOptimization (constraints, expr2, expr3, m) -> - let expr2R, e2info = OptimizeExpr cenv env expr2 - let expr3R, e3info = OptimizeExpr cenv env expr3 - Expr.StaticOptimization (constraints, expr2R, expr3R, m), - { TotalSize = min e2info.TotalSize e3info.TotalSize - FunctionSize = min e2info.FunctionSize e3info.FunctionSize - HasEffect = e2info.HasEffect || e3info.HasEffect - MightMakeCriticalTailcall=e2info.MightMakeCriticalTailcall || e3info.MightMakeCriticalTailcall // seems conservative - Info= UnknownValue } + | Expr.StaticOptimization (staticConditions, expr2, expr3, m) -> + let d = DecideStaticOptimizations g staticConditions false + if d = StaticOptimizationAnswer.Yes then OptimizeExpr cenv env expr2 + elif d = StaticOptimizationAnswer.No then OptimizeExpr cenv env expr3 + else + let expr2R, e2info = OptimizeExpr cenv env expr2 + let expr3R, e3info = OptimizeExpr cenv env expr3 + Expr.StaticOptimization (staticConditions, expr2R, expr3R, m), + { TotalSize = min e2info.TotalSize e3info.TotalSize + FunctionSize = min e2info.FunctionSize e3info.FunctionSize + HasEffect = e2info.HasEffect || e3info.HasEffect + MightMakeCriticalTailcall=e2info.MightMakeCriticalTailcall || e3info.MightMakeCriticalTailcall // seems conservative + Info= UnknownValue } | Expr.Link _eref -> assert ("unexpected reclink" = "") diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index f88b31f14f3..949998e8a64 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -153,7 +153,7 @@ module DeclarationListHelpers = let denv = SimplerDisplayEnv denv let xml = GetXmlCommentForItem infoReader m item.Item match item.Item with - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) -> + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) -> // operator with solution FormatItemDescriptionToToolTipElement displayFullName infoReader ad m denv { item with Item = Item.Value vref } diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index d26e4e3e5ad..ee3fd7b6d7d 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -111,7 +111,7 @@ module internal SymbolHelpers = | Item.SetterArg (_, item) -> rangeOfItem g preferFlag item | Item.ArgName (id, _, _) -> Some id.idRange | Item.CustomOperation (_, _, implOpt) -> implOpt |> Option.bind (rangeOfMethInfo g preferFlag) - | Item.ImplicitOp (_, {contents = Some(TraitConstraintSln.FSMethSln(_, vref, _))}) -> Some vref.Range + | Item.ImplicitOp (_, {contents = Some(TraitConstraintSln.FSMethSln(vref=vref))}) -> Some vref.Range | Item.ImplicitOp _ -> None | Item.UnqualifiedType tcrefs -> tcrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) | Item.DelegateCtor ty @@ -566,7 +566,7 @@ module internal SymbolHelpers = let rec FullNameOfItem g item = let denv = DisplayEnv.Empty g match item with - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) | Item.Value vref | Item.CustomBuilder (_, vref) -> fullDisplayTextOfValRef vref | Item.UnionCase (ucinfo, _) -> fullDisplayTextOfUnionCaseRef ucinfo.UnionCaseRef | Item.ActivePatternResult(apinfo, _ty, idx, _) -> apinfo.Names[idx] @@ -612,7 +612,7 @@ module internal SymbolHelpers = match item with | Item.ImplicitOp(_, sln) -> match sln.Value with - | Some(TraitConstraintSln.FSMethSln(_, vref, _)) -> + | Some(TraitConstraintSln.FSMethSln(vref=vref)) -> GetXmlCommentForItem infoReader m (Item.Value vref) | Some (TraitConstraintSln.ILMethSln _) | Some (TraitConstraintSln.FSRecdFieldSln _) diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index 02b76eec32f..e3ddd9774a0 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -322,7 +322,7 @@ type FSharpSymbol(cenv: SymbolEnv, item: unit -> Item, access: FSharpSymbol -> C | Item.ArgName(id, ty, argOwner) -> FSharpParameter(cenv, id, ty, argOwner) :> _ - | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) -> + | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(vref=vref)) }) -> FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ // TODO: the following don't currently return any interesting subtype diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 828dec9ef78..935d9e52f9b 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2398,7 +2398,8 @@ type TraitConstraintSln = /// ty -- the type and its instantiation /// vref -- the method that solves the trait constraint /// minst -- the generic method instantiation - | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst + /// staticTyOpt -- the static type governing a static virtual call, if any + | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst * staticTyOpt: TType option /// FSRecdFieldSln(tinst, rfref, isSetProp) /// @@ -2418,7 +2419,8 @@ type TraitConstraintSln = /// extOpt -- information about an extension member, if any /// ilMethodRef -- the method that solves the trait constraint /// minst -- the generic method instantiation - | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst + /// staticTyOpt -- the static type governing a static virtual call, if any + | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst * staticTyOpt: TType option /// ClosedExprSln expr /// diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 9b163e4ffc8..1db42bf70e3 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1701,8 +1701,9 @@ type TraitConstraintSln = /// Indicates a trait is solved by an F# method. /// ty -- the type type its instantiation /// vref -- the method that solves the trait constraint + /// staticTyOpt -- the static type governing a static virtual call, if any /// minst -- the generic method instantiation - | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst + | FSMethSln of ty: TType * vref: ValRef * minst: TypeInst * staticTyOpt: TType option /// FSRecdFieldSln(tinst, rfref, isSetProp) /// @@ -1722,7 +1723,8 @@ type TraitConstraintSln = /// extOpt -- information about an extension member, if any /// ilMethodRef -- the method that solves the trait constraint /// minst -- the generic method instantiation - | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst + /// staticTyOpt -- the static type governing a static virtual call, if any + | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst * staticTyOpt: TType option /// ClosedExprSln expr /// diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index b0020664ff7..eca6f57332a 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -243,6 +243,12 @@ let stripTyparEqns ty = stripTyparEqnsAux false ty let stripUnitEqns unt = stripUnitEqnsAux false unt +/// Detect a use of a nominal type, including type abbreviations. +let (|AbbrevOrAppTy|_|) (ty: TType) = + match stripTyparEqns ty with + | TType_app (tcref, _, _) -> Some tcref + | _ -> None + //--------------------------------------------------------------------------- // These make local/non-local references to values according to whether // the item is globally stable ("published") or not. diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fsi b/src/Compiler/TypedTree/TypedTreeBasics.fsi index 246a9e74baa..13eacdfe2dd 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fsi +++ b/src/Compiler/TypedTree/TypedTreeBasics.fsi @@ -132,6 +132,9 @@ val stripTyparEqns: ty: TType -> TType val stripUnitEqns: unt: Measure -> Measure +/// Detect a use of a nominal type, including type abbreviations. +val (|AbbrevOrAppTy|_|): ty: TType -> TyconRef option + val mkLocalValRef: v: Val -> ValRef val mkLocalModuleRef: v: ModuleOrNamespace -> EntityRef diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 2465771e9a2..8ce9c45c33d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -284,10 +284,10 @@ and remapTraitInfo tyenv (TTrait(tys, nm, flags, argTys, retTy, slnCell)) = | Some sln -> let sln = match sln with - | ILMethSln(ty, extOpt, ilMethRef, minst) -> - ILMethSln(remapTypeAux tyenv ty, extOpt, ilMethRef, remapTypesAux tyenv minst) - | FSMethSln(ty, vref, minst) -> - FSMethSln(remapTypeAux tyenv ty, remapValRef tyenv vref, remapTypesAux tyenv minst) + | ILMethSln(ty, extOpt, ilMethRef, minst, staticTyOpt) -> + ILMethSln(remapTypeAux tyenv ty, extOpt, ilMethRef, remapTypesAux tyenv minst, Option.map (remapTypeAux tyenv) staticTyOpt) + | FSMethSln(ty, vref, minst, staticTyOpt) -> + FSMethSln(remapTypeAux tyenv ty, remapValRef tyenv vref, remapTypesAux tyenv minst, Option.map (remapTypeAux tyenv) staticTyOpt) | FSRecdFieldSln(tinst, rfref, isSet) -> FSRecdFieldSln(remapTypesAux tyenv tinst, remapRecdFieldRef tyenv.tyconRefRemap rfref, isSet) | FSAnonRecdFieldSln(anonInfo, tinst, n) -> @@ -2261,13 +2261,15 @@ and accFreeInWitnessArg opts (TraitWitnessInfo(tys, _nm, _mf, argTys, retTy)) ac and accFreeInTraitSln opts sln acc = match sln with - | ILMethSln(ty, _, _, minst) -> - accFreeInType opts ty - (accFreeInTypes opts minst acc) - | FSMethSln(ty, vref, minst) -> - accFreeInType opts ty + | ILMethSln(ty, _, _, minst, staticTyOpt) -> + Option.foldBack (accFreeInType opts) staticTyOpt + (accFreeInType opts ty + (accFreeInTypes opts minst acc)) + | FSMethSln(ty, vref, minst, staticTyOpt) -> + Option.foldBack (accFreeInType opts) staticTyOpt + (accFreeInType opts ty (accFreeValRefInTraitSln opts vref - (accFreeInTypes opts minst acc)) + (accFreeInTypes opts minst acc))) | FSAnonRecdFieldSln(_anonInfo, tinst, _n) -> accFreeInTypes opts tinst acc | FSRecdFieldSln(tinst, _rfref, _isSet) -> @@ -5520,11 +5522,23 @@ type StaticOptimizationAnswer = | No = -1y | Unknown = 0y -let decideStaticOptimizationConstraint g c haveWitnesses = +// Most static optimization conditionals in FSharp.Core are +// ^T : tycon +// +// These decide positively if ^T is nominal and identical to tycon. +// These decide negatively if ^T is nominal and different to tycon. +// +// The "special" static optimization conditionals +// ^T : ^T +// 'T : 'T +// are used as hacks in FSharp.Core as follows: +// ^T : ^T --> used in (+), (-) etc. to guard witness-invoking implementations added in F# 5 +// 'T : 'T --> used in FastGenericEqualityComparer, FastGenericComparer to guard struct/tuple implementations +// +// canDecideTyparEqn is set to true in IlxGen when the witness-invoking implementation can be used. +let decideStaticOptimizationConstraint g c canDecideTyparEqn = match c with - // When witnesses are available in generic code during codegen, "when ^T : ^T" resolves StaticOptimizationAnswer.Yes - // This doesn't apply to "when 'T : 'T" use for "FastGenericEqualityComparer" and others. - | TTyconEqualsTycon (a, b) when haveWitnesses && typeEquiv g a b && (match tryDestTyparTy g a with ValueSome tp -> tp.StaticReq = TyparStaticReq.HeadType | _ -> false) -> + | TTyconEqualsTycon (a, b) when canDecideTyparEqn && typeEquiv g a b && isTyparTy g a -> StaticOptimizationAnswer.Yes | TTyconEqualsTycon (a, b) -> // Both types must be nominal for a definite result @@ -5561,13 +5575,13 @@ let decideStaticOptimizationConstraint g c haveWitnesses = | ValueSome tcref1 -> if tcref1.IsStructOrEnumTycon then StaticOptimizationAnswer.Yes else StaticOptimizationAnswer.No | ValueNone -> StaticOptimizationAnswer.Unknown -let rec DecideStaticOptimizations g cs haveWitnesses = +let rec DecideStaticOptimizations g cs canDecideTyparEqn = match cs with | [] -> StaticOptimizationAnswer.Yes | h :: t -> - let d = decideStaticOptimizationConstraint g h haveWitnesses + let d = decideStaticOptimizationConstraint g h canDecideTyparEqn if d = StaticOptimizationAnswer.No then StaticOptimizationAnswer.No - elif d = StaticOptimizationAnswer.Yes then DecideStaticOptimizations g t haveWitnesses + elif d = StaticOptimizationAnswer.Yes then DecideStaticOptimizations g t canDecideTyparEqn else StaticOptimizationAnswer.Unknown let mkStaticOptimizationExpr g (cs, e1, e2, m) = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 47d1843487a..b471cb3a617 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1480,11 +1480,11 @@ module DebugPrint = /// A set of function parameters (visitor) for folding over expressions type ExprFolder<'State> = - { exprIntercept: ('State -> Expr -> 'State) (* noInterceptF *) + { exprIntercept: ('State -> Expr -> 'State) -> ('State -> Expr -> 'State) -> 'State -> Expr - -> 'State (* recurseF *) + -> 'State valBindingSiteIntercept: 'State -> bool * Val -> 'State nonRecBindingsIntercept: 'State -> Binding -> 'State recBindingsIntercept: 'State -> Bindings -> 'State @@ -1496,10 +1496,10 @@ type ExprFolder<'State> = val ExprFolder0: ExprFolder<'State> /// Fold over all the expressions in an implementation file -val FoldImplFile: ExprFolder<'State> -> ('State -> CheckedImplFile -> 'State) +val FoldImplFile: ExprFolder<'State> -> 'State -> CheckedImplFile -> 'State /// Fold over all the expressions in an expression -val FoldExpr: ExprFolder<'State> -> ('State -> Expr -> 'State) +val FoldExpr: ExprFolder<'State> -> 'State -> Expr -> 'State #if DEBUG /// Extract some statistics from an expression @@ -2379,7 +2379,7 @@ type StaticOptimizationAnswer = | No = -1y | Unknown = 0y -val DecideStaticOptimizations: TcGlobals -> StaticOptimization list -> haveWitnesses: bool -> StaticOptimizationAnswer +val DecideStaticOptimizations: TcGlobals -> StaticOptimization list -> canDecideTyparEqn: bool -> StaticOptimizationAnswer val mkStaticOptimizationExpr: TcGlobals -> StaticOptimization list * Expr * Expr * range -> Expr diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index eda40c33fb5..f25d1660731 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -1513,9 +1513,9 @@ let p_anonInfo x st = let p_trait_sln sln st = match sln with - | ILMethSln(a, b, c, d) -> + | ILMethSln(a, b, c, d, None) -> p_byte 0 st; p_tup4 p_ty (p_option p_ILTypeRef) p_ILMethodRef p_tys (a, b, c, d) st - | FSMethSln(a, b, c) -> + | FSMethSln(a, b, c, None) -> p_byte 1 st; p_tup3 p_ty (p_vref "trait") p_tys (a, b, c) st | BuiltInSln -> p_byte 2 st @@ -1525,6 +1525,10 @@ let p_trait_sln sln st = p_byte 4 st; p_tup3 p_tys p_rfref p_bool (a, b, c) st | FSAnonRecdFieldSln(a, b, c) -> p_byte 5 st; p_tup3 p_anonInfo p_tys p_int (a, b, c) st + | ILMethSln(a, b, c, d, Some e) -> + p_byte 6 st; p_tup5 p_ty (p_option p_ILTypeRef) p_ILMethodRef p_tys p_ty (a, b, c, d, e) st + | FSMethSln(a, b, c, Some d) -> + p_byte 7 st; p_tup4 p_ty (p_vref "trait") p_tys p_ty (a, b, c, d) st let p_trait (TTrait(a, b, c, d, e, f)) st = @@ -1543,10 +1547,10 @@ let u_trait_sln st = match tag with | 0 -> let a, b, c, d = u_tup4 u_ty (u_option u_ILTypeRef) u_ILMethodRef u_tys st - ILMethSln(a, b, c, d) + ILMethSln(a, b, c, d, None) | 1 -> let a, b, c = u_tup3 u_ty u_vref u_tys st - FSMethSln(a, b, c) + FSMethSln(a, b, c, None) | 2 -> BuiltInSln | 3 -> @@ -1557,6 +1561,12 @@ let u_trait_sln st = | 5 -> let a, b, c = u_tup3 u_anonInfo u_tys u_int st FSAnonRecdFieldSln(a, b, c) + | 6 -> + let a, b, c, d, e = u_tup5 u_ty (u_option u_ILTypeRef) u_ILMethodRef u_tys u_ty st + ILMethSln(a, b, c, d, Some e) + | 7 -> + let a, b, c, d = u_tup4 u_ty u_vref u_tys u_ty st + FSMethSln(a, b, c, Some d) | _ -> ufailwith st "u_trait_sln" let u_trait st = diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 85d2a3e5de6..6f4a00a8e3c 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -25,6 +25,9 @@ type IUnitMethod<'T when 'T :> IUnitMethod<'T>> = type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = static abstract op_Addition: 'T * 'T -> 'T +type ISinOperator<'T when 'T :> ISinOperator<'T>> = + static abstract Sin: 'T -> 'T + type C(c: int) = member _.Value = c interface IAdditionOperator with @@ -257,8 +260,37 @@ module Negative = #endif -//let f7<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = -// x + y +module ``Use SRTP operators from generic IWSAM code`` = + let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + x + y + + let fSin<'T when ISinOperator<'T>>(x: 'T) = + sin x + +module ``Use SRTP operators from generic IWSAM code not rigid`` = + let fAdd(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = + x + y + + let fSin(x: 'T when ISinOperator<'T>) = + sin x + +module ``Use SRTP operators from generic IWSAM code flex`` = + let fAdd(x: #IAdditionOperator<'T>, y) = + x + y + + let fSin(x: #ISinOperator<'T>) = + sin x + +module ``Use SRTP operators from generic IWSAM code super flex`` = + let fAdd(x: #IAdditionOperator<_>, y) = + x + y + + let fSin(x: #ISinOperator<_>) = + sin x + + //let fSin<'T when ISinOperator<'T>>(x: 'T) = + // sin x + (* let inline f_SRTP_GoToDefinition_FindAllReferences (x: 'T) = From ce57d100db1e1c12199f09e55aaae380f26090f6 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 4 Jul 2022 23:43:49 +0100 Subject: [PATCH 37/91] fix to signature compat --- src/Compiler/Checking/SignatureConformance.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index f9d9b41b871..989df031b9a 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -122,7 +122,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let aenv = aenv.BindEquivTypars implTypars sigTypars (implTypars, sigTypars) ||> List.forall2 (fun implTypar sigTypar -> let m = sigTypar.Range - if implTypar.StaticReq <> sigTypar.StaticReq then + if implTypar.StaticReq = TyparStaticReq.HeadType && sigTypar.StaticReq = TyparStaticReq.None then errorR (Error(FSComp.SR.typrelSigImplNotCompatibleCompileTimeRequirementsDiffer(), m)) // Adjust the actual type parameter name to look like the signature From fb8b75c7561c7a0b4e82e9f3c5053073305ac757 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 4 Jul 2022 23:57:31 +0100 Subject: [PATCH 38/91] format code --- src/Compiler/Checking/MethodCalls.fsi | 11 +++++-- src/Compiler/CodeGen/IlxGen.fs | 44 +++++++++++++++++++------ src/Compiler/TypedTree/TypedTree.fsi | 7 +++- src/Compiler/TypedTree/TypedTreeOps.fsi | 9 ++--- 4 files changed, 52 insertions(+), 19 deletions(-) diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index 18a43c7e424..ad5bb10ebaa 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -205,7 +205,7 @@ type CalledMeth<'T> = callerArgs: CallerArgs<'T> * allowParamArgs: bool * allowOutAndOptArgs: bool * - tyargsOpt: TType option * + tyargsOpt: TType option * staticTyOpt: TType option -> CalledMeth<'T> @@ -341,7 +341,14 @@ val BuildILMethInfoCall: /// Make a call to a method info. Used by the optimizer and code generator to build /// calls to the type-directed solutions to member constraints. -val MakeMethInfoCall: amap: ImportMap -> m: range -> minfo: MethInfo -> minst: TType list -> args: Exprs -> staticTyOpt: TType option -> Expr +val MakeMethInfoCall: + amap: ImportMap -> + m: range -> + minfo: MethInfo -> + minst: TType list -> + args: Exprs -> + staticTyOpt: TType option -> + Expr /// Build an expression that calls a given method info. /// This is called after overload resolution, and also to call other diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 6b08f19aa04..15e500353a7 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -7094,22 +7094,27 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod (slotsig, _attribs /// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates and ExprIsTraitCall expr = - match expr with - | Expr.Op(TOp.TraitCall _, _, _, _) -> true + match expr with + | Expr.Op (TOp.TraitCall _, _, _, _) -> true | _ -> false /// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates and ExprIndicatesGenericStaticConstrainedCall g expr = - match expr with - | Expr.Val(vref, PossibleConstrainedCall ty, _) -> vref.IsMember && not vref.MemberInfo.Value.MemberFlags.IsInstance && isTyparTy g ty - | Expr.Op(TOp.ILCall (valUseFlag=PossibleConstrainedCall ty; ilMethRef=ilMethRef), _, _, _) -> not ilMethRef.CallingConv.IsInstance && isTyparTy g ty + match expr with + | Expr.Val (vref, PossibleConstrainedCall ty, _) -> + vref.IsMember + && not vref.MemberInfo.Value.MemberFlags.IsInstance + && isTyparTy g ty + | Expr.Op (TOp.ILCall (valUseFlag = PossibleConstrainedCall ty; ilMethRef = ilMethRef), _, _, _) -> + not ilMethRef.CallingConv.IsInstance && isTyparTy g ty | _ -> false /// Used to search FSharp.Core implementations of "^T : ^T" and decide whether the conditional activates and ExprRequiresWitness cenv m expr = let g = cenv.g - match expr with - | Expr.Op(TOp.TraitCall(traitInfo), _, _, _) -> + + match expr with + | Expr.Op (TOp.TraitCall (traitInfo), _, _, _) -> ConstraintSolver.CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs cenv.tcVal g cenv.amap m traitInfo |> CommitOperationResult | _ -> false @@ -7117,22 +7122,41 @@ and ExprRequiresWitness cenv m expr = /// Generate statically-resolved conditionals used for type-directed optimizations in FSharp.Core only. and GenStaticOptimization cenv cgbuf eenv (staticConditions, e2, e3, m) sequel = let g = cenv.g + let e = // See 'decideStaticOptimizationConstraint' // - // For ^T : ^T we can additionally decide the conditional positively if either + // For ^T : ^T we can additionally decide the conditional positively if either // 1. we're in code generating witnesses // 2. e2 uses a trait call of some kind // 2. e2 doesn't require a witness let generateWitnesses = ComputeGenerateWitnesses cenv.g eenv let canDecideTyparEqn = - let usesTraitOrConstrainedCall = (false, e2) ||> FoldExpr { ExprFolder0 with exprIntercept = (fun _exprF noInterceptF z expr -> z || ExprIsTraitCall expr || ExprIndicatesGenericStaticConstrainedCall g expr || noInterceptF false expr) } + let usesTraitOrConstrainedCall = + (false, e2) + ||> FoldExpr + { ExprFolder0 with + exprIntercept = + (fun _exprF noInterceptF z expr -> + z + || ExprIsTraitCall expr + || ExprIndicatesGenericStaticConstrainedCall g expr + || noInterceptF false expr) + } + if usesTraitOrConstrainedCall then if generateWitnesses then true else - let requiresWitness = (false, e2) ||> FoldExpr { ExprFolder0 with exprIntercept = (fun _exprF noInterceptF z expr -> z || ExprRequiresWitness cenv m expr || noInterceptF false expr) } + let requiresWitness = + (false, e2) + ||> FoldExpr + { ExprFolder0 with + exprIntercept = + (fun _exprF noInterceptF z expr -> z || ExprRequiresWitness cenv m expr || noInterceptF false expr) + } + not requiresWitness else false diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 1db42bf70e3..eb55b3fe5a6 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1724,7 +1724,12 @@ type TraitConstraintSln = /// ilMethodRef -- the method that solves the trait constraint /// minst -- the generic method instantiation /// staticTyOpt -- the static type governing a static virtual call, if any - | ILMethSln of ty: TType * extOpt: ILTypeRef option * ilMethodRef: ILMethodRef * minst: TypeInst * staticTyOpt: TType option + | ILMethSln of + ty: TType * + extOpt: ILTypeRef option * + ilMethodRef: ILMethodRef * + minst: TypeInst * + staticTyOpt: TType option /// ClosedExprSln expr /// diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index b471cb3a617..194b520d4bc 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1480,11 +1480,7 @@ module DebugPrint = /// A set of function parameters (visitor) for folding over expressions type ExprFolder<'State> = - { exprIntercept: ('State -> Expr -> 'State) - -> ('State -> Expr -> 'State) - -> 'State - -> Expr - -> 'State + { exprIntercept: ('State -> Expr -> 'State) -> ('State -> Expr -> 'State) -> 'State -> Expr -> 'State valBindingSiteIntercept: 'State -> bool * Val -> 'State nonRecBindingsIntercept: 'State -> Binding -> 'State recBindingsIntercept: 'State -> Bindings -> 'State @@ -2379,7 +2375,8 @@ type StaticOptimizationAnswer = | No = -1y | Unknown = 0y -val DecideStaticOptimizations: TcGlobals -> StaticOptimization list -> canDecideTyparEqn: bool -> StaticOptimizationAnswer +val DecideStaticOptimizations: + TcGlobals -> StaticOptimization list -> canDecideTyparEqn: bool -> StaticOptimizationAnswer val mkStaticOptimizationExpr: TcGlobals -> StaticOptimization list * Expr * Expr * range -> Expr From b33b80b322b0d06a6378300ceaf9ff1413e02b4b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 5 Jul 2022 16:06:08 +0100 Subject: [PATCH 39/91] fix task tests --- src/Compiler/Checking/MethodCalls.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 950b3224335..e0c98ecc42d 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -886,6 +886,7 @@ let ComputeConstrainedCallInfo g amap m staticTyOpt args (minfo: MethInfo) = | (objArgExpr :: _), _ when minfo.IsInstance && not minfo.IsExtensionMember -> let methObjTy = minfo.ApparentEnclosingType let objArgTy = tyOfExpr g objArgExpr + let objArgTy = if isByrefTy g objArgTy then destByrefTy g objArgTy else objArgTy if TypeDefinitelySubsumesTypeNoCoercion 0 g amap m methObjTy objArgTy // Constrained calls to class types can only ever be needed for the three class types that // are base types of value types From 243c207f24b4d76a90aecd054a2514a2f22f363f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 5 Jul 2022 22:48:41 +0100 Subject: [PATCH 40/91] fix test --- src/Compiler/Checking/InfoReader.fs | 9 +++++++-- src/Compiler/Checking/TypeHierarchy.fs | 27 +++++++++++++++++++++----- src/Compiler/TypedTree/TcGlobals.fs | 12 ++++++++++++ 3 files changed, 41 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index f6f3d45ef77..b02f057871b 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -701,7 +701,12 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = let IsInterfaceWithStaticAbstractMemberTyUncached ((ad, nm), m, ty) = ExistsInEntireHierarchyOfType (fun parentTy -> - this.TryFindIntrinsicMethInfo m ad nm parentTy |> List.isEmpty |> not) + let meths = this.TryFindIntrinsicMethInfo m ad nm parentTy + meths |> List.exists (fun meth -> + not meth.IsInstance && + meth.IsDispatchSlot && + isInterfaceTy g meth.ApparentEnclosingAppType + )) g amap m AllowMultiIntfInstantiations.Yes ty let hashFlags0 = @@ -901,7 +906,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = | None -> None /// Try to detect the existence of a method on a type. - member infoReader.TryFindIntrinsicMethInfo m ad nm ty = + member infoReader.TryFindIntrinsicMethInfo m ad nm ty : MethInfo list = infoReader.GetIntrinsicMethInfosOfType (Some nm) ad AllowMultiIntfInstantiations.Yes IgnoreOverrides m ty /// Try to find a particular named property on a type. Only used to ensure that local 'let' definitions and property names diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index 852ad054cea..9791a2a98cc 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -151,21 +151,26 @@ let rec GetImmediateInterfacesOfType skipUnref g amap m ty = // This measure-annotated type is considered to support the interfaces on its representation type A, // with the exception that // -// 1. we rewrite the IComparable and IEquatable interfaces, so that +// 1. Rewrite the IComparable and IEquatable interfaces, so that // IComparable --> IComparable> // IEquatable --> IEquatable> // -// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces +// 2. Omit any other interfaces that derive from IComparable and IEquatable interfaces // // This rule is conservative and only applies to IComparable and IEquatable interfaces. // -// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. +// We also: +// 3. Omit any interfaces in System.Numerics, since pretty much none of them are adequate for units of measure +// There are some exceptions, e.g. IAdditiveIdentity, but these are available3 by different routes in F# and for clarity +// it is better to imply omit all and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = [ - // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> + // Suppress any interfaces that derive from IComparable<_> or IEquatable<_> + // Suppress any interfaces in System.Numerics, since none of them are adequate for units of measure for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m ity) && - not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) then + not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) && + not (ExistsSystemNumericsTypeInInterfaceHierarchy skipUnref g amap m ity) then ity // NOTE: we should really only report the IComparable> interface for measure-annotated types @@ -180,6 +185,18 @@ and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = mkAppTy g.system_GenericIEquatable_tcref [ty] ] +// Check for any System.Numerics type in the interface hierarchy +and ExistsSystemNumericsTypeInInterfaceHierarchy skipUnref g amap m ity = + ExistsInInterfaceHierarchy + (fun ity2 -> + match ity2 with + | AppTy g (tcref,_) -> + match tcref.CompilationPath.AccessPath with + | [("System", _); ("Numerics", _)] -> true + | _ -> false + | _ -> false) + skipUnref g amap m ity + // Check for IComparable, IEquatable and interfaces that derive from these and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m ity = ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m ity diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 6033b98e2f5..675fb3c50fe 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -179,6 +179,18 @@ let tname_AsyncCallback = "System.AsyncCallback" let tname_IAsyncResult = "System.IAsyncResult" [] let tname_IsByRefLikeAttribute = "System.Runtime.CompilerServices.IsByRefLikeAttribute" +//[] +//let tname_IAdditionOperators = "System.Numerics.IAdditionOperators`3" +//[] +//let tname_INumberBase = "System.Numerics.INumberBase`1" +//[] +//let tname_IExponentialFunctions = "System.Numerics.IExponentialFunctions`1" +//[] +//let tname_IBinaryFloatingPointIeee754 = "System.Numerics.IBinaryFloatingPointIeee754`1" +//[] +//let tname_IBinaryInteger = "System.Numerics.IBinaryInteger`1" +//[] +//let tname_IBinaryInteger = "System.Numerics.IBinaryInteger`1" //------------------------------------------------------------------------- // Table of all these "globals" From 09f7f17014ffc71790cd411cc5f238b3e4e1aea3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 Jul 2022 12:26:28 +0100 Subject: [PATCH 41/91] fix up tests --- src/Compiler/Checking/MethodOverrides.fs | 6 +++--- .../overloads/neg_generic_known_argument_types.bsl | 2 +- .../neg_known_return_type_and_known_type_arguments.bsl | 10 +++++----- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index e54af657a39..779f403b3c8 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -923,9 +923,9 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv /// at the member signature prior to type inference. This is used to pre-assign type information if it does let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = - //if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then - // checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm - // checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm + if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then + checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm + checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm let minfos = match typToSearchForAbstractMembers with diff --git a/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl b/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl index 7993b054461..fcd4fb9de75 100644 --- a/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl +++ b/tests/fsharp/typecheck/overloads/neg_generic_known_argument_types.bsl @@ -1,7 +1,7 @@ neg_generic_known_argument_types.fsx(9,16,9,49): typecheck error FS0041: A unique overload for method 'Foo' could not be determined based on type information prior to this program point. A type annotation may be needed. -Known types of arguments: ^fa * 'fb * 'a * argD: 'c when ^fa: (member X: ^fa * ^b -> ^b) and ^b: (member BBBB: ^b -> unit) +Known types of arguments: ^fa * 'fb * 'a * argD: 'c when ^fa: (member X: ^b -> ^b) and ^b: (member BBBB: unit -> unit) Candidates: - static member A.Foo: argA1: 'a * argB1: ('a -> 'b) * argC1: ('a -> 'b) * argD: ('a -> 'b) * argZ1: 'zzz -> 'b diff --git a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl index cb7a1e3dad6..698171eac59 100644 --- a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl +++ b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl @@ -6,11 +6,6 @@ Known return type: MonoidSample Known type parameters: < MonoidSample , Zero > Available overloads: - - static member Zero.Zero: ^t * Default1 -> ^t when ^t: (static member get_Zero: -> ^t) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default1 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ^t when (FromInt32 or ^t) : (static member FromInt32: ^t * FromInt32 -> (int32 -> ^t)) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default3 -> ^t when ^t: (static member get_Empty: -> ^t) // Argument at index 1 doesn't match - static member Zero.Zero: 'a array * Zero -> 'a array // Argument at index 1 doesn't match - static member Zero.Zero: 'a list * Zero -> 'a list // Argument at index 1 doesn't match - static member Zero.Zero: 'a option * Zero -> 'a option // Argument at index 1 doesn't match @@ -21,6 +16,11 @@ Available overloads: - static member Zero.Zero: ResizeArray<'a> * Zero -> ResizeArray<'a> // Argument at index 1 doesn't match - static member Zero.Zero: Set<'a> * Zero -> Set<'a> when 'a: comparison // Argument at index 1 doesn't match - static member Zero.Zero: System.TimeSpan * Zero -> System.TimeSpan // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default1 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default1 -> ^t when ^t: (static member Zero: ^t) // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default2 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default2 -> ^t when (FromInt32 or ^t) : (static member FromInt32: ^t * FromInt32 -> (int32 -> ^t)) // Argument at index 1 doesn't match + - static member Zero.Zero: ^t * Default3 -> ^t when ^t: (static member Empty: ^t) // Argument at index 1 doesn't match - static member Zero.Zero: seq<'a> * Zero -> seq<'a> // Argument at index 1 doesn't match - static member Zero.Zero: string * Zero -> string // Argument at index 1 doesn't match - static member Zero.Zero: unit * Zero -> unit // Argument at index 1 doesn't match From 4200b5e4798928a9133aeff762ab73661da59565 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 Jul 2022 14:22:03 +0100 Subject: [PATCH 42/91] fix test --- .../LegacyLanguageService/Tests.LanguageService.ErrorList.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index a31538cd201..a5ebf535ac8 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -396,7 +396,7 @@ type staticInInterface = end""" CheckErrorList fileContent (function - | [err1] -> + | err1 :: _ -> Assert.IsTrue(err1.Message.Contains("No abstract or interface member was found that corresponds to this override")) | x -> Assert.Fail(sprintf "Unexpected errors: %A" x)) From 13b97fc2aeb895ba1750da8c2982608c9ce5faf3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 Jul 2022 17:08:26 +0100 Subject: [PATCH 43/91] add warnings to match RFC --- src/Compiler/Checking/CheckDeclarations.fs | 31 ++--- src/Compiler/Checking/CheckExpressions.fs | 135 ++++++++++++--------- src/Compiler/Checking/CheckExpressions.fsi | 10 ++ src/Compiler/Checking/CheckPatterns.fs | 8 +- src/Compiler/Checking/ConstraintSolver.fs | 55 ++++++--- src/Compiler/Checking/InfoReader.fs | 6 +- src/Compiler/Checking/InfoReader.fsi | 2 +- src/Compiler/Checking/MethodOverrides.fs | 2 + src/Compiler/FSComp.txt | 4 +- src/Compiler/xlf/FSComp.txt.cs.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.de.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.es.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.fr.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.it.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.ja.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.ko.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.pl.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.ru.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.tr.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 14 ++- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 14 ++- tests/adhoc.fsx | 5 + 23 files changed, 316 insertions(+), 124 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 3ddf1a0daf8..d809a67ab1f 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -411,7 +411,7 @@ module TcRecdUnionAndEnumDeclarations = let attrsForProperty, attrsForField = attrs |> List.partition (fun (attrTargets, _) -> (attrTargets &&& AttributeTargets.Property) <> enum 0) let attrsForProperty = (List.map snd attrsForProperty) let attrsForField = (List.map snd attrsForField) - let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let zeroInit = HasFSharpAttribute g g.attrib_DefaultValueAttribute attrsForField let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute attrsForField @@ -504,7 +504,7 @@ module TcRecdUnionAndEnumDeclarations = rfields, thisTy | SynUnionCaseKind.FullType (ty, arity) -> - let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let curriedArgTys, recordTy = GetTopTauTypeInFSharpForm g (arity |> TranslateSynValInfo m (TcAttributes cenv env) |> TranslatePartialValReprInfo []).ArgInfos tyR m if curriedArgTys.Length > 1 then @@ -658,7 +658,7 @@ let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) = checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration mOpenDecl - let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType + let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open WarnOnIWSAM.Yes env emptyUnscopedTyparEnv synType if not (isAppTy g typ) then error(Error(FSComp.SR.tcNamedTypeRequired("open type"), m)) @@ -1046,7 +1046,7 @@ module MutRecBindingChecking = // Phase2B: typecheck the argument to an 'inherits' call and build the new object expr for the inherit-call | Phase2AInherit (synBaseTy, arg, baseValOpt, m) -> - let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Use envInstance tpenv synBaseTy + let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g let inheritsExpr, tpenv = try @@ -1620,7 +1620,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial bindsm scopem mutRecNSInfo (env let intfTyR = let envinner = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForTycon - TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner emptyUnscopedTyparEnv intfTy |> fst + TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.No envinner emptyUnscopedTyparEnv intfTy |> fst if not (tcref.HasInterface g intfTyR) then error(Error(FSComp.SR.tcAllImplementedInterfacesShouldBeDeclared(), intfTy.Range)) @@ -2348,11 +2348,11 @@ module EstablishTypeDefinitionCores = match args with | SynUnionCaseKind.Fields flds -> for SynField(_, _, _, ty, _, _, _, m) in flds do - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty yield (tyR, m) | SynUnionCaseKind.FullType (ty, arity) -> - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let curriedArgTys, _ = GetTopTauTypeInFSharpForm g (arity |> TranslateSynValInfo m (TcAttributes cenv env) |> TranslatePartialValReprInfo []).ArgInfos tyR m if curriedArgTys.Length > 1 then @@ -2363,9 +2363,10 @@ module EstablishTypeDefinitionCores = yield (argTy, m) | SynTypeDefnSimpleRepr.General (_, _, _, fields, _, _, implicitCtorSynPats, _) when tycon.IsFSharpStructOrEnumTycon -> // for structs - for SynField(_, isStatic, _, ty, _, _, _, m) in fields do + for field in fields do + let (SynField(_, isStatic, _, ty, _, _, _, m)) = field if not isStatic then - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty yield (tyR, m) match implicitCtorSynPats with @@ -2384,7 +2385,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Record (_, fields, _) -> for SynField(_, _, _, ty, _, _, _, m) in fields do - let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty yield (tyR, m) | _ -> @@ -2918,7 +2919,7 @@ module EstablishTypeDefinitionCores = // This case deals with ordinary type and measure abbreviations if not hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type - let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkConstraints ItemOccurence.UseInType envinner tpenv rhsType + let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No envinner tpenv rhsType if not firstPass then let ftyvs = freeInTypeLeftToRight g false ty @@ -2952,7 +2953,7 @@ module EstablishTypeDefinitionCores = let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner let envinner = MakeInnerEnvForTyconRef envinner tcref false - let implementedTys, _ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType envinner)) tpenv explicitImplements + let implementedTys, _ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No envinner)) tpenv explicitImplements if firstPass then tycon.entity_attribs <- attrs @@ -2964,7 +2965,7 @@ module EstablishTypeDefinitionCores = let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) let inherits = inherits |> List.map (fun (ty, m, _) -> (ty, m)) - let inheritedTys = fst (List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType envinner)) tpenv inherits) + let inheritedTys = fst (List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No envinner)) tpenv inherits) let implementedTys, inheritedTys = match kind with | SynTypeDefnKind.Interface -> @@ -3203,7 +3204,7 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() if hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type - let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv rhsType + let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.No envinner tpenv rhsType TMeasureableRepr theTypeAbbrev, None, NoSafeInitInfo // If we already computed a representation, e.g. for a generative type definition, then don't change it here. @@ -3326,7 +3327,7 @@ module EstablishTypeDefinitionCores = noAbstractClassAttributeCheck() noFieldsCheck userFields primaryConstructorInDelegateCheck(implicitCtorSynPats) - let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv ty + let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes envinner tpenv ty let _, _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm g (arity |> TranslateSynValInfo m (TcAttributes cenv envinner) |> TranslatePartialValReprInfo []) 0 tyR m if curriedArgInfos.Length < 1 then error(Error(FSComp.SR.tcInvalidDelegateSpecification(), m)) if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcDelegatesCannotBeCurried(), m)) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 9077ed1a14d..f97b4a250db 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -4034,6 +4034,13 @@ type ImplicitlyBoundTyparsAllowed = | NewTyparsOK | NoNewTypars +/// Indicates whether the position being checked is precisely the r.h.s. of a "'T :> ***" constraint or a similar +/// places where IWSAM types do not generate a warning +[] +type WarnOnIWSAM = + | Yes + | No + /// Represents information about the module or type in which a member or value is declared. type MemberOrValContainerInfo = | MemberOrValContainerInfo of @@ -4165,13 +4172,13 @@ let rec TcTyparConstraint ridx cenv newOk checkConstraints occ (env: TcEnv) tpen match c with | SynTypeConstraint.WhereTyparDefaultsToType(tp, ty, m) -> - let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty + let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty let tpR, tpenv = TcTypar cenv env newOk tpenv tp AddCxTyparDefaultsTo env.DisplayEnv cenv.css m env.eContextInfo tpR ridx tyR tpenv | SynTypeConstraint.WhereTyparSubtypeOfType(tp, ty, m) -> - let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType env tpenv ty + let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No env tpenv ty let tpR, tpenv = TcTypar cenv env newOk tpenv tp if newOk = NoNewTypars && isSealedTy g tyR then errorR(Error(FSComp.SR.tcInvalidConstraintTypeSealed(), m)) @@ -4207,7 +4214,7 @@ let rec TcTyparConstraint ridx cenv newOk checkConstraints occ (env: TcEnv) tpen | SynTypeConstraint.WhereSelfConstrained(ty, m) -> checkLanguageFeatureAndRecover g.langVersion LanguageFeature.SelfTypeConstraints m - let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType env tpenv ty + let tyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No env tpenv ty match tyR with | TType_app(tcref, tinst, _) when (tcref.IsTypeAbbrev && (isTyparTy g tcref.TypeAbbrev.Value) && tinst |> List.forall (isTyparTy g)) -> match checkConstraints with @@ -4230,7 +4237,7 @@ and TcConstraintWhereTyparIsEnum cenv env newOk checkConstraints tpenv tp synUnd let tpenv = match synUnderlingTys with | [synUnderlyingTy] -> - let underlyingTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType env tpenv synUnderlyingTy + let underlyingTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synUnderlyingTy AddCxTypeIsEnum env.DisplayEnv cenv.css m NoTrace (mkTyparTy tpR) underlyingTy tpenv | _ -> @@ -4242,8 +4249,8 @@ and TcConstraintWhereTyparIsDelegate cenv env newOk checkConstraints occ tpenv t let tpR, tpenv = TcTypar cenv env newOk tpenv tp match synTys with | [a;b] -> - let a', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv a - let b', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv b + let a', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv a + let b', tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv b AddCxTypeIsDelegate env.DisplayEnv cenv.css m NoTrace (mkTyparTy tpR) a' b' tpenv | _ -> @@ -4274,7 +4281,7 @@ and TcSimpleTyparConstraint cenv env newOk tpenv tp m constraintAdder = and TcPseudoMemberSpec cenv newOk env synTypes tpenv synMemberSig m = let g = cenv.g - let tys, tpenv = List.mapFold (TcTypeAndRecover cenv newOk CheckCxs ItemOccurence.UseInType env) tpenv synTypes + let tys, tpenv = List.mapFold (TcTypeAndRecover cenv newOk CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env) tpenv synTypes match synMemberSig with | SynMemberSig.Member (synValSig, memberFlags, m) -> @@ -4350,7 +4357,7 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv allDeclaredTypars |> List.iter (SetTyparRigid env.DisplayEnv m) // Process the type, including any constraints - let declaredTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType envinner tpenv ty + let declaredTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints ItemOccurence.UseInType WarnOnIWSAM.Yes envinner tpenv ty match memFlagsOpt, thisTyOpt with | Some memberFlags, Some thisTy -> @@ -4508,7 +4515,7 @@ and TcTypeOrMeasureParameter kindOpt cenv (env: TcEnv) newOk tpenv (SynTypar(id, tpR, AddUnscopedTypar key tpR tpenv -and TcTypar cenv env newOk tpenv tp = +and TcTypar cenv env newOk tpenv tp : Typar * UnscopedTyparEnv = TcTypeOrMeasureParameter (Some TyparKind.Type) cenv env newOk tpenv tp and TcTyparDecl cenv env synTyparDecl = @@ -4543,7 +4550,7 @@ and TcTyparDecls cenv env synTypars = /// If kindOpt=Some kind, then this is the kind we're expecting (we're doing kind checking) /// If kindOpt=None, we need to determine the kind (we're doing kind inference) /// -and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) synTy = +and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ (iwsam: WarnOnIWSAM) env (tpenv: UnscopedTyparEnv) synTy = let g = cenv.g match synTy with @@ -4552,13 +4559,13 @@ and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env (tpenv: Unscoped g.obj_ty, tpenv | SynType.LongIdent synLongId -> - TcLongIdent kindOpt cenv newOk checkConstraints occ env tpenv synLongId + TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId | SynType.App (StripParenTypes (SynType.LongIdent longId), _, args, _, _, postfix, m) -> - TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId postfix args m + TcLongIdentAppType kindOpt cenv newOk checkConstraints occ iwsam env tpenv longId postfix args m | SynType.LongIdentApp (synLeftTy, synLongId, _, args, _commas, _, m) -> - TcNestedAppType cenv newOk checkConstraints occ env tpenv synLeftTy synLongId args m + TcNestedAppType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy synLongId args m | SynType.Tuple(isStruct, args, m) -> TcTupleType kindOpt cenv newOk checkConstraints occ env tpenv isStruct args m @@ -4605,13 +4612,26 @@ and TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env (tpenv: Unscoped TcTypeMeasureApp kindOpt cenv newOk checkConstraints occ env tpenv arg1 args postfix m | SynType.Paren(innerType, _) -> - TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env tpenv innerType + TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ iwsam env tpenv innerType + +and CheckIWSAM (cenv: cenv) (env: TcEnv) checkConstraints iwsam m tcref = + let g = cenv.g + let ad = env.eAccessRights + let ty = generalizedTyconRef g tcref + if iwsam = WarnOnIWSAM.Yes && isInterfaceTy g ty && checkConstraints = CheckCxs then + let meths = AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides m ty + if meths |> List.exists (fun meth -> not meth.IsInstance && meth.IsDispatchSlot) then + warning(Error(FSComp.SR.tcUsingInterfaceWithStaticAbstractMethodAsType(), m)) -and TcLongIdent kindOpt cenv newOk checkConstraints occ env tpenv synLongId = +and TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId = let (SynLongIdent(tc, _, _)) = synLongId let m = synLongId.Range let ad = env.eAccessRights + let tinstEnclosing, tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.NameEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) + + CheckIWSAM cenv env checkConstraints iwsam m tcref + match kindOpt, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4626,7 +4646,7 @@ and TcLongIdent kindOpt cenv newOk checkConstraints occ env tpenv synLongId = /// Some.Long.TypeName /// ty1 SomeLongTypeName -and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId postfix args m = +and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ iwsam env tpenv longId postfix args m = let (SynLongIdent(tc, _, _)) = longId let ad = env.eAccessRights @@ -4635,6 +4655,8 @@ and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc tyResInfo PermitDirectReferenceToGeneratedType.No |> ForceRaise + CheckIWSAM cenv env checkConstraints iwsam m tcref + match kindOpt, tcref.TypeOrMeasureKind with | Some TyparKind.Type, TyparKind.Measure -> error(Error(FSComp.SR.tcExpectedTypeNotUnitOfMeasure(), m)) @@ -4659,11 +4681,11 @@ and TcLongIdentAppType kindOpt cenv newOk checkConstraints occ env tpenv longId errorR(Error(FSComp.SR.tcUnitsOfMeasureInvalidInTypeConstructor(), m)) NewErrorType (), tpenv -and TcNestedAppType cenv newOk checkConstraints occ env tpenv synLeftTy synLongId args m = +and TcNestedAppType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy synLongId args m = let g = cenv.g let ad = env.eAccessRights let (SynLongIdent(longId, _, _)) = synLongId - let leftTy, tpenv = TcType cenv newOk checkConstraints occ env tpenv synLeftTy + let leftTy, tpenv = TcType cenv newOk checkConstraints occ iwsam env tpenv synLeftTy match leftTy with | AppTy g (tcref, tinst) -> let tcref = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId @@ -4714,14 +4736,14 @@ and TcAnonRecdType cenv newOk checkConstraints occ env tpenv isStruct args m = and TcFunctionType cenv newOk checkConstraints occ env tpenv domainTy resultTy = let g = cenv.g - let domainTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv domainTy - let resultTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv resultTy + let domainTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv domainTy + let resultTyR, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv resultTy let tyR = mkFunTy g domainTyR resultTyR tyR, tpenv and TcElementType cenv newOk checkConstraints occ env tpenv rank elemTy m = let g = cenv.g - let elemTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv elemTy + let elemTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv elemTy let tyR = mkArrayTy g rank elemTy m tyR, tpenv @@ -4739,14 +4761,14 @@ and TcAnonType kindOpt cenv newOk tpenv m = | TyparKind.Type -> mkTyparTy tp, tpenv and TcTypeWithConstraints cenv env newOk checkConstraints occ tpenv synTy synConstraints = - let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv synTy + let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv synTy let tpenv = TcTyparConstraints cenv newOk checkConstraints occ env tpenv synConstraints ty, tpenv // #typ and TcTypeHashConstraint cenv env newOk checkConstraints occ tpenv synTy m = let tp = TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m - let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv synTy + let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.No env tpenv synTy AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty (mkTyparTy tp) tp.AsType, tpenv @@ -4796,8 +4818,8 @@ and TcTypeMeasureApp kindOpt cenv newOk checkConstraints occ env tpenv arg1 args errorR(Error(FSComp.SR.tcIllegalSyntaxInTypeExpression(), m)) NewErrorType (), tpenv -and TcType cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) ty = - TcTypeOrMeasure (Some TyparKind.Type) cenv newOk checkConstraints occ env tpenv ty +and TcType cenv newOk checkConstraints occ iwsam env (tpenv: UnscopedTyparEnv) ty = + TcTypeOrMeasure (Some TyparKind.Type) cenv newOk checkConstraints occ iwsam env tpenv ty and TcMeasure cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) (StripParenTypes ty) m = match ty with @@ -4805,7 +4827,7 @@ and TcMeasure cenv newOk checkConstraints occ env (tpenv: UnscopedTyparEnv) (Str error(Error(FSComp.SR.tcAnonymousUnitsOfMeasureCannotBeNested(), m)) NewErrorMeasure (), tpenv | _ -> - match TcTypeOrMeasure (Some TyparKind.Measure) cenv newOk checkConstraints occ env tpenv ty with + match TcTypeOrMeasure (Some TyparKind.Measure) cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty with | TType_measure ms, tpenv -> ms, tpenv | _ -> error(Error(FSComp.SR.tcExpectedUnitOfMeasureNotType(), m)) @@ -4827,15 +4849,15 @@ and TcAnonTypeOrMeasure kindOpt _cenv rigid dyn newOk m = NewAnonTypar (kind, m, rigid, TyparStaticReq.None, dyn) -and TcTypes cenv newOk checkConstraints occ env tpenv args = - List.mapFold (TcTypeAndRecover cenv newOk checkConstraints occ env) tpenv args +and TcTypes cenv newOk checkConstraints occ iwsam env tpenv args = + List.mapFold (TcTypeAndRecover cenv newOk checkConstraints occ iwsam env) tpenv args and TcTypesAsTuple cenv newOk checkConstraints occ env tpenv args m = match args with | [] -> error(InternalError("empty tuple type", m)) - | [(_, ty)] -> let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty in [ty], tpenv + | [(_, ty)] -> let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty in [ty], tpenv | (isquot, ty) :: args -> - let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty + let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv ty let tys, tpenv = TcTypesAsTuple cenv newOk checkConstraints occ env tpenv args m if isquot then errorR(Error(FSComp.SR.tcUnexpectedSlashInType(), m)) ty :: tys, tpenv @@ -4853,10 +4875,10 @@ and TcMeasuresAsTuple cenv newOk checkConstraints occ env (tpenv: UnscopedTyparE and TcTypesOrMeasures optKinds cenv newOk checkConstraints occ env tpenv args m = match optKinds with | None -> - List.mapFold (TcTypeOrMeasure None cenv newOk checkConstraints occ env) tpenv args + List.mapFold (TcTypeOrMeasure None cenv newOk checkConstraints occ WarnOnIWSAM.Yes env) tpenv args | Some kinds -> if List.length kinds = List.length args then - List.mapFold (fun tpenv (arg, kind) -> TcTypeOrMeasure (Some kind) cenv newOk checkConstraints occ env tpenv arg) tpenv (List.zip args kinds) + List.mapFold (fun tpenv (arg, kind) -> TcTypeOrMeasure (Some kind) cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv arg) tpenv (List.zip args kinds) elif isNil kinds then error(Error(FSComp.SR.tcUnexpectedTypeArguments(), m)) else error(Error(FSComp.SR.tcTypeParameterArityMismatch((List.length kinds), (List.length args)), m)) @@ -5093,10 +5115,10 @@ and TcTypeApp cenv newOk checkConstraints occ env tpenv m tcref pathTypeArgs (sy ty, tpenv -and TcTypeOrMeasureAndRecover kindOpt cenv newOk checkConstraints occ env tpenv ty = +and TcTypeOrMeasureAndRecover kindOpt cenv newOk checkConstraints occ iwsam env tpenv ty = let g = cenv.g try - TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ env tpenv ty + TcTypeOrMeasure kindOpt cenv newOk checkConstraints occ iwsam env tpenv ty with e -> errorRecovery e ty.Range @@ -5109,10 +5131,10 @@ and TcTypeOrMeasureAndRecover kindOpt cenv newOk checkConstraints occ env tpenv recoveryTy, tpenv -and TcTypeAndRecover cenv newOk checkConstraints occ env tpenv ty = - TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkConstraints occ env tpenv ty +and TcTypeAndRecover cenv newOk checkConstraints occ iwsam env tpenv ty = + TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkConstraints occ iwsam env tpenv ty -and TcNestedTypeApplication cenv newOk checkConstraints occ env tpenv mWholeTypeApp ty pathTypeArgs tyargs = +and TcNestedTypeApplication cenv newOk checkConstraints occ iwsam env tpenv mWholeTypeApp ty pathTypeArgs tyargs = let g = cenv.g let ty = convertToTypeWithMetadataIfPossible g ty @@ -5122,6 +5144,7 @@ and TcNestedTypeApplication cenv newOk checkConstraints occ env tpenv mWholeType match ty with | TType_app(tcref, _, _) -> + CheckIWSAM cenv env checkConstraints iwsam mWholeTypeApp tcref TcTypeApp cenv newOk checkConstraints occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) @@ -5753,7 +5776,7 @@ and TcExprUndelayed cenv (overallTy: OverallTy) env tpenv (synExpr: SynExpr) = TcExprArrayOrList cenv overallTy env tpenv (isArray, args, m) | SynExpr.New (superInit, synObjTy, arg, mNewExpr) -> - let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.Use env tpenv synObjTy + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.Use WarnOnIWSAM.Yes env tpenv synObjTy TcNonControlFlowExpr env <| fun env -> TcPropagatingExprLeafThenConvert cenv overallTy objTy env (* true *) mNewExpr (fun () -> @@ -5944,7 +5967,7 @@ and TcExprMatchLambda cenv overallTy env tpenv (isExnMatch, mArg, clauses, spMat overallExpr, tpenv and TcExprTypeAnnotated cenv overallTy env tpenv (synBodyExpr, synType, m) = - let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType + let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synType UnifyOverallType cenv env m overallTy tgtTy let bodyExpr, tpenv = TcExpr cenv (MustConvertTo (false, tgtTy)) env tpenv synBodyExpr let bodyExpr2 = TcAdjustExprForTypeDirectedConversions cenv overallTy tgtTy env m bodyExpr @@ -5954,7 +5977,7 @@ and TcExprTypeTest cenv overallTy env tpenv (synInnerExpr, tgtTy, m) = let g = cenv.g let innerExpr, srcTy, tpenv = TcExprOfUnknownType cenv env tpenv synInnerExpr UnifyTypes cenv env m overallTy.Commit g.bool_ty - let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy + let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv tgtTy TcRuntimeTypeTest false true cenv env.DisplayEnv m tgtTy srcTy let expr = mkCallTypeTest g m tgtTy innerExpr expr, tpenv @@ -5964,7 +5987,7 @@ and TcExprUpcast cenv overallTy env tpenv (synExpr, synInnerExpr, m) = let tgtTy, tpenv = match synExpr with | SynExpr.Upcast (_, tgtTy, m) -> - let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy + let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv tgtTy UnifyTypes cenv env m tgtTy overallTy.Commit tgtTy, tpenv | SynExpr.InferredUpcast _ -> @@ -5982,7 +6005,7 @@ and TcExprDowncast cenv overallTy env tpenv (synExpr, synInnerExpr, m) = let tgtTy, tpenv, isOperator = match synExpr with | SynExpr.Downcast (_, tgtTy, m) -> - let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgtTy + let tgtTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv tgtTy UnifyTypes cenv env m tgtTy overallTy.Commit tgtTy, tpenv, true | SynExpr.InferredDowncast _ -> overallTy.Commit, tpenv, false @@ -6064,13 +6087,13 @@ and TcExprObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImp let mObjTy = synObjTy.Range - let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synObjTy + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synObjTy // Work out the type of any interfaces to implement let extraImpls, tpenv = (tpenv, extraImpls) ||> List.mapFold (fun tpenv (SynInterfaceImpl(synIntfTy, _mWith, bindings, members, m)) -> let overrides = unionBindingAndMembers bindings members - let intfTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synIntfTy + let intfTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synIntfTy if not (isInterfaceTy g intfTy) then error(Error(FSComp.SR.tcExpectedInterfaceType(), m)) if isErasedType g intfTy then @@ -6290,11 +6313,11 @@ and TcExprILAssembly cenv overallTy env tpenv (ilInstrs, synTyArgs, synArgs, syn let g = cenv.g let ilInstrs = (ilInstrs :?> ILInstr[]) let argTys = NewInferenceTypes g synArgs - let tyargs, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synTyArgs + let tyargs, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synTyArgs // No subsumption at uses of IL assembly code let flexes = argTys |> List.map (fun _ -> false) let args, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys synArgs - let retTys, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synRetTys + let retTys, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synRetTys let returnTy = match retTys with | [] -> g.unit_ty @@ -8188,7 +8211,7 @@ and TcNameOfExpr cenv env tpenv (synArg: SynExpr) = // expr : type" allowed with no subsequent qualifications | SynExpr.Typed (synBodyExpr, synType, _) when delayed.IsEmpty && overallTyOpt.IsNone -> - let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synType + let tgtTy, _tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synType check (Some (MustEqual tgtTy)) resultOpt synBodyExpr delayed | _ -> @@ -8572,7 +8595,7 @@ and TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed = // If Item.Types is returned then the ty will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [ty]) @@ -8583,7 +8606,7 @@ and TcTypeItemThen cenv overallTy env nm ty tpenv mItem tinstEnclosing delayed = | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: _delayed' -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs + let ty, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs ty tinstEnclosing tyargs let item = Item.Types(nm, [ty]) CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights) @@ -8660,7 +8683,7 @@ and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: DelayedApp(_, _, _, arg, mExprAndArg) :: otherDelayed -> - let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if !NO_TYPEPROVIDERS @@ -8681,7 +8704,7 @@ and TcCtorItemThen cenv overallTy env item nm minfos tinstEnclosing tpenv mItem | DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs) :: otherDelayed -> - let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mExprAndTypeArgs objTy tinstEnclosing tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) @@ -8875,7 +8898,7 @@ and TcDelegateCtorItemThen cenv overallTy env ty tinstEnclosing tpenv mItem dela | DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg ty arg atomicFlag otherDelayed | DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs) :: DelayedApp (atomicFlag, _, _, arg, mItemAndArg) :: otherDelayed -> - let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs + let ty, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv mItemAndTypeArgs ty tinstEnclosing tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor ty @@ -10261,7 +10284,7 @@ and TcStaticOptimizationConstraint cenv env tpenv c = | SynStaticOptimizationConstraint.WhenTyparTyconEqualsTycon(tp, ty, m) -> if not g.compilingFSharpCore then errorR(Error(FSComp.SR.tcStaticOptimizationConditionalsOnlyForFSharpLibrary(), m)) - let tyR, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv ty + let tyR, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv ty let tpR, tpenv = TcTypar cenv env NewTyparsOK tpenv tp TTyconEqualsTycon(mkTyparTy tpR, tyR), tpenv | SynStaticOptimizationConstraint.WhenTyparIsStruct(tp, m) -> @@ -10685,7 +10708,7 @@ and TcAttributeEx canFail cenv (env: TcEnv) attrTgt attrEx (synAttr: SynAttribut let ad = env.eAccessRights match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze err - | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv (SynType.App(SynType.LongIdent(SynLongIdent(tycon, [], List.replicate tycon.Length None)), None, [], [], None, false, mAttr)) ) + | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute WarnOnIWSAM.Yes env tpenv (SynType.App(SynType.LongIdent(SynLongIdent(tycon, [], List.replicate tycon.Length None)), None, [], [], None, false, mAttr)) ) ForceRaise ((try1 (tyid.idText + "Attribute")) |> otherwise (fun () -> (try1 tyid.idText))) let ad = env.eAccessRights @@ -11060,7 +11083,7 @@ and ApplyTypesFromArgumentPatterns (cenv, env, optionalArgsOK, ty, m, tpenv, Nor match retInfoOpt with | None -> () | Some (SynBindingReturnInfo (retInfoTy, m, _)) -> - let retInfoTy, _ = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv retInfoTy + let retInfoTy, _ = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv retInfoTy UnifyTypes cenv env m ty retInfoTy // Property setters always have "unit" return type match memberFlagsOpt with @@ -11476,7 +11499,7 @@ and AnalyzeRecursiveDecl match pat with | SynPat.FromParseError(pat', _) -> analyzeRecursiveDeclPat tpenv pat' | SynPat.Typed(pat', cty, _) -> - let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType envinner tpenv cty + let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes envinner tpenv cty UnifyTypes cenv envinner mBinding ty ctyR analyzeRecursiveDeclPat tpenv pat' | SynPat.Attrib(_pat', _attribs, m) -> diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 831a4cf9b20..c0950356397 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -506,6 +506,13 @@ type ImplicitlyBoundTyparsAllowed = | NewTyparsOK | NoNewTypars +/// Indicates whether the position being checked is precisely the r.h.s. of a "'T :> ***" constraint or a similar +/// places where IWSAM types do not generate a warning +[] +type WarnOnIWSAM = + | Yes + | No + /// Indicates if a member binding is an object expression binding type IsObjExprBinding = | ObjExprBinding @@ -1081,6 +1088,7 @@ val TcType: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> @@ -1093,6 +1101,7 @@ val TcTypeOrMeasureAndRecover: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> @@ -1104,6 +1113,7 @@ val TcTypeAndRecover: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index b39d6481517..e575d65752e 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -96,7 +96,7 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p = id.idText, patEnvR | SynSimplePat.Typed (p, cty, m) -> - let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK checkConstraints ItemOccurence.UseInType env tpenv cty + let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK checkConstraints ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty match p with // Optional arguments on members @@ -166,7 +166,7 @@ and TcSimplePats (cenv: cenv) optionalArgsOK checkConstraints ty env patEnv synS ps', patEnvR | SynSimplePats.Typed (p, cty, m) -> - let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty + let ctyR, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty match p with // Solitary optional arguments on members @@ -277,7 +277,7 @@ and TcPat warnOnUpper (cenv: cenv) env valReprInfo vFlags (patEnv: TcPatLinearEn | SynPat.Typed (p, cty, m) -> let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv - let ctyR, tpenvR = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty + let ctyR, tpenvR = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv cty UnifyTypes cenv env m ty ctyR let patEnvR = TcPatLinearEnv(tpenvR, names, takenNames) TcPat warnOnUpper cenv env valReprInfo vFlags patEnvR ty p @@ -369,7 +369,7 @@ and TcPatNamed warnOnUpper cenv env vFlags patEnv id ty isMemberThis vis valRepr and TcPatIsInstance warnOnUpper cenv env valReprInfo vFlags patEnv srcTy synPat synTargetTy m = let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv - let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOKButWarnIfNotRigid CheckCxs ItemOccurence.UseInType env tpenv synTargetTy + let tgtTy, tpenv = TcTypeAndRecover cenv NewTyparsOKButWarnIfNotRigid CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synTargetTy TcRuntimeTypeTest false true cenv env.DisplayEnv m tgtTy srcTy let patEnv = TcPatLinearEnv(tpenv, names, takenNames) match synPat with diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index e6741d92951..b136babf070 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1007,9 +1007,16 @@ and SolveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty // Propagate compat flex requirements from 'tp' to 'ty' do! SolveTypIsCompatFlex csenv trace r.IsCompatFlex ty - // Propagate dynamic requirements from 'tp' to 'ty' + // Propagate dynamic requirements from 'tp' to 'ty' do! SolveTypDynamicReq csenv trace r.DynamicReq ty + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then + // Propagate static requirements from 'tp' to 'ty' + // + // If IWSAMs are not supported then this is done on a per-type-variable basis when constraints + // are applied - see other calls to SolveTypStaticReq + do! SolveTypStaticReq csenv trace r.StaticReq ty + // Solve constraints on 'tp' w.r.t. 'ty' for e in r.Constraints do do! @@ -1775,10 +1782,15 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors = trackErrors { + let g = csenv.g + // Trait calls are only supported on pseudo type (variables) unless supported by IWSAM constraints - for supportTy in traitInfo.SupportTypes do - if not (SupportTypeOfMemberConstraintIsSolved csenv traitInfo supportTy) then - do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType supportTy + // + // SolveTypStaticReq is applied here if IWSAMs are supported + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + for supportTy in traitInfo.SupportTypes do + if not (SupportTypeOfMemberConstraintIsSolved csenv traitInfo supportTy) then + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType supportTy let nm = traitInfo.MemberLogicalName let support = GetTyparSupportOfMemberConstraint csenv traitInfo @@ -1940,7 +1952,7 @@ and GetNominalSupportOfMemberConstraint csenv nm traitInfo = let mutable replaced = false for cx in (destTyparTy g supportTy).Constraints do match cx with - | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceWithStaticAbstractMemberTy m nm AccessibleFromSomeFSharpCode interfaceTy -> + | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceTypeWithMatchingStaticAbstractMember m nm AccessibleFromSomeFSharpCode interfaceTy -> replaced <- true (supportTy, interfaceTy) | _ -> () @@ -1950,15 +1962,20 @@ and GetNominalSupportOfMemberConstraint csenv nm traitInfo = (supportTy, supportTy) ] and SupportTypeHasInterfaceWithMatchingStaticAbstractMember (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) (supportTyPar: Typar) = + let g = csenv.g let m = csenv.m let infoReader = csenv.InfoReader - let mutable found = false - for cx in supportTyPar.Constraints do - match cx with - | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceWithStaticAbstractMemberTy m traitInfo.MemberLogicalName AccessibleFromSomeFSharpCode interfaceTy -> - found <- true - | _ -> () - found + + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + let mutable found = false + for cx in supportTyPar.Constraints do + match cx with + | TyparConstraint.CoercesTo(interfaceTy, _) when infoReader.IsInterfaceTypeWithMatchingStaticAbstractMember m traitInfo.MemberLogicalName AccessibleFromSomeFSharpCode interfaceTy -> + found <- true + | _ -> () + found + else + false and SupportTypeOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) supportTy = let g = csenv.g @@ -1976,21 +1993,21 @@ and GetFreeTyparsOfMemberConstraint (csenv: ConstraintSolverEnv) traitInfo = freeInTypesLeftToRightSkippingConstraints csenv.g (supportTys @ argTys @ Option.toList retTy) and MemberConstraintIsReadyForWeakResolution csenv traitInfo = - SupportOfMemberConstraintIsSolved csenv traitInfo + SupportOfMemberConstraintIsFullySolved csenv traitInfo and MemberConstraintIsReadyForStrongResolution csenv traitInfo = - SupportOfMemberConstraintIsSolved csenv traitInfo + SupportOfMemberConstraintIsFullySolved csenv traitInfo and MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo = - SupportOfMemberConstraintIsSolved csenv traitInfo || + SupportOfMemberConstraintIsFullySolved csenv traitInfo || // Left-bias for SRTP constraints where the first is constrained by an IWSAM type. This is because typical IWSAM hierarchies // such as System.Numerics hierarchy math are left-biased. (match traitInfo.SupportTypes with - | firstSupportTy :: _ -> isTyparTy csenv.g firstSupportTy && SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo (destAnyParTy csenv.g firstSupportTy) + | firstSupportTy :: _ -> isAnyParTy csenv.g firstSupportTy && SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo (destAnyParTy csenv.g firstSupportTy) | _ -> false) /// Check if the support is fully solved. -and SupportOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) traitInfo = +and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) traitInfo = traitInfo.SupportTypes |> List.forall (SupportTypeOfMemberConstraintIsSolved csenv traitInfo) /// Re-solve the global constraints involving any of the given type variables. @@ -2415,7 +2432,9 @@ and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty choiceTys = let denv = csenv.DisplayEnv match tryDestTyparTy g ty with | ValueSome destTypar -> - do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType ty + // SolveTypStaticReq is applied here if IWSAMs are supported + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType ty return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(choiceTys, m)) | _ -> diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index b02f057871b..0724bc8bc84 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -699,7 +699,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = else this.TryFindIntrinsicMethInfo m ad "op_Implicit" ty - let IsInterfaceWithStaticAbstractMemberTyUncached ((ad, nm), m, ty) = + let IsInterfaceTypeWithMatchingStaticAbstractMemberUncached ((ad, nm), m, ty) = ExistsInEntireHierarchyOfType (fun parentTy -> let meths = this.TryFindIntrinsicMethInfo m ad nm parentTy meths |> List.exists (fun meth -> @@ -748,7 +748,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = let entireTypeHierarchyCache = MakeInfoCache GetEntireTypeHierarchyUncached HashIdentity.Structural let primaryTypeHierarchyCache = MakeInfoCache GetPrimaryTypeHierarchyUncached HashIdentity.Structural let implicitConversionCache = MakeInfoCache FindImplicitConversionsUncached hashFlags3 - let isInterfaceWithStaticAbstractMethodCache = MakeInfoCache IsInterfaceWithStaticAbstractMemberTyUncached hashFlags4 + let isInterfaceWithStaticAbstractMethodCache = MakeInfoCache IsInterfaceTypeWithMatchingStaticAbstractMemberUncached hashFlags4 // Runtime feature support @@ -917,7 +917,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member _.FindImplicitConversions m ad ty = implicitConversionCache.Apply((ad, m, ty)) - member _.IsInterfaceWithStaticAbstractMemberTy m nm ad ty = + member _.IsInterfaceTypeWithMatchingStaticAbstractMember m nm ad ty = isInterfaceWithStaticAbstractMethodCache.Apply((ad, nm), m, ty) let checkLanguageFeatureRuntimeAndRecover (infoReader: InfoReader) langFeature m = diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index ba1a3747954..2360af102f7 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -196,7 +196,7 @@ type InfoReader = member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list /// Determine if a type has a static abstract method with the given name somewhere in its hierarchy - member IsInterfaceWithStaticAbstractMemberTy: m: range -> nm: string -> ad: AccessorDomain -> ty: TType -> bool + member IsInterfaceTypeWithMatchingStaticAbstractMember: m: range -> nm: string -> ad: AccessorDomain -> ty: TType -> bool val checkLanguageFeatureRuntimeAndRecover: infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> unit diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 779f403b3c8..0ef889e79bf 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -926,6 +926,8 @@ let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm + if infoReader.g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + warning(Error(FSComp.SR.tcUsingInterfacesWithStaticAbstractMethods(), bindm)) let minfos = match typToSearchForAbstractMembers with diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index b014a4c48ce..66990a8308d 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1653,5 +1653,7 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3530,tcTraitIsStatic,"Trait '%s' is static" 3531,tcTraitIsNotStatic,"Trait '%s' is not static" 3532,tcTraitMayNotUseComplexThings,"A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" -3533,tcInvalidSelfConstraint,"Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax" +3533,tcInvalidSelfConstraint,"Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax." 3534,tcTraitInvocationShouldUseTick,"Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters." +3535,tcUsingInterfacesWithStaticAbstractMethods,"Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'." +3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 84b2c86e28c..a9790fbe497 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Neplatný interpolovaný řetězec. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Člen rozhraní {0} nemá nejvíce specifickou implementaci. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 301c698e42c..17fed7c310d 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Ungültige interpolierte Zeichenfolge. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Der Schnittstellenmember "{0}" weist keine spezifischste Implementierung auf. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 920b0576570..07684c62750 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Cadena interpolada no válida. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. El miembro de interfaz "{0}" no tiene una implementación más específica. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 2cebbff08e7..33175c0033c 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Chaîne interpolée non valide. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Le membre d'interface '{0}' n'a pas l'implémentation la plus spécifique. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index cb91962e69b..c775448e2ee 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ La stringa interpolata non è valida. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Il membro di interfaccia '{0}' non contiene un'implementazione più specifica. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 82a0fbfd663..09a8bca72ec 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ 補間された文字列が無効です。{0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. インターフェイス メンバー '{0}' には最も固有な実装がありません。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 6b6c42e4848..bbda64597ba 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ 잘못된 보간 문자열. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. 인터페이스 멤버 '{0}'에 가장 한정적인 구현이 없습니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index f28b629a41e..5fc88eb1fd2 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Nieprawidłowy ciąg interpolowany. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Składowa interfejsu „{0}” nie ma najbardziej specyficznej implementacji. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 7b10d321282..48d39d87a53 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Cadeia de caracteres interpolada inválida. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. O membro de interface '{0}' não tem uma implementação mais específica. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index ce2135fb77c..76e6966556e 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Недопустимая интерполированная строка. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. Элемент интерфейса "{0}" не имеет наиболее конкретной реализации. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 6fb2f811103..fa87b47f191 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ Geçersiz düz metin arasına kod eklenmiş dize. {0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. '{0}' arabirim üyesinin en belirgin uygulaması yok. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 2f18ba797f9..f0418905ffa 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ 内插字符串无效。{0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. 接口成员“{0}”没有最具体的实现。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 43a0bc44269..e4285f393ad 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. @@ -897,6 +897,16 @@ 插補字串無效。{0} + + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + + + + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'. + + Interface member '{0}' does not have a most specific implementation. 介面成員 '{0}' 沒有最具體的實作。 diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 6f4a00a8e3c..96f502bb3de 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -292,9 +292,14 @@ module ``Use SRTP operators from generic IWSAM code super flex`` = // sin x +let fExpectAWarning(x: ISinOperator<'T>) = + () + (* let inline f_SRTP_GoToDefinition_FindAllReferences (x: 'T) = let y = x + x // implicitly adds constraint to type inference variable 'T let z = 'T.op_Addition(x, x) // where would go-to-definition go? what does find-all-references do? y + z *) + + From 7eeae6d411a04f9173b1ca480815c4c0a7d7f34f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 Jul 2022 19:04:07 +0100 Subject: [PATCH 44/91] update messages and protect changes --- src/Compiler/Checking/ConstraintSolver.fs | 141 ++++++++++++---------- src/Compiler/FSComp.txt | 2 +- src/Compiler/xlf/FSComp.txt.cs.xlf | 4 +- src/Compiler/xlf/FSComp.txt.de.xlf | 4 +- src/Compiler/xlf/FSComp.txt.es.xlf | 4 +- src/Compiler/xlf/FSComp.txt.fr.xlf | 4 +- src/Compiler/xlf/FSComp.txt.it.xlf | 4 +- src/Compiler/xlf/FSComp.txt.ja.xlf | 4 +- src/Compiler/xlf/FSComp.txt.ko.xlf | 4 +- src/Compiler/xlf/FSComp.txt.pl.xlf | 4 +- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 4 +- src/Compiler/xlf/FSComp.txt.ru.xlf | 4 +- src/Compiler/xlf/FSComp.txt.tr.xlf | 4 +- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 4 +- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 4 +- 15 files changed, 103 insertions(+), 92 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index b136babf070..fcbeb51c204 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2070,79 +2070,77 @@ and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr } +and TraitsAreRelated (csenv: ConstraintSolverEnv) retry traitInfo1 traitInfo2 = + let g = csenv.g + let (TTrait(tys1, nm1, memFlags1, argTys1, _, _)) = traitInfo1 + let (TTrait(tys2, nm2, memFlags2, argTys2, _, _)) = traitInfo2 + memFlags1.IsInstance = memFlags2.IsInstance && + nm1 = nm2 && + // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. + // See FSharp 1.0 bug 6477. + not (nm1 = "op_Explicit" || nm1 = "op_Implicit") && + argTys1.Length = argTys2.Length && + (List.lengthsEqAndForall2 (typeEquiv g) tys1 tys2 || retry) + // Type variable sets may not have two trait constraints with the same name, nor // be constrained by different instantiations of the same interface type. // // This results in limitations on generic code, especially "inline" code, which // may require type annotations. // -// The 'retry' flag is passed when a rigid type variable is about to taise a missing constraint error. -// In this case the support types are all first forced to be equal. -and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace retry tpc1 tpc2 = +// The 'retry' flag is passed when a rigid type variable is about to raise a missing constraint error +// and the lengths of the support types are not equal (i.e. one is length 1, the other is length 2). +// In this case the support types are first forced to be equal. +and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace retry tpc1 tpc2 = trackErrors { let g = csenv.g let amap = csenv.amap let m = csenv.m match tpc1, tpc2 with - | (TyparConstraint.MayResolveMember(TTrait(tys1, nm1, memFlags1, argTys1, rty1, _), _), - TyparConstraint.MayResolveMember(TTrait(tys2, nm2, memFlags2, argTys2, rty2, _), _)) - when - (memFlags1.IsInstance = memFlags2.IsInstance && - nm1 = nm2 && - // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. - // See FSharp 1.0 bug 6477. - not (nm1 = "op_Explicit" || nm1 = "op_Implicit") && - argTys1.Length = argTys2.Length && - (List.lengthsEqAndForall2 (typeEquiv g) tys1 tys2 || retry)) -> - - trackErrors { - if retry then - match tys1, tys2 with - | [ty1], [ty2] -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 - | [ty1], _ -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1) tys2 - | _, [ty2] -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty2) tys1 - | _ -> () - do! Iterate2D (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace) argTys1 argTys2 - let rty1 = GetFSharpViewOfReturnType g rty1 - let rty2 = GetFSharpViewOfReturnType g rty2 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty1 rty2 - () - } + | TyparConstraint.MayResolveMember(traitInfo1, _), TyparConstraint.MayResolveMember(traitInfo2, _) + when TraitsAreRelated csenv retry traitInfo1 traitInfo2 -> + let (TTrait(tys1, _, _, argTys1, rty1, _)) = traitInfo1 + let (TTrait(tys2, _, _, argTys2, rty2, _)) = traitInfo2 + if retry then + match tys1, tys2 with + | [ty1], [ty2] -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 + | [ty1], _ -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1) tys2 + | _, [ty2] -> do! IterateD (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty2) tys1 + | _ -> () + do! Iterate2D (SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace) argTys1 argTys2 + let rty1 = GetFSharpViewOfReturnType g rty1 + let rty2 = GetFSharpViewOfReturnType g rty2 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty1 rty2 - | (TyparConstraint.CoercesTo(ty1, _), - TyparConstraint.CoercesTo(ty2, _)) -> - // Record at most one subtype constraint for each head type. - // That is, we forbid constraints by both I and I. - // This works because the types on the r.h.s. of subtype - // constraints are head-types and so any further inferences are equational. - let collect ty = - let mutable res = [] - IterateEntireHierarchyOfType (fun x -> res <- x :: res) g amap m AllowMultiIntfInstantiations.No ty - List.rev res - let parents1 = collect ty1 - let parents2 = collect ty2 - trackErrors { - for ty1Parent in parents1 do - for ty2Parent in parents2 do - do! if not (HaveSameHeadType g ty1Parent ty2Parent) then CompleteD else - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1Parent ty2Parent - } - - | (TyparConstraint.IsEnum (u1, _), - TyparConstraint.IsEnum (u2, m2)) -> - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace u1 u2 + | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> + // Record at most one subtype constraint for each head type. + // That is, we forbid constraints by both I and I. + // This works because the types on the r.h.s. of subtype + // constraints are head-types and so any further inferences are equational. + let collect ty = + let mutable res = [] + IterateEntireHierarchyOfType (fun x -> res <- x :: res) g amap m AllowMultiIntfInstantiations.No ty + List.rev res + let parents1 = collect ty1 + let parents2 = collect ty2 + for ty1Parent in parents1 do + for ty2Parent in parents2 do + if HaveSameHeadType g ty1Parent ty2Parent then + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1Parent ty2Parent + + | TyparConstraint.IsEnum (u1, _), + TyparConstraint.IsEnum (u2, m2) -> + return! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace u1 u2 - | (TyparConstraint.IsDelegate (aty1, bty1, _), - TyparConstraint.IsDelegate (aty2, bty2, m2)) -> trackErrors { + | TyparConstraint.IsDelegate (aty1, bty1, _), + TyparConstraint.IsDelegate (aty2, bty2, m2) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace aty1 aty2 return! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bty1 bty2 - } | TyparConstraint.SupportsComparison _, TyparConstraint.IsDelegate _ | TyparConstraint.IsDelegate _, TyparConstraint.SupportsComparison _ | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _ | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _ -> - ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) - + return! ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ @@ -2152,9 +2150,10 @@ and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace ret | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ | TyparConstraint.SimpleChoice _, TyparConstraint.SimpleChoice _ -> - CompleteD + () - | _ -> CompleteD + | _ -> () + } // See when one constraint implies implies another. // 'a :> ty1 implies 'a :> 'ty2 if the head type name of ty2 (say T2) occursCheck anywhere in the hierarchy of ty1 @@ -2191,6 +2190,9 @@ and CheckConstraintImplication (csenv: ConstraintSolverEnv) tpc1 tpc2 = (priority1 = priority2) && typeEquiv g dty1 dty2 | _ -> false +and CheckConstraintsImplication csenv existingConstraints newConstraint = + existingConstraints |> List.exists (fun tpc2 -> CheckConstraintImplication csenv tpc2 newConstraint) + // Ensure constraint conforms with existing constraints // NOTE: QUADRATIC and EnforceConstraintSetConsistency csenv ndeep m2 trace retry allCxs i cxs = @@ -2218,6 +2220,7 @@ and EliminateRedundantConstraints csenv cxs acc = and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint = let denv = csenv.DisplayEnv let m = csenv.m + let g = csenv.g let existingConstraints = tp.Constraints @@ -2225,8 +2228,23 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint trackErrors { do! EnforceConstraintSetConsistency csenv ndeep m2 trace false allCxs 0 allCxs - let impliedByExistingConstraints = existingConstraints |> List.exists (fun tpc2 -> CheckConstraintImplication csenv tpc2 newConstraint) - + let mutable impliedByExistingConstraints = CheckConstraintsImplication csenv existingConstraints newConstraint + + // When InterfacesWithAbstractStaticMembers enabled, retry constraint consistency and implication when one of the constraints is known to have + // a single support type, and the other has two support types. + // (T1 : static member Foo: int) + // and the constraint we're adding is this: + // ((T2 or ?inf) : static member Foo: int) + // + // Then the only logical solution is ?inf = T1 = T2. So just enforce this and try again. + if + not impliedByExistingConstraints && + (IsRigid csenv tp || tp.Rigidity.WarnIfMissingConstraint) && + g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + then + do! EnforceConstraintSetConsistency csenv ndeep m2 trace true allCxs 0 allCxs + impliedByExistingConstraints <- CheckConstraintsImplication csenv existingConstraints newConstraint + if impliedByExistingConstraints then () // "Default" constraints propagate softly and can be omitted from explicit declarations of type parameters elif (match tp.Rigidity, newConstraint with @@ -2234,13 +2252,6 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint | _ -> false) then () elif IsRigid csenv tp then - // Retry rigid type parameters where the supporting types are forced to be identical, e.g if declared type parameter has this: - // (T : static member Foo: int) - // and the constraint we're adding is this: - // ((T or ?inf) : static member Foo: int) - // then the only logical solution is ?inf = T. So just enforce this and try again. - do! EnforceConstraintSetConsistency csenv ndeep m2 trace true allCxs 0 allCxs - let impliedByExistingConstraints = existingConstraints |> List.exists (fun tpc2 -> CheckConstraintImplication csenv tpc2 newConstraint) if not impliedByExistingConstraints then return! ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 66990a8308d..1296024b80e 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1656,4 +1656,4 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3533,tcInvalidSelfConstraint,"Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax." 3534,tcTraitInvocationShouldUseTick,"Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters." 3535,tcUsingInterfacesWithStaticAbstractMethods,"Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'." -3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." +3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index a9790fbe497..c48c5fda0bb 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 17fed7c310d..5fcc67eaabf 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 07684c62750..67d4915ad26 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 33175c0033c..5eca70dd6ed 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index c775448e2ee..1082f713ecb 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 09a8bca72ec..608e414b0ca 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index bbda64597ba..94a8c89f5de 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 5fc88eb1fd2..9525465a9a7 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 48d39d87a53..362bf34c0de 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 76e6966556e..d5c8f7c6982 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index fa87b47f191..609e15ba191 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index f0418905ffa..b9df8db475c 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index e4285f393ad..3ed39ea99bc 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -898,8 +898,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. From 7f6a46dee1cad7de1591ad450226f4e09f466053 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 Jul 2022 21:27:36 +0100 Subject: [PATCH 45/91] clear static req for inference variables --- src/Compiler/Checking/CheckExpressions.fs | 15 +++++--- src/Compiler/Checking/ConstraintSolver.fs | 34 +++++++++++-------- src/Compiler/Checking/InfoReader.fs | 8 ++--- src/Compiler/Checking/MethodOverrides.fs | 10 ++++-- src/Compiler/Checking/SignatureConformance.fs | 11 ++++-- src/Compiler/Checking/TypeHierarchy.fs | 2 ++ src/Compiler/Checking/infos.fs | 4 +-- src/Compiler/FSComp.txt | 1 + src/Compiler/Service/ServiceParsedInputOps.fs | 4 +-- src/Compiler/SyntaxTree/SyntaxTree.fs | 2 +- src/Compiler/SyntaxTree/SyntaxTree.fsi | 4 +-- src/Compiler/TypedTree/TypedTree.fs | 26 ++++++++++---- src/Compiler/TypedTree/TypedTree.fsi | 2 ++ src/Compiler/TypedTree/TypedTreeBasics.fs | 8 +++-- src/Compiler/TypedTree/TypedTreeBasics.fsi | 4 +-- src/Compiler/TypedTree/TypedTreeOps.fs | 8 ++--- src/Compiler/pars.fsy | 28 +++++++-------- src/Compiler/xlf/FSComp.txt.cs.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.de.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.es.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.fr.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.it.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ja.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ko.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.pl.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.ru.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.tr.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 5 +++ src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 5 +++ tests/adhoc.fsx | 26 ++++++++++++++ 31 files changed, 195 insertions(+), 67 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index f97b4a250db..7308515c7ff 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1997,7 +1997,7 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars = let origTypars = declaredTyconTypars - let freshTypars = copyTypars origTypars + let freshTypars = copyTypars true origTypars if rigid <> TyparRigidity.Rigid then for tp in freshTypars do tp.SetRigidity rigid @@ -6264,10 +6264,9 @@ and TcExprNamedIndexPropertySet cenv overallTy env tpenv (synLongId, synExpr1, s [ DelayedApp(ExprAtomicFlag.Atomic, false, None, synExpr1, mStmt) MakeDelayedSet(synExpr2, mStmt) ] -and TcExprTraitCall cenv overallTy env tpenv (tps, synMemberSig, arg, m) = +and TcExprTraitCall cenv overallTy env tpenv (synTypes, synMemberSig, arg, m) = let g = cenv.g TcNonPropagatingExprLeafThenConvert cenv overallTy env m (fun () -> - let synTypes = tps |> List.map (fun tp -> SynType.Var(tp, m)) let traitInfo, tpenv = TcPseudoMemberSpec cenv NewTyparsOK env synTypes tpenv synMemberSig m if BakedInTraitConstraintNames.Contains traitInfo.MemberLogicalName then warning(BakedInMemberConstraintName(traitInfo.MemberLogicalName, m)) @@ -8723,6 +8722,14 @@ and TcTraitItemThen cenv overallTy env objOpt traitInfo tpenv mItem delayed = let argTys = traitInfo.GetLogicalArgumentTypes(g) let retTy = traitInfo.GetReturnType(g) + match traitInfo.SupportTypes with + | tys when tys.Length > 1 -> + //| (t0 :: (_ :: _) as rest) -> + error(Error (FSComp.SR.tcTraitHasMultipleSupportTypes(traitInfo.MemberDisplayNameCore), mItem)) + //for ty in rest do + // UnifyTypes cenv env mItem t0 ty + | _ -> () + match objOpt, traitInfo.MemberFlags.IsInstance with | Some _, false -> error (Error (FSComp.SR.tcTraitIsStatic traitInfo.MemberDisplayNameCore, mItem)) | None, true -> error (Error (FSComp.SR.tcTraitIsNotStatic traitInfo.MemberDisplayNameCore, mItem)) @@ -10663,7 +10670,7 @@ and TcBindingTyparDecls alwaysRigid cenv env tpenv (ValTyparDecls(synTypars, syn declaredTypars |> List.iter (fun tp -> SetTyparRigid env.DisplayEnv tp.Range tp) declaredTypars else - let rigidCopyOfDeclaredTypars = copyTypars declaredTypars + let rigidCopyOfDeclaredTypars = copyTypars false declaredTypars // The type parameters used to check rigidity after inference are marked rigid straight away rigidCopyOfDeclaredTypars |> List.iter (fun tp -> SetTyparRigid env.DisplayEnv tp.Range tp) // The type parameters using during inference will be marked rigid after inference diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index fcbeb51c204..75d9eeb38cd 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -115,14 +115,16 @@ let NewByRefKindInferenceType (g: TcGlobals) m = let NewInferenceTypes g l = l |> List.map (fun _ -> NewInferenceType g) +let FreshenTypar rigid (tp: Typar) = + NewCompGenTypar (tp.Kind, rigid, TyparStaticReq.None, (if rigid=TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No), false) + // QUERY: should 'rigid' ever really be 'true'? We set this when we know // we are going to have to generalize a typar, e.g. when implementing a // abstract generic method slot. But we later check the generalization // condition anyway, so we could get away with a non-rigid typar. This // would sort of be cleaner, though give errors later. let FreshenAndFixupTypars m rigid fctps tinst tpsorig = - let copy_tyvar (tp: Typar) = NewCompGenTypar (tp.Kind, rigid, tp.StaticReq, (if rigid=TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No), false) - let tps = tpsorig |> List.map copy_tyvar + let tps = tpsorig |> List.map (FreshenTypar rigid) let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps tps, renaming, tinst @@ -1010,6 +1012,9 @@ and SolveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty // Propagate dynamic requirements from 'tp' to 'ty' do! SolveTypDynamicReq csenv trace r.DynamicReq ty + // Propagate static requirements from 'tp' to 'ty' + do! SolveTypStaticReq csenv trace r.StaticReq ty + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then // Propagate static requirements from 'tp' to 'ty' // @@ -1784,18 +1789,18 @@ and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignore trackErrors { let g = csenv.g + let nm = traitInfo.MemberLogicalName + let supportTypars = GetTyparSupportOfMemberConstraint csenv traitInfo + let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo + // Trait calls are only supported on pseudo type (variables) unless supported by IWSAM constraints // // SolveTypStaticReq is applied here if IWSAMs are supported if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then - for supportTy in traitInfo.SupportTypes do - if not (SupportTypeOfMemberConstraintIsSolved csenv traitInfo supportTy) then - do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType supportTy + for supportTypar in supportTypars do + if not (SupportTypeOfMemberConstraintIsSolved csenv traitInfo supportTypar) then + do! SolveTypStaticReqTypar csenv trace TyparStaticReq.HeadType supportTypar - let nm = traitInfo.MemberLogicalName - let support = GetTyparSupportOfMemberConstraint csenv traitInfo - let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo - // If there's nothing left to learn then raise the errors. // Note: we should likely call MemberConstraintIsReadyForResolution here when permitWeakResolution=false but for stability // reasons we use the more restrictive isNil frees. @@ -1803,7 +1808,7 @@ and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignore do! errors // Otherwise re-record the trait waiting for canonicalization else - do! AddMemberConstraint csenv ndeep m2 trace traitInfo support frees + do! AddMemberConstraint csenv ndeep m2 trace traitInfo supportTypars frees match errors with | ErrorResult (_, UnresolvedOverloading _) @@ -1977,10 +1982,8 @@ and SupportTypeHasInterfaceWithMatchingStaticAbstractMember (csenv: ConstraintSo else false -and SupportTypeOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) supportTy = - let g = csenv.g - not (isAnyParTy g supportTy) || - SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo (destAnyParTy g supportTy) +and SupportTypeOfMemberConstraintIsSolved (csenv: ConstraintSolverEnv) (traitInfo: TraitConstraintInfo) supportTypar = + SupportTypeHasInterfaceWithMatchingStaticAbstractMember csenv traitInfo supportTypar // This may be relevant to future bug fixes, see https://github.com/dotnet/fsharp/issues/3814 // /// Check if some part of the support is solved. @@ -2008,7 +2011,8 @@ and MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo = /// Check if the support is fully solved. and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) traitInfo = - traitInfo.SupportTypes |> List.forall (SupportTypeOfMemberConstraintIsSolved csenv traitInfo) + let g = csenv.g + traitInfo.SupportTypes |> List.forall (fun ty -> if isAnyParTy g ty then SupportTypeOfMemberConstraintIsSolved csenv traitInfo (destAnyParTy g ty) else true) /// Re-solve the global constraints involving any of the given type variables. /// Trait constraints can't always be solved using the pessimistic rules. We only canonicalize diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 0724bc8bc84..f0bf0639d55 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -752,19 +752,19 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = // Runtime feature support - let isRuntimeFeatureSupported (infoReader: InfoReader) runtimeFeature = + let isRuntimeFeatureSupported runtimeFeature = match g.System_Runtime_CompilerServices_RuntimeFeature_ty with | Some runtimeFeatureTy -> - infoReader.GetILFieldInfosOfType (None, AccessorDomain.AccessibleFromEverywhere, range0, runtimeFeatureTy) + GetIntrinsicILFieldInfosUncached ((None, AccessorDomain.AccessibleFromEverywhere), range0, runtimeFeatureTy) |> List.exists (fun (ilFieldInfo: ILFieldInfo) -> ilFieldInfo.FieldName = runtimeFeature) | _ -> false let isRuntimeFeatureDefaultImplementationsOfInterfacesSupported = - lazy isRuntimeFeatureSupported this "DefaultImplementationsOfInterfaces" + lazy isRuntimeFeatureSupported "DefaultImplementationsOfInterfaces" let isRuntimeFeatureVirtualStaticsInInterfacesSupported = - lazy isRuntimeFeatureSupported this "VirtualStaticsInInterfaces" + lazy isRuntimeFeatureSupported "VirtualStaticsInInterfaces" member _.g = g member _.amap = amap diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 0ef889e79bf..5719225030c 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -767,11 +767,15 @@ module DispatchSlotChecking = let allImpls = List.zip allReqdTys slotImplSets // Find the methods relevant to implementing the abstract slots listed under the reqdType being checked. + // + // Methods that are + // - Not static OR Static in the interface + // - override/default let allImmediateMembersThatMightImplementDispatchSlots = allImmediateMembers |> List.filter (fun overrideBy -> - (overrideBy.IsInstanceMember || IsStaticAbstractImpl overrideBy) // Not static OR Static in the interface - && overrideBy.IsVirtualMember // exclude non virtual (e.g. keep override/default). [4469] - && not overrideBy.IsDispatchSlotMember) + (overrideBy.IsInstanceMember || IsStaticAbstractImpl overrideBy) && + overrideBy.IsVirtualMember && + not overrideBy.IsDispatchSlotMember) let mustOverrideSomething reqdTy (overrideBy: ValRef) = let memberInfo = overrideBy.MemberInfo.Value diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index 989df031b9a..a9145207ebb 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -11,6 +11,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax @@ -122,9 +123,15 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = let aenv = aenv.BindEquivTypars implTypars sigTypars (implTypars, sigTypars) ||> List.forall2 (fun implTypar sigTypar -> let m = sigTypar.Range - if implTypar.StaticReq = TyparStaticReq.HeadType && sigTypar.StaticReq = TyparStaticReq.None then - errorR (Error(FSComp.SR.typrelSigImplNotCompatibleCompileTimeRequirementsDiffer(), m)) + let check = + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + implTypar.StaticReq = TyparStaticReq.HeadType && sigTypar.StaticReq = TyparStaticReq.None + else + implTypar.StaticReq <> sigTypar.StaticReq + if check then + errorR (Error(FSComp.SR.typrelSigImplNotCompatibleCompileTimeRequirementsDiffer(), m)) + // Adjust the actual type parameter name to look like the signature implTypar.SetIdent (mkSynId implTypar.Range sigTypar.Id.idText) diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index 9791a2a98cc..73fefe514b7 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -9,6 +9,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import +open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.TcGlobals @@ -187,6 +188,7 @@ and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = // Check for any System.Numerics type in the interface hierarchy and ExistsSystemNumericsTypeInInterfaceHierarchy skipUnref g amap m ity = + g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers && ExistsInInterfaceHierarchy (fun ity2 -> match ity2 with diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 41fb4d50281..7d22684250c 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -1209,9 +1209,9 @@ type MethInfo = // REVIEW: should we copy down attributes to slot params? let tcref = tcrefOfAppTy g x.ApparentEnclosingAppType let formalEnclosingTyparsOrig = tcref.Typars m - let formalEnclosingTypars = copyTypars formalEnclosingTyparsOrig + let formalEnclosingTypars = copyTypars false formalEnclosingTyparsOrig let _, formalEnclosingTyparTys = FixupNewTypars m [] [] formalEnclosingTyparsOrig formalEnclosingTypars - let formalMethTypars = copyTypars x.FormalMethodTypars + let formalMethTypars = copyTypars false x.FormalMethodTypars let _, formalMethTyparTys = FixupNewTypars m formalEnclosingTypars formalEnclosingTyparTys x.FormalMethodTypars formalMethTypars let formalRetTy, formalParams = diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 1296024b80e..b9febdf4d96 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1657,3 +1657,4 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3534,tcTraitInvocationShouldUseTick,"Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters." 3535,tcUsingInterfacesWithStaticAbstractMethods,"Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'." 3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." +3537,tcTraitHasMultipleSupportTypes,"The trait '%s' invoked by this call has multiple support types." \ No newline at end of file diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index f3da41ef59f..6d117ac7c47 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -831,7 +831,7 @@ module ParsedInput = | SynExpr.DoBang (e, _) -> walkExprWithKind parentKind e | SynExpr.TraitCall (ts, sign, e, _) -> - List.tryPick walkTypar ts + List.tryPick walkType ts |> Option.orElseWith (fun () -> walkMemberSig sign) |> Option.orElseWith (fun () -> walkExprWithKind parentKind e) @@ -1802,7 +1802,7 @@ module ParsedInput = walkExpr e2 | SynExpr.TraitCall (ts, sign, e, _) -> - List.iter walkTypar ts + List.iter walkType ts walkMemberSig sign walkExpr e | SynExpr.Const (SynConst.Measure (_, _, m), _) -> walkMeasure m diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fs b/src/Compiler/SyntaxTree/SyntaxTree.fs index 41868ea401f..d2428ce7b5f 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fs +++ b/src/Compiler/SyntaxTree/SyntaxTree.fs @@ -628,7 +628,7 @@ type SynExpr = | AddressOf of isByref: bool * expr: SynExpr * opRange: range * range: range - | TraitCall of supportTys: SynTypar list * traitSig: SynMemberSig * argExpr: SynExpr * range: range + | TraitCall of supportTys: SynType list * traitSig: SynMemberSig * argExpr: SynExpr * range: range | JoinIn of lhsExpr: SynExpr * lhsRange: range * rhsExpr: SynExpr * range: range diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 3a9950fe6f8..1cf1959bc22 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -814,8 +814,8 @@ type SynExpr = /// F# syntax: &expr, &&expr | AddressOf of isByref: bool * expr: SynExpr * opRange: range * range: range - /// F# syntax: ((typar1 or ... or typarN): (member-dig) expr) - | TraitCall of supportTys: SynTypar list * traitSig: SynMemberSig * argExpr: SynExpr * range: range + /// F# syntax: ((type1 or ... or typeN): (member-dig) expr) + | TraitCall of supportTys: SynType list * traitSig: SynMemberSig * argExpr: SynExpr * range: range /// F# syntax: ... in ... /// Computation expressions only, based on JOIN_IN token from lex filter diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 935d9e52f9b..c4ab13150b8 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -376,6 +376,9 @@ type TyparFlags(flags: int32) = else TyparFlags(flags &&& ~~~0b00010000000000000) + member x.WithStaticReq staticReq = + TyparFlags(x.Kind, x.Rigidity, x.IsFromError, x.IsCompilerGenerated, staticReq, x.DynamicReq, x.EqualityConditionalOn, x.ComparisonConditionalOn) + /// Get the flags as included in the F# binary metadata. We pickle this as int64 to allow for future expansion member x.PickledBits = flags @@ -2266,22 +2269,33 @@ type Typar = member x.SetIdent id = x.typar_id <- id /// Sets the rigidity of a type variable - member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetRigidity b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable is compiler generated - member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetCompilerGenerated b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether a type variable has a static requirement - member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetStaticReq b = + x.typar_flags <- x.typar_flags.WithStaticReq(b) /// Sets whether a type variable is required at runtime - member x.SetDynamicReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + member x.SetDynamicReq b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) /// Sets whether the equality constraint of a type definition depends on this type variable - member x.SetEqualityDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b, flags.ComparisonConditionalOn) + member x.SetEqualityDependsOn b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b, flags.ComparisonConditionalOn) /// Sets whether the comparison constraint of a type definition depends on this type variable - member x.SetComparisonDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) + member x.SetComparisonDependsOn b = + let flags = x.typar_flags + x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) [] member x.DebugText = x.ToString() diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index eb55b3fe5a6..572f3e91890 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -206,6 +206,8 @@ type TyparFlags = member WithCompatFlex: b: bool -> TyparFlags + member WithStaticReq: staticReq: Syntax.TyparStaticReq -> TyparFlags + /// Indicates that whether or not a generic type definition satisfies the comparison constraint is dependent on whether this type variable satisfies the comparison constraint. member ComparisonConditionalOn: bool diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index eca6f57332a..b8863eec764 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -178,17 +178,19 @@ let mkTyparTy (tp: Typar) = | TyparKind.Type -> tp.AsType | TyparKind.Measure -> TType_measure (Measure.Var tp) -let copyTypar (tp: Typar) = +// We clear the StaticReq when copying because the requirement will be re-established through the +// process of type inference. +let copyTypar isFresh (tp: Typar) = let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs }) Typar.New { typar_id = tp.typar_id - typar_flags = tp.typar_flags + typar_flags = (if isFresh then tp.typar_flags.WithStaticReq(TyparStaticReq.None) else tp.typar_flags) typar_stamp = newStamp() typar_solution = tp.typar_solution typar_astype = Unchecked.defaultof<_> // Be careful to clone the mutable optional data too typar_opt_data = optData } -let copyTypars tps = List.map copyTypar tps +let copyTypars isFresh tps = List.map (copyTypar isFresh) tps //-------------------------------------------------------------------------- // Inference variables diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fsi b/src/Compiler/TypedTree/TypedTreeBasics.fsi index 13eacdfe2dd..16b93a3026e 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fsi +++ b/src/Compiler/TypedTree/TypedTreeBasics.fsi @@ -118,9 +118,7 @@ val ccuOfTyconRef: eref: EntityRef -> CcuThunk option val mkTyparTy: tp: Typar -> TType -val copyTypar: tp: Typar -> Typar - -val copyTypars: tps: Typar list -> Typar list +val copyTypars: isFresh: bool -> tps: Typar list -> Typar list val tryShortcutSolvedUnitPar: canShortcut: bool -> r: Typar -> Measure diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 8ce9c45c33d..77e186f61ab 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -325,7 +325,7 @@ and copyAndRemapAndBindTyparsFull remapAttrib tyenv tps = match tps with | [] -> tps, tyenv | _ -> - let tpsR = copyTypars tps + let tpsR = copyTypars false tps let tyenv = { tyenv with tpinst = bindTypars tps (generalizeTypars tpsR) tyenv.tpinst } (tps, tpsR) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (remapTyparConstraintsAux tyenv tporig.Constraints) @@ -2602,9 +2602,9 @@ type TraitConstraintInfo with /// Put these in canonical order. let GetTraitConstraintInfosOfTypars g (tps: Typars) = [ for tp in tps do - for cx in tp.Constraints do + for cx in tp.Constraints do match cx with - | TyparConstraint.MayResolveMember(traitInfo, _) -> yield traitInfo + | TyparConstraint.MayResolveMember(traitInfo, _) -> traitInfo | _ -> () ] |> ListSet.setify (traitsAEquiv g TypeEquivEnv.Empty) |> List.sortBy (fun traitInfo -> traitInfo.MemberLogicalName, traitInfo.GetCompiledArgumentTypes().Length) @@ -8230,7 +8230,7 @@ let MakeArgsForTopArgs _g m argTysl tpenv = let AdjustValForExpectedArity g m (vref: ValRef) flags topValInfo = let tps, argTysl, retTy, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type m - let tpsR = copyTypars tps + let tpsR = copyTypars false tps let tyargsR = List.map mkTyparTy tpsR let tpenv = bindTypars tps tyargsR emptyTyparInst let rtyR = instType tpenv retTy diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 8805ae45b7f..b661bbf1b71 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -2372,7 +2372,7 @@ typeConstraint: { let tp = $1 SynTypeConstraint.WhereTyparSupportsMember([ SynType.Var(tp, tp.Range) ], $4, lhs parseState) } - | LPAREN typarAlts rparen COLON LPAREN classMemberSpfn rparen + | LPAREN typeAlts rparen COLON LPAREN classMemberSpfn rparen { SynTypeConstraint.WhereTyparSupportsMember(List.rev($2), $6, lhs parseState) } | typar COLON DELEGATE typeArgsNoHpaDeprecated @@ -2396,8 +2396,8 @@ typeConstraint: | appType { SynTypeConstraint.WhereSelfConstrained($1, lhs parseState) } -typarAlts: - | typarAlts OR appType +typeAlts: + | typeAlts OR appType { $3 :: $1 } | appType @@ -4557,7 +4557,7 @@ parenExpr: //arbExpr("parenExpr2", lhsm) } parenExprBody: - | staticallyKnownHeadTypars COLON LPAREN classMemberSpfn rparen typedSequentialExpr + | typars COLON LPAREN classMemberSpfn rparen typedSequentialExpr { (fun m -> SynExpr.TraitCall ($1, $4, $6, m)) } /* disambiguate: x $a.id(x) */ | typedSequentialExpr @@ -4566,19 +4566,19 @@ parenExprBody: | inlineAssemblyExpr { $1 } -staticallyKnownHeadTypars: - | staticallyKnownHeadTypar - { [$1] } +typars: + | typar + { [SynType.Var($1, rhs parseState 1)] } - | LPAREN staticallyKnownHeadTyparAlts rparen + | LPAREN typarAlts rparen { List.rev $2 } -staticallyKnownHeadTyparAlts: - | staticallyKnownHeadTyparAlts OR staticallyKnownHeadTypar +typarAlts: + | typarAlts OR appType {$3 :: $1} - | staticallyKnownHeadTypar - { [$1] } + | typar + { [SynType.Var($1, rhs parseState 1)] } braceExpr: | LBRACE braceExprBody rbrace @@ -5439,10 +5439,6 @@ typar: { let id = mkSynId (lhs parseState) ($2).idText SynTypar(id, TyparStaticReq.None, false) } - | staticallyKnownHeadTypar - { $1 } - -staticallyKnownHeadTypar: | INFIX_AT_HAT_OP ident { if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.tcUnexpectedSymbolInTypeExpression($1)); let id = mkSynId (lhs parseState) ($2).idText diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index c48c5fda0bb..af0e9dce7ad 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -872,6 +872,11 @@ Tento výraz implicitně převede typ {0} na typ {1}. Přečtěte si téma https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 5fcc67eaabf..ae08431d777 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -872,6 +872,11 @@ Dieser Ausdruck konvertiert den Typ "{0}" implizit in den Typ "{1}". Siehe https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 67d4915ad26..c815ba027e0 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -872,6 +872,11 @@ Esta expresión convierte implícitamente el tipo '{0}' al tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 5eca70dd6ed..bbce6965717 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -872,6 +872,11 @@ Cette expression convertit implicitement le type « {0} » en type « {1} ». Voir https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 1082f713ecb..b61186d2728 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -872,6 +872,11 @@ Questa espressione converte in modo implicito il tipo '{0}' nel tipo '{1}'. Vedere https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 608e414b0ca..c3576acf67b 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -872,6 +872,11 @@ この式は、型 '{0}' を型 '{1}' に暗黙的に変換します。https://aka.ms/fsharp-implicit-convs を参照してください。 + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 94a8c89f5de..d0546868ef9 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -872,6 +872,11 @@ 이 식은 암시적으로 '{0}' 형식을 '{1}' 형식으로 변환 합니다. https://aka.ms/fsharp-implicit-convs 참조 + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 9525465a9a7..b3620e62b27 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -872,6 +872,11 @@ To wyrażenie bezwzględnie konwertuje typ "{0}" na typ "{1}". Zobacz https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 362bf34c0de..25db1ae20a4 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -872,6 +872,11 @@ Essa expressão converte implicitamente o tipo '{0}' ao tipo '{1}'. Consulte https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index d5c8f7c6982..9f4f09645bd 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -872,6 +872,11 @@ Это выражение неявно преобразует тип "{0}" в тип "{1}". См. сведения на странице https://aka.ms/fsharp-implicit-convs. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 609e15ba191..474886216ac 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -872,6 +872,11 @@ Bu ifade '{0}' türünü örtülü olarak '{1}' türüne dönüştürür. https://aka.ms/fsharp-implicit-convs adresine bakın. + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index b9df8db475c..5c6f0c2c596 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -872,6 +872,11 @@ 此表达式将类型“{0}”隐式转换为类型“{1}”。请参阅 https://aka.ms/fsharp-implicit-convs。 + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 3ed39ea99bc..40529bcabfd 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -872,6 +872,11 @@ 此運算式將類型 '{0}' 隱含轉換為類型 '{1}'。請參閱 https://aka.ms/fsharp-implicit-convs。 + + The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. + + Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters. diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 96f502bb3de..b65eae4c085 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -303,3 +303,29 @@ let inline f_SRTP_GoToDefinition_FindAllReferences (x: 'T) = *) +module CheckStaticTyparInference = + + let inline f0 (x: ^T) = x + let g0 (x: 'T) = f0 x // ^T need not be static because it has no static constraint. Therefore this is ok to be properly generic + + let inline f1 (x: ^T) = (^T : (static member A: int) ()) + let inline f2 (x: 'T) = ((^T or int) : (static member A: int) ()) // will infer 'T to have a static req + let inline f3 (x: 'T) = ((^U or 'T) : (static member A: int) ()) // will infer 'T to have a static req + let inline f4 (x: 'T when 'T : (static member A: int) ) = 'T.A // will infer 'T to have a static req + + let inline f5 (x: ^T) = printfn "%d" x + let g5 (x: 'T) = f5 x // 'T should be inferred int + let inline h5 (x: 'T) = f5 x // 'T should be inferred static because it has a choice constraint + + + //val inline f0: x: ^T -> ^T + // val g0: x: 'T -> 'T + // val inline f1: x: ^T -> int when ^T: (static member A: int) + // val inline f2: x: ^T -> int when (^T or int) : (static member A: int) + // val inline f3: x: ^T -> int when (^U or ^T) : (static member A: int) + // val inline f4: x: ^T -> int when ^T: (static member A: int) +#if NEGATIVE +// this should fail compilation - the trait has multiple support types and can't be invoked using this syntax + let inline f5 (x: 'T when ('T or int) : (static member A: int) ) = 'T.A +#endif + \ No newline at end of file From 01f6ec4ba0a436888ab7f1932cb07d8ebc5bdddd Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 Jul 2022 21:29:44 +0100 Subject: [PATCH 46/91] clear static req for inference variables --- src/Compiler/FSComp.txt | 2 +- src/Compiler/xlf/FSComp.txt.cs.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.de.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.es.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.fr.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.it.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.ja.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.ko.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.pl.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.ru.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.tr.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 4 ++-- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 4 ++-- 14 files changed, 27 insertions(+), 27 deletions(-) diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index b9febdf4d96..43af1224a84 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1657,4 +1657,4 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3534,tcTraitInvocationShouldUseTick,"Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters." 3535,tcUsingInterfacesWithStaticAbstractMethods,"Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'." 3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." -3537,tcTraitHasMultipleSupportTypes,"The trait '%s' invoked by this call has multiple support types." \ No newline at end of file +3537,tcTraitHasMultipleSupportTypes,"The trait '%s' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance." \ No newline at end of file diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index af0e9dce7ad..bf9e7eb4826 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index ae08431d777..825d54c59e5 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index c815ba027e0..8c921347046 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index bbce6965717..ad554de29e0 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index b61186d2728..0fc0ee7933c 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index c3576acf67b..05c644d5835 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index d0546868ef9..32117962355 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index b3620e62b27..52f5b1312d6 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 25db1ae20a4..90329384257 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 9f4f09645bd..7e6cc8fd5f0 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 474886216ac..be31369400c 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 5c6f0c2c596..cd95408ff36 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 40529bcabfd..81f3267b3a7 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -873,8 +873,8 @@ - The trait '{0}' invoked by this call has multiple support types. - The trait '{0}' invoked by this call has multiple support types. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. + The trait '{0}' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance. From 9f9c49a5ffd8f595a16b113be50ec282a8489c4c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 6 Jul 2022 23:59:26 +0100 Subject: [PATCH 47/91] fix another case of generalization --- src/Compiler/Checking/CheckExpressions.fs | 21 +- src/Compiler/Checking/CheckExpressions.fsi | 6 +- src/Compiler/Checking/CheckFormatStrings.fs | 14 +- src/Compiler/Checking/ConstraintSolver.fs | 45 +++- src/Compiler/Checking/ConstraintSolver.fsi | 13 +- src/Compiler/Checking/InfoReader.fsi | 3 +- src/Compiler/TypedTree/TypedTreeBasics.fs | 9 +- src/Compiler/TypedTree/TypedTreeBasics.fsi | 2 +- tests/adhoc.fsx | 283 +++++++++++++++++++- 9 files changed, 350 insertions(+), 46 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 7308515c7ff..3f832e4ca33 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -718,7 +718,7 @@ type TcFileState = tcComputationExpression) = let infoReader = InfoReader(g, amap) - let instantiationGenerator m tpsorig = FreshenTypars m tpsorig + let instantiationGenerator m tpsorig = FreshenTypars g m tpsorig let nameResolver = NameResolver(g, amap, infoReader, instantiationGenerator) { g = g amap = amap @@ -750,8 +750,8 @@ type TcFileState = type cenv = TcFileState -let CopyAndFixupTypars m rigid tpsorig = - FreshenAndFixupTypars m rigid [] [] tpsorig +let CopyAndFixupTypars g m rigid tpsorig = + FreshenAndFixupTypars g m rigid [] [] tpsorig let UnifyTypes (cenv: cenv) (env: TcEnv) m actualTy expectedTy = let g = cenv.g @@ -1765,11 +1765,11 @@ let SetTyparRigid denv m (tp: Typar) = errorR(Error(FSComp.SR.tcTypeParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty), tp.Range)) tp.SetRigidity TyparRigidity.Rigid -let GeneralizeVal (cenv: cenv) denv enclosingDeclaredTypars generalizedTyparsForThisBinding - (PrelimVal1(id, explicitTyparInfo, ty, prelimValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, isCompGen)) = +let GeneralizeVal (cenv: cenv) denv enclosingDeclaredTypars generalizedTyparsForThisBinding prelimVal = let g = cenv.g + let (PrelimVal1(id, explicitTyparInfo, ty, prelimValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, isCompGen)) = prelimVal let (ExplicitTyparInfo(_rigidCopyOfDeclaredTypars, declaredTypars, _)) = explicitTyparInfo let m = id.idRange @@ -1997,7 +1997,8 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> let FreshenTyconRef (g: TcGlobals) m rigid (tcref: TyconRef) declaredTyconTypars = let origTypars = declaredTyconTypars - let freshTypars = copyTypars true origTypars + let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + let freshTypars = copyTypars clearStaticReq origTypars if rigid <> TyparRigidity.Rigid then for tp in freshTypars do tp.SetRigidity rigid @@ -2014,11 +2015,11 @@ let FreshenPossibleForallTy g m rigid ty = else // tps may be have been equated to other tps in equi-recursive type inference and units-of-measure type inference. Normalize them here let origTypars = NormalizeDeclaredTyparsForEquiRecursiveInference g origTypars - let tps, renaming, tinst = CopyAndFixupTypars m rigid origTypars + let tps, renaming, tinst = CopyAndFixupTypars g m rigid origTypars origTypars, tps, tinst, instType renaming tau let FreshenTyconRef2 (g: TcGlobals) m (tcref: TyconRef) = - let tps, renaming, tinst = FreshenTypeInst m (tcref.Typars m) + let tps, renaming, tinst = FreshenTypeInst g m (tcref.Typars m) tps, renaming, tinst, TType_app (tcref, tinst, g.knownWithoutNull) /// Given a abstract method, which may be a generic method, freshen the type in preparation @@ -2045,7 +2046,7 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = let ttps = absMethInfo.GetFormalTyparsOfDeclaringType m let ttinst = argsOfAppTy g absMethInfo.ApparentEnclosingType let rigid = if typarsFromAbsSlotAreRigid then TyparRigidity.Rigid else TyparRigidity.Flexible - FreshenAndFixupTypars m rigid ttps ttinst fmtps + FreshenAndFixupTypars g m rigid ttps ttinst fmtps // Work out the required type of the member let argTysFromAbsSlot = argTys |> List.mapSquared (instType typarInstFromAbsSlot) @@ -2424,7 +2425,7 @@ module GeneralizationHelpers = generalizedTypars |> List.iter (SetTyparRigid denv m) // Generalization removes constraints related to generalized type variables - EliminateConstraintsForGeneralizedTypars denv cenv.css m NoTrace generalizedTypars + AddCxTyparsGeneralized denv cenv.css m ContextInfo.NoContext NoTrace generalizedTypars generalizedTypars diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index c0950356397..3f6c282f83b 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -1088,7 +1088,7 @@ val TcType: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> - iwsam: WarnOnIWSAM -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> @@ -1101,7 +1101,7 @@ val TcTypeOrMeasureAndRecover: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> - iwsam: WarnOnIWSAM -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> @@ -1113,7 +1113,7 @@ val TcTypeAndRecover: newOk: ImplicitlyBoundTyparsAllowed -> checkConstraints: CheckConstraints -> occ: ItemOccurence -> - iwsam: WarnOnIWSAM -> + iwsam: WarnOnIWSAM -> env: TcEnv -> tpenv: UnscopedTyparEnv -> ty: SynType -> diff --git a/src/Compiler/Checking/CheckFormatStrings.fs b/src/Compiler/Checking/CheckFormatStrings.fs index fb4b4cec03a..615e40c18b6 100644 --- a/src/Compiler/Checking/CheckFormatStrings.fs +++ b/src/Compiler/Checking/CheckFormatStrings.fs @@ -16,25 +16,25 @@ open FSharp.Compiler.TcGlobals type FormatItem = Simple of TType | FuncAndVal -let copyAndFixupFormatTypar m tp = - let _,_,tinst = FreshenAndFixupTypars m TyparRigidity.Flexible [] [] [tp] +let copyAndFixupFormatTypar g m tp = + let _,_,tinst = FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] [tp] List.head tinst let lowestDefaultPriority = 0 (* See comment on TyparConstraint.DefaultsTo *) -let mkFlexibleFormatTypar m tys dflt = +let mkFlexibleFormatTypar g m tys dflt = let tp = Construct.NewTypar (TyparKind.Type, TyparRigidity.Rigid, SynTypar(mkSynId m "fmt",TyparStaticReq.HeadType,true),false,TyparDynamicReq.Yes,[],false,false) tp.SetConstraints [ TyparConstraint.SimpleChoice (tys,m); TyparConstraint.DefaultsTo (lowestDefaultPriority,dflt,m)] - copyAndFixupFormatTypar m tp + copyAndFixupFormatTypar g m tp let mkFlexibleIntFormatTypar (g: TcGlobals) m = - mkFlexibleFormatTypar m [ g.byte_ty; g.int16_ty; g.int32_ty; g.int64_ty; g.sbyte_ty; g.uint16_ty; g.uint32_ty; g.uint64_ty;g.nativeint_ty;g.unativeint_ty; ] g.int_ty + mkFlexibleFormatTypar g m [ g.byte_ty; g.int16_ty; g.int32_ty; g.int64_ty; g.sbyte_ty; g.uint16_ty; g.uint32_ty; g.uint64_ty;g.nativeint_ty;g.unativeint_ty; ] g.int_ty let mkFlexibleDecimalFormatTypar (g: TcGlobals) m = - mkFlexibleFormatTypar m [ g.decimal_ty ] g.decimal_ty + mkFlexibleFormatTypar g m [ g.decimal_ty ] g.decimal_ty let mkFlexibleFloatFormatTypar (g: TcGlobals) m = - mkFlexibleFormatTypar m [ g.float_ty; g.float32_ty; g.decimal_ty ] g.float_ty + mkFlexibleFormatTypar g m [ g.float_ty; g.float32_ty; g.decimal_ty ] g.float_ty type FormatInfoRegister = { mutable leftJustify : bool diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 75d9eeb38cd..bd1fedf1382 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -115,34 +115,37 @@ let NewByRefKindInferenceType (g: TcGlobals) m = let NewInferenceTypes g l = l |> List.map (fun _ -> NewInferenceType g) -let FreshenTypar rigid (tp: Typar) = - NewCompGenTypar (tp.Kind, rigid, TyparStaticReq.None, (if rigid=TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No), false) +let FreshenTypar (g: TcGlobals) rigid (tp: Typar) = + let clearStaticReq = g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers + let staticReq = if clearStaticReq then TyparStaticReq.None else tp.StaticReq + let dynamicReq = if rigid = TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No + NewCompGenTypar (tp.Kind, rigid, staticReq, dynamicReq, false) // QUERY: should 'rigid' ever really be 'true'? We set this when we know // we are going to have to generalize a typar, e.g. when implementing a // abstract generic method slot. But we later check the generalization // condition anyway, so we could get away with a non-rigid typar. This // would sort of be cleaner, though give errors later. -let FreshenAndFixupTypars m rigid fctps tinst tpsorig = - let tps = tpsorig |> List.map (FreshenTypar rigid) +let FreshenAndFixupTypars g m rigid fctps tinst tpsorig = + let tps = tpsorig |> List.map (FreshenTypar g rigid) let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps tps, renaming, tinst -let FreshenTypeInst m tpsorig = - FreshenAndFixupTypars m TyparRigidity.Flexible [] [] tpsorig +let FreshenTypeInst g m tpsorig = + FreshenAndFixupTypars g m TyparRigidity.Flexible [] [] tpsorig -let FreshMethInst m fctps tinst tpsorig = - FreshenAndFixupTypars m TyparRigidity.Flexible fctps tinst tpsorig +let FreshMethInst g m fctps tinst tpsorig = + FreshenAndFixupTypars g m TyparRigidity.Flexible fctps tinst tpsorig -let FreshenTypars m tpsorig = +let FreshenTypars g m tpsorig = match tpsorig with | [] -> [] | _ -> - let _, _, tptys = FreshenTypeInst m tpsorig + let _, _, tptys = FreshenTypeInst g m tpsorig tptys let FreshenMethInfo m (minfo: MethInfo) = - let _, _, tptys = FreshMethInst m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars + let _, _, tptys = FreshMethInst minfo.TcGlobals m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars tptys //------------------------------------------------------------------------- @@ -3397,7 +3400,23 @@ let UnifyUniqueOverloading ResultD false /// Remove the global constraints where these type variables appear in the support of the constraint -let EliminateConstraintsForGeneralizedTypars denv css m (trace: OptionalTrace) (generalizedTypars: Typars) = +let AddCxTyparsGeneralized (denv: DisplayEnv) css m ctxtInfo (trace: OptionalTrace) (generalizedTypars: Typars) = + let g = denv.g + let csenv = MakeConstraintSolverEnv ctxtInfo css m denv + trackErrors { + if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + for tp in generalizedTypars do + for cx in tp.Constraints do + match cx with + | TyparConstraint.MayResolveMember(traitInfo,_) -> + for supportTy in traitInfo.SupportTypes do + if isAnyParTy g supportTy then + do! SolveTypStaticReqTypar csenv NoTrace TyparStaticReq.HeadType (destAnyParTy g supportTy) + | TyparConstraint.SimpleChoice _ -> + do! SolveTypStaticReqTypar csenv NoTrace TyparStaticReq.HeadType tp + | _ -> () + } |> RaiseOperationResult + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv for tp in generalizedTypars do let tpn = tp.Stamp @@ -3627,7 +3646,7 @@ let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstrai let CodegenWitnessesForTyparInst tcVal g amap m typars tyargs = trackErrors { let css = CreateCodegenState tcVal g amap let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let ftps, _renaming, tinst = FreshenTypeInst m typars + let ftps, _renaming, tinst = FreshenTypeInst g m typars let traitInfos = GetTraitConstraintInfosOfTypars g ftps do! SolveTyparsEqualTypes csenv 0 m NoTrace tinst tyargs return GenWitnessArgs amap g m traitInfos diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index b9d3bba048f..3f4f4f87881 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -41,7 +41,7 @@ val NewInferenceTypes: TcGlobals -> 'T list -> TType list /// 2. the instantiation mapping old type parameters to inference variables /// 3. the inference type variables as a list of types. val FreshenAndFixupTypars: - m: range -> rigid: TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInstantiation * TType list + g: TcGlobals -> m: range -> rigid: TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInstantiation * TType list /// Given a set of type parameters, make new inference type variables for /// each and ensure that the constraints on the new type variables are adjusted. @@ -50,13 +50,13 @@ val FreshenAndFixupTypars: /// 1. the new type parameters /// 2. the instantiation mapping old type parameters to inference variables /// 3. the inference type variables as a list of types. -val FreshenTypeInst: range -> Typars -> Typars * TyparInstantiation * TType list +val FreshenTypeInst: g: TcGlobals -> range -> Typars -> Typars * TyparInstantiation * TType list /// Given a set of type parameters, make new inference type variables for /// each and ensure that the constraints on the new type variables are adjusted. /// /// Returns the inference type variables as a list of types. -val FreshenTypars: range -> Typars -> TType list +val FreshenTypars: g: TcGlobals -> range -> Typars -> TType list /// Given a method, which may be generic, make new inference type variables for /// its generic parameters, and ensure that the constraints the new type variables are adjusted. @@ -251,9 +251,10 @@ val UnifyUniqueOverloading: OverallTy -> OperationResult -/// Remove the global constraints where these type variables appear in the support of the constraint -val EliminateConstraintsForGeneralizedTypars: - DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> Typars -> unit +/// Note that the type parameters have ben generalized. Assess the staticness of the type parameters +/// and remove the global constraints where these type variables appear in the support of the constraint. +val AddCxTyparsGeneralized: + DisplayEnv -> ConstraintSolverState -> range -> ctxtInfo: ContextInfo -> OptionalTrace -> Typars -> unit val CheckDeclaredTypars: DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index 2360af102f7..01bc832740c 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -196,7 +196,8 @@ type InfoReader = member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list /// Determine if a type has a static abstract method with the given name somewhere in its hierarchy - member IsInterfaceTypeWithMatchingStaticAbstractMember: m: range -> nm: string -> ad: AccessorDomain -> ty: TType -> bool + member IsInterfaceTypeWithMatchingStaticAbstractMember: + m: range -> nm: string -> ad: AccessorDomain -> ty: TType -> bool val checkLanguageFeatureRuntimeAndRecover: infoReader: InfoReader -> langFeature: Features.LanguageFeature -> m: range -> unit diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index b8863eec764..fe8e52418f8 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -178,19 +178,20 @@ let mkTyparTy (tp: Typar) = | TyparKind.Type -> tp.AsType | TyparKind.Measure -> TType_measure (Measure.Var tp) -// We clear the StaticReq when copying because the requirement will be re-established through the +// For fresh type variables clear the StaticReq when copying because the requirement will be re-established through the // process of type inference. -let copyTypar isFresh (tp: Typar) = +let copyTypar clearStaticReq (tp: Typar) = let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs }) + let flags = if clearStaticReq then tp.typar_flags.WithStaticReq(TyparStaticReq.None) else tp.typar_flags Typar.New { typar_id = tp.typar_id - typar_flags = (if isFresh then tp.typar_flags.WithStaticReq(TyparStaticReq.None) else tp.typar_flags) + typar_flags = flags typar_stamp = newStamp() typar_solution = tp.typar_solution typar_astype = Unchecked.defaultof<_> // Be careful to clone the mutable optional data too typar_opt_data = optData } -let copyTypars isFresh tps = List.map (copyTypar isFresh) tps +let copyTypars clearStaticReq tps = List.map (copyTypar clearStaticReq) tps //-------------------------------------------------------------------------- // Inference variables diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fsi b/src/Compiler/TypedTree/TypedTreeBasics.fsi index 16b93a3026e..fad14a4e5d1 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fsi +++ b/src/Compiler/TypedTree/TypedTreeBasics.fsi @@ -118,7 +118,7 @@ val ccuOfTyconRef: eref: EntityRef -> CcuThunk option val mkTyparTy: tp: Typar -> TType -val copyTypars: isFresh: bool -> tps: Typar list -> Typar list +val copyTypars: clearStaticReq: bool -> tps: Typar list -> Typar list val tryShortcutSolvedUnitPar: canShortcut: bool -> r: Typar -> Measure diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index b65eae4c085..57fe9464f85 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -328,4 +328,285 @@ module CheckStaticTyparInference = // this should fail compilation - the trait has multiple support types and can't be invoked using this syntax let inline f5 (x: 'T when ('T or int) : (static member A: int) ) = 'T.A #endif - \ No newline at end of file + +// This is tested in the bootstrap of FSharp.Core +module ``Check generalized type variables have correct staticness`` = + open System + + let inline uint32 (value: ^T) = + (^T : (static member op_Explicit: ^T -> uint32) (value)) + + let inline uint value = uint32 value // the inferred signature of this should also be static-required + +module NullableOperators = + let (?>=) (x: Nullable<'T>) (y: 'T) = + x.HasValue && x.Value >= y + + let (?>) (x: Nullable<'T>) (y: 'T) = + x.HasValue && x.Value > y + + let (?<=) (x: Nullable<'T>) (y: 'T) = + x.HasValue && x.Value <= y + + let (?<) (x: Nullable<'T>) (y: 'T) = + x.HasValue && x.Value < y + + let (?=) (x: Nullable<'T>) (y: 'T) = + x.HasValue && x.Value = y + + let (?<>) (x: Nullable<'T>) (y: 'T) = + not (x ?= y) + + let (>=?) (x: 'T) (y: Nullable<'T>) = + y.HasValue && x >= y.Value + + let (>?) (x: 'T) (y: Nullable<'T>) = + y.HasValue && x > y.Value + + let (<=?) (x: 'T) (y: Nullable<'T>) = + y.HasValue && x <= y.Value + + let () = + y.HasValue && x < y.Value + + let (=?) (x: 'T) (y: Nullable<'T>) = + y.HasValue && x = y.Value + + let (<>?) (x: 'T) (y: Nullable<'T>) = + not (x =? y) + + let (?>=?) (x: Nullable<'T>) (y: Nullable<'T>) = + (x.HasValue && y.HasValue && x.Value >= y.Value) + + let (?>?) (x: Nullable<'T>) (y: Nullable<'T>) = + (x.HasValue && y.HasValue && x.Value > y.Value) + + let (?<=?) (x: Nullable<'T>) (y: Nullable<'T>) = + (x.HasValue && y.HasValue && x.Value <= y.Value) + + let (?) (y: Nullable<'T>) = + (x.HasValue && y.HasValue && x.Value < y.Value) + + let (?=?) (x: Nullable<'T>) (y: Nullable<'T>) = + (not x.HasValue && not y.HasValue) + || (x.HasValue && y.HasValue && x.Value = y.Value) + + let (?<>?) (x: Nullable<'T>) (y: Nullable<'T>) = + not (x ?=? y) + + let inline (?+) (x: Nullable<_>) y = + if x.HasValue then + Nullable(x.Value + y) + else + Nullable() + + let inline (+?) x (y: Nullable<_>) = + if y.HasValue then + Nullable(x + y.Value) + else + Nullable() + + let inline (?+?) (x: Nullable<_>) (y: Nullable<_>) = + if x.HasValue && y.HasValue then + Nullable(x.Value + y.Value) + else + Nullable() + + let inline (?-) (x: Nullable<_>) y = + if x.HasValue then + Nullable(x.Value - y) + else + Nullable() + + let inline (-?) x (y: Nullable<_>) = + if y.HasValue then + Nullable(x - y.Value) + else + Nullable() + + let inline (?-?) (x: Nullable<_>) (y: Nullable<_>) = + if x.HasValue && y.HasValue then + Nullable(x.Value - y.Value) + else + Nullable() + + let inline (?*) (x: Nullable<_>) y = + if x.HasValue then + Nullable(x.Value * y) + else + Nullable() + + let inline ( *? ) x (y: Nullable<_>) = + if y.HasValue then + Nullable(x * y.Value) + else + Nullable() + + let inline (?*?) (x: Nullable<_>) (y: Nullable<_>) = + if x.HasValue && y.HasValue then + Nullable(x.Value * y.Value) + else + Nullable() + + let inline (?%) (x: Nullable<_>) y = + if x.HasValue then + Nullable(x.Value % y) + else + Nullable() + + let inline (%?) x (y: Nullable<_>) = + if y.HasValue then + Nullable(x % y.Value) + else + Nullable() + + let inline (?%?) (x: Nullable<_>) (y: Nullable<_>) = + if x.HasValue && y.HasValue then + Nullable(x.Value % y.Value) + else + Nullable() + + let inline (?/) (x: Nullable<_>) y = + if x.HasValue then + Nullable(x.Value / y) + else + Nullable() + + let inline (/?) x (y: Nullable<_>) = + if y.HasValue then + Nullable(x / y.Value) + else + Nullable() + + let inline (?/?) (x: Nullable<_>) (y: Nullable<_>) = + if x.HasValue && y.HasValue then + Nullable(x.Value / y.Value) + else + Nullable() + +module Nullable = + let inline uint8 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.byte value.Value) + else + Nullable() + + let inline int8 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.sbyte value.Value) + else + Nullable() + + let inline byte (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.byte value.Value) + else + Nullable() + + let inline sbyte (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.sbyte value.Value) + else + Nullable() + + let inline int16 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.int16 value.Value) + else + Nullable() + + let inline uint16 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.uint16 value.Value) + else + Nullable() + + let inline int (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.int value.Value) + else + Nullable() + + let inline uint (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.uint value.Value) + else + Nullable() + + let inline enum (value: Nullable) = + if value.HasValue then + Nullable(Operators.enum value.Value) + else + Nullable() + + let inline int32 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.int32 value.Value) + else + Nullable() + + let inline uint32 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.uint32 value.Value) + else + Nullable() + + let inline int64 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.int64 value.Value) + else + Nullable() + + let inline uint64 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.uint64 value.Value) + else + Nullable() + + let inline float32 (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.float32 value.Value) + else + Nullable() + + let inline float (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.float value.Value) + else + Nullable() + + let inline single (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.float32 value.Value) + else + Nullable() + + let inline double (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.float value.Value) + else + Nullable() + + let inline nativeint (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.nativeint value.Value) + else + Nullable() + + let inline unativeint (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.unativeint value.Value) + else + Nullable() + + let inline decimal (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.decimal value.Value) + else + Nullable() + + let inline char (value: Nullable<_>) = + if value.HasValue then + Nullable(Operators.char value.Value) + else + Nullable() From d0544e4a1a5bee1a0462105afd9ce9c19b3a1092 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 00:21:03 +0100 Subject: [PATCH 48/91] fix build --- src/Compiler/Checking/ConstraintSolver.fs | 5 +++++ tests/adhoc.fsx | 13 +++++++++++++ 2 files changed, 18 insertions(+) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index bd1fedf1382..1a901a55dba 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1405,6 +1405,11 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | [ty], h :: _ -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) + // Trait calls are only supported on pseudo type (variables) + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then + for e in supportTys do + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType e + // SRTP constraints on rigid type parameters do not need to be solved let isRigid = supportTys |> List.forall (fun ty -> diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 57fe9464f85..077c07c07d0 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -610,3 +610,16 @@ module Nullable = Nullable(Operators.char value.Value) else Nullable() +open System.Collections.Generic + +module HashIdentity = + + let inline NonStructural<'T when 'T: equality and 'T: (static member (=): 'T * 'T -> bool)> = + { new IEqualityComparer<'T> with + member _.GetHashCode(x) = + NonStructuralComparison.hash x + + member _.Equals(x, y) = + NonStructuralComparison.(=) x y + } + From 8438abd085aba12ca9ae0278d93a41fdcadbf77f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 00:25:38 +0100 Subject: [PATCH 49/91] fix formatting --- src/Compiler/Checking/ConstraintSolver.fsi | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index 3f4f4f87881..50d55377466 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -41,7 +41,13 @@ val NewInferenceTypes: TcGlobals -> 'T list -> TType list /// 2. the instantiation mapping old type parameters to inference variables /// 3. the inference type variables as a list of types. val FreshenAndFixupTypars: - g: TcGlobals -> m: range -> rigid: TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInstantiation * TType list + g: TcGlobals -> + m: range -> + rigid: TyparRigidity -> + Typars -> + TType list -> + Typars -> + Typars * TyparInstantiation * TType list /// Given a set of type parameters, make new inference type variables for /// each and ensure that the constraints on the new type variables are adjusted. From aa5820a0108ac84dcdc2e7664fc2c2ae6ae2753f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 00:55:25 +0100 Subject: [PATCH 50/91] fix tests --- src/Compiler/Checking/MethodOverrides.fs | 5 ++--- src/Compiler/pars.fsy | 10 ++++++++-- .../Interop/StaticsInInterfaces.fs | 6 +++--- 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 5719225030c..06b2b67bd94 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -927,11 +927,10 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv /// at the member signature prior to type inference. This is used to pre-assign type information if it does let GetAbstractMethInfosForSynMethodDecl(infoReader: InfoReader, ad, memberName: Ident, bindm, typToSearchForAbstractMembers, valSynData, memberFlags: SynMemberFlags) = + let g = infoReader.g if not memberFlags.IsInstance && memberFlags.IsOverrideOrExplicitImpl then checkLanguageFeatureRuntimeAndRecover infoReader LanguageFeature.InterfacesWithAbstractStaticMembers bindm - checkLanguageFeatureAndRecover infoReader.g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm - if infoReader.g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then - warning(Error(FSComp.SR.tcUsingInterfacesWithStaticAbstractMethods(), bindm)) + checkLanguageFeatureAndRecover g.langVersion LanguageFeature.InterfacesWithAbstractStaticMembers bindm let minfos = match typToSearchForAbstractMembers with diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index b661bbf1b71..46f57ebe696 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -1874,12 +1874,18 @@ abstractMemberFlags: let mMember = rhs parseState 2 AbstractMemberFlags true (AbstractMemberSynMemberFlagsTrivia mAbstract mMember) } | STATIC ABSTRACT - { parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers (rhs2 parseState 1 2) + { let mWhole = rhs2 parseState 1 2 + parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers mWhole + if parseState.LexBuffer.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + warning(Error(FSComp.SR.tcUsingInterfacesWithStaticAbstractMethods(), mWhole)) let mStatic = rhs parseState 1 let mAbstract = rhs parseState 2 AbstractMemberFlags false (StaticAbstractSynMemberFlagsTrivia mStatic mAbstract) } | STATIC ABSTRACT MEMBER - { parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers (rhs2 parseState 1 2) + { let mWhole = rhs2 parseState 1 2 + parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers mWhole + if parseState.LexBuffer.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then + warning(Error(FSComp.SR.tcUsingInterfacesWithStaticAbstractMethods(), mWhole)) let mStatic = rhs parseState 1 let mAbstract = rhs parseState 2 let mMember = rhs parseState 3 diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 56303f360a2..e952fbf8ae1 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -326,7 +326,7 @@ let main _ = let fsharpSource = """ - +#nowarn "3535" type IAdditionOperator<'T> = static abstract op_Addition: 'T * 'T -> 'T @@ -352,7 +352,7 @@ let main _ = 0 let fsharpSource = """ - +#nowarn "3535" type IAdditionOperator<'T> = static abstract op_Addition: 'T * 'T -> 'T @@ -380,7 +380,7 @@ let main _ = 0 let outputFilePath = CompilerAssert.GenerateDllOutputPath() let fsharpSource = """ - +#nowarn "3535" [] do() From 87e1304f15bb8bfd5f5409d8ade81340db6f163c Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 01:17:22 +0100 Subject: [PATCH 51/91] fix tests --- .../FSharp.CompilerService.SurfaceArea.netstandard.expected | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected index 3fe27c995d6..8147a3f3257 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstandard.expected @@ -6724,8 +6724,8 @@ FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Syntax.SynMemberSig ge FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Syntax.SynMemberSig traitSig FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Text.Range get_range() FSharp.Compiler.Syntax.SynExpr+TraitCall: FSharp.Compiler.Text.Range range -FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar] get_supportTys() -FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar] supportTys +FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynType] get_supportTys() +FSharp.Compiler.Syntax.SynExpr+TraitCall: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynType] supportTys FSharp.Compiler.Syntax.SynExpr+TryFinally: FSharp.Compiler.Syntax.DebugPointAtFinally finallyDebugPoint FSharp.Compiler.Syntax.SynExpr+TryFinally: FSharp.Compiler.Syntax.DebugPointAtFinally get_finallyDebugPoint() FSharp.Compiler.Syntax.SynExpr+TryFinally: FSharp.Compiler.Syntax.DebugPointAtTry get_tryDebugPoint() @@ -7008,7 +7008,7 @@ FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewRecord(Microso FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSequential(FSharp.Compiler.Syntax.DebugPointAtSequential, Boolean, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSequentialOrImplicitYield(FSharp.Compiler.Syntax.DebugPointAtSequential, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewSet(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) -FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTraitCall(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynTypar], FSharp.Compiler.Syntax.SynMemberSig, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) +FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTraitCall(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynType], FSharp.Compiler.Syntax.SynMemberSig, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTypar(FSharp.Compiler.Syntax.SynTypar, FSharp.Compiler.Text.Range) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryFinally(FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Syntax.SynExpr, FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtFinally, FSharp.Compiler.SyntaxTrivia.SynExprTryFinallyTrivia) FSharp.Compiler.Syntax.SynExpr: FSharp.Compiler.Syntax.SynExpr NewTryWith(FSharp.Compiler.Syntax.SynExpr, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Syntax.SynMatchClause], FSharp.Compiler.Text.Range, FSharp.Compiler.Syntax.DebugPointAtTry, FSharp.Compiler.Syntax.DebugPointAtWith, FSharp.Compiler.SyntaxTrivia.SynExprTryWithTrivia) From 03f7bef9f00a94e058ea781301ff3f887243ef56 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 14:15:05 +0100 Subject: [PATCH 52/91] add tests and improve diagnostics --- VisualFSharp.sln | 8 +- src/Compiler/Checking/CheckExpressions.fs | 12 +- src/Compiler/Checking/ConstraintSolver.fs | 34 +-- src/Compiler/Checking/ConstraintSolver.fsi | 10 +- src/Compiler/FSComp.txt | 4 +- src/Compiler/Service/FSharpCheckerResults.fs | 90 ++++---- .../Service/FSharpParseFileResults.fs | 2 +- src/Compiler/Service/ServiceParsedInputOps.fs | 2 +- .../Service/ServiceParsedInputOps.fsi | 2 +- src/Compiler/Symbols/Exprs.fs | 33 ++- src/Compiler/pars.fsy | 4 + src/Compiler/xlf/FSComp.txt.cs.xlf | 8 +- src/Compiler/xlf/FSComp.txt.de.xlf | 8 +- src/Compiler/xlf/FSComp.txt.es.xlf | 8 +- src/Compiler/xlf/FSComp.txt.fr.xlf | 8 +- src/Compiler/xlf/FSComp.txt.it.xlf | 8 +- src/Compiler/xlf/FSComp.txt.ja.xlf | 8 +- src/Compiler/xlf/FSComp.txt.ko.xlf | 8 +- src/Compiler/xlf/FSComp.txt.pl.xlf | 8 +- src/Compiler/xlf/FSComp.txt.pt-BR.xlf | 8 +- src/Compiler/xlf/FSComp.txt.ru.xlf | 8 +- src/Compiler/xlf/FSComp.txt.tr.xlf | 8 +- src/Compiler/xlf/FSComp.txt.zh-Hans.xlf | 8 +- src/Compiler/xlf/FSComp.txt.zh-Hant.xlf | 8 +- tests/adhoc.fsx | 4 + tests/service/EditorTests.fs | 1 + vsintegration/tests/Directory.Build.props | 10 - .../UnitTests/BraceMatchingServiceTests.fs | 2 +- .../UnitTests/BreakpointResolutionService.fs | 4 +- .../UnitTests/CompletionProviderTests.fs | 53 +++-- .../DocumentDiagnosticAnalyzerTests.fs | 4 +- .../DocumentHighlightsServiceTests.fs | 4 +- .../UnitTests/EditorFormattingServiceTests.fs | 2 +- .../UnitTests/FsxCompletionProviderTests.fs | 7 +- .../UnitTests/GoToDefinitionServiceTests.fs | 35 ++-- .../UnitTests/HelpContextServiceTests.fs | 198 +++++++++--------- .../UnitTests/IndentationServiceTests.fs | 2 +- .../LanguageDebugInfoServiceTests.fs | 2 +- .../Tests.ProjectSystem.References.fs | 71 ++++--- .../tests/UnitTests/ProjectOptionsBuilder.fs | 2 +- .../tests/UnitTests/QuickInfoProviderTests.fs | 6 +- .../tests/UnitTests/QuickInfoTests.fs | 6 +- .../tests/UnitTests/RoslynSourceTextTests.fs | 2 +- .../SemanticColorizationServiceTests.fs | 4 +- .../UnitTests/SignatureHelpProviderTests.fs | 12 +- .../SyntacticColorizationServiceTests.fs | 2 +- .../tests/UnitTests/Tests.RoslynHelpers.fs | 9 +- .../UnitTests/VisualFSharp.UnitTests.fsproj | 43 ++-- .../UnitTests/Workspace/WorkspaceTests.fs | 2 +- 49 files changed, 430 insertions(+), 362 deletions(-) delete mode 100644 vsintegration/tests/Directory.Build.props diff --git a/VisualFSharp.sln b/VisualFSharp.sln index c99c08c29c5..7e4b4a06544 100644 --- a/VisualFSharp.sln +++ b/VisualFSharp.sln @@ -84,6 +84,12 @@ EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Test.Utilities", "tests\FSharp.Test.Utilities\FSharp.Test.Utilities.fsproj", "{60D275B0-B14A-41CB-A1B2-E815A7448FCB}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharpSuite.Tests", "tests\fsharp\FSharpSuite.Tests.fsproj", "{C163E892-5BF7-4B59-AA99-B0E8079C67C4}" + ProjectSection(ProjectDependencies) = postProject + {37EB3E54-ABC6-4CF5-8273-7CE4B61A42C1} = {37EB3E54-ABC6-4CF5-8273-7CE4B61A42C1} + {511C95D9-3BA6-451F-B6F8-F033F40878A5} = {511C95D9-3BA6-451F-B6F8-F033F40878A5} + {597D9896-4B90-4E9E-9C99-445C2CB9FF60} = {597D9896-4B90-4E9E-9C99-445C2CB9FF60} + {E54456F4-D51A-4334-B225-92EBBED92B40} = {E54456F4-D51A-4334-B225-92EBBED92B40} + EndProjectSection EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.UnitTests", "tests\FSharp.Compiler.UnitTests\FSharp.Compiler.UnitTests.fsproj", "{A8D9641A-9170-4CF4-8FE0-6DB8C134E1B5}" EndProject @@ -149,8 +155,8 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service", " EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Service.Tests", "tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj", "{14F3D3D6-5C8E-43C2-98A2-17EA704D4DEA}" ProjectSection(ProjectDependencies) = postProject - {FF76BD3C-5E0A-4752-B6C3-044F6E15719B} = {FF76BD3C-5E0A-4752-B6C3-044F6E15719B} {887630A3-4B1D-40EA-B8B3-2D842E9C40DB} = {887630A3-4B1D-40EA-B8B3-2D842E9C40DB} + {FF76BD3C-5E0A-4752-B6C3-044F6E15719B} = {FF76BD3C-5E0A-4752-B6C3-044F6E15719B} EndProjectSection EndProject Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "VisualFSharpDebug", "vsintegration\Vsix\VisualFSharpFull\VisualFSharpDebug.csproj", "{A422D673-8E3B-4924-821B-DD3174173426}" diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 3f832e4ca33..544914f4a2c 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1798,8 +1798,10 @@ let GeneralizeVal (cenv: cenv) denv enclosingDeclaredTypars generalizedTyparsFor warning(Error(FSComp.SR.tcTypeParametersInferredAreNotStable(), m)) let hasDeclaredTypars = not (isNil declaredTypars) + // This is just about the only place we form a GeneralizedType let tyScheme = GeneralizedType(generalizedTypars, ty) + PrelimVal2(id, tyScheme, prelimValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, isCompGen, hasDeclaredTypars) let GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars types = @@ -2403,6 +2405,10 @@ module GeneralizationHelpers = then (ListSet.unionFavourLeft typarEq allDeclaredTypars maxInferredTypars) else allDeclaredTypars + // Update the StaticReq of type variables prior to assessing generalization + for typar in typarsToAttemptToGeneralize do + UpdateStaticReqOfTypar denv cenv.css m NoTrace typar + let generalizedTypars, freeInEnv = TrimUngeneralizableTypars genConstrainedTyparFlag inlineFlag typarsToAttemptToGeneralize freeInEnv @@ -2425,7 +2431,7 @@ module GeneralizationHelpers = generalizedTypars |> List.iter (SetTyparRigid denv m) // Generalization removes constraints related to generalized type variables - AddCxTyparsGeneralized denv cenv.css m ContextInfo.NoContext NoTrace generalizedTypars + EliminateConstraintsForGeneralizedTypars denv cenv.css m NoTrace generalizedTypars generalizedTypars @@ -4620,9 +4626,10 @@ and CheckIWSAM (cenv: cenv) (env: TcEnv) checkConstraints iwsam m tcref = let ad = env.eAccessRights let ty = generalizedTyconRef g tcref if iwsam = WarnOnIWSAM.Yes && isInterfaceTy g ty && checkConstraints = CheckCxs then + let tcref = tcrefOfAppTy g ty let meths = AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides m ty if meths |> List.exists (fun meth -> not meth.IsInstance && meth.IsDispatchSlot) then - warning(Error(FSComp.SR.tcUsingInterfaceWithStaticAbstractMethodAsType(), m)) + warning(Error(FSComp.SR.tcUsingInterfaceWithStaticAbstractMethodAsType(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m)) and TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId = let (SynLongIdent(tc, _, _)) = synLongId @@ -6403,6 +6410,7 @@ and TcTyparExprThen cenv overallTy env tpenv synTypar m delayed = match rest with | [] -> delayed2 | _ -> DelayedDotLookup (rest, m2) :: delayed2 + CallNameResolutionSink cenv.tcSink (ident.idRange, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.AccessRights) TcItemThen cenv overallTy env tpenv ([], item, mExprAndLongId, [], AfterResolution.DoNothing) (Some ty) delayed3 //TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed item mItem rest afterResolution | _ -> diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 1a901a55dba..c9fc5e8ef3b 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -699,7 +699,12 @@ let SubstMeasure (r: Typar) ms = let rec TransactStaticReq (csenv: ConstraintSolverEnv) (trace: OptionalTrace) (tpr: Typar) req = let m = csenv.m - if tpr.Rigidity.ErrorIfUnified && tpr.StaticReq <> req then + let g = csenv.g + + // Prior to feature InterfacesWithAbstractStaticMembers the StaticReq must match the + // declared StaticReq. With feature InterfacesWithAbstractStaticMembers it is inferred + // from the finalized constraints on the type variable. + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) && tpr.Rigidity.ErrorIfUnified && tpr.StaticReq <> req then ErrorD(ConstraintSolverError(FSComp.SR.csTypeCannotBeResolvedAtCompileTime(tpr.Name), m, m)) else let orig = tpr.StaticReq @@ -3404,25 +3409,26 @@ let UnifyUniqueOverloading | _ -> ResultD false -/// Remove the global constraints where these type variables appear in the support of the constraint -let AddCxTyparsGeneralized (denv: DisplayEnv) css m ctxtInfo (trace: OptionalTrace) (generalizedTypars: Typars) = +/// Re-assess the staticness of the type parameters. Necessary prior to assessing generalization. +let UpdateStaticReqOfTypar (denv: DisplayEnv) css m (trace: OptionalTrace) (typar: Typar) = let g = denv.g - let csenv = MakeConstraintSolverEnv ctxtInfo css m denv + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv trackErrors { if g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers then - for tp in generalizedTypars do - for cx in tp.Constraints do - match cx with - | TyparConstraint.MayResolveMember(traitInfo,_) -> - for supportTy in traitInfo.SupportTypes do - if isAnyParTy g supportTy then - do! SolveTypStaticReqTypar csenv NoTrace TyparStaticReq.HeadType (destAnyParTy g supportTy) - | TyparConstraint.SimpleChoice _ -> - do! SolveTypStaticReqTypar csenv NoTrace TyparStaticReq.HeadType tp - | _ -> () + for cx in typar.Constraints do + match cx with + | TyparConstraint.MayResolveMember(traitInfo,_) -> + for supportTy in traitInfo.SupportTypes do + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType supportTy + | TyparConstraint.SimpleChoice _ -> + do! SolveTypStaticReqTypar csenv trace TyparStaticReq.HeadType typar + | _ -> () } |> RaiseOperationResult +/// Remove the global constraints related to generalized type variables +let EliminateConstraintsForGeneralizedTypars (denv: DisplayEnv) css m (trace: OptionalTrace) (generalizedTypars: Typars) = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + for tp in generalizedTypars do let tpn = tp.Stamp let cxst = csenv.SolverState.ExtraCxs diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index 50d55377466..c45db538fc2 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -257,10 +257,12 @@ val UnifyUniqueOverloading: OverallTy -> OperationResult -/// Note that the type parameters have ben generalized. Assess the staticness of the type parameters -/// and remove the global constraints where these type variables appear in the support of the constraint. -val AddCxTyparsGeneralized: - DisplayEnv -> ConstraintSolverState -> range -> ctxtInfo: ContextInfo -> OptionalTrace -> Typars -> unit +/// Re-assess the staticness of the type parameters +val UpdateStaticReqOfTypar: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> Typar -> unit + +/// Remove the global constraints related to generalized type variables +val EliminateConstraintsForGeneralizedTypars: + DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> Typars -> unit val CheckDeclaredTypars: DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index 43af1224a84..36a1bff0b5b 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1653,8 +1653,8 @@ reprStateMachineInvalidForm,"The state machine has an unexpected form" 3530,tcTraitIsStatic,"Trait '%s' is static" 3531,tcTraitIsNotStatic,"Trait '%s' is not static" 3532,tcTraitMayNotUseComplexThings,"A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" -3533,tcInvalidSelfConstraint,"Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax." +3533,tcInvalidSelfConstraint,"Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints." 3534,tcTraitInvocationShouldUseTick,"Invocation of a static constraint should use \"'T.Ident\" and not \"^T.Ident\", even for statically resolved type parameters." 3535,tcUsingInterfacesWithStaticAbstractMethods,"Declaring \"interfaces with static abstract methods\" is an advanced feature. See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3535\"' or '--nowarn:3535'." -3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." +3536,tcUsingInterfaceWithStaticAbstractMethodAsType,"'%s' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'." 3537,tcTraitHasMultipleSupportTypes,"The trait '%s' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance." \ No newline at end of file diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 1ba70f26a65..8a521b357dc 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -462,6 +462,8 @@ type internal TypeCheckInfo match cnrs, membersByResidue with + // Exact resolution via SomeType.$ or SomeType.$ + // // If we're looking for members using a residue, we'd expect only // a single item (pick the first one) and we need the residue (which may be "") | CNR (Item.Types (_, ty :: _), _, denv, nenv, ad, m) :: _, Some _ -> @@ -472,6 +474,15 @@ type internal TypeCheckInfo let items = List.map ItemWithNoInst items ReturnItemsOfType items g denv m filterCtors + // Exact resolution via 'T.$ + | CNR (Item.TypeVar (_, tp), _, denv, nenv, ad, m) :: _, Some _ -> + let targets = + ResolveCompletionTargets.All(ConstraintSolver.IsApplicableMethApprox g amap m) + + let items = ResolveCompletionsInType ncenv nenv targets m ad true (mkTyparTy tp) + let items = List.map ItemWithNoInst items + ReturnItemsOfType items g denv m filterCtors + // Value reference from the name resolution. Primarily to disallow "let x.$ = 1" // In most of the cases, value references can be obtained from expression typings or from environment, // so we wouldn't have to handle values here. However, if we have something like: @@ -720,27 +731,21 @@ type internal TypeCheckInfo let items = items |> RemoveExplicitlySuppressed g items, nenv.DisplayEnv, m - /// Resolve a location and/or text to items. - // Three techniques are used - // - look for an exact known name resolution from type checking - // - use the known type of an expression, e.g. (expr).Name, to generate an item list - // - lookup an entire name in the name resolution environment, e.g. A.B.Name, to generate an item list - // - // The overall aim is to resolve as accurately as possible based on what we know from type inference - - let GetBaseClassCandidates = - function + /// Is the item suitable for completion at "inherits $" + let IsInheritsCompletionCandidate item = + match item with | Item.ModuleOrNamespaces _ -> true - | Item.Types (_, ty :: _) when (isClassTy g ty) && not (isSealedTy g ty) -> true + | Item.Types (_, ty :: _) when isClassTy g ty && not (isSealedTy g ty) -> true | _ -> false - let GetInterfaceCandidates = - function + /// Is the item suitable for completion at "interface $" + let IsInterfaceCompletionCandidate item = + match item with | Item.ModuleOrNamespaces _ -> true - | Item.Types (_, ty :: _) when (isInterfaceTy g ty) -> true + | Item.Types (_, ty :: _) when isInterfaceTy g ty -> true | _ -> false - // Return only items with the specified name + /// Return only items with the specified name, modulo "Attribute" for type completions let FilterDeclItemsByResidue (getItem: 'a -> Item) residue (items: 'a list) = let attributedResidue = residue + "Attribute" @@ -769,7 +774,7 @@ type internal TypeCheckInfo /// Post-filter items to make sure they have precisely the right name /// This also checks that there are some remaining results /// exactMatchResidueOpt = Some _ -- means that we are looking for exact matches - let FilterRelevantItemsBy (getItem: 'a -> Item) (exactMatchResidueOpt: _ option) check (items: 'a list, denv, m) = + let FilterRelevantItemsBy (getItem: 'a -> Item) (exactMatchResidueOpt: string option) check (items: 'a list, denv, m) = // can throw if type is in located in non-resolved CCU: i.e. bigint if reference to System.Numerics is absent let inline safeCheck item = try @@ -812,6 +817,7 @@ type internal TypeCheckInfo if p >= 0 then Some p else None + /// Build a CompetionItem let CompletionItem (ty: ValueOption) (assemblySymbol: ValueOption) (item: ItemWithInst) = let kind = match item.Item with @@ -1138,19 +1144,19 @@ type internal TypeCheckInfo // Completion at 'inherit C(...)" | Some (CompletionContext.Inherit (InheritanceContext.Class, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) - |> FilterRelevantItemsBy getItem None (getItem >> GetBaseClassCandidates) + |> FilterRelevantItemsBy getItem None (getItem >> IsInheritsCompletionCandidate) |> Option.map toCompletionItems // Completion at 'interface ..." | Some (CompletionContext.Inherit (InheritanceContext.Interface, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) - |> FilterRelevantItemsBy getItem None (getItem >> GetInterfaceCandidates) + |> FilterRelevantItemsBy getItem None (getItem >> IsInterfaceCompletionCandidate) |> Option.map toCompletionItems // Completion at 'implement ..." | Some (CompletionContext.Inherit (InheritanceContext.Unknown, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) - |> FilterRelevantItemsBy getItem None (getItem >> (fun t -> GetBaseClassCandidates t || GetInterfaceCandidates t)) + |> FilterRelevantItemsBy getItem None (getItem >> (fun t -> IsInheritsCompletionCandidate t || IsInterfaceCompletionCandidate t)) |> Option.map toCompletionItems // Completion at ' { XXX = ... } " @@ -1400,6 +1406,7 @@ type internal TypeCheckInfo /// Return 'false' if this is not a completion item valid in an interface file. let IsValidSignatureFileItem item = match item with + | Item.TypeVar _ | Item.Types _ | Item.ModuleOrNamespaces _ -> true | _ -> false @@ -1429,7 +1436,7 @@ type internal TypeCheckInfo /// Get the auto-complete items at a location member _.GetDeclarations(parseResultsOpt, line, lineStr, partialName, completionContextAtPos, getAllEntities) = - let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName + let isSigFile = SourceFileImpl.IsSignatureFile mainInputFileName DiagnosticsScope.Protect range0 @@ -1454,7 +1461,7 @@ type internal TypeCheckInfo | None -> DeclarationListInfo.Empty | Some (items, denv, ctx, m) -> let items = - if isInterfaceFile then + if isSigFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items @@ -1486,7 +1493,7 @@ type internal TypeCheckInfo /// Get the symbols for auto-complete items at a location member _.GetDeclarationListSymbols(parseResultsOpt, line, lineStr, partialName, getAllEntities) = - let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName + let isSigFile = SourceFileImpl.IsSignatureFile mainInputFileName DiagnosticsScope.Protect range0 @@ -1511,7 +1518,7 @@ type internal TypeCheckInfo | None -> List.Empty | Some (items, denv, _, m) -> let items = - if isInterfaceFile then + if isSigFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items @@ -1527,10 +1534,10 @@ type internal TypeCheckInfo |> List.sortBy (fun d -> let n = match d.Item with - | Item.Types (_, TType_app (tcref, _, _) :: _) -> 1 + tcref.TyparsNoRange.Length + | Item.Types (_, AbbrevOrAppTy tcref :: _) -> 1 + tcref.TyparsNoRange.Length // Put delegate ctors after types, sorted by #typars. RemoveDuplicateItems will remove FakeInterfaceCtor and DelegateCtor if an earlier type is also reported with this name - | Item.FakeInterfaceCtor (TType_app (tcref, _, _)) - | Item.DelegateCtor (TType_app (tcref, _, _)) -> 1000 + tcref.TyparsNoRange.Length + | Item.FakeInterfaceCtor (AbbrevOrAppTy tcref) + | Item.DelegateCtor (AbbrevOrAppTy tcref) -> 1000 + tcref.TyparsNoRange.Length // Put type ctors after types, sorted by #typars. RemoveDuplicateItems will remove DefaultStructCtors if a type is also reported with this name | Item.CtorGroup (_, cinfo :: _) -> 1000 + 10 * cinfo.DeclaringTyconRef.TyparsNoRange.Length | _ -> 0 @@ -1546,11 +1553,11 @@ type internal TypeCheckInfo items |> List.groupBy (fun d -> match d.Item with - | Item.Types (_, TType_app (tcref, _, _) :: _) + | Item.Types (_, AbbrevOrAppTy tcref :: _) | Item.ExnCase tcref -> tcref.LogicalName | Item.UnqualifiedType (tcref :: _) - | Item.FakeInterfaceCtor (TType_app (tcref, _, _)) - | Item.DelegateCtor (TType_app (tcref, _, _)) -> tcref.CompiledName + | Item.FakeInterfaceCtor (AbbrevOrAppTy tcref) + | Item.DelegateCtor (AbbrevOrAppTy tcref) -> tcref.CompiledName | Item.CtorGroup (_, cinfo :: _) -> cinfo.ApparentEnclosingTyconRef.CompiledName | _ -> d.Item.DisplayName) @@ -1736,22 +1743,21 @@ type internal TypeCheckInfo | [] -> None | [ item ] -> GetF1Keyword g item.Item | _ -> - // handle new Type() + // For "new Type()" it seems from the code below that multiple items are returned. + // It combine the information from these items preferring a constructor if present. let allTypes, constr, ty = - List.fold - (fun (allTypes, constr, ty) (item: CompletionItem) -> - match item.Item, constr, ty with - | Item.Types _ as t, _, None -> allTypes, constr, Some t - | Item.Types _, _, _ -> allTypes, constr, ty - | Item.CtorGroup _, None, _ -> allTypes, Some item.Item, ty - | _ -> false, None, None) - (true, None, None) - items + ((true, None, None), items) + ||> List.fold (fun (allTypes, constr, ty) (item: CompletionItem) -> + match item.Item, constr, ty with + | Item.Types _ as t, _, None -> allTypes, constr, Some t + | Item.Types _, _, _ -> allTypes, constr, ty + | Item.CtorGroup _, None, _ -> allTypes, Some item.Item, ty + | _ -> false, None, None) match allTypes, constr, ty with - | true, Some (Item.CtorGroup _ as item), _ -> GetF1Keyword g item - | true, _, Some ty -> GetF1Keyword g ty - | _ -> None) + | true, Some item, _ -> GetF1Keyword g item + | true, _, Some item -> GetF1Keyword g item + | _ -> GetF1Keyword g items.Head.Item) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetF1Keyword: '%s'" msg) None) diff --git a/src/Compiler/Service/FSharpParseFileResults.fs b/src/Compiler/Service/FSharpParseFileResults.fs index 3b32b42ed98..324087f32f9 100644 --- a/src/Compiler/Service/FSharpParseFileResults.fs +++ b/src/Compiler/Service/FSharpParseFileResults.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Range module SourceFileImpl = - let IsInterfaceFile file = + let IsSignatureFile file = let ext = Path.GetExtension file 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) diff --git a/src/Compiler/Service/ServiceParsedInputOps.fs b/src/Compiler/Service/ServiceParsedInputOps.fs index 6d117ac7c47..eafb20c0baa 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fs +++ b/src/Compiler/Service/ServiceParsedInputOps.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range module SourceFileImpl = - let IsInterfaceFile file = + let IsSignatureFile file = let ext = Path.GetExtension file 0 = String.Compare(".fsi", ext, StringComparison.OrdinalIgnoreCase) diff --git a/src/Compiler/Service/ServiceParsedInputOps.fsi b/src/Compiler/Service/ServiceParsedInputOps.fsi index 07a1ac56fe6..d1f78613db7 100644 --- a/src/Compiler/Service/ServiceParsedInputOps.fsi +++ b/src/Compiler/Service/ServiceParsedInputOps.fsi @@ -157,6 +157,6 @@ module public ParsedInput = // implementation details used by other code in the compiler module internal SourceFileImpl = - val IsInterfaceFile: string -> bool + val IsSignatureFile: string -> bool val GetImplicitConditionalDefinesForEditing: isInteractive: bool -> string list diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index f508d7267da..e007843b840 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -307,22 +307,19 @@ module FSharpExprConvert = let (|TTypeConvOp|_|) (cenv: SymbolEnv) ty = let g = cenv.g match ty with - | TType_app (tcref, _, _) -> - match tcref with - | _ when tyconRefEq g tcref g.sbyte_tcr -> Some mkCallToSByteOperator - | _ when tyconRefEq g tcref g.byte_tcr -> Some mkCallToByteOperator - | _ when tyconRefEq g tcref g.int16_tcr -> Some mkCallToInt16Operator - | _ when tyconRefEq g tcref g.uint16_tcr -> Some mkCallToUInt16Operator - | _ when tyconRefEq g tcref g.int_tcr -> Some mkCallToIntOperator - | _ when tyconRefEq g tcref g.int32_tcr -> Some mkCallToInt32Operator - | _ when tyconRefEq g tcref g.uint32_tcr -> Some mkCallToUInt32Operator - | _ when tyconRefEq g tcref g.int64_tcr -> Some mkCallToInt64Operator - | _ when tyconRefEq g tcref g.uint64_tcr -> Some mkCallToUInt64Operator - | _ when tyconRefEq g tcref g.float32_tcr -> Some mkCallToSingleOperator - | _ when tyconRefEq g tcref g.float_tcr -> Some mkCallToDoubleOperator - | _ when tyconRefEq g tcref g.nativeint_tcr -> Some mkCallToIntPtrOperator - | _ when tyconRefEq g tcref g.unativeint_tcr -> Some mkCallToUIntPtrOperator - | _ -> None + | _ when typeEquiv g ty g.sbyte_ty -> Some mkCallToSByteOperator + | _ when typeEquiv g ty g.byte_ty -> Some mkCallToByteOperator + | _ when typeEquiv g ty g.int16_ty -> Some mkCallToInt16Operator + | _ when typeEquiv g ty g.uint16_ty -> Some mkCallToUInt16Operator + | _ when typeEquiv g ty g.int_ty -> Some mkCallToIntOperator + | _ when typeEquiv g ty g.int32_ty -> Some mkCallToInt32Operator + | _ when typeEquiv g ty g.uint32_ty -> Some mkCallToUInt32Operator + | _ when typeEquiv g ty g.int64_ty -> Some mkCallToInt64Operator + | _ when typeEquiv g ty g.uint64_ty -> Some mkCallToUInt64Operator + | _ when typeEquiv g ty g.float32_ty -> Some mkCallToSingleOperator + | _ when typeEquiv g ty g.float_ty -> Some mkCallToDoubleOperator + | _ when typeEquiv g ty g.nativeint_ty -> Some mkCallToIntPtrOperator + | _ when typeEquiv g ty g.unativeint_ty -> Some mkCallToUIntPtrOperator | _ -> None let ConvType cenv ty = FSharpType(cenv, ty) @@ -793,10 +790,10 @@ module FSharpExprConvert = let op2 = convertOp2 g m ty2 op1 ConvExprPrim cenv env op2 - | TOp.ILAsm ([ ILConvertOp convertOp ], [TType_app (tcref, _, _)]), _, [arg] -> + | TOp.ILAsm ([ ILConvertOp convertOp ], [ty2]), _, [arg] -> let ty = tyOfExpr g arg let op = - if tyconRefEq g tcref g.char_tcr then + if typeEquiv g ty2 g.char_ty then mkCallToCharOperator g m ty arg else convertOp g m ty arg ConvExprPrim cenv env op diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 46f57ebe696..23bd6412daf 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -1829,6 +1829,7 @@ classDefnMemberGetSet: classDefnMemberGetSetElements: | classDefnMemberGetSetElement { [$1], None } + | classDefnMemberGetSetElement AND classDefnMemberGetSetElement { let mAnd = rhs parseState 2 [$1;$3], Some mAnd } @@ -1869,10 +1870,12 @@ abstractMemberFlags: | ABSTRACT { let mAbstract = rhs parseState 1 AbstractMemberFlags true (AbstractSynMemberFlagsTrivia mAbstract) } + | ABSTRACT MEMBER { let mAbstract = rhs parseState 1 let mMember = rhs parseState 2 AbstractMemberFlags true (AbstractMemberSynMemberFlagsTrivia mAbstract mMember) } + | STATIC ABSTRACT { let mWhole = rhs2 parseState 1 2 parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers mWhole @@ -1881,6 +1884,7 @@ abstractMemberFlags: let mStatic = rhs parseState 1 let mAbstract = rhs parseState 2 AbstractMemberFlags false (StaticAbstractSynMemberFlagsTrivia mStatic mAbstract) } + | STATIC ABSTRACT MEMBER { let mWhole = rhs2 parseState 1 2 parseState.LexBuffer.CheckLanguageFeatureAndRecover LanguageFeature.InterfacesWithAbstractStaticMembers mWhole diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index bf9e7eb4826..174ee3e82c0 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 825d54c59e5..6d09ec2c91d 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 8c921347046..8a5e6c342bf 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index ad554de29e0..fd676240484 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 0fc0ee7933c..bbfb21360dd 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index 05c644d5835..954a9fd4a42 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index 32117962355..062ebe9c64a 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index 52f5b1312d6..ebdcb3efeb0 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 90329384257..06a8a5c801e 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index 7e6cc8fd5f0..a85392c5b44 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index be31369400c..e883b87f7d6 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index cd95408ff36..99060787490 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 81f3267b3a7..392b8f2909f 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -743,8 +743,8 @@ - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. - Invalid constraint. Consider using \"'T :> ISomeInterface\" for interface constraints, and \"WithConstraints<'T>\" for type abbreviations that add constraints. See https://aka.ms/fsharp-type-constraint-syntax. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. + Invalid constraint. Valid constraint forms include \"'T :> ISomeInterface\" for interface constraints and \"SomeConstrainingType<'T>\" for self-constraints. See https://aka.ms/fsharp-type-constraints. @@ -903,8 +903,8 @@ - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. - This type is an interface with a static abstract method. These are normally used as type constraints in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. + '{0}' is normally used as a type constraint in generic code, e.g. \"'T when ISomeInterface<'T>\" or \"let f (x: #ISomeInterface<_>)\". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn \"3536\"' or '--nowarn:3536'. diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 077c07c07d0..daa3b219360 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -623,3 +623,7 @@ module HashIdentity = NonStructuralComparison.(=) x y } + +// This test case caused an error due to a change in generalization +module ``Caused error`` = + let checkReflexive f x y = (f x y = - f y x) diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs index 3d3705bf2c8..d91874c6d50 100644 --- a/tests/service/EditorTests.fs +++ b/tests/service/EditorTests.fs @@ -1909,3 +1909,4 @@ do let x = 1 in () | ToolTipText [ToolTipElement.Group [data]] -> data.MainDescription |> Array.map (fun text -> text.Text) |> String.concat "" |> shouldEqual "val x: int" | elements -> failwith $"Tooltip elements: {elements}" + diff --git a/vsintegration/tests/Directory.Build.props b/vsintegration/tests/Directory.Build.props deleted file mode 100644 index 5737505f968..00000000000 --- a/vsintegration/tests/Directory.Build.props +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - true - portable - - - diff --git a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs index e94163042e4..f0a158b694b 100644 --- a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/BreakpointResolutionService.fs b/vsintegration/tests/UnitTests/BreakpointResolutionService.fs index 09b5e105857..1081471994e 100644 --- a/vsintegration/tests/UnitTests/BreakpointResolutionService.fs +++ b/vsintegration/tests/UnitTests/BreakpointResolutionService.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading @@ -72,7 +72,7 @@ let main argv = let searchPosition = code.IndexOf(searchToken) Assert.IsTrue(searchPosition >= 0, "SearchToken '{0}' is not found in code", searchToken) - let document, sourceText = RoslynTestHelpers.CreateDocument(fileName, code) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(fileName, code) let searchSpan = TextSpan.FromBounds(searchPosition, searchPosition + searchToken.Length) let actualResolutionOption = FSharpBreakpointResolutionService.GetBreakpointLocation(document, searchSpan) |> Async.RunSynchronously diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index ea808bc81a9..8d56dc1d2d5 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -2,7 +2,7 @@ // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn.CompletionProviderTests +module VisualFSharp.UnitTests.Editor.CompletionProviderTests open System open System.Linq @@ -36,8 +36,9 @@ let formatCompletions(completions : string seq) = "\n\t" + String.Join("\n\t", completions) let VerifyCompletionListWithOptions(fileContents: string, marker: string, expected: string list, unexpected: string list, opts) = + let options = projectOptions opts let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) let results = FSharpCompletionProvider.ProvideCompletionsAsyncAux(document, caretPosition, (fun _ -> [])) |> Async.RunSynchronously @@ -46,23 +47,23 @@ let VerifyCompletionListWithOptions(fileContents: string, marker: string, expect let expectedFound = expected - |> Seq.filter results.Contains + |> List.filter results.Contains let expectedNotFound = expected - |> Seq.filter (expectedFound.Contains >> not) + |> List.filter (expectedFound.Contains >> not) let unexpectedNotFound = unexpected - |> Seq.filter (results.Contains >> not) + |> List.filter (results.Contains >> not) let unexpectedFound = unexpected - |> Seq.filter (unexpectedNotFound.Contains >> not) + |> List.filter (unexpectedNotFound.Contains >> not) // If either of these are true, then the test fails. - let hasExpectedNotFound = not (Seq.isEmpty expectedNotFound) - let hasUnexpectedFound = not (Seq.isEmpty unexpectedFound) + let hasExpectedNotFound = not (List.isEmpty expectedNotFound) + let hasUnexpectedFound = not (List.isEmpty unexpectedFound) if hasExpectedNotFound || hasUnexpectedFound then let expectedNotFoundMsg = @@ -82,13 +83,15 @@ let VerifyCompletionListWithOptions(fileContents: string, marker: string, expect let msg = sprintf "%s%s%s" expectedNotFoundMsg unexpectedFoundMsg completionsMsg Assert.Fail(msg) + let VerifyCompletionList(fileContents, marker, expected, unexpected) = VerifyCompletionListWithOptions(fileContents, marker, expected, unexpected, [| |]) -let VerifyCompletionListExactly(fileContents: string, marker: string, expected: string list) = +let VerifyCompletionListExactlyWithOptions(fileContents: string, marker: string, expected: string list, opts) = + let options = projectOptions opts let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) let actual = FSharpCompletionProvider.ProvideCompletionsAsyncAux(document, caretPosition, (fun _ -> [])) |> Async.RunSynchronously @@ -105,6 +108,9 @@ let VerifyCompletionListExactly(fileContents: string, marker: string, expected: (String.Join("; ", actualNames |> List.map (sprintf "\"%s\""))) (String.Join("\n", actual |> List.map (fun x -> sprintf "%s => %s" x.DisplayText x.SortText)))) +let VerifyCompletionListExactly(fileContents: string, marker: string, expected: string list) = + VerifyCompletionListExactlyWithOptions(fileContents, marker, expected, [| |]) + let VerifyNoCompletionList(fileContents: string, marker: string) = VerifyCompletionListExactly(fileContents, marker, []) @@ -333,7 +339,7 @@ type T1 = member this.M2 = "literal" let x = $"1 not the same as {System.Int32.MaxValue} is it" """ - VerifyCompletionListWithOptions(fileContents, "System.", ["Console"; "Array"; "String"], ["T1"; "M1"; "M2"], [| "/langversion:preview" |]) + VerifyCompletionList(fileContents, "System.", ["Console"; "Array"; "String"], ["T1"; "M1"; "M2"]) [] let ``Class instance members are ordered according to their kind and where they are defined (simple case, by a variable)``() = @@ -860,6 +866,25 @@ let emptyMap<'keyType, 'lValueType> () = """ VerifyCompletionList(fileContents, ", l", ["LanguagePrimitives"; "List"; "lValueType"], ["let"; "log"]) -#if EXE -ShouldDisplaySystemNamespace() -#endif +[] +let ``Completion list for interface with static abstract method type invocation contains static property with residue``() = + let fileContents = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty +""" + VerifyCompletionListWithOptions(fileContents, "'T.Stati", ["StaticProperty"], [], [| "/langversion:preview" |]) + +[] +let ``Completion list for interface with static abstract method type invocation contains static property after dot``() = + let fileContents = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty +""" + VerifyCompletionListWithOptions(fileContents, "'T.", ["StaticProperty"], [], [| "/langversion:preview" |]) + diff --git a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs index c9674a89861..b438c0b96ff 100644 --- a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading @@ -40,7 +40,7 @@ type DocumentDiagnosticAnalyzerTests() = let getDiagnostics (fileContents: string) = async { - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let! syntacticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document, DiagnosticsType.Syntax) let! semanticDiagnostics = FSharpDocumentDiagnosticAnalyzer.GetDiagnostics(document, DiagnosticsType.Semantic) return syntacticDiagnostics.AddRange(semanticDiagnostics) diff --git a/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs b/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs index 8ca66298300..322d3f37eed 100644 --- a/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs +++ b/vsintegration/tests/UnitTests/DocumentHighlightsServiceTests.fs @@ -4,7 +4,7 @@ // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests [] -module Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn.DocumentHighlightsServiceTests +module VisualFSharp.UnitTests.Editor.DocumentHighlightsServiceTests open System open System.Threading @@ -36,7 +36,7 @@ let internal projectOptions = { } let private getSpans (sourceText: SourceText) (caretPosition: int) = - let document = RoslynTestHelpers.CreateDocument(filePath, sourceText) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, sourceText) FSharpDocumentHighlightsService.GetDocumentHighlights(document, caretPosition) |> Async.RunSynchronously |> Option.defaultValue [||] diff --git a/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs b/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs index 915129f0c17..739b2600f6e 100644 --- a/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs +++ b/vsintegration/tests/UnitTests/EditorFormattingServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System diff --git a/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs b/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs index 4a0e2f2dcfe..45a415ea187 100644 --- a/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/FsxCompletionProviderTests.fs @@ -2,7 +2,7 @@ // // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Collections.Generic @@ -40,7 +40,7 @@ type Worker () = member _.VerifyCompletionListExactly(fileContents: string, marker: string, expected: List) = let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document = RoslynTestHelpers.CreateDocument(filePath, SourceText.From(fileContents), options = projectOptions) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, SourceText.From(fileContents), options = projectOptions) let expected = expected |> Seq.toList let actual = let x = FSharpCompletionProvider.ProvideCompletionsAsyncAux(document, caretPosition, (fun _ -> [])) @@ -76,6 +76,3 @@ module FsxCompletionProviderTests = // We execute in a seperate appdomain so that we can set BaseDirectory to a non-existent location getWorker().VerifyCompletionListExactly(fileContents, "fsi.", expected) -#if EXE -ShouldTriggerCompletionInFsxFile() -#endif diff --git a/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs b/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs index 811086e051f..fa9e0ca2937 100644 --- a/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs +++ b/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs @@ -2,7 +2,7 @@ // // To run the tests in this file: Compile VisualFSharp.UnitTests.dll and run it as a set of unit tests -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.IO @@ -17,7 +17,7 @@ open FSharp.Compiler.EditorServices open FSharp.Compiler.Text open UnitTests.TestLib.LanguageService -[][] +[] module GoToDefinitionServiceTests = let userOpName = "GoToDefinitionServiceTests" @@ -58,13 +58,14 @@ module GoToDefinitionServiceTests = Stamp = None } - let GoToDefinitionTest (fileContents: string, caretMarker: string, expected) = + let GoToDefinitionTest (fileContents: string, caretMarker: string, expected, opts) = let filePath = Path.GetTempFileName() + ".fs" File.WriteAllText(filePath, fileContents) + let options = makeOptions filePath opts let caretPosition = fileContents.IndexOf(caretMarker) + caretMarker.Length - 1 // inside the marker - let document, sourceText = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) let actual = findDefinition(document, sourceText, caretPosition, []) |> Option.map (fun range -> (range.StartLine, range.EndLine, range.StartColumn, range.EndColumn)) @@ -73,7 +74,7 @@ module GoToDefinitionServiceTests = Assert.Fail(sprintf "Incorrect information returned for fileContents=<<<%s>>>, caretMarker=<<<%s>>>, expected =<<<%A>>>, actual = <<<%A>>>" fileContents caretMarker expected actual) [] - let VerifyDefinition() = + let ``goto definition smoke test``() = let manyTestCases = [ @@ -110,10 +111,10 @@ let _ = Module1.foo 1 for caretMarker, expected in testCases do printfn "Test case: caretMarker=<<<%s>>>" caretMarker - GoToDefinitionTest (fileContents, caretMarker, expected) + GoToDefinitionTest (fileContents, caretMarker, expected, [| |]) [] - let VerifyDefinitionStringInterpolation() = + let ``goto definition for string interpolation``() = let fileContents = """ let xxxxx = 1 @@ -121,9 +122,19 @@ let yyyy = $"{abc{xxxxx}def}" """ let caretMarker = "xxxxx" let expected = Some(2, 2, 4, 9) - GoToDefinitionTest (fileContents, caretMarker, expected) + GoToDefinitionTest (fileContents, caretMarker, expected, [| |]) -#if EXE - VerifyDefinition() - VerifyDefinitionStringInterpolation() -#endif \ No newline at end of file + [] + let ``goto definition for static abstract method invocation``() = + + let fileContents = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty +""" + let caretMarker = "'T.StaticProperty" + let expected = Some(3, 3, 20, 34) + + GoToDefinitionTest (fileContents, caretMarker, expected, [| "/langversion:preview" |]) diff --git a/vsintegration/tests/UnitTests/HelpContextServiceTests.fs b/vsintegration/tests/UnitTests/HelpContextServiceTests.fs index b1ea19c2ad7..eb270f54f02 100644 --- a/vsintegration/tests/UnitTests/HelpContextServiceTests.fs +++ b/vsintegration/tests/UnitTests/HelpContextServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading @@ -10,7 +10,7 @@ open Microsoft.CodeAnalysis.Classification open Microsoft.CodeAnalysis.Editor open Microsoft.CodeAnalysis.Text open Microsoft.CodeAnalysis -open FSharp.Compiler.SourceCodeServices +open FSharp.Compiler.CodeAnalysis open Microsoft.VisualStudio.FSharp.Editor open Microsoft.VisualStudio.FSharp.LanguageService open UnitTests.TestLib.Utils @@ -19,63 +19,58 @@ open UnitTests.TestLib.LanguageService [][] type HelpContextServiceTests() = - let fileName = "C:\\test.fs" - let options: FSharpProjectOptions = { - ProjectFileName = "C:\\test.fsproj" - ProjectId = None - SourceFiles = [| fileName |] - ReferencedProjects = [| |] - OtherOptions = [| |] - IsIncompleteTypeCheckEnvironment = true - UseScriptResolutionRules = false - LoadTime = DateTime.MaxValue - UnresolvedReferences = None - ExtraProjectInfo = None - OriginalLoadReferences = [] - Stamp = None - } - - let markers (source:string) = + let filePath = "C:\\test.fs" + let makeOptions args = + { + ProjectFileName = "C:\\test.fsproj" + ProjectId = None + SourceFiles = [| filePath |] + ReferencedProjects = [| |] + OtherOptions = args + IsIncompleteTypeCheckEnvironment = true + UseScriptResolutionRules = false + LoadTime = DateTime.MaxValue + OriginalLoadReferences = [] + UnresolvedReferences = None + Stamp = None + } + + let getMarkers (source:string) = let mutable cnt = 0 - [ - for i in 0 .. (source.Length - 1) do - if source.[i] = '$' then - yield (i - cnt) - cnt <- cnt + 1 + [ for i in 0 .. (source.Length - 1) do + if source.[i] = '$' then + yield (i - cnt) + cnt <- cnt + 1 ] - member private this.TestF1Keywords(expectedKeywords: string option list, lines : string list, ?addtlRefAssy : list) = - let newOptions = - let refs = - defaultArg addtlRefAssy [] - |> List.map (fun r -> "-r:" + r) - |> Array.ofList - { options with OtherOptions = Array.append options.OtherOptions refs } - - let fileContents = String.Join("\r\n", lines) - let version = fileContents.GetHashCode() - let sourceText = SourceText.From(fileContents.Replace("$", "")) - - let res = [ - for marker in markers fileContents do - let span = Microsoft.CodeAnalysis.Text.TextSpan(marker, 0) - let textLine = sourceText.Lines.GetLineFromPosition(marker) - let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) - let classifiedSpans = Tokenizer.getClassifiedSpans(documentId, sourceText, textLine.Span, Some "test.fs", [], CancellationToken.None) - - yield FSharpHelpContextService.GetHelpTerm(checker, sourceText, fileName, newOptions, span, classifiedSpans, version) - |> Async.RunSynchronously - ] - let equalLength = List.length expectedKeywords = List.length res + let TestF1KeywordsWithOptions(expectedKeywords: string option list, lines : string list, opts : string[]) = + let options = makeOptions opts + + let fileContentsWithMarkers = String.Join("\r\n", lines) + let fileContents = fileContentsWithMarkers.Replace("$", "") + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents, options = options) + + let markers = getMarkers fileContentsWithMarkers + let res = + [ for marker in markers do + let span = Microsoft.CodeAnalysis.Text.TextSpan(marker, 0) + let textLine = sourceText.Lines.GetLineFromPosition(marker) + let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId()) + let classifiedSpans = Tokenizer.getClassifiedSpans(documentId, sourceText, textLine.Span, Some "test.fs", [], CancellationToken.None) + + FSharpHelpContextService.GetHelpTerm(document, span, classifiedSpans) |> Async.RunSynchronously + ] + let equalLength = (expectedKeywords.Length = res.Length) Assert.True(equalLength) - List.iter2(fun exp res -> + for (exp, res) in List.zip expectedKeywords res do Assert.AreEqual(exp, res) - ) expectedKeywords res + let TestF1Keywords(expectedKeywords, lines) = + TestF1KeywordsWithOptions(expectedKeywords, lines, [| |]) [] - member public this.``NoKeyword.Negative`` () = + member _.``F1 help keyword NoKeyword.Negative`` () = let file = [ "let s = \"System.Con$sole\"" "let n = 999$99" @@ -84,19 +79,19 @@ type HelpContextServiceTests() = "#endif" ] let keywords = [ None; None; None ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Preprocessor`` () = + member _.``F1 help keyword Preprocessor`` () = let file = [ "#i$f foobaz" "#e$ndif" ] let keywords = [ Some "#if_FS"; Some "#endif_FS" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Regression.DotNetMethod.854364``() = + member _.``F1 help keyword Regression.DotNetMethod.854364``() = let file = [ "let i : int = 42" "i.ToStri$ng()" @@ -106,10 +101,10 @@ type HelpContextServiceTests() = [ Some "System.Int32.ToString" Some "System.Int32.ToString" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Namespaces`` () = + member _.``F1 help keyword Namespaces`` () = let file = [ "open Syst$em.N$et" "open System.I$O" @@ -123,10 +118,10 @@ type HelpContextServiceTests() = Some "System.IO" Some "System.Console" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Namespaces.BeforeDot`` () = + member _.``F1 help keyword Namespaces.BeforeDot`` () = let file = [ "open System$.Net$" "open System$.IO" @@ -145,10 +140,10 @@ type HelpContextServiceTests() = Some "System" Some "System.Console" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Namespaces.AfterDot`` () = + member _.``F1 help keyword Namespaces.AfterDot`` () = let file = [ "open $System.$Net" "open $System.IO" @@ -168,10 +163,10 @@ type HelpContextServiceTests() = Some "System.Console" Some "System.Console.WriteLine" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``QuotedIdentifiers``() = + member _.``F1 help keyword QuotedIdentifiers``() = let file = [ "let `$`escaped func`` x y = x + y" @@ -193,10 +188,10 @@ type HelpContextServiceTests() = Some "Test.z" Some "Test.z" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Attributes`` () = + member _.``F1 help keyword Attributes`` () = let file = [ "open System.Runtime.InteropServices" @@ -206,7 +201,7 @@ type HelpContextServiceTests() = " []" " val mutable f : int" " []" - " member this.Run() = ()" + " member _.Run() = ()" "[]" "type Y = class end" ] @@ -217,14 +212,14 @@ type HelpContextServiceTests() = Some "System.Runtime.CompilerServices.MethodImplAttribute.#ctor" Some "System.Runtime.InteropServices.StructLayoutAttribute.Size" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] [] [] //This test case Verify that when F1 is Hit on TypeProvider namespaces it contain the right keyword - member public this.``TypeProvider.Namespaces`` () = + member _.``F1 help keyword TypeProvider.Namespaces`` () = let file = [ "open N$1" @@ -233,14 +228,13 @@ type HelpContextServiceTests() = [ Some "N1" ] - this.TestF1Keywords(keywords, file, - addtlRefAssy = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) + TestF1KeywordsWithOptions(keywords, file, [| "-r:" + PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll") |]) [] [] [] //This test case Verify that when F1 is Hit on TypeProvider Type it contain the right keyword - member public this.``TypeProvider.type`` () = + member _.``F1 help keyword TypeProvider.type`` () = let file = [ @@ -251,11 +245,10 @@ type HelpContextServiceTests() = [ Some "N1.T" ] - this.TestF1Keywords(keywords, file, - addtlRefAssy = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) + TestF1KeywordsWithOptions(keywords, file, [| "-r:"+PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll") |]) [] - member public this.``EndOfLine``() = + member _.``F1 help keyword EndOfLine``() = let file = [ "open System.Net$" "open System.IO$" @@ -264,10 +257,10 @@ type HelpContextServiceTests() = [ Some "System.Net" Some "System.IO" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``EndOfLine2``() = + member _.``F1 help keyword EndOfLine2``() = let file = [ "module M" "open System.Net$" @@ -277,21 +270,21 @@ type HelpContextServiceTests() = [ Some "System.Net" Some "System.IO" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Comments``() = + member _.``F1 help keyword Comments``() = let file = [ "($* co$mment *$)" "/$/ com$ment" ] let keywords = [ Some "comment_FS"; Some "comment_FS"; Some "comment_FS"; Some "comment_FS"; Some "comment_FS"; ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``FSharpEntities`` () = + member _.``F1 help keyword FSharpEntities`` () = let file = [ "let (KeyValu$e(k,v)) = null" "let w : int lis$t = []" @@ -320,10 +313,10 @@ type HelpContextServiceTests() = Some "Microsoft.FSharp.Core.Operators.Ref``1" Some "Microsoft.FSharp.Core.FSharpRef`1.contents" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Keywords`` () = + member _.``F1 help keyword Keywords`` () = let file = [ "l$et r = ref 0" "r :$= 1" @@ -338,66 +331,66 @@ type HelpContextServiceTests() = Some "<-_FS" Some "let_FS" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Regression.NewInstance.854367`` () = + member _.``F1 help keyword Regression.NewInstance.854367`` () = let file = [ "let q : System.Runtime.Remoting.TypeE$ntry = null" ] let keywords = [ Some "System.Runtime.Remoting.TypeEntry" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Regression.NewInstance.854367.2`` () = + member _.``F1 help keyword Regression.NewInstance.854367.2`` () = let file = [ "let q1 = new System.Runtime.Remoting.Type$Entry()" // this consutrctor exists but is not accessible (it is protected), but the help entry still goes to the type ] let keywords = [ Some "System.Runtime.Remoting.TypeEntry" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.WebClient`` () = + member _.``F1 help keyword Classes.WebClient`` () = let file = [ "let w : System.Net.Web$Client = new System.Net.Web$Client()" ] let keywords = [ Some "System.Net.WebClient" Some "System.Net.WebClient.#ctor" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.Object`` () = + member _.``F1 help keyword Classes.Object`` () = let file = [ "let w : System.Ob$ject = new System.Obj$ect()" ] let keywords = [ Some "System.Object" Some "System.Object.#ctor" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.Generic`` () = + member _.``F1 help keyword Classes.Generic`` () = let file = [ "let x : System.Collections.Generic.L$ist = null" ] let keywords = [ Some "System.Collections.Generic.List`1" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Classes.Abbrev`` () = + member _.``F1 help keyword Classes.Abbrev`` () = let file = [ "let z : Resi$zeArray = null" ] let keywords = [ Some "System.Collections.Generic.List`1" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) [] - member public this.``Members`` () = + member _.``F1 help keyword Members`` () = let file = [ "open System.Linq" "open System" @@ -422,4 +415,17 @@ type HelpContextServiceTests() = Some "System.String.Equals" Some "System.Int32.ToString" ] - this.TestF1Keywords(keywords, file) + TestF1Keywords(keywords, file) + + [] + member _.``F1 help keyword static abstract interface method`` () = + let file = + ["type IStaticProperty<'T when 'T :> IStaticProperty<'T>> =" + " static abstract StaticProperty: 'T" + "" + "let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) =" + " 'T.StaticProp$erty" ] + let keywords = + [ Some "System.Collections.Generic.List`1" ] + TestF1Keywords(keywords, file) + diff --git a/vsintegration/tests/UnitTests/IndentationServiceTests.fs b/vsintegration/tests/UnitTests/IndentationServiceTests.fs index 7c535ccdff9..477fa4b2e93 100644 --- a/vsintegration/tests/UnitTests/IndentationServiceTests.fs +++ b/vsintegration/tests/UnitTests/IndentationServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs b/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs index 6c2968a16ca..76dc7a54681 100644 --- a/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs +++ b/vsintegration/tests/UnitTests/LanguageDebugInfoServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs index 50805ed6356..60478081e58 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs @@ -51,6 +51,17 @@ type References() = l.[0] + /// Create a dummy project named 'Test', build it, and then call k with the full path to the resulting exe + member this.CreateDummyTestProjectBuildItAndDo(k : string -> unit) = + this.MakeProjectAndDo(["foo.fs"], [], "", (fun project -> + // Let's create a run-of-the-mill project just to have a spare assembly around + let fooPath = Path.Combine(project.ProjectFolder, "foo.fs") + File.AppendAllText(fooPath, "namespace Foo\nmodule Bar =\n let x = 42") + let buildResult = project.Build("Build") + Assert.IsTrue buildResult.IsSuccessful + let exe = Path.Combine(project.ProjectFolder, "bin\\Debug\\Test.exe") + k exe)) + [] member this.``BasicAssemblyReferences1``() = this.MakeProjectAndDo([], ["System"], "", (fun proj -> @@ -66,7 +77,7 @@ type References() = )) [] - member public this.``AddReference.StarredAssemblyName`` () = + member this.``AddReference.StarredAssemblyName`` () = DoWithTempFile "Test.fsproj" (fun projFile -> File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [], "")) use project = TheTests.CreateProject(projFile) @@ -86,7 +97,7 @@ type References() = ) [] - member public this.``References.Bug787899.AddDuplicateUnresolved``() = + member this.``References.Bug787899.AddDuplicateUnresolved``() = // Let's create a run-of-the-mill project just to have a spare assembly around this.CreateDummyTestProjectBuildItAndDo(fun exe -> Assert.IsTrue(File.Exists exe, "failed to build exe") @@ -103,7 +114,7 @@ type References() = ) [] - member public this.``References.Bug787899.AddDuplicateResolved``() = + member this.``References.Bug787899.AddDuplicateResolved``() = // Let's create a run-of-the-mill project just to have a spare assembly around this.CreateDummyTestProjectBuildItAndDo(fun exe -> Assert.IsTrue(File.Exists exe, "failed to build exe") @@ -123,7 +134,7 @@ type References() = ) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.Works``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.Works``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["mscorlib"; "System"; "System.Core"; "System.Net"], "", "v4.0", (fun project -> let expectedRefInfo = [ "mscorlib", true "System", true @@ -141,7 +152,7 @@ type References() = [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WithExactDuplicates``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WithExactDuplicates``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["System"; "System"], "", "v4.0", (fun project -> let expectedRefInfo = [ "System", true // In C#, one will be banged out, whereas "System", true] // one will be ok, but in F# both show up as ok. Bug? Not worth the effort to fix. @@ -156,7 +167,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WithBadDuplicates``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WithBadDuplicates``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["System"; "System.dll"], "", "v4.0", (fun project -> let expectedRefInfo = [ "System", false // one will be banged out "System.dll", true] // one will be ok @@ -171,7 +182,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WorksWithFilenames``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WorksWithFilenames``() = let netDir = currentFrameworkDirectory let ssmw = Path.Combine(netDir, "System.ServiceModel.Web.dll") this.MakeProjectAndDo(["doesNotMatter.fs"], [ssmw], "", "v4.0", (fun project -> @@ -187,7 +198,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.LoadedFsProj.WeirdCases``() = + member this.``ReferenceResolution.Bug4423.LoadedFsProj.WeirdCases``() = this.MakeProjectAndDo(["doesNotMatter.fs"], ["mscorlib, Version=4.0.0.0"; "System, Version=4.0.0.0"; "System.Core, Version=4.0.0.0"; "System.Net, Version=4.0.0.0"], "", "v4.0", (fun project -> let expectedRefInfo = [ "mscorlib", true "System", true @@ -203,10 +214,10 @@ type References() = AssertEqual expectedRefInfo actualRefInfo )) - member public this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string) = + member this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string) = this.ReferenceResolutionHelper(tab, fullPath, expectedFsprojRegex, "v4.0", []) - member public this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string, targetFrameworkVersion : string, originalReferences : string list) = + member this.ReferenceResolutionHelper(tab : AddReferenceDialogTab, fullPath : string, expectedFsprojRegex : string, targetFrameworkVersion : string, originalReferences : string list) = // Trace.Log <- "ProjectSystemReferenceResolution" // can be useful this.MakeProjectAndDo(["doesNotMatter.fs"], originalReferences, "", targetFrameworkVersion, (fun project -> let cType = @@ -224,7 +235,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate1``() = + member this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate1``() = let netDir = currentFrameworkDirectory try this.ReferenceResolutionHelper(AddReferenceDialogTab.DotNetTab, @@ -236,8 +247,8 @@ type References() = with e -> TheTests.HelpfulAssertMatches ' ' "A reference to '.*' \\(with assembly name '.*'\\) could not be added. A reference to the component '.*' with the same assembly name already exists in the project." e.Message - // see 5491 [] - member public this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate2``() = +// see 5491 [] + member this.``ReferenceResolution.Bug4423.FxAssembly.NetTab.AddDuplicate2``() = let netDir = currentFrameworkDirectory try this.ReferenceResolutionHelper(AddReferenceDialogTab.DotNetTab, @@ -249,9 +260,10 @@ type References() = with e -> TheTests.HelpfulAssertMatches ' ' "A reference to '.*' could not be added. A reference to the component '.*' already exists in the project." e.Message +(* [] [] - member public this.``ReferenceResolution.Bug650591.AutomationReference.Add.FullPath``() = + member this.``ReferenceResolution.Bug650591.AutomationReference.Add.FullPath``() = match Net20AssemExPath() with | Some(net20) -> let invoker = @@ -316,20 +328,10 @@ type References() = finally File.Delete(copy) | _ -> () - - /// Create a dummy project named 'Test', build it, and then call k with the full path to the resulting exe - member public this.CreateDummyTestProjectBuildItAndDo(k : string -> unit) = - this.MakeProjectAndDo(["foo.fs"], [], "", (fun project -> - // Let's create a run-of-the-mill project just to have a spare assembly around - let fooPath = Path.Combine(project.ProjectFolder, "foo.fs") - File.AppendAllText(fooPath, "namespace Foo\nmodule Bar =\n let x = 42") - let buildResult = project.Build("Build") - Assert.IsTrue buildResult.IsSuccessful - let exe = Path.Combine(project.ProjectFolder, "bin\\Debug\\Test.exe") - k exe)) +*) [] - member public this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.InsideProjectDir``() = + member this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.InsideProjectDir``() = // Let's create a run-of-the-mill project just to have a spare assembly around this.CreateDummyTestProjectBuildItAndDo(fun exe -> Assert.IsTrue(File.Exists exe, "failed to build exe") @@ -359,9 +361,9 @@ type References() = Assert.IsTrue buildResult.IsSuccessful )) ) - + [] - member public this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.OutsideProjectDir``() = + member this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.OutsideProjectDir``() = this.MakeProjectAndDo(["foo.fs"], [], "", (fun project -> // Let's create a run-of-the-mill let fooPath = Path.Combine(project.ProjectFolder, "foo.fs") @@ -395,7 +397,7 @@ type References() = )) [] - member public this.``ReferenceResolution.Bug4423.NotAValidDll.BrowseTab``() = + member this.``ReferenceResolution.Bug4423.NotAValidDll.BrowseTab``() = let dirName = Path.GetTempPath() let dll = Path.Combine(dirName, "Foo.dll") File.AppendAllText(dll, "This is not actually a valid dll") @@ -413,7 +415,7 @@ type References() = File.Delete(dll) [] - member public this.``PathReferences.Existing`` () = + member this.``PathReferences.Existing`` () = DoWithTempFile "Test.fsproj"(fun projFile -> let dirName = Path.GetDirectoryName(projFile) let libDirName = Directory.CreateDirectory(Path.Combine(dirName, "lib")).FullName @@ -444,7 +446,7 @@ type References() = ) [] - member public this.``PathReferences.Existing.Captions`` () = + member this.``PathReferences.Existing.Captions`` () = DoWithTempFile "Test.fsproj"(fun projFile -> File.AppendAllText(projFile, TheTests.FsprojTextWithProjectReferences( [], // @@ -462,7 +464,7 @@ type References() = ) [] - member public this.``PathReferences.NonExistent`` () = + member this.``PathReferences.NonExistent`` () = DoWithTempFile "Test.fsproj"(fun projFile -> let refLibPath = @"c:\foo\baz\blahblah.dll" File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [refLibPath], "")) @@ -476,7 +478,7 @@ type References() = [] - member public this.``FsprojPreferencePage.ProjSupportsPrefReadWrite``() = + member this.``FsprojPreferencePage.ProjSupportsPrefReadWrite``() = let testProp = "AssemblyName" let compileItem = [@"foo.fs"] @@ -508,11 +510,12 @@ type References() = AssertContains contents newPropVal ) + // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 // On DEV 15 Preview 4 the VS IDE Test fails with : // System.InvalidOperationException : Operation is not valid due to the current state of the object. // [] // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 - member public this.``AddReference.COM`` () = + member this.``AddReference.COM`` () = DoWithTempFile "Test.fsproj" (fun projFile -> File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [], "")) use project = TheTests.CreateProject(projFile) diff --git a/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs b/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs index 847adf617b2..f9a20e674d6 100644 --- a/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs +++ b/vsintegration/tests/UnitTests/ProjectOptionsBuilder.fs @@ -1,4 +1,4 @@ -namespace VisualFSharp.UnitTests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.IO diff --git a/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs b/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs index d55dc57e2ac..7d5aa2613fd 100644 --- a/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoProviderTests.fs @@ -6,7 +6,7 @@ // ------------------------------------------------------------------------------------------------------------------------ -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open NUnit.Framework @@ -82,7 +82,7 @@ let ShouldShowQuickInfoAtCorrectPositions() = System.Console.WriteLine(x + y) """ let caretPosition = fileContents.IndexOf(symbol) - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let quickInfo = FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) @@ -212,7 +212,7 @@ let res7 = sin 5.0 let res8 = abs 5.0 """ let caretPosition = fileContents.IndexOf(symbol) + symbol.Length - 1 - let document, _ = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let quickInfo = FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) diff --git a/vsintegration/tests/UnitTests/QuickInfoTests.fs b/vsintegration/tests/UnitTests/QuickInfoTests.fs index ff460f45144..a560dc5eae5 100644 --- a/vsintegration/tests/UnitTests/QuickInfoTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoTests.fs @@ -1,11 +1,11 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System.IO open Microsoft.VisualStudio.FSharp.Editor open NUnit.Framework -open VisualFSharp.UnitTests.Roslyn +open VisualFSharp.UnitTests.Editor [] module QuickInfo = @@ -13,7 +13,7 @@ module QuickInfo = let internal GetQuickInfo (project:FSharpProject) (fileName:string) (caretPosition:int) = async { let code = File.ReadAllText(fileName) - let document, _ = RoslynTestHelpers.CreateDocument(fileName, code) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(fileName, code) return! FSharpAsyncQuickInfoSource.ProvideQuickInfo(document, caretPosition) } |> Async.RunSynchronously diff --git a/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs b/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs index 54a92f3cd0b..12132dc9acd 100644 --- a/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs +++ b/vsintegration/tests/UnitTests/RoslynSourceTextTests.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open NUnit.Framework diff --git a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs index 78d0732493b..7b8d2825abe 100644 --- a/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs +++ b/vsintegration/tests/UnitTests/SemanticColorizationServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open NUnit.Framework @@ -33,7 +33,7 @@ type SemanticClassificationServiceTests() = let getRanges (source: string) : SemanticClassificationItem list = asyncMaybe { - let document, _ = RoslynTestHelpers.CreateDocument(filePath, source) + let document, _ = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, source) let! _, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("SemanticClassificationServiceTests") |> liftAsync return checkFileResults.GetSemanticClassification(None) } diff --git a/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs b/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs index 77b8038e98c..35995cc45c4 100644 --- a/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs +++ b/vsintegration/tests/UnitTests/SignatureHelpProviderTests.fs @@ -1,5 +1,5 @@ [] -module Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn.SignatureHelpProvider +module VisualFSharp.UnitTests.Editor.SignatureHelpProvider open System open System.IO @@ -8,7 +8,7 @@ open NUnit.Framework open Microsoft.VisualStudio.FSharp.Editor -open VisualFSharp.UnitTests.Roslyn +open VisualFSharp.UnitTests.Editor open UnitTests.TestLib.LanguageService @@ -54,7 +54,7 @@ let GetSignatureHelp (project:FSharpProject) (fileName:string) (caretPosition:in let caretLinePos = textLines.GetLinePosition(caretPosition) let caretLineColumn = caretLinePos.Character - let document = RoslynTestHelpers.CreateDocument(fileName, sourceText, options = project.Options) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(fileName, sourceText, options = project.Options) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("GetSignatureHelp") |> Async.RunSynchronously @@ -101,7 +101,7 @@ let assertSignatureHelpForMethodCalls (fileContents: string) (marker: string) (e let caretLinePos = textLines.GetLinePosition(caretPosition) let caretLineColumn = caretLinePos.Character - let document = RoslynTestHelpers.CreateDocument(filePath, sourceText, options = projectOptions) + let document = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, sourceText, options = projectOptions) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("assertSignatureHelpForMethodCalls") |> Async.RunSynchronously @@ -132,7 +132,7 @@ let assertSignatureHelpForMethodCalls (fileContents: string) (marker: string) (e let assertSignatureHelpForFunctionApplication (fileContents: string) (marker: string) expectedArgumentCount expectedArgumentIndex = let caretPosition = fileContents.LastIndexOf(marker) + marker.Length - let document, sourceText = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("assertSignatureHelpForFunctionApplication") @@ -413,7 +413,7 @@ M.f let marker = "id " let caretPosition = fileContents.IndexOf(marker) + marker.Length - let document, sourceText = RoslynTestHelpers.CreateDocument(filePath, fileContents) + let document, sourceText = RoslynTestHelpers.CreateSingleDocumentSolution(filePath, fileContents) let parseResults, checkFileResults = document.GetFSharpParseAndCheckResultsAsync("function application in single pipeline with no additional args") diff --git a/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs b/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs index 05b0d39e7aa..3bb4245ee4d 100644 --- a/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs +++ b/vsintegration/tests/UnitTests/SyntacticColorizationServiceTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace VisualFSharp.UnitTests.Editor open System open System.Threading diff --git a/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs b/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs index 4387329518f..f7de265b87b 100644 --- a/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs +++ b/vsintegration/tests/UnitTests/Tests.RoslynHelpers.fs @@ -1,4 +1,4 @@ -namespace rec Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +namespace rec VisualFSharp.UnitTests.Editor open System open System.IO @@ -16,6 +16,7 @@ open Microsoft.VisualStudio.FSharp.Editor open Microsoft.CodeAnalysis.Host.Mef open Microsoft.VisualStudio.LanguageServices open Microsoft.VisualStudio.Shell +open FSharp.Compiler.CodeAnalysis [] module MefHelpers = @@ -226,7 +227,7 @@ type RoslynTestHelpers private () = filePath = projFilePath ) - static member CreateDocument (filePath, text: SourceText, ?options: FSharp.Compiler.CodeAnalysis.FSharpProjectOptions) = + static member CreateSingleDocumentSolution (filePath, text: SourceText, ?options: FSharpProjectOptions) = let isScript = String.Equals(Path.GetExtension(filePath), ".fsx", StringComparison.OrdinalIgnoreCase) let workspace = new AdhocWorkspace(TestHostServices()) @@ -272,7 +273,7 @@ type RoslynTestHelpers private () = document - static member CreateDocument (filePath, code: string) = + static member CreateSingleDocumentSolution (filePath, code: string, ?options) = let text = SourceText.From(code) - RoslynTestHelpers.CreateDocument(filePath, text), text + RoslynTestHelpers.CreateSingleDocumentSolution(filePath, text, ?options = options), text diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index 4caa4aa00f9..e403a88e898 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -61,57 +61,58 @@ CompilerService\UnusedOpensTests.fs - Roslyn\ProjectOptionsBuilder.fs + Editor\ProjectOptionsBuilder.fs - Roslyn\SyntacticColorizationServiceTests.fs + Editor\SyntacticColorizationServiceTests.fs - Roslyn\SemanticColorizationServiceTests.fs + Editor\SemanticColorizationServiceTests.fs - Roslyn\BraceMatchingServiceTests.fs + Editor\BraceMatchingServiceTests.fs - + Editor\EditorFormattingServiceTests.fs + + + Editor\RoslynSourceTextTests.fs - - Roslyn\IndentationServiceTests.fs + Editor\IndentationServiceTests.fs - Roslyn\BreakpointResolutionService.fs + Editor\BreakpointResolutionService.fs - Roslyn\LanguageDebugInfoServiceTests.fs + Editor\LanguageDebugInfoServiceTests.fs - Roslyn\DocumentDiagnosticAnalyzerTests.fs + Editor\DocumentDiagnosticAnalyzerTests.fs - Roslyn\CompletionProviderTests.fs + Editor\CompletionProviderTests.fs - Roslyn\FsxCompletionProviderTests.fs + Editor\FsxCompletionProviderTests.fs - Roslyn\SignatureHelpProviderTests.fs + Editor\SignatureHelpProviderTests.fs - Roslyn\QuickInfoTests.fs + Editor\QuickInfoTests.fs - Roslyn\GoToDefinitionServiceTests.fs + Editor\GoToDefinitionServiceTests.fs - Roslyn\QuickInfoProviderTests.fs + Editor\QuickInfoProviderTests.fs + + + Editor\HelpContextServiceTests.fs - Roslyn\DocumentHighlightsServiceTests.fs + Editor\DocumentHighlightsServiceTests.fs {{FSCoreVersion}} diff --git a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs index bcdcd67b66b..3ef0697c2fd 100644 --- a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs +++ b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs @@ -17,7 +17,7 @@ open Microsoft.VisualStudio.FSharp.Editor open Microsoft.CodeAnalysis.Host.Mef open Microsoft.VisualStudio.LanguageServices open Microsoft.VisualStudio.Shell -open Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn +open VisualFSharp.UnitTests.Editor open NUnit.Framework [] From 7ee7e076d1726a89a94e91c31008fff83d4641c5 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 14:21:40 +0100 Subject: [PATCH 53/91] format code --- src/Compiler/Service/FSharpCheckerResults.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 8a521b357dc..32d5260fe67 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -1156,7 +1156,11 @@ type internal TypeCheckInfo // Completion at 'implement ..." | Some (CompletionContext.Inherit (InheritanceContext.Unknown, (plid, _))) -> GetEnvironmentLookupResolutionsAtPosition(mkPos line loc, plid, filterCtors, false) - |> FilterRelevantItemsBy getItem None (getItem >> (fun t -> IsInheritsCompletionCandidate t || IsInterfaceCompletionCandidate t)) + |> FilterRelevantItemsBy + getItem + None + (getItem + >> (fun t -> IsInheritsCompletionCandidate t || IsInterfaceCompletionCandidate t)) |> Option.map toCompletionItems // Completion at ' { XXX = ... } " From ab95b72f02a01dacb24d3a4703c2dd4a55380c62 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 15:24:16 +0100 Subject: [PATCH 54/91] fix tests --- src/Compiler/Symbols/Exprs.fs | 1 - src/Compiler/TypedTree/TypedTreeOps.fs | 2 -- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 -- vsintegration/tests/UnitTests/HelpContextServiceTests.fs | 2 +- 4 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index e007843b840..cd90332a3ea 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -311,7 +311,6 @@ module FSharpExprConvert = | _ when typeEquiv g ty g.byte_ty -> Some mkCallToByteOperator | _ when typeEquiv g ty g.int16_ty -> Some mkCallToInt16Operator | _ when typeEquiv g ty g.uint16_ty -> Some mkCallToUInt16Operator - | _ when typeEquiv g ty g.int_ty -> Some mkCallToIntOperator | _ when typeEquiv g ty g.int32_ty -> Some mkCallToInt32Operator | _ when typeEquiv g ty g.uint32_ty -> Some mkCallToUInt32Operator | _ when typeEquiv g ty g.int64_ty -> Some mkCallToInt64Operator diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 77e186f61ab..51cdd999f63 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -7663,8 +7663,6 @@ let mkCallToInt16Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrins let mkCallToUInt16Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint16_operator_info, [[ty]], [e1], m) -let mkCallToIntOperator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int_operator_info, [[ty]], [e1], m) - let mkCallToInt32Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.int32_operator_info, [[ty]], [e1], m) let mkCallToUInt32Operator (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.uint32_operator_info, [[ty]], [e1], m) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 194b520d4bc..03d09c2f685 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2082,8 +2082,6 @@ val mkCallToInt16Operator: TcGlobals -> range -> TType -> Expr -> Expr val mkCallToUInt16Operator: TcGlobals -> range -> TType -> Expr -> Expr -val mkCallToIntOperator: TcGlobals -> range -> TType -> Expr -> Expr - val mkCallToInt32Operator: TcGlobals -> range -> TType -> Expr -> Expr val mkCallToUInt32Operator: TcGlobals -> range -> TType -> Expr -> Expr diff --git a/vsintegration/tests/UnitTests/HelpContextServiceTests.fs b/vsintegration/tests/UnitTests/HelpContextServiceTests.fs index eb270f54f02..248535527f3 100644 --- a/vsintegration/tests/UnitTests/HelpContextServiceTests.fs +++ b/vsintegration/tests/UnitTests/HelpContextServiceTests.fs @@ -426,6 +426,6 @@ type HelpContextServiceTests() = "let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) =" " 'T.StaticProp$erty" ] let keywords = - [ Some "System.Collections.Generic.List`1" ] + [ Some "Test.IStaticProperty`1.StaticProperty" ] TestF1Keywords(keywords, file) From a254a88a764a37e6e952d4865c085c3765cb3003 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Thu, 7 Jul 2022 15:56:39 +0100 Subject: [PATCH 55/91] add more quickinfo etc tests --- src/Compiler/Checking/NicePrint.fs | 7 ++- .../Service/ServiceDeclarationLists.fs | 1 + .../UnitTests/CompletionProviderTests.fs | 19 +++++++ .../tests/UnitTests/QuickInfoTests.fs | 54 +++++++++++++++++-- 4 files changed, 76 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index e7b4a34f470..91bc2c39f16 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1155,7 +1155,12 @@ module PrintTypes = fakeTypar.SetConstraints [TyparConstraint.MayResolveMember(traitInfo, Range.range0)] let ty, cxs = PrettyTypes.PrettifyType denv.g (mkTyparTy fakeTypar) let env = SimplifyTypes.CollectInfo true [ty] cxs - layoutConstraintsWithInfo denv env env.postfixConstraints + // We expect one constraint, since we put one in. + match env.postfixConstraints with + | cx :: _ -> + // We expect at most one per constraint + sepListL emptyL (layoutConstraintWithInfo denv env cx) + | [] -> emptyL let prettyLayoutOfTypeNoConstraints denv ty = let ty, _cxs = PrettyTypes.PrettifyType denv.g ty diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index 949998e8a64..36324164759 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -387,6 +387,7 @@ module DeclarationListHelpers = // Traits | Item.Trait traitInfo -> + let denv = { denv with shortConstraints = false} let layout = NicePrint.prettyLayoutOfTrait denv traitInfo ToolTipElement.Single (toArray layout, xml) diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 8d56dc1d2d5..debcc4296a8 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -888,3 +888,22 @@ let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = """ VerifyCompletionListWithOptions(fileContents, "'T.", ["StaticProperty"], [], [| "/langversion:preview" |]) + +[] +let ``Completion list for SRTP invocation contains static property with residue``() = + let fileContents = """ +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + +""" + VerifyCompletionListWithOptions(fileContents, "'T.Stati", ["StaticProperty"], [], [| "/langversion:preview" |]) + +[] +let ``Completion list for SRTP invocation contains static property after dot``() = + let fileContents = """ +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + +""" + VerifyCompletionListWithOptions(fileContents, "'T.", ["StaticProperty"], [], [| "/langversion:preview" |]) + diff --git a/vsintegration/tests/UnitTests/QuickInfoTests.fs b/vsintegration/tests/UnitTests/QuickInfoTests.fs index a560dc5eae5..bfe98d6f742 100644 --- a/vsintegration/tests/UnitTests/QuickInfoTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoTests.fs @@ -437,11 +437,8 @@ module Test = let fu$$nc x = () """ let expectedSignature = "val func: x: 'a -> unit" - let tooltip = GetQuickInfoTextFromCode code - StringAssert.StartsWith(expectedSignature, tooltip) - () [] let ``Automation.LetBindings.InsideType``() = @@ -454,8 +451,57 @@ module Test = """ let expectedSignature = "val func: x: 'a -> unit" + let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) + +[] +let ``quick info for IWSAM property get``() = + let code = """ +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticPr$$operty +""" + + let expectedSignature = "property IStaticProperty.StaticProperty: 'T with get" + let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) + +[] +let ``quick info for IWSAM method call``() = + let code = """ +type IStaticMethod<'T when 'T :> IStaticMethod<'T>> = + static abstract StaticMethod: unit -> 'T + +let f (x: #IStaticMethod<'T>) = + 'T.StaticMe$$thod() +""" + let expectedSignature = "static abstract IStaticMethod.StaticMethod: unit -> 'T" let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) + +[] +let ``quick info for SRTP property get``() = + let code = """ +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticPr$$operty +""" + + let expectedSignature = "'T: (static member StaticProperty: 'T)" + let tooltip = GetQuickInfoTextFromCode code + StringAssert.StartsWith(expectedSignature, tooltip) + +[] +let ``quick info for SRTP method call``() = + let code = """ + +let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticMethod: unit -> 'T) >() = + 'T.StaticMe$$thod() +""" + + let expectedSignature = "'T: (static member StaticMethod: unit -> 'T)" + let tooltip = GetQuickInfoTextFromCode code StringAssert.StartsWith(expectedSignature, tooltip) - () From 19a49347d3f5f0d9e1d5f5ed4c4d8c3147fe3aa4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 8 Jul 2022 16:46:24 +0100 Subject: [PATCH 56/91] clean up tests --- src/Compiler/SyntaxTree/SyntaxTree.fsi | 12 +- src/Compiler/TypedTree/TcGlobals.fs | 12 - tests/adhoc.fsx | 607 ++++-------------- .../UnitTests/VisualFSharp.UnitTests.fsproj | 6 +- 4 files changed, 143 insertions(+), 494 deletions(-) diff --git a/src/Compiler/SyntaxTree/SyntaxTree.fsi b/src/Compiler/SyntaxTree/SyntaxTree.fsi index 1cf1959bc22..e0218b30036 100644 --- a/src/Compiler/SyntaxTree/SyntaxTree.fsi +++ b/src/Compiler/SyntaxTree/SyntaxTree.fsi @@ -617,11 +617,6 @@ type SynExpr = range: range /// F# syntax: ^expr, used for from-end-of-collection indexing and ^T.Operation - /// - /// NOTE: In the case of ^T.ident the Typar node is not initially in the tree as produced by the parser, - /// but rather is a IndexFromEnd node that is then processed using adjustHatPrefixToTyparLookup - /// when in arbitrary expression position. If ^expr occurs in index/slicing position then it is not processed - /// and the node is interpreted as from-the-end-indexing. | IndexFromEnd of expr: SynExpr * range: range /// F# syntax: { expr } @@ -735,12 +730,7 @@ type SynExpr = range: range * trivia: SynExprIfThenElseTrivia - /// F# syntax: ^T (for ^T.ident) or (for 'T.ident). - /// - /// NOTE: In the case of ^T.ident the Typar node is not initially in the tree as produced by the parser, - /// but rather is a IndexFromEnd node that is then processed using adjustHatPrefixToTyparLookup - /// when in arbitrary expression position. If ^expr occurs in index/slicing position then it is not processed - /// and the node is interpreted as from-the-end-indexing. + /// F# syntax: 'T (for 'T.ident). | Typar of typar: SynTypar * range: range /// F# syntax: ident diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 675fb3c50fe..6033b98e2f5 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -179,18 +179,6 @@ let tname_AsyncCallback = "System.AsyncCallback" let tname_IAsyncResult = "System.IAsyncResult" [] let tname_IsByRefLikeAttribute = "System.Runtime.CompilerServices.IsByRefLikeAttribute" -//[] -//let tname_IAdditionOperators = "System.Numerics.IAdditionOperators`3" -//[] -//let tname_INumberBase = "System.Numerics.INumberBase`1" -//[] -//let tname_IExponentialFunctions = "System.Numerics.IExponentialFunctions`1" -//[] -//let tname_IBinaryFloatingPointIeee754 = "System.Numerics.IBinaryFloatingPointIeee754`1" -//[] -//let tname_IBinaryInteger = "System.Numerics.IBinaryInteger`1" -//[] -//let tname_IBinaryInteger = "System.Numerics.IBinaryInteger`1" //------------------------------------------------------------------------- // Table of all these "globals" diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index daa3b219360..a77ec4df706 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -1,18 +1,5 @@ open System -let legacyConcat1 (x: string) (y: string) = x ^ y -let legacyConcat2 (x: string) (y: string) = x ^y -let legacyConcat3 (x: string) (y: string) = x^ y -let legacyConcat4 (x: string) (y: string) = x^y - -let testSlicingOne() = - let arr = [| 1;2;3;4;5 |] - arr.[^3..] - -let testSlicingTwo() = - let arr = [| 1;2;3;4;5 |] - arr[^3..] - type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = static abstract StaticProperty: 'T @@ -39,65 +26,66 @@ type C(c: int) = interface IUnitMethod with static member UnitMethod() = () -let f_IWSAM_explicit_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.op_Addition(x, y) +module ``Test basic IWSAM generic code`` = + let f_IWSAM_explicit_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) -let f_IWSAM_pretty_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.(+)(x, y) + let f_IWSAM_pretty_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.(+)(x, y) -let f_IWSAM_StaticProperty<'T when 'T :> IStaticProperty<'T>>() = - 'T.StaticProperty + let f_IWSAM_StaticProperty<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty -let f_IWSAM_declared_StaticMethod<'T when 'T :> IStaticMethod<'T>>(x: 'T) = - 'T.StaticMethod(x) + let f_IWSAM_declared_StaticMethod<'T when 'T :> IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) -let f_IWSAM_declared_UnitMethod<'T when 'T :> IUnitMethod<'T>>() = - 'T.UnitMethod() + let f_IWSAM_declared_UnitMethod<'T when 'T :> IUnitMethod<'T>>() = + 'T.UnitMethod() -let f_IWSAM_declared_UnitMethod_list<'T when 'T :> IUnitMethod<'T>>() = - let v = 'T.UnitMethod() - [ v ] + let f_IWSAM_declared_UnitMethod_list<'T when 'T :> IUnitMethod<'T>>() = + let v = 'T.UnitMethod() + [ v ] -let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = - 'T.StaticProperty + let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty -let f_IWSAM_flex_StaticMethod(x: #IStaticMethod<'T>) = - 'T.StaticMethod(x) + let f_IWSAM_flex_StaticMethod(x: #IStaticMethod<'T>) = + 'T.StaticMethod(x) -let inline f3<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.op_Addition(x,y) + let inline f3<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) -let inline f4<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = - 'T.op_Addition(x,y) + let inline f4<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) -let inline f5<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = - 'T.(+)(x,y) + let inline f5<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + 'T.(+)(x,y) -let inline f6<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = - x + y + let inline f6<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + x + y -let inline f_StaticProperty_IWSAM<'T when 'T :> IStaticProperty<'T>>() = - 'T.StaticProperty + let inline f_StaticProperty_IWSAM<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty -let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = - 'T.StaticProperty + let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty -let inline f_StaticProperty_BOTH<'T when 'T :> IStaticProperty<'T> and 'T : (static member StaticProperty: 'T) >() = - 'T.StaticProperty + let inline f_StaticProperty_BOTH<'T when 'T :> IStaticProperty<'T> and 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty -module CheckExecution = - if f_IWSAM_explicit_operator_name(C(3), C(4)).Value <> 7 then - failwith "incorrect value" + module CheckExecution = + if f_IWSAM_explicit_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" - if f_IWSAM_pretty_operator_name(C(3), C(4)).Value <> 7 then - failwith "incorrect value" + if f_IWSAM_pretty_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" - if f_IWSAM_StaticProperty().Value <> 7 then - failwith "incorrect value" + if f_IWSAM_StaticProperty().Value <> 7 then + failwith "incorrect value" +// Check that "Property" and "get_Property" and "set_Property" constraints are considered logically equivalent module EquivalenceOfPropertiesAndGetters = - // Check that "property" and "get_ method" constraints are considered logically equivalent let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() = (^T : (static member StaticProperty: int) ()) let inline f_StaticProperty_explicit<'T when 'T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) let inline f_StaticProperty_mixed<'T when 'T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member StaticProperty: int) ()) @@ -123,74 +111,12 @@ module EquivalenceOfPropertiesAndGetters = let inline f_Item_mixed<'T when 'T : (member get_Item: int -> string) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3)) let inline f_Item_mixed2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3)) - //let inline f_set_Item<'T when 'T : (member Item: int -> string with set) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, "a")) - //let inline f_set_Item_explicit<'T when 'T : (member set_Item: int * string -> int) >(x: 'T) = (^T : (member set_Item: int * string -> int) (x, 3, "a")) - - -module CheckSelfConstrainedSRTP = - type WithStaticProperty<'T when 'T : (static member StaticProperty: int)> = 'T - type WithStaticMethod<'T when 'T : (static member StaticMethod: int -> int)> = 'T - //type WithBoth<'T when WithStaticProperty<'T> and WithStaticMethod<'T>> = 'T - - let inline f_StaticProperty<'T when WithStaticProperty<'T>>() = 'T.StaticProperty - let inline f_StaticMethod<'T when WithStaticMethod<'T>>() = 'T.StaticMethod(3) - //let inline f_Both<'T when WithBoth<'T> >() = - // let v1 = 'T.StaticProperty - // let v2 = 'T.StaticMethod(3) - // v1 + v2 - - type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) - and 'T: (static member DivideByInt : 'T*int -> 'T) - and 'T: (static member Zero : 'T)> = 'T - - //let inline f_OK1<'T when WithBoth<'T>>() = - // 'T.StaticMethod(3) - // 'T.StaticMethod(3) - - //let inline f_OK2<'T when WithBoth<'T>>() = - // 'T.StaticMethod(3) - // 'T.StaticMethod(3) - - //let inline f_Bug1<'T when WithBoth<'T>>() = - // printfn "" - // 'T.StaticMethod(3) - //let inline f_Bug1<'T when WithBoth<'T>>() = - // 'T.StaticMethod(3) - // 'T.StaticMethod(3) - //let inline f_Bug2<'T when WithBoth<'T>>() = - // 'T.StaticMethod(3) - // 'T.StaticMethod(3) -// BUG - //let inline f_Both<'T when WithBoth<'T>>() = - // 'T.StaticMethod(3) - // 'T.StaticMethod(3) - - //'T.StaticMethod(3) |> ignore - -module CheckSelfSRTP = - type IStaticProperty<'T when IStaticProperty<'T>> = - static abstract StaticProperty: 'T - - type IStaticMethod<'T when IStaticMethod<'T>> = - static abstract StaticMethod: 'T -> 'T - - type IUnitMethod<'T when IUnitMethod<'T>> = - static abstract UnitMethod: unit -> unit - - type IAdditionOperator<'T when IAdditionOperator<'T>> = - static abstract op_Addition: 'T * 'T -> 'T - - type C(c: int) = - member _.Value = c - interface IAdditionOperator with - static member op_Addition(x, y) = C(x.Value + y.Value) - interface IStaticProperty with - static member StaticProperty = C(7) - interface IStaticMethod with - static member StaticMethod(x) = C(x.Value + 4) - interface IUnitMethod with - static member UnitMethod() = () + let inline f_set_Item<'T when 'T : (member Item: int -> string with set) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, "a")) + let inline f_set_Item_explicit<'T when 'T : (member set_Item: int * string -> unit) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, "a")) + let inline f_set_Item_mixed<'T when 'T : (member set_Item: int * string -> unit) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, "a")) + let inline f_set_Item_mixed2<'T when 'T : (member Item: int -> string with set) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, "a")) +module CheckSelfConstrainedIWSAM = let f_IWSAM_explicit_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = 'T.op_Addition(x, y) @@ -213,9 +139,43 @@ module CheckSelfSRTP = let inline f3<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = 'T.op_Addition(x,y) + type WithStaticProperty<'T when 'T : (static member StaticProperty: int)> = 'T + type WithStaticMethod<'T when 'T : (static member StaticMethod: int -> int)> = 'T + type WithBoth<'T when WithStaticProperty<'T> and WithStaticMethod<'T>> = 'T + + let inline f_StaticProperty<'T when WithStaticProperty<'T>>() = 'T.StaticProperty + let inline f_StaticMethod<'T when WithStaticMethod<'T>>() = 'T.StaticMethod(3) + let inline f_Both<'T when WithBoth<'T> >() = + let v1 = 'T.StaticProperty + let v2 = 'T.StaticMethod(3) + v1 + v2 + + let inline f_OK1<'T when WithBoth<'T>>() = + 'T.StaticMethod(3) + 'T.StaticMethod(3) + + let inline f_OK2<'T when WithBoth<'T>>() = + 'T.StaticMethod(3) + 'T.StaticMethod(3) + + let inline f_OK3<'T when WithBoth<'T>>() = + printfn "" + 'T.StaticMethod(3) + +module CheckSelfConstrainedSRTP = let inline f_StaticProperty_IWSAM<'T when IStaticProperty<'T>>() = 'T.StaticProperty + type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) + and 'T: (static member DivideByInt : 'T*int -> 'T) + and 'T: (static member Zero : 'T)> = 'T + + let inline f_AverageOps<'T when AverageOps<'T>>(xs: 'T[]) = + let mutable sum = 'T.Zero + for x in xs do + sum <- sum + x + 'T.DivideByInt(sum, xs.Length) + module CheckNewSyntax = // Check that "property" and "get_ method" constraints are considered logically equivalent let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() : int = 'T.StaticProperty @@ -230,10 +190,10 @@ module CheckNewSyntax = let inline f_Item1<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x.get_Item(3) - // Limitation: As yet the syntax "'T.StaticProperty <- 3" can't be used - // Limitation: As yet the syntax "x.Length <- 3" can't be used - // Limitation: As yet the syntax "x[3]" can't be used, nor can any slicing syntax - // Limitation: The disposal pattern can't be used with "use" + // Limitation by-design: As yet the syntax "'T.StaticProperty <- 3" can't be used + // Limitation by-design: As yet the syntax "x.Length <- 3" can't be used + // Limitation by-design: As yet the syntax "x[3]" can't be used, nor can any slicing syntax + // Limitation by-design: The disposal pattern can't be used with "use" //let inline f_set_StaticProperty2<'T when 'T : (static member StaticProperty: int with set) >() = 'T.StaticProperty <- 3 //let inline f_set_Length2<'T when 'T : (member Length: int with set) >(x: 'T) = x.Length <- 3 @@ -249,60 +209,43 @@ let inline f_StaticMethod_BOTH<'T when 'T :> IStaticMethod<'T> and 'T : (static 'T.StaticMethod(x) -#if NEGATIVE -module Negative = - let inline f_TraitWithOptional<'T when 'T : (static member StaticMethod: ?x: int -> int) >() = () - let inline f_TraitWithIn<'T when 'T : (static member StaticMethod: x: inref -> int) >() = () - let inline f_TraitWithOut<'T when 'T : (static member StaticMethod: x: outref -> int) >() = () - let inline f_TraitWithParamArray<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () - let inline f_TraitWithCallerName<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () - let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = () -#endif - - -module ``Use SRTP operators from generic IWSAM code`` = - let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - x + y - - let fSin<'T when ISinOperator<'T>>(x: 'T) = - sin x - -module ``Use SRTP operators from generic IWSAM code not rigid`` = - let fAdd(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = - x + y - - let fSin(x: 'T when ISinOperator<'T>) = - sin x - -module ``Use SRTP operators from generic IWSAM code flex`` = - let fAdd(x: #IAdditionOperator<'T>, y) = - x + y - - let fSin(x: #ISinOperator<'T>) = - sin x +module ``Use SRTP from IWSAM generic code`` = + module ``Use SRTP operators from generic IWSAM code`` = + let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + x + y -module ``Use SRTP operators from generic IWSAM code super flex`` = - let fAdd(x: #IAdditionOperator<_>, y) = - x + y + let fSin<'T when ISinOperator<'T>>(x: 'T) = + sin x - let fSin(x: #ISinOperator<_>) = - sin x + module ``Use SRTP operators from generic IWSAM code not rigid`` = + let fAdd(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = + x + y - //let fSin<'T when ISinOperator<'T>>(x: 'T) = - // sin x + let fSin(x: 'T when ISinOperator<'T>) = + sin x + module ``Use SRTP operators from generic IWSAM code flex`` = + let fAdd(x: #IAdditionOperator<'T>, y) = + x + y -let fExpectAWarning(x: ISinOperator<'T>) = - () + let fSin(x: #ISinOperator<'T>) = + sin x -(* -let inline f_SRTP_GoToDefinition_FindAllReferences (x: 'T) = - let y = x + x // implicitly adds constraint to type inference variable 'T - let z = 'T.op_Addition(x, x) // where would go-to-definition go? what does find-all-references do? - y + z -*) + module ``Use SRTP operators from generic IWSAM code super flex`` = + let fAdd(x: #IAdditionOperator<_>, y) = + x + y + let fSin(x: #ISinOperator<_>) = + sin x +// We should check the signatures reported for these definitions +// Expected: +// val inline f0: x: ^T -> ^T +// val g0: x: 'T -> 'T +// val inline f1: x: ^T -> int when ^T: (static member A: int) +// val inline f2: x: ^T -> int when (^T or int) : (static member A: int) +// val inline f3: x: ^T -> int when (^U or ^T) : (static member A: int) +// val inline f4: x: ^T -> int when ^T: (static member A: int) module CheckStaticTyparInference = let inline f0 (x: ^T) = x @@ -317,313 +260,41 @@ module CheckStaticTyparInference = let g5 (x: 'T) = f5 x // 'T should be inferred int let inline h5 (x: 'T) = f5 x // 'T should be inferred static because it has a choice constraint - - //val inline f0: x: ^T -> ^T - // val g0: x: 'T -> 'T - // val inline f1: x: ^T -> int when ^T: (static member A: int) - // val inline f2: x: ^T -> int when (^T or int) : (static member A: int) - // val inline f3: x: ^T -> int when (^U or ^T) : (static member A: int) - // val inline f4: x: ^T -> int when ^T: (static member A: int) -#if NEGATIVE -// this should fail compilation - the trait has multiple support types and can't be invoked using this syntax - let inline f5 (x: 'T when ('T or int) : (static member A: int) ) = 'T.A -#endif - -// This is tested in the bootstrap of FSharp.Core -module ``Check generalized type variables have correct staticness`` = - open System - let inline uint32 (value: ^T) = (^T : (static member op_Explicit: ^T -> uint32) (value)) let inline uint value = uint32 value // the inferred signature of this should also be static-required -module NullableOperators = - let (?>=) (x: Nullable<'T>) (y: 'T) = - x.HasValue && x.Value >= y + // This changed type in generalization - was caught by test suite incidentally + let checkReflexive f x y = (f x y = - f y x) - let (?>) (x: Nullable<'T>) (y: 'T) = - x.HasValue && x.Value > y +module TestLegacyThingsThatRegressedDuringRFC = + let legacyConcat1 (x: string) (y: string) = x ^ y + let legacyConcat2 (x: string) (y: string) = x ^y + let legacyConcat3 (x: string) (y: string) = x^ y + let legacyConcat4 (x: string) (y: string) = x^y - let (?<=) (x: Nullable<'T>) (y: 'T) = - x.HasValue && x.Value <= y + let testSlicingOne() = + let arr = [| 1;2;3;4;5 |] + arr.[^3..] - let (?<) (x: Nullable<'T>) (y: 'T) = - x.HasValue && x.Value < y + let testSlicingTwo() = + let arr = [| 1;2;3;4;5 |] + arr[^3..] - let (?=) (x: Nullable<'T>) (y: 'T) = - x.HasValue && x.Value = y +// These should all report errors or warnings +#if NEGATIVE +module Negative = + let inline f_TraitWithOptional<'T when 'T : (static member StaticMethod: ?x: int -> int) >() = () + let inline f_TraitWithIn<'T when 'T : (static member StaticMethod: x: inref -> int) >() = () + let inline f_TraitWithOut<'T when 'T : (static member StaticMethod: x: outref -> int) >() = () + let inline f_TraitWithParamArray<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () + let inline f_TraitWithCallerName<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () + let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = () - let (?<>) (x: Nullable<'T>) (y: 'T) = - not (x ?= y) - - let (>=?) (x: 'T) (y: Nullable<'T>) = - y.HasValue && x >= y.Value + let fExpectAWarning(x: ISinOperator<'T>) = + () - let (>?) (x: 'T) (y: Nullable<'T>) = - y.HasValue && x > y.Value - - let (<=?) (x: 'T) (y: Nullable<'T>) = - y.HasValue && x <= y.Value - - let () = - y.HasValue && x < y.Value - - let (=?) (x: 'T) (y: Nullable<'T>) = - y.HasValue && x = y.Value - - let (<>?) (x: 'T) (y: Nullable<'T>) = - not (x =? y) - - let (?>=?) (x: Nullable<'T>) (y: Nullable<'T>) = - (x.HasValue && y.HasValue && x.Value >= y.Value) - - let (?>?) (x: Nullable<'T>) (y: Nullable<'T>) = - (x.HasValue && y.HasValue && x.Value > y.Value) - - let (?<=?) (x: Nullable<'T>) (y: Nullable<'T>) = - (x.HasValue && y.HasValue && x.Value <= y.Value) - - let (?) (y: Nullable<'T>) = - (x.HasValue && y.HasValue && x.Value < y.Value) - - let (?=?) (x: Nullable<'T>) (y: Nullable<'T>) = - (not x.HasValue && not y.HasValue) - || (x.HasValue && y.HasValue && x.Value = y.Value) - - let (?<>?) (x: Nullable<'T>) (y: Nullable<'T>) = - not (x ?=? y) - - let inline (?+) (x: Nullable<_>) y = - if x.HasValue then - Nullable(x.Value + y) - else - Nullable() - - let inline (+?) x (y: Nullable<_>) = - if y.HasValue then - Nullable(x + y.Value) - else - Nullable() - - let inline (?+?) (x: Nullable<_>) (y: Nullable<_>) = - if x.HasValue && y.HasValue then - Nullable(x.Value + y.Value) - else - Nullable() - - let inline (?-) (x: Nullable<_>) y = - if x.HasValue then - Nullable(x.Value - y) - else - Nullable() - - let inline (-?) x (y: Nullable<_>) = - if y.HasValue then - Nullable(x - y.Value) - else - Nullable() - - let inline (?-?) (x: Nullable<_>) (y: Nullable<_>) = - if x.HasValue && y.HasValue then - Nullable(x.Value - y.Value) - else - Nullable() - - let inline (?*) (x: Nullable<_>) y = - if x.HasValue then - Nullable(x.Value * y) - else - Nullable() - - let inline ( *? ) x (y: Nullable<_>) = - if y.HasValue then - Nullable(x * y.Value) - else - Nullable() - - let inline (?*?) (x: Nullable<_>) (y: Nullable<_>) = - if x.HasValue && y.HasValue then - Nullable(x.Value * y.Value) - else - Nullable() - - let inline (?%) (x: Nullable<_>) y = - if x.HasValue then - Nullable(x.Value % y) - else - Nullable() - - let inline (%?) x (y: Nullable<_>) = - if y.HasValue then - Nullable(x % y.Value) - else - Nullable() - - let inline (?%?) (x: Nullable<_>) (y: Nullable<_>) = - if x.HasValue && y.HasValue then - Nullable(x.Value % y.Value) - else - Nullable() - - let inline (?/) (x: Nullable<_>) y = - if x.HasValue then - Nullable(x.Value / y) - else - Nullable() - - let inline (/?) x (y: Nullable<_>) = - if y.HasValue then - Nullable(x / y.Value) - else - Nullable() - - let inline (?/?) (x: Nullable<_>) (y: Nullable<_>) = - if x.HasValue && y.HasValue then - Nullable(x.Value / y.Value) - else - Nullable() - -module Nullable = - let inline uint8 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.byte value.Value) - else - Nullable() - - let inline int8 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.sbyte value.Value) - else - Nullable() - - let inline byte (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.byte value.Value) - else - Nullable() - - let inline sbyte (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.sbyte value.Value) - else - Nullable() - - let inline int16 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.int16 value.Value) - else - Nullable() - - let inline uint16 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.uint16 value.Value) - else - Nullable() - - let inline int (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.int value.Value) - else - Nullable() - - let inline uint (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.uint value.Value) - else - Nullable() - - let inline enum (value: Nullable) = - if value.HasValue then - Nullable(Operators.enum value.Value) - else - Nullable() - - let inline int32 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.int32 value.Value) - else - Nullable() - - let inline uint32 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.uint32 value.Value) - else - Nullable() - - let inline int64 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.int64 value.Value) - else - Nullable() - - let inline uint64 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.uint64 value.Value) - else - Nullable() - - let inline float32 (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.float32 value.Value) - else - Nullable() - - let inline float (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.float value.Value) - else - Nullable() - - let inline single (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.float32 value.Value) - else - Nullable() - - let inline double (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.float value.Value) - else - Nullable() - - let inline nativeint (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.nativeint value.Value) - else - Nullable() - - let inline unativeint (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.unativeint value.Value) - else - Nullable() - - let inline decimal (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.decimal value.Value) - else - Nullable() - - let inline char (value: Nullable<_>) = - if value.HasValue then - Nullable(Operators.char value.Value) - else - Nullable() -open System.Collections.Generic - -module HashIdentity = - - let inline NonStructural<'T when 'T: equality and 'T: (static member (=): 'T * 'T -> bool)> = - { new IEqualityComparer<'T> with - member _.GetHashCode(x) = - NonStructuralComparison.hash x - - member _.Equals(x, y) = - NonStructuralComparison.(=) x y - } - - -// This test case caused an error due to a change in generalization -module ``Caused error`` = - let checkReflexive f x y = (f x y = - f y x) +// this should fail compilation - the trait has multiple support types and can't be invoked using this syntax + let inline f5 (x: 'T when ('T or int) : (static member A: int) ) = 'T.A +#endif diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index e403a88e898..728d55383c2 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -73,13 +73,13 @@ Editor\BraceMatchingServiceTests.fs - Editor\EditorFormattingServiceTests.fs - + Editor\EditorFormattingServiceTests.fs + Editor\RoslynSourceTextTests.fs - Editor\IndentationServiceTests.fs + Editor\IndentationServiceTests.fs Editor\BreakpointResolutionService.fs From c9e62846633f56b098247e2271993445cd822890 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 11 Jul 2022 19:11:23 +0100 Subject: [PATCH 57/91] format code --- src/Compiler/Service/SemanticClassification.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index b22c0c84ddc..67056ab8218 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -278,8 +278,10 @@ module TcResolutionsExtensions = match minfos with | [] -> add m SemanticClassificationType.ConstructorForReferenceType | _ -> - if minfos - |> List.forall (fun minfo -> isDisposableTy g amap minfo.ApparentEnclosingType) then + if + minfos + |> List.forall (fun minfo -> isDisposableTy g amap minfo.ApparentEnclosingType) + then add m SemanticClassificationType.DisposableType elif minfos |> List.forall (fun minfo -> isStructTy g minfo.ApparentEnclosingType) then add m SemanticClassificationType.ConstructorForValueType From 6df8a343e97c3e73a4dad2f04eb6fdc072b82942 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 11 Jul 2022 19:58:00 +0100 Subject: [PATCH 58/91] fix build --- tests/service/SyntaxTreeTests/MemberFlagTests.fs | 16 ++++++++-------- .../Tests.ProjectSystem.References.fs | 11 ----------- 2 files changed, 8 insertions(+), 19 deletions(-) diff --git a/tests/service/SyntaxTreeTests/MemberFlagTests.fs b/tests/service/SyntaxTreeTests/MemberFlagTests.fs index 464884ae055..b95d91bae9d 100644 --- a/tests/service/SyntaxTreeTests/MemberFlagTests.fs +++ b/tests/service/SyntaxTreeTests/MemberFlagTests.fs @@ -89,25 +89,25 @@ type Foo = SynModuleOrNamespace.SynModuleOrNamespace(decls = [ SynModuleDecl.Types ([ SynTypeDefn.SynTypeDefn (typeRepr = SynTypeDefnRepr.ObjectModel (members=[ - SynMemberDefn.AutoProperty(memberFlags= mkFlags1) - SynMemberDefn.AutoProperty(memberFlags= mkFlags2) - SynMemberDefn.AutoProperty(memberFlags= mkFlags3) - SynMemberDefn.AutoProperty(memberFlags= mkFlags4) + SynMemberDefn.AutoProperty(memberFlags= flags1) + SynMemberDefn.AutoProperty(memberFlags= flags2) + SynMemberDefn.AutoProperty(memberFlags= flags3) + SynMemberDefn.AutoProperty(memberFlags= flags4) ])) ], _) ]) ])) -> - let ({ Trivia = flagsTrivia1 } : SynMemberFlags) = mkFlags1 SynMemberKind.Member + let ({ Trivia = flagsTrivia1 } : SynMemberFlags) = flags1 assertRange (3, 4) (3, 10) flagsTrivia1.StaticRange.Value assertRange (3, 11) (3, 17) flagsTrivia1.MemberRange.Value - let ({ Trivia = flagsTrivia2 } : SynMemberFlags) = mkFlags2 SynMemberKind.Member + let ({ Trivia = flagsTrivia2 } : SynMemberFlags) = flags2 assertRange (4, 4) (4, 10) flagsTrivia2.MemberRange.Value - let ({ Trivia = flagsTrivia3 } : SynMemberFlags) = mkFlags3 SynMemberKind.Member + let ({ Trivia = flagsTrivia3 } : SynMemberFlags) = flags3 assertRange (5, 4) (5, 12) flagsTrivia3.OverrideRange.Value - let ({ Trivia = flagsTrivia4 } : SynMemberFlags) = mkFlags4 SynMemberKind.Member + let ({ Trivia = flagsTrivia4 } : SynMemberFlags) = flags4 assertRange (6, 4) (6, 11) flagsTrivia4.DefaultRange.Value | _ -> Assert.Fail "Could not get valid AST" diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs index 3ec3428c349..f97e58ce654 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs @@ -243,17 +243,6 @@ type References() = with e -> TheTests.HelpfulAssertMatches ' ' "A reference to '.*' could not be added. A reference to the component '.*' already exists in the project." e.Message - /// Create a dummy project named 'Test', build it, and then call k with the full path to the resulting exe - member public this.CreateDummyTestProjectBuildItAndDo(k : string -> unit) = - this.MakeProjectAndDo(["foo.fs"], [], "", (fun project -> - // Let's create a run-of-the-mill project just to have a spare assembly around - let fooPath = Path.Combine(project.ProjectFolder, "foo.fs") - File.AppendAllText(fooPath, "namespace Foo\nmodule Bar =\n let x = 42") - let buildResult = project.Build("Build") - Assert.IsTrue buildResult.IsSuccessful - let exe = Path.Combine(project.ProjectFolder, "bin\\Debug\\Test.exe") - k exe)) - [] member this.``ReferenceResolution.Bug4423.NonFxAssembly.BrowseTab.RelativeHintPath.InsideProjectDir``() = // Let's create a run-of-the-mill project just to have a spare assembly around From 9d33a53f142d2202be91969cb87e0b4cb547c3ea Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 11 Jul 2022 20:55:26 +0100 Subject: [PATCH 59/91] Update LanguageFeatures.fs --- src/Compiler/Facilities/LanguageFeatures.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Compiler/Facilities/LanguageFeatures.fs b/src/Compiler/Facilities/LanguageFeatures.fs index cb1da74e083..68594ade31e 100644 --- a/src/Compiler/Facilities/LanguageFeatures.fs +++ b/src/Compiler/Facilities/LanguageFeatures.fs @@ -49,9 +49,9 @@ type LanguageFeature = | DelegateTypeNameResolutionFix | ReallyLongLists | ErrorOnDeprecatedRequireQualifiedAccess - | SelfTypeConstraints | LowercaseDUWhenRequireQualifiedAccess | InterfacesWithAbstractStaticMembers + | SelfTypeConstraints /// LanguageVersion management type LanguageVersion(versionText) = From fb5012650f19eced73a20a3399b70c21a2b10281 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 11 Jul 2022 22:27:11 +0100 Subject: [PATCH 60/91] merge main --- vsintegration/tests/UnitTests/QuickInfoTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/tests/UnitTests/QuickInfoTests.fs b/vsintegration/tests/UnitTests/QuickInfoTests.fs index d70c6d2c6e0..f397be19e01 100644 --- a/vsintegration/tests/UnitTests/QuickInfoTests.fs +++ b/vsintegration/tests/UnitTests/QuickInfoTests.fs @@ -434,7 +434,7 @@ namespace FsTest module Test = let fu$$nc x = () """>] -let ``Automation.LetBindings.InsideType.Instance`` code = +let ``Automation.LetBindings.Module`` code = let expectedSignature = "val func: x: 'a -> unit" let tooltip = GetQuickInfoTextFromCode code StringAssert.StartsWith(expectedSignature, tooltip) From 5aaa9a12a69b371d1132cc9a54047f2fc8aa7f0f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 11 Jul 2022 23:21:37 +0100 Subject: [PATCH 61/91] fix build --- src/Compiler/Checking/CheckExpressions.fs | 6 +++--- src/Compiler/pars.fsy | 4 ++-- src/FSharp.Build/FSharp.Build.fsproj | 9 +++++---- 3 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 22178a43f9b..8e1375c7e2d 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -3522,7 +3522,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr mkCompGenLocal m "enumerator" getEnumeratorRetTy, getEnumeratorRetTy let getEnumExpr, getEnumTy = - let getEnumExpr, getEnumTy as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumeratorMethInfo NormalValUse getEnumerator_minst [exprToSearchForGetEnumeratorAndItem] [] None + let getEnumExpr, getEnumTy as res = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false getEnumeratorMethInfo NormalValUse getEnumeratorMethInst [exprToSearchForGetEnumeratorAndItem] [] None if not isEnumeratorTypeStruct || localAlloc then res else // wrap enumerators that are represented as mutable structs into ref cells @@ -3530,8 +3530,8 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr let getEnumTy = mkRefCellTy g getEnumTy getEnumExpr, getEnumTy - let guardExpr, guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNextMethInfo NormalValUse moveNext_minst [enumeratorExpr] [] None - let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true getCurrentMethInfo NormalValUse get_Current_minst [enumeratorExpr] [] None + let guardExpr, guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNextMethInfo NormalValUse moveNextMethInst [enumeratorExpr] [] None + let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true getCurrentMethInfo NormalValUse getCurrentMethInst [enumeratorExpr] [] None let currentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) let currentExpr, enumElemTy = // Implicitly dereference byref for expr 'for x in ...' diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index c22ea20710d..0279bdd2b2e 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -1079,7 +1079,7 @@ classMemberSpfn: | None -> m | Some e -> unionRanges m e.Range let trivia = { ValKeyword = None; WithKeyword = mWith; EqualsRange = mEquals } - let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, optLiteralValue, wholeRange, trivia) + let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, vis2, optLiteralValue, mWhole, trivia) let flags = $3 (getSetAdjuster arity) SynMemberSig.Member(valSpfn, flags, mWhole) } @@ -1937,7 +1937,7 @@ classDefnMember: | None -> unionRanges m ty.Range | Some m2 -> unionRanges m m2 |> unionRangeWithXmlDoc doc - if Option.isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(), wholeRange)) + if Option.isSome $2 then errorR(Error(FSComp.SR.parsAccessibilityModsIllegalForAbstract(), mWhole)) let trivia = { ValKeyword = None; WithKeyword = mWith; EqualsRange = None } let valSpfn = SynValSig($1, id, explicitValTyparDecls, ty, arity, isInline, false, doc, None, None, mWhole, trivia) [ SynMemberDefn.AbstractSlot(valSpfn, $3 (getSetAdjuster arity), mWhole) ] } diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index 56abe4a113a..ce010764b62 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -4,14 +4,15 @@ Library - netstandard2.0 + netstandard2.0 + netstandard2.0 FSharp.Build $(NoWarn);75 true $(DefineConstants);LOCALIZATION_FSBUILD NU1701;FS0075 true - 6.0 + 5.0 @@ -57,10 +58,10 @@ The FSharp.Build built here may be loaded directly into a shipped Visual Studio, to that end, we cannot rely on new API's just being added to FSharp.Core. --> - + - + From 6c783a72e50b4e400687e0f0495d96cd95b2d736 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Wed, 13 Jul 2022 17:42:48 +0200 Subject: [PATCH 62/91] Moved tests/adhoc to ComponentTests --- .../IWSAM/IWSAMTests.fs | 304 ++++++++++++++++++ .../TypesAndTypeConstraints/IWSAM/Types.fs | 27 ++ .../IWSAM/testFiles/BasicTests.fs | 61 ++++ .../IWSAM/testFiles/CheckNewSyntax.fs | 40 +++ .../testFiles/CheckSelfConstrainedIWSAM.fs | 51 +++ .../testFiles/CheckSelfConstrainedSRTP.fs | 18 ++ .../TestLegacyThingsThatRegressedDuringRFC.fs | 17 + .../testFiles/UseSRTPFromIWSAMGenericCode.fs | 33 ++ .../FSharp.Compiler.ComponentTests.fsproj | 1 + .../Interop/StaticsInInterfaces.fs | 1 + tests/FSharp.Test.Utilities/Compiler.fs | 121 +++---- tests/adhoc.fsx | 300 ----------------- 12 files changed, 618 insertions(+), 356 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/Types.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/BasicTests.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedIWSAM.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedSRTP.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs create mode 100644 tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/UseSRTPFromIWSAMGenericCode.fs delete mode 100644 tests/adhoc.fsx diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs new file mode 100644 index 00000000000..ae377b7329e --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs @@ -0,0 +1,304 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +module FSharp.Compiler.ComponentTests.Conformance.TypeAndTypeConstraints.IWSAM + +open Xunit +open System.IO +open FSharp.Test +open FSharp.Test.Compiler + +let typesModule = + FSharp (loadSourceFromFile (Path.Combine(__SOURCE_DIRECTORY__, "Types.fs"))) + |> withName "Types" + |> withLangVersionPreview + |> withOptions ["--nowarn:3535"] + +let setupCompilation compilation = + compilation + |> asExe + |> withLangVersionPreview + |> withReferences [typesModule] + +[] +let ``IWSAM test files`` compilation = + compilation + |> setupCompilation + |> compileAndRun + |> shouldSucceed + +[] +[ ^T")>] +[ 'T")>] + +[ int when ^T: (static member A: int)")>] + +[ int when (^T or int) : (static member A: int)")>] + +[ int when (^U or ^T) : (static member A: int)")>] + +[ unit")>] +[ unit when ^T: (byte|int16|int32|int64|sbyte|uint16|uint32|uint64|nativeint|unativeint)")>] +[ uint32) (value)) + let inline uint value = uint32 value""", + "val inline uint: value: ^a -> uint32 when ^a: (static member op_Explicit: ^a -> uint32)")>] + +[ 'a -> int) -> x: 'a -> y: 'a -> bool")>] +let ``Check static type parameter inference`` code expectedSignature = + FSharp code + |> ignoreWarnings + |> signaturesShouldContain expectedSignature + + +module ``Equivalence of properties and getters`` = + + [] + [() = (^T : (static member StaticProperty: int) ())")>] + [ int) >() = (^T : (static member get_StaticProperty: unit -> int) ())")>] + [ int) >() = (^T : (static member StaticProperty: int) ())")>] + [() = (^T : (static member get_StaticProperty: unit -> int) ())")>] + let ``Static property getter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static int32 f_StaticProperty() cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of get_StaticProperty is not su" + + "pported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static int32 f_StaticProperty$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 get_StaticProperty) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldnull + IL_0002: tail. + IL_0004: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0009: ret + }"""] + + [] + [() = (^T : (static member StaticProperty: int with set) (3))")>] + [ unit) >() = (^T : (static member set_StaticProperty: int -> unit) (3))")>] + [ unit) >() = (^T : (static member StaticProperty: int with set) (3))")>] + [() = (^T : (static member set_StaticProperty: int -> unit) (3))")>] + let ``Static property setter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static void f_set_StaticProperty() cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of set_StaticProperty is not su" + + "pported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static void f_set_StaticProperty$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 set_StaticProperty) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldc.i4.3 + IL_0002: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0007: pop + IL_0008: ret + }"""] + + [] + [(x: 'T) = (^T : (member Length: int) (x))")>] + [ int) >(x: 'T) = (^T : (member get_Length: unit -> int) (x))")>] + [ int) >(x: 'T) = (^T : (member Length: int) (x))")>] + [(x: 'T) = (^T : (member get_Length: unit -> int) (x))")>] + let ``Instance property getter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static int32 f_Length(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of get_Length is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static int32 f_Length$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 get_Length, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: tail. + IL_0004: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0009: ret + }"""] + + [] + [(x: 'T) = (^T : (member Length: int with set) (x, 3))")>] + [ unit) >(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3))")>] + [ unit) >(x: 'T) = (^T : (member Length: int with set) (x, 3))")>] + [(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3))")>] + let ``Instance property setter`` code = + Fsx code + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static void f_set_Length(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of set_Length is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static void f_set_Length$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> set_Length, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: ldc.i4.3 + IL_0003: call !!0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, + !0, + !1) + IL_0008: pop + IL_0009: ret + }"""] + + [] + [ string with get) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3))")>] + [ string) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3))")>] + [ string) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3))")>] + [ string with get) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3))")>] + let ``Get item`` code = + Fsx code + |> withOptions ["--nowarn:77"] + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static string f_Item(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of get_Item is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static string f_Item$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2> get_Item, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: ldc.i4.3 + IL_0003: tail. + IL_0005: call !!0 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>, + !0, + !1) + IL_000a: ret + }"""] + + [] + [ string with set) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, \"a\"))")>] + [ unit) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, \"a\"))")>] + [ unit) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, \"a\"))")>] + [ string with set) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, \"a\"))")>] + let ``Set item`` code = + Fsx code + |> withOptions ["--nowarn:77"] + |> compile + |> shouldSucceed + |> verifyIL [""" + .method public static void f_set_Item(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldstr "Dynamic invocation of set_Item is not supported" + IL_0005: newobj instance void [runtime]System.NotSupportedException::.ctor(string) + IL_000a: throw + } + + .method public static void f_set_Item$W(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>> set_Item, + !!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: ldc.i4.3 + IL_0003: ldstr "a" + IL_0008: call !!1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::InvokeFast(class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2>>, + !0, + !1, + !!0) + IL_000d: pop + IL_000e: ret + }"""] + + +module Negative = + + [] + [ int) >() = ()")>] + [ -> int) >() = ()")>] + [ -> int) >() = ()")>] + [] x: int[] -> int) >() = ()")>] + [] x: int[] -> int) >() = ()")>] + [> -> int) >() = ()")>] + let ``Trait warning`` code = + Fsx code + |> compile + |> shouldFail + |> withWarningCode 3532 + |> withDiagnosticMessage "A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" + |> ignore + + [] + let ``IWSAM waring`` () = + Fsx "let fExpectAWarning(x: Types.ISinOperator<'T>) = ()" + |> withReferences [typesModule] + |> compile + |> shouldFail + |> withWarningCode 3536 + |> withDiagnosticMessage """'ISinOperator<_>' is normally used as a type constraint in generic code, e.g. "'T when ISomeInterface<'T>" or "let f (x: #ISomeInterface<_>)". See https://aka.ms/fsharp-iwsams for guidance. You can disable this warning by using '#nowarn "3536"' or '--nowarn:3536'.""" + |> ignore + + [] + let ``Multiple support types trait error`` () = + Fsx "let inline f5 (x: 'T when ('T or int) : (static member A: int) ) = 'T.A" + |> compile + |> shouldFail + |> withErrorCode 3537 + |> withDiagnosticMessage "The trait 'A' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance." + |> ignore diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/Types.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/Types.fs new file mode 100644 index 00000000000..95bb0282752 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/Types.fs @@ -0,0 +1,27 @@ +module Types + +type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = + static abstract StaticProperty: 'T + +type IStaticMethod<'T when 'T :> IStaticMethod<'T>> = + static abstract StaticMethod: 'T -> 'T + +type IUnitMethod<'T when 'T :> IUnitMethod<'T>> = + static abstract UnitMethod: unit -> unit + +type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = + static abstract op_Addition: 'T * 'T -> 'T + +type ISinOperator<'T when 'T :> ISinOperator<'T>> = + static abstract Sin: 'T -> 'T + +type C(c: int) = + member _.Value = c + interface IAdditionOperator with + static member op_Addition(x, y) = C(x.Value + y.Value) + interface IStaticProperty with + static member StaticProperty = C(7) + interface IStaticMethod with + static member StaticMethod(x) = C(x.Value + 4) + interface IUnitMethod with + static member UnitMethod() = () diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/BasicTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/BasicTests.fs new file mode 100644 index 00000000000..420b85ab2f5 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/BasicTests.fs @@ -0,0 +1,61 @@ +open Types + +module ``Test basic IWSAM generic code`` = + + let f_IWSAM_explicit_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + + let f_IWSAM_pretty_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.(+)(x, y) + + let f_IWSAM_StaticProperty<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty + + let f_IWSAM_declared_StaticMethod<'T when 'T :> IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) + + let f_IWSAM_declared_UnitMethod<'T when 'T :> IUnitMethod<'T>>() = + 'T.UnitMethod() + + let f_IWSAM_declared_UnitMethod_list<'T when 'T :> IUnitMethod<'T>>() = + let v = 'T.UnitMethod() + [ v ] + + let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = + 'T.StaticProperty + + let f_IWSAM_flex_StaticMethod(x: #IStaticMethod<'T>) = + 'T.StaticMethod(x) + + + let inline f3<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) + + let inline f4<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) + + let inline f5<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + 'T.(+)(x,y) + + let inline f6<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = + x + y + + let inline f_StaticProperty_IWSAM<'T when 'T :> IStaticProperty<'T>>() = + 'T.StaticProperty + + let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + + let inline f_StaticProperty_BOTH<'T when 'T :> IStaticProperty<'T> and 'T : (static member StaticProperty: 'T) >() = + 'T.StaticProperty + + + module CheckExecution = + if f_IWSAM_explicit_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + + if f_IWSAM_pretty_operator_name(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + + if f_IWSAM_StaticProperty().Value <> 7 then + failwith "incorrect value" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs new file mode 100644 index 00000000000..b371fc0f25b --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs @@ -0,0 +1,40 @@ +open Types + +module CheckNewSyntax = + + type MyType() = + static member val StaticProperty = 0 with get, set + static member StaticMethod x = x + 5 + member val Length = 0 with get, set + + // Check that "property" and "get_ method" constraints are considered logically equivalent + let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() : int = 'T.StaticProperty + + let inline f_StaticMethod<'T when 'T : (static member StaticMethod: int -> int) >() : int = 'T.StaticMethod(3) + + let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3) + + let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = x.Length + + let inline f_set_Length<'T when 'T : (member Length: int with set) >(x: 'T) = x.set_Length(3) + + let inline f_Item1<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x.get_Item(3) + + // Limitation by-design: As yet the syntax "'T.StaticProperty <- 3" can't be used + // Limitation by-design: As yet the syntax "x.Length <- 3" can't be used + // Limitation by-design: As yet the syntax "x[3]" can't be used, nor can any slicing syntax + // Limitation by-design: The disposal pattern can't be used with "use" + + //let inline f_set_StaticProperty2<'T when 'T : (static member StaticProperty: int with set) >() = 'T.StaticProperty <- 3 + //let inline f_set_Length2<'T when 'T : (member Length: int with set) >(x: 'T) = x.Length <- 3 + //let inline f_Item2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x[3] + + assert (f_StaticMethod() = 8) + assert (f_set_StaticProperty() = ()) + assert (f_StaticProperty() = 3) + + let myInstance = MyType() + + assert (f_set_Length(myInstance) = ()) + assert (f_Length(myInstance) = 3) + assert false \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedIWSAM.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedIWSAM.fs new file mode 100644 index 00000000000..3755c6bfc86 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedIWSAM.fs @@ -0,0 +1,51 @@ +open System +open Types + +module CheckSelfConstrainedIWSAM = + + let f_IWSAM_explicit_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + + let f_IWSAM_pretty_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.(+)(x, y) + + let f_IWSAM_StaticProperty<'T when IStaticProperty<'T>>() = + 'T.StaticProperty + + let f_IWSAM_declared_StaticMethod<'T when IStaticMethod<'T>>(x: 'T) = + 'T.StaticMethod(x) + + let f_IWSAM_declared_UnitMethod<'T when IUnitMethod<'T>>() = + 'T.UnitMethod() + + let f_IWSAM_declared_UnitMethod_list<'T when IUnitMethod<'T>>() = + let v = 'T.UnitMethod() + [ v ] + + let inline f3<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x,y) + + type WithStaticProperty<'T when 'T : (static member StaticProperty: int)> = 'T + type WithStaticMethod<'T when 'T : (static member StaticMethod: int -> int)> = 'T + type WithBoth<'T when WithStaticProperty<'T> and WithStaticMethod<'T>> = 'T + + let inline f_StaticProperty<'T when WithStaticProperty<'T>>() = 'T.StaticProperty + let inline f_StaticMethod<'T when WithStaticMethod<'T>>() = 'T.StaticMethod(3) + let inline f_Both<'T when WithBoth<'T> >() = + let v1 = 'T.StaticProperty + let v2 = 'T.StaticMethod(3) + v1 + v2 + + let inline f_OK1<'T when WithBoth<'T>>() = + 'T.StaticMethod(3) |> ignore + 'T.StaticMethod(3) + + let inline f_OK2<'T when WithBoth<'T>>() = + 'T.StaticMethod(3) |> ignore + 'T.StaticMethod(3) + + let inline f_OK3<'T when WithBoth<'T>>() = + printfn "" + 'T.StaticMethod(3) + + printfn "" \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedSRTP.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedSRTP.fs new file mode 100644 index 00000000000..c96e1481cdc --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedSRTP.fs @@ -0,0 +1,18 @@ +open Types + +module CheckSelfConstrainedSRTP = + + let inline f_StaticProperty_IWSAM<'T when IStaticProperty<'T>>() = + 'T.StaticProperty + + type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) + and 'T: (static member DivideByInt : 'T*int -> 'T) + and 'T: (static member Zero : 'T)> = 'T + + let inline f_AverageOps<'T when AverageOps<'T>>(xs: 'T[]) = + let mutable sum = 'T.Zero + for x in xs do + sum <- sum + x + 'T.DivideByInt(sum, xs.Length) + + printfn "" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs new file mode 100644 index 00000000000..b7080061a72 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs @@ -0,0 +1,17 @@ +#nowarn "62" + +module TestLegacyThingsThatRegressedDuringRFC = + let legacyConcat1 (x: string) (y: string) = x ^ y + let legacyConcat2 (x: string) (y: string) = x ^y + let legacyConcat3 (x: string) (y: string) = x^ y + let legacyConcat4 (x: string) (y: string) = x^y + + let testSlicingOne() = + let arr = [| 1;2;3;4;5 |] + arr.[^3..] + + let testSlicingTwo() = + let arr = [| 1;2;3;4;5 |] + arr[^3..] + + printfn "" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/UseSRTPFromIWSAMGenericCode.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/UseSRTPFromIWSAMGenericCode.fs new file mode 100644 index 00000000000..de287cbf754 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/UseSRTPFromIWSAMGenericCode.fs @@ -0,0 +1,33 @@ +#nowarn "64" +open Types + +module ``Use SRTP from IWSAM generic code`` = + module ``Use SRTP operators from generic IWSAM code`` = + let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + x + y + + let fSin<'T when ISinOperator<'T>>(x: 'T) = + sin x + + module ``Use SRTP operators from generic IWSAM code not rigid`` = + let fAdd(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = + x + y + + let fSin(x: 'T when ISinOperator<'T>) = + sin x + + module ``Use SRTP operators from generic IWSAM code flex`` = + let fAdd(x: #IAdditionOperator<'T>, y) = + x + y + + let fSin(x: #ISinOperator<'T>) = + sin x + + module ``Use SRTP operators from generic IWSAM code super flex`` = + let fAdd(x: #IAdditionOperator<_>, y) = + x + y + + let fSin(x: #ISinOperator<_>) = + sin x + + printfn "" diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index ef93bc62772..90191144d56 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -84,6 +84,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index e952fbf8ae1..83947f82c57 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -406,3 +406,4 @@ let main _ = |> withLangVersionPreview |> compileAndRun |> shouldSucceed + // TODO: verifyIL diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 54822b93d80..b55104faa09 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -137,7 +137,7 @@ module rec Compiler = type Disposable (dispose : unit -> unit) = interface IDisposable with - member this.Dispose() = + member this.Dispose() = dispose() type ErrorInfo = @@ -145,15 +145,13 @@ module rec Compiler = Range: Range Message: string } - type EvalOutput = Result - type ExecutionOutput = { ExitCode: int StdOut: string StdErr: string } type RunOutput = - | EvalOutput of EvalOutput + | EvalOutput of Result | ExecutionOutput of ExecutionOutput type CompilationOutput = @@ -168,6 +166,9 @@ module rec Compiler = type CompilationResult = | Success of CompilationOutput | Failure of CompilationOutput + with + member this.Output = match this with Success o | Failure o -> o + member this.RunOutput = this.Output.Output type ExecutionPlatform = | Anycpu = 0 @@ -464,7 +465,7 @@ module rec Compiler = let withPlatform (platform:ExecutionPlatform) (cUnit: CompilationUnit) : CompilationUnit = match cUnit with - | FS _ -> + | FS _ -> let p = match platform with | ExecutionPlatform.Anycpu -> "anycpu" @@ -575,7 +576,7 @@ module rec Compiler = Dependencies = [] Adjust = 0 Diagnostics = [] - Output = None + Output = None Compilation = CS csSource } if cmplResult.Success then @@ -664,7 +665,7 @@ module rec Compiler = Dependencies = [] Adjust = 0 Diagnostics = diagnostics - Output = None + Output = None Compilation = FS fsSource } if failed then @@ -694,7 +695,7 @@ module rec Compiler = Dependencies = [] Adjust = 0 Diagnostics = diagnostics - Output = None + Output = None Compilation = FS fsSource } let (errors, warnings) = partitionErrors diagnostics @@ -747,18 +748,18 @@ module rec Compiler = let options = fs.Options |> Array.ofList use script = new FSharpScript(additionalArgs=options) - let ((evalresult: Result), (err: FSharpDiagnostic[])) = script.Eval(source) + let (evalResult: Result), (err: FSharpDiagnostic[]) = script.Eval(source) let diagnostics = err |> fromFSharpDiagnostic let result = { OutputPath = None Dependencies = [] Adjust = 0 Diagnostics = diagnostics - Output = Some(EvalOutput evalresult) + Output = Some (EvalOutput evalResult) Compilation = FS fs } let (errors, warnings) = partitionErrors diagnostics - let evalError = match evalresult with Ok _ -> false | _ -> true + let evalError = match evalResult with Ok _ -> false | _ -> true if evalError || errors.Length > 0 || (warnings.Length > 0 && not fs.IgnoreWarnings) then CompilationResult.Failure result else @@ -807,7 +808,7 @@ module rec Compiler = Dependencies = [] Adjust = 0 Diagnostics = [] - Output = None + Output = None Compilation = cUnit } if errors.Count > 0 then @@ -966,19 +967,19 @@ module rec Compiler = let private verifySequencePoints (reader: MetadataReader) expectedSequencePoints = - let sequencePoints = + let sequencePoints = [ for sp in reader.MethodDebugInformation do let mdi = reader.GetMethodDebugInformation sp yield! mdi.GetSequencePoints() ] |> List.sortBy (fun sp -> sp.StartLine) |> List.map (fun sp -> (Line sp.StartLine, Col sp.StartColumn, Line sp.EndLine, Col sp.EndColumn) ) - + if sequencePoints <> expectedSequencePoints then failwith $"Expected sequence points are different from PDB.\nExpected: %A{expectedSequencePoints}\nActual: %A{sequencePoints}" let private verifyDocuments (reader: MetadataReader) expectedDocuments = - let documents = + let documents = [ for doc in reader.Documents do if not doc.IsNil then let di = reader.GetDocument doc @@ -987,7 +988,7 @@ module rec Compiler = let name = reader.GetString nmh name ] |> List.sort - + let expectedDocuments = expectedDocuments |> List.sort if documents <> expectedDocuments then @@ -1097,7 +1098,7 @@ module rec Compiler = match result with | CompilationResult.Success _ -> result | CompilationResult.Failure r -> - let message = + let message = [ sprintf "Operation failed (expected to succeed).\n All errors:\n%A\n" r.Diagnostics match r.Output with | Some (ExecutionOutput output) -> @@ -1108,12 +1109,12 @@ module rec Compiler = let shouldFail (result: CompilationResult) : CompilationResult = match result with - | CompilationResult.Success _ -> failwith "Operation was succeeded (expected to fail)." + | CompilationResult.Success _ -> failwith "Operation succeeded (expected to fail)." | CompilationResult.Failure _ -> result let private assertResultsCategory (what: string) (selector: CompilationOutput -> ErrorInfo list) (expected: ErrorInfo list) (result: CompilationResult) : CompilationResult = match result with - | CompilationResult.Success r + | CompilationResult.Success r | CompilationResult.Failure r -> assertErrors what r.Adjust (selector r) expected result @@ -1182,6 +1183,12 @@ module rec Compiler = let private diagnosticMatches (pattern: string) (diagnostics: ErrorInfo list) : bool = diagnostics |> List.exists (fun d -> Regex.IsMatch(d.Message, pattern)) + let withDiagnosticMessage (message: string) (result: CompilationResult) : CompilationResult = + let messages = [for d in result.Output.Diagnostics -> d.Message] + if not (messages |> List.exists ((=) message)) then + failwith $"Message:\n{message}\n\nwas not found. All diagnostic messages:\n{messages}" + result + let withDiagnosticMessageMatches (pattern: string) (result: CompilationResult) : CompilationResult = match result with | CompilationResult.Success r @@ -1217,30 +1224,24 @@ module rec Compiler = withWarningMessages [message] result let withExitCode (expectedExitCode: int) (result: CompilationResult) : CompilationResult = - match result with - | CompilationResult.Success r - | CompilationResult.Failure r -> - match r.Output with - | None -> failwith "Execution output is missing, cannot check exit code." - | Some o -> - match o with - | ExecutionOutput e -> Assert.AreEqual(e.ExitCode, expectedExitCode, sprintf "Exit code was expected to be: %A, but got %A." expectedExitCode e.ExitCode) - | _ -> failwith "Cannot check exit code on this run result." + match result.RunOutput with + | None -> failwith "Execution output is missing, cannot check exit code." + | Some o -> + match o with + | ExecutionOutput e -> Assert.AreEqual(e.ExitCode, expectedExitCode, sprintf "Exit code was expected to be: %A, but got %A." expectedExitCode e.ExitCode) + | _ -> failwith "Cannot check exit code on this run result." result let private checkOutput (category: string) (substring: string) (selector: ExecutionOutput -> string) (result: CompilationResult) : CompilationResult = - match result with - | CompilationResult.Success r - | CompilationResult.Failure r -> - match r.Output with - | None -> failwith (sprintf "Execution output is missing cannot check \"%A\"" category) - | Some o -> - match o with - | ExecutionOutput e -> - let where = selector e - if not (where.Contains(substring)) then - failwith (sprintf "\nThe following substring:\n %A\nwas not found in the %A\nOutput:\n %A" substring category where) - | _ -> failwith "Cannot check output on this run result." + match result.RunOutput with + | None -> failwith (sprintf "Execution output is missing cannot check \"%A\"" category) + | Some o -> + match o with + | ExecutionOutput e -> + let where = selector e + if not (where.Contains(substring)) then + failwith (sprintf "\nThe following substring:\n %A\nwas not found in the %A\nOutput:\n %A" substring category where) + | _ -> failwith "Cannot check output on this run result." result let withOutputContains (substring: string) (result: CompilationResult) : CompilationResult = @@ -1252,23 +1253,13 @@ module rec Compiler = let withStdErrContains (substring: string) (result: CompilationResult) : CompilationResult = checkOutput "STDERR" substring (fun o -> o.StdErr) result - // TODO: probably needs a bit of simplification, + need to remove that pyramid of doom. let private assertEvalOutput (selector: FsiValue -> 'T) (value: 'T) (result: CompilationResult) : CompilationResult = - match result with - | CompilationResult.Success r - | CompilationResult.Failure r -> - match r.Output with - | None -> failwith "Execution output is missing cannot check value." - | Some o -> - match o with - | EvalOutput e -> - match e with - | Ok v -> - match v with - | None -> failwith "Cannot assert value of evaluation, since it is None." - | Some e -> Assert.AreEqual(value, (selector e)) - | Result.Error ex -> raise ex - | _ -> failwith "Only 'eval' output is supported." + match result.RunOutput with + | None -> failwith "Execution output is missing cannot check value." + | Some (EvalOutput (Ok (Some e))) -> Assert.AreEqual(value, (selector e)) + | Some (EvalOutput (Ok None )) -> failwith "Cannot assert value of evaluation, since it is None." + | Some (EvalOutput (Result.Error ex)) -> raise ex + | Some _ -> failwith "Only 'eval' output is supported." result // TODO: Need to support for: @@ -1280,3 +1271,21 @@ module rec Compiler = let withEvalTypeEquals t (result: CompilationResult) : CompilationResult = assertEvalOutput (fun (x: FsiValue) -> x.ReflectionType) t result + + let signatureText (checkResults: FSharp.Compiler.CodeAnalysis.FSharpCheckFileResults) = + checkResults.GenerateSignature() + |> Option.defaultWith (fun _ -> failwith "Unable to generate signature text.") + + let signaturesShouldContain (expected: string) cUnit = + let text = + cUnit + |> typecheckResults + |> signatureText + + let actual = + text.ToString().Split('\n') + |> Array.map (fun s -> s.TrimEnd(' ')) + |> Array.filter (fun s -> s.Length > 0) + + if not (actual |> Array.contains expected) then + failwith ($"The following signature:\n%s{expected}\n\nwas not found in:\n" + (actual |> String.concat "\n")) diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx deleted file mode 100644 index a77ec4df706..00000000000 --- a/tests/adhoc.fsx +++ /dev/null @@ -1,300 +0,0 @@ -open System - -type IStaticProperty<'T when 'T :> IStaticProperty<'T>> = - static abstract StaticProperty: 'T - -type IStaticMethod<'T when 'T :> IStaticMethod<'T>> = - static abstract StaticMethod: 'T -> 'T - -type IUnitMethod<'T when 'T :> IUnitMethod<'T>> = - static abstract UnitMethod: unit -> unit - -type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = - static abstract op_Addition: 'T * 'T -> 'T - -type ISinOperator<'T when 'T :> ISinOperator<'T>> = - static abstract Sin: 'T -> 'T - -type C(c: int) = - member _.Value = c - interface IAdditionOperator with - static member op_Addition(x, y) = C(x.Value + y.Value) - interface IStaticProperty with - static member StaticProperty = C(7) - interface IStaticMethod with - static member StaticMethod(x) = C(x.Value + 4) - interface IUnitMethod with - static member UnitMethod() = () - -module ``Test basic IWSAM generic code`` = - let f_IWSAM_explicit_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.op_Addition(x, y) - - let f_IWSAM_pretty_operator_name<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.(+)(x, y) - - let f_IWSAM_StaticProperty<'T when 'T :> IStaticProperty<'T>>() = - 'T.StaticProperty - - let f_IWSAM_declared_StaticMethod<'T when 'T :> IStaticMethod<'T>>(x: 'T) = - 'T.StaticMethod(x) - - let f_IWSAM_declared_UnitMethod<'T when 'T :> IUnitMethod<'T>>() = - 'T.UnitMethod() - - let f_IWSAM_declared_UnitMethod_list<'T when 'T :> IUnitMethod<'T>>() = - let v = 'T.UnitMethod() - [ v ] - - let f_IWSAM_flex_StaticProperty(x: #IStaticProperty<'T>) = - 'T.StaticProperty - - let f_IWSAM_flex_StaticMethod(x: #IStaticMethod<'T>) = - 'T.StaticMethod(x) - - - let inline f3<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.op_Addition(x,y) - - let inline f4<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = - 'T.op_Addition(x,y) - - let inline f5<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = - 'T.(+)(x,y) - - let inline f6<'T when 'T : (static member (+): 'T * 'T -> 'T)>(x: 'T, y: 'T) = - x + y - - let inline f_StaticProperty_IWSAM<'T when 'T :> IStaticProperty<'T>>() = - 'T.StaticProperty - - let inline f_StaticProperty_SRTP<'T when 'T : (static member StaticProperty: 'T) >() = - 'T.StaticProperty - - let inline f_StaticProperty_BOTH<'T when 'T :> IStaticProperty<'T> and 'T : (static member StaticProperty: 'T) >() = - 'T.StaticProperty - - module CheckExecution = - if f_IWSAM_explicit_operator_name(C(3), C(4)).Value <> 7 then - failwith "incorrect value" - - if f_IWSAM_pretty_operator_name(C(3), C(4)).Value <> 7 then - failwith "incorrect value" - - if f_IWSAM_StaticProperty().Value <> 7 then - failwith "incorrect value" - -// Check that "Property" and "get_Property" and "set_Property" constraints are considered logically equivalent -module EquivalenceOfPropertiesAndGetters = - let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() = (^T : (static member StaticProperty: int) ()) - let inline f_StaticProperty_explicit<'T when 'T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) - let inline f_StaticProperty_mixed<'T when 'T : (static member get_StaticProperty: unit -> int) >() = (^T : (static member StaticProperty: int) ()) - let inline f_StaticProperty_mixed2<'T when 'T : (static member StaticProperty: int) >() = (^T : (static member get_StaticProperty: unit -> int) ()) - - let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = (^T : (static member StaticProperty: int with set) (3)) - let inline f_set_StaticProperty_explicit<'T when 'T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) - let inline f_set_StaticProperty_mixed<'T when 'T : (static member set_StaticProperty: int -> unit) >() = (^T : (static member StaticProperty: int with set) (3)) - let inline f_set_StaticProperty_mixed2<'T when 'T : (static member StaticProperty: int with set) >() = (^T : (static member set_StaticProperty: int -> unit) (3)) - - let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = (^T : (member Length: int) (x)) - let inline f_Length_explicit<'T when 'T : (member get_Length: unit -> int) >(x: 'T) = (^T : (member get_Length: unit -> int) (x)) - let inline f_Length_mixed<'T when 'T : (member get_Length: unit -> int) >(x: 'T) = (^T : (member Length: int) (x)) - let inline f_Length_mixed2<'T when 'T : (member Length: int) >(x: 'T) = (^T : (member get_Length: unit -> int) (x)) - - let inline f_set_Length<'T when 'T : (member Length: int with set) >(x: 'T) = (^T : (member Length: int with set) (x, 3)) - let inline f_set_Length_explicit<'T when 'T : (member set_Length: int -> unit) >(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3)) - let inline f_set_Length_mixed<'T when 'T : (member set_Length: int -> unit) >(x: 'T) = (^T : (member Length: int with set) (x, 3)) - let inline f_set_Length_mixed2<'T when 'T : (member Length: int with set) >(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3)) - - let inline f_Item<'T when 'T : (member Item: int -> string with get) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3)) - let inline f_Item_explicit<'T when 'T : (member get_Item: int -> string) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3)) - let inline f_Item_mixed<'T when 'T : (member get_Item: int -> string) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3)) - let inline f_Item_mixed2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3)) - - let inline f_set_Item<'T when 'T : (member Item: int -> string with set) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, "a")) - let inline f_set_Item_explicit<'T when 'T : (member set_Item: int * string -> unit) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, "a")) - let inline f_set_Item_mixed<'T when 'T : (member set_Item: int * string -> unit) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, "a")) - let inline f_set_Item_mixed2<'T when 'T : (member Item: int -> string with set) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, "a")) - -module CheckSelfConstrainedIWSAM = - let f_IWSAM_explicit_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.op_Addition(x, y) - - let f_IWSAM_pretty_operator_name<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.(+)(x, y) - - let f_IWSAM_StaticProperty<'T when IStaticProperty<'T>>() = - 'T.StaticProperty - - let f_IWSAM_declared_StaticMethod<'T when IStaticMethod<'T>>(x: 'T) = - 'T.StaticMethod(x) - - let f_IWSAM_declared_UnitMethod<'T when IUnitMethod<'T>>() = - 'T.UnitMethod() - - let f_IWSAM_declared_UnitMethod_list<'T when IUnitMethod<'T>>() = - let v = 'T.UnitMethod() - [ v ] - - let inline f3<'T when IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.op_Addition(x,y) - - type WithStaticProperty<'T when 'T : (static member StaticProperty: int)> = 'T - type WithStaticMethod<'T when 'T : (static member StaticMethod: int -> int)> = 'T - type WithBoth<'T when WithStaticProperty<'T> and WithStaticMethod<'T>> = 'T - - let inline f_StaticProperty<'T when WithStaticProperty<'T>>() = 'T.StaticProperty - let inline f_StaticMethod<'T when WithStaticMethod<'T>>() = 'T.StaticMethod(3) - let inline f_Both<'T when WithBoth<'T> >() = - let v1 = 'T.StaticProperty - let v2 = 'T.StaticMethod(3) - v1 + v2 - - let inline f_OK1<'T when WithBoth<'T>>() = - 'T.StaticMethod(3) - 'T.StaticMethod(3) - - let inline f_OK2<'T when WithBoth<'T>>() = - 'T.StaticMethod(3) - 'T.StaticMethod(3) - - let inline f_OK3<'T when WithBoth<'T>>() = - printfn "" - 'T.StaticMethod(3) - -module CheckSelfConstrainedSRTP = - let inline f_StaticProperty_IWSAM<'T when IStaticProperty<'T>>() = - 'T.StaticProperty - - type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) - and 'T: (static member DivideByInt : 'T*int -> 'T) - and 'T: (static member Zero : 'T)> = 'T - - let inline f_AverageOps<'T when AverageOps<'T>>(xs: 'T[]) = - let mutable sum = 'T.Zero - for x in xs do - sum <- sum + x - 'T.DivideByInt(sum, xs.Length) - -module CheckNewSyntax = - // Check that "property" and "get_ method" constraints are considered logically equivalent - let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() : int = 'T.StaticProperty - - let inline f_StaticMethod<'T when 'T : (static member StaticMethod: int -> int) >() : int = 'T.StaticMethod(3) - - let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3) - - let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = x.Length - - let inline f_set_Length<'T when 'T : (member Length: int with set) >(x: 'T) = x.set_Length(3) - - let inline f_Item1<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x.get_Item(3) - - // Limitation by-design: As yet the syntax "'T.StaticProperty <- 3" can't be used - // Limitation by-design: As yet the syntax "x.Length <- 3" can't be used - // Limitation by-design: As yet the syntax "x[3]" can't be used, nor can any slicing syntax - // Limitation by-design: The disposal pattern can't be used with "use" - - //let inline f_set_StaticProperty2<'T when 'T : (static member StaticProperty: int with set) >() = 'T.StaticProperty <- 3 - //let inline f_set_Length2<'T when 'T : (member Length: int with set) >(x: 'T) = x.Length <- 3 - //let inline f_Item2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x[3] - -let f_StaticMethod_IWSAM<'T when 'T :> IStaticMethod<'T>>(x: 'T) = - 'T.StaticMethod(x) - -let inline f_StaticMethod_SRTP<'T when 'T : (static member StaticMethod: 'T -> 'T) >(x: 'T) = - 'T.StaticMethod(x) - -let inline f_StaticMethod_BOTH<'T when 'T :> IStaticMethod<'T> and 'T : (static member StaticMethod: 'T -> 'T) >(x: 'T) = - 'T.StaticMethod(x) - - -module ``Use SRTP from IWSAM generic code`` = - module ``Use SRTP operators from generic IWSAM code`` = - let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - x + y - - let fSin<'T when ISinOperator<'T>>(x: 'T) = - sin x - - module ``Use SRTP operators from generic IWSAM code not rigid`` = - let fAdd(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = - x + y - - let fSin(x: 'T when ISinOperator<'T>) = - sin x - - module ``Use SRTP operators from generic IWSAM code flex`` = - let fAdd(x: #IAdditionOperator<'T>, y) = - x + y - - let fSin(x: #ISinOperator<'T>) = - sin x - - module ``Use SRTP operators from generic IWSAM code super flex`` = - let fAdd(x: #IAdditionOperator<_>, y) = - x + y - - let fSin(x: #ISinOperator<_>) = - sin x - -// We should check the signatures reported for these definitions -// Expected: -// val inline f0: x: ^T -> ^T -// val g0: x: 'T -> 'T -// val inline f1: x: ^T -> int when ^T: (static member A: int) -// val inline f2: x: ^T -> int when (^T or int) : (static member A: int) -// val inline f3: x: ^T -> int when (^U or ^T) : (static member A: int) -// val inline f4: x: ^T -> int when ^T: (static member A: int) -module CheckStaticTyparInference = - - let inline f0 (x: ^T) = x - let g0 (x: 'T) = f0 x // ^T need not be static because it has no static constraint. Therefore this is ok to be properly generic - - let inline f1 (x: ^T) = (^T : (static member A: int) ()) - let inline f2 (x: 'T) = ((^T or int) : (static member A: int) ()) // will infer 'T to have a static req - let inline f3 (x: 'T) = ((^U or 'T) : (static member A: int) ()) // will infer 'T to have a static req - let inline f4 (x: 'T when 'T : (static member A: int) ) = 'T.A // will infer 'T to have a static req - - let inline f5 (x: ^T) = printfn "%d" x - let g5 (x: 'T) = f5 x // 'T should be inferred int - let inline h5 (x: 'T) = f5 x // 'T should be inferred static because it has a choice constraint - - let inline uint32 (value: ^T) = - (^T : (static member op_Explicit: ^T -> uint32) (value)) - - let inline uint value = uint32 value // the inferred signature of this should also be static-required - - // This changed type in generalization - was caught by test suite incidentally - let checkReflexive f x y = (f x y = - f y x) - -module TestLegacyThingsThatRegressedDuringRFC = - let legacyConcat1 (x: string) (y: string) = x ^ y - let legacyConcat2 (x: string) (y: string) = x ^y - let legacyConcat3 (x: string) (y: string) = x^ y - let legacyConcat4 (x: string) (y: string) = x^y - - let testSlicingOne() = - let arr = [| 1;2;3;4;5 |] - arr.[^3..] - - let testSlicingTwo() = - let arr = [| 1;2;3;4;5 |] - arr[^3..] - -// These should all report errors or warnings -#if NEGATIVE -module Negative = - let inline f_TraitWithOptional<'T when 'T : (static member StaticMethod: ?x: int -> int) >() = () - let inline f_TraitWithIn<'T when 'T : (static member StaticMethod: x: inref -> int) >() = () - let inline f_TraitWithOut<'T when 'T : (static member StaticMethod: x: outref -> int) >() = () - let inline f_TraitWithParamArray<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () - let inline f_TraitWithCallerName<'T when 'T : (static member StaticMethod: [] x: int[] -> int) >() = () - let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = () - - let fExpectAWarning(x: ISinOperator<'T>) = - () - -// this should fail compilation - the trait has multiple support types and can't be invoked using this syntax - let inline f5 (x: 'T when ('T or int) : (static member A: int) ) = 'T.A -#endif From cb21cefd463c7eb83a7e2f7edd409c249810b585 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 14 Jul 2022 15:09:28 +0200 Subject: [PATCH 63/91] Updated new syntax test --- src/Compiler/Checking/MethodCalls.fs | 2 +- .../IWSAM/testFiles/CheckNewSyntax.fs | 19 +++++++++++++------ 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 852c7143558..69bc37e1f88 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -2080,7 +2080,7 @@ let CheckRecdFieldMutation m denv (rfinfo: RecdFieldInfo) = if not rfinfo.RecdField.IsMutable then errorR (FieldNotMutable (denv, rfinfo.RecdFieldRef, m)) -/// Generate a witness for the given (solved) constraint. Five possiblilities are taken +/// Generate a witness for the given (solved) constraint. Five possibilities are taken /// into account. /// 1. The constraint is solved by a .NET-declared method or an F#-declared method /// 2. The constraint is solved by an F# record field diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs index b371fc0f25b..7c8fb240f1b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs @@ -29,12 +29,19 @@ module CheckNewSyntax = //let inline f_set_Length2<'T when 'T : (member Length: int with set) >(x: 'T) = x.Length <- 3 //let inline f_Item2<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x[3] - assert (f_StaticMethod() = 8) - assert (f_set_StaticProperty() = ()) - assert (f_StaticProperty() = 3) + if f_StaticMethod() <> 8 then + failwith "Unexpected result" + + if f_set_StaticProperty() <> () then + failwith "Unexpected result" + + if f_StaticProperty() <> 3 then + failwith "Unexpected result" let myInstance = MyType() - assert (f_set_Length(myInstance) = ()) - assert (f_Length(myInstance) = 3) - assert false \ No newline at end of file + if f_set_Length(myInstance) <> () then + failwith "Unexpected result" + + if f_Length(myInstance) <> 3 then + failwith "Unexpected result" From aaf86b772da8b1fab12d7e3881b394c386590184 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 14 Jul 2022 15:20:07 +0200 Subject: [PATCH 64/91] Updated new syntax test --- .../IWSAM/testFiles/CheckNewSyntax.fs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs index 7c8fb240f1b..990b180eb10 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs @@ -6,6 +6,8 @@ module CheckNewSyntax = static member val StaticProperty = 0 with get, set static member StaticMethod x = x + 5 member val Length = 0 with get, set + member _.Item with get x = "Hello" + member _.InstanceMethod x = x + 5 // Check that "property" and "get_ method" constraints are considered logically equivalent let inline f_StaticProperty<'T when 'T : (static member StaticProperty: int) >() : int = 'T.StaticProperty @@ -14,11 +16,13 @@ module CheckNewSyntax = let inline f_set_StaticProperty<'T when 'T : (static member StaticProperty: int with set) >() = 'T.set_StaticProperty(3) + let inline f_InstanceMethod<'T when 'T : (member InstanceMethod: int -> int) >(x: 'T) : int = x.InstanceMethod(3) + let inline f_Length<'T when 'T : (member Length: int) >(x: 'T) = x.Length let inline f_set_Length<'T when 'T : (member Length: int with set) >(x: 'T) = x.set_Length(3) - let inline f_Item1<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x.get_Item(3) + let inline f_Item<'T when 'T : (member Item: int -> string with get) >(x: 'T) = x.get_Item(3) // Limitation by-design: As yet the syntax "'T.StaticProperty <- 3" can't be used // Limitation by-design: As yet the syntax "x.Length <- 3" can't be used @@ -40,8 +44,14 @@ module CheckNewSyntax = let myInstance = MyType() + if f_InstanceMethod(myInstance) <> 8 then + failwith "Unexpected result" + if f_set_Length(myInstance) <> () then failwith "Unexpected result" if f_Length(myInstance) <> 3 then failwith "Unexpected result" + + if f_Item(myInstance) <> "Hello" then + failwith "Unexpected result" From ef8fecf060bee6bd185e6ba5ade8ee23dc4580ec Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 14 Jul 2022 15:43:07 +0200 Subject: [PATCH 65/91] Disabling failing tests for now --- .../IWSAM/IWSAMTests.fs | 11 +++++----- .../IWSAM/testFiles/CheckNewSyntax.fs | 22 +++++++++++-------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs index ae377b7329e..30e7bf1366a 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs @@ -28,10 +28,11 @@ let ``IWSAM test files`` compilation = [] [ ^T")>] -[ 'T")>] +// TODO: fix this: +//[ 'T")>] [ int when ^T: (static member A: int)")>] @@ -275,7 +276,7 @@ module Negative = [ -> int) >() = ()")>] [] x: int[] -> int) >() = ()")>] [] x: int[] -> int) >() = ()")>] - [> -> int) >() = ()")>] +// TODO: fix this: [> -> int) >() = ()")>] let ``Trait warning`` code = Fsx code |> compile diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs index 990b180eb10..9ad5bb24663 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs @@ -44,14 +44,18 @@ module CheckNewSyntax = let myInstance = MyType() - if f_InstanceMethod(myInstance) <> 8 then + if f_Length(myInstance) <> 0 then failwith "Unexpected result" - if f_set_Length(myInstance) <> () then - failwith "Unexpected result" - - if f_Length(myInstance) <> 3 then - failwith "Unexpected result" - - if f_Item(myInstance) <> "Hello" then - failwith "Unexpected result" +// TODO: fix these +// if f_InstanceMethod(myInstance) <> 8 then +// failwith "Unexpected result" +// +// if f_set_Length(myInstance) <> () then +// failwith "Unexpected result" +// +// if f_Length(myInstance) <> 3 then +// failwith "Unexpected result" +// +// if f_Item(myInstance) <> "Hello" then +// failwith "Unexpected result" From 218f9eef3949e78b9c0ffc0368150176eb829b93 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 14 Jul 2022 16:55:31 +0200 Subject: [PATCH 66/91] Fix new SRTP instance method invocation --- src/Compiler/Checking/CheckExpressions.fs | 2 +- .../IWSAM/IWSAMTests.fs | 6 +++++ .../IWSAM/testFiles/CheckNewSyntax.fs | 23 +++++++++---------- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 8e1375c7e2d..da479f626d3 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -8780,7 +8780,7 @@ and TcTraitItemThen cenv overallTy env objOpt traitInfo tpenv mItem delayed = Expr.Op (TOp.TraitCall traitInfo, [], objArgs, mItem) | _ -> let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip - let expr = Expr.Op (TOp.TraitCall traitInfo, [], ves, mItem) + let expr = Expr.Op (TOp.TraitCall traitInfo, [], objArgs@ves, mItem) let v, body = MultiLambdaToTupledLambda g vs expr mkLambda mItem v (body, retTy) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs index 30e7bf1366a..ba59679e757 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs @@ -73,6 +73,7 @@ module ``Equivalence of properties and getters`` = [ int) >() = (^T : (static member get_StaticProperty: unit -> int) ())")>] [ int) >() = (^T : (static member StaticProperty: int) ())")>] [() = (^T : (static member get_StaticProperty: unit -> int) ())")>] + [() = 'T.StaticProperty")>] let ``Static property getter`` code = Fsx code |> compile @@ -104,6 +105,7 @@ module ``Equivalence of properties and getters`` = [ unit) >() = (^T : (static member set_StaticProperty: int -> unit) (3))")>] [ unit) >() = (^T : (static member StaticProperty: int with set) (3))")>] [() = (^T : (static member set_StaticProperty: int -> unit) (3))")>] + [() = 'T.set_StaticProperty(3)")>] let ``Static property setter`` code = Fsx code |> compile @@ -135,6 +137,7 @@ module ``Equivalence of properties and getters`` = [ int) >(x: 'T) = (^T : (member get_Length: unit -> int) (x))")>] [ int) >(x: 'T) = (^T : (member Length: int) (x))")>] [(x: 'T) = (^T : (member get_Length: unit -> int) (x))")>] + [(x: 'T) = x.Length")>] let ``Instance property getter`` code = Fsx code |> compile @@ -166,6 +169,7 @@ module ``Equivalence of properties and getters`` = [ unit) >(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3))")>] [ unit) >(x: 'T) = (^T : (member Length: int with set) (x, 3))")>] [(x: 'T) = (^T : (member set_Length: int -> unit) (x, 3))")>] + [(x: 'T) = x.set_Length(3)")>] let ``Instance property setter`` code = Fsx code |> compile @@ -200,6 +204,7 @@ module ``Equivalence of properties and getters`` = [ string) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3))")>] [ string) >(x: 'T) = (^T : (member Item: int -> string with get) (x, 3))")>] [ string with get) >(x: 'T) = (^T : (member get_Item: int -> string) (x, 3))")>] + [ string with get) >(x: 'T) = x.get_Item(3)")>] let ``Get item`` code = Fsx code |> withOptions ["--nowarn:77"] @@ -235,6 +240,7 @@ module ``Equivalence of properties and getters`` = [ unit) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, \"a\"))")>] [ unit) >(x: 'T) = (^T : (member Item: int -> string with set) (x, 3, \"a\"))")>] [ string with set) >(x: 'T) = (^T : (member set_Item: int * string -> unit) (x, 3, \"a\"))")>] + [ string with set) >(x: 'T) = x.set_Item(3, \"a\")")>] let ``Set item`` code = Fsx code |> withOptions ["--nowarn:77"] diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs index 9ad5bb24663..f9a593a5cf2 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs @@ -47,15 +47,14 @@ module CheckNewSyntax = if f_Length(myInstance) <> 0 then failwith "Unexpected result" -// TODO: fix these -// if f_InstanceMethod(myInstance) <> 8 then -// failwith "Unexpected result" -// -// if f_set_Length(myInstance) <> () then -// failwith "Unexpected result" -// -// if f_Length(myInstance) <> 3 then -// failwith "Unexpected result" -// -// if f_Item(myInstance) <> "Hello" then -// failwith "Unexpected result" + if f_InstanceMethod(myInstance) <> 8 then + failwith "Unexpected result" + + if f_set_Length(myInstance) <> () then + failwith "Unexpected result" + + if f_Length(myInstance) <> 3 then + failwith "Unexpected result" + + if f_Item(myInstance) <> "Hello" then + failwith "Unexpected result" From 1ac2e272ff765e4f458359f68ab81e8ea9c38bd2 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Fri, 15 Jul 2022 12:07:17 +0200 Subject: [PATCH 67/91] Func conversion tests, renaming --- .../IWSAMsAndSRTPsTests.fs} | 24 ++++++++++++++++--- .../{IWSAM => IWSAMsAndSRTPs}/Types.fs | 0 .../testFiles/BasicTests.fs | 0 .../testFiles/CheckNewSyntax.fs | 0 .../testFiles/CheckSelfConstrainedIWSAM.fs | 0 .../testFiles/CheckSelfConstrainedSRTP.fs | 0 .../TestLegacyThingsThatRegressedDuringRFC.fs | 0 .../testFiles/UseSRTPFromIWSAMGenericCode.fs | 0 .../FSharp.Compiler.ComponentTests.fsproj | 2 +- 9 files changed, 22 insertions(+), 4 deletions(-) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM/IWSAMTests.fs => IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs} (94%) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM => IWSAMsAndSRTPs}/Types.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM => IWSAMsAndSRTPs}/testFiles/BasicTests.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM => IWSAMsAndSRTPs}/testFiles/CheckNewSyntax.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM => IWSAMsAndSRTPs}/testFiles/CheckSelfConstrainedIWSAM.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM => IWSAMsAndSRTPs}/testFiles/CheckSelfConstrainedSRTP.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM => IWSAMsAndSRTPs}/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs (100%) rename tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/{IWSAM => IWSAMsAndSRTPs}/testFiles/UseSRTPFromIWSAMGenericCode.fs (100%) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs similarity index 94% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index ba59679e757..605e7e921d7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/IWSAMTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -1,5 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module FSharp.Compiler.ComponentTests.Conformance.TypeAndTypeConstraints.IWSAM +module FSharp.Compiler.ComponentTests.Conformance.TypeAndTypeConstraints.IWSAMsAndSRTPs open Xunit open System.IO @@ -282,7 +282,6 @@ module Negative = [ -> int) >() = ()")>] [] x: int[] -> int) >() = ()")>] [] x: int[] -> int) >() = ()")>] -// TODO: fix this: [> -> int) >() = ()")>] let ``Trait warning`` code = Fsx code |> compile @@ -292,7 +291,7 @@ module Negative = |> ignore [] - let ``IWSAM waring`` () = + let ``IWSAM warning`` () = Fsx "let fExpectAWarning(x: Types.ISinOperator<'T>) = ()" |> withReferences [typesModule] |> compile @@ -309,3 +308,22 @@ module Negative = |> withErrorCode 3537 |> withDiagnosticMessage "The trait 'A' invoked by this call has multiple support types. This invocation syntax is not permitted for such traits. See https://aka.ms/fsharp-srtp for guidance." |> ignore + + +module FuncConversions = + + [] + let ``SRTP expression conversion not supported`` () = + Fsx "let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = + 'T.StaticMethod(fun x -> x + 1)" + |> compile + |> shouldFail + |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" + + [] + let ``SRTP delegate conversion not supported`` () = + Fsx "let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Func -> int) >() = + 'T.StaticMethod(fun x -> x + 1)" + |> compile + |> shouldFail + |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/Types.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/Types.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/BasicTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/BasicTests.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/BasicTests.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/BasicTests.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckNewSyntax.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckNewSyntax.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckNewSyntax.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedIWSAM.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedIWSAM.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedIWSAM.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedIWSAM.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedSRTP.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedSRTP.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/CheckSelfConstrainedSRTP.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/CheckSelfConstrainedSRTP.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/TestLegacyThingsThatRegressedDuringRFC.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/UseSRTPFromIWSAMGenericCode.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/UseSRTPFromIWSAMGenericCode.fs similarity index 100% rename from tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAM/testFiles/UseSRTPFromIWSAMGenericCode.fs rename to tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/testFiles/UseSRTPFromIWSAMGenericCode.fs diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 90191144d56..8716171ccc7 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -84,7 +84,7 @@ - + From 22aa7d5f1701bfbec65024a1d8c04dd1a76cc444 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Fri, 15 Jul 2022 13:59:16 +0200 Subject: [PATCH 68/91] Verify IL for IWSAM test --- .../Interop/StaticsInInterfaces.fs | 148 ++++++++++++++++-- 1 file changed, 134 insertions(+), 14 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 83947f82c57..453bd567be3 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -381,29 +381,149 @@ let main _ = 0 let fsharpSource = """ #nowarn "3535" +namespace Tests + [] do() -type IAdditionOperator<'T> = - static abstract op_Addition: 'T * 'T -> 'T +module Test = -type C(c: int) = - member _.Value = c - interface IAdditionOperator with - static member op_Addition(x, y) = C(x.Value + y.Value) + type IAdditionOperator<'T> = + static abstract op_Addition: 'T * 'T -> 'T -let f<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = - 'T.op_Addition(x, y) + type C(c: int) = + member _.Value = c + interface IAdditionOperator with + static member op_Addition(x, y) = C(x.Value + y.Value) -[] -let main _ = - if f(C(3), C(4)).Value <> 7 then - failwith "incorrect value" - 0 + let f<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = + 'T.op_Addition(x, y) + + [] + let main _ = + if f(C(3), C(4)).Value <> 7 then + failwith "incorrect value" + 0 """ FSharpWithInputAndOutputPath fsharpSource inputFilePath outputFilePath |> asExe |> withLangVersionPreview |> compileAndRun |> shouldSucceed - // TODO: verifyIL + |> verifyIL [ + """ +.class public abstract auto ansi sealed Tests.Test + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .class interface abstract auto ansi serializable nested public IAdditionOperator`1 + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .method public hidebysig static abstract virtual + !T op_Addition(!T A_0, + !T A_1) cil managed + { + } + + } + + .class auto ansi serializable nested public C + extends [runtime]System.Object + implements class Tests.Test/IAdditionOperator`1 + { + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 03 00 00 00 00 00 ) + .field assembly int32 c + .method public specialname rtspecialname + instance void .ctor(int32 c) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: callvirt instance void [runtime]System.Object::.ctor() + IL_0006: ldarg.0 + IL_0007: pop + IL_0008: ldarg.0 + IL_0009: ldarg.1 + IL_000a: stfld int32 Tests.Test/C::c + IL_000f: ret + } + + .method public hidebysig specialname + instance int32 get_Value() cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 Tests.Test/C::c + IL_0006: ret + } + + .method public hidebysig static class Tests.Test/C + 'Tests.Test.IAdditionOperator.op_Addition'(class Tests.Test/C x, + class Tests.Test/C y) cil managed + { + .override method !0 class Tests.Test/IAdditionOperator`1::op_Addition(!0, + !0) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldfld int32 Tests.Test/C::c + IL_0006: ldarg.1 + IL_0007: ldfld int32 Tests.Test/C::c + IL_000c: add + IL_000d: newobj instance void Tests.Test/C::.ctor(int32) + IL_0012: ret + } + + .property instance int32 Value() + { + .get instance int32 Tests.Test/C::get_Value() + } + } + + .method public static !!T f<(class Tests.Test/IAdditionOperator`1) T>(!!T x, + !!T y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: constrained. !!T + IL_0008: call !0 class Tests.Test/IAdditionOperator`1::op_Addition(!0, + !0) + IL_000d: ret + } + + .method public static int32 main(string[] _arg1) cil managed + { + .entrypoint + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.EntryPointAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 4 + .locals init (class Tests.Test/C V_0, + class Tests.Test/C V_1) + IL_0000: ldc.i4.3 + IL_0001: newobj instance void Tests.Test/C::.ctor(int32) + IL_0006: stloc.0 + IL_0007: ldc.i4.4 + IL_0008: newobj instance void Tests.Test/C::.ctor(int32) + IL_000d: stloc.1 + IL_000e: ldloc.0 + IL_000f: ldloc.1 + IL_0010: constrained. Tests.Test/C + IL_0016: call !0 class Tests.Test/IAdditionOperator`1::op_Addition(!0, + !0) + IL_001b: ldfld int32 Tests.Test/C::c + IL_0020: ldc.i4.7 + IL_0021: beq.s IL_002e + + IL_0023: ldstr "incorrect value" + IL_0028: call class [runtime]System.Exception [FSharp.Core]Microsoft.FSharp.Core.Operators::Failure(string) + IL_002d: throw + + IL_002e: ldc.i4.0 + IL_002f: ret + } + +} + """ ] From c464aefe393dfe9bbb777dc9b34927a738339b8a Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Fri, 15 Jul 2022 18:15:08 +0200 Subject: [PATCH 69/91] Byref tests --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 26 ++++++++++++++++--- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 605e7e921d7..38bcb2e2576 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -310,10 +310,10 @@ module Negative = |> ignore -module FuncConversions = +module SRTPInvocationBehavior = [] - let ``SRTP expression conversion not supported`` () = + let ``Expression conversion not supported`` () = Fsx "let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = 'T.StaticMethod(fun x -> x + 1)" |> compile @@ -321,9 +321,27 @@ module FuncConversions = |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" [] - let ``SRTP delegate conversion not supported`` () = - Fsx "let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Func -> int) >() = + let ``Delegate conversion not supported`` () = + Fsx "let inline f_TraitWithDelegate<'T when 'T : (static member StaticMethod: x: System.Func -> int) >() = 'T.StaticMethod(fun x -> x + 1)" |> compile |> shouldFail |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" + + [] + let ``Byref can be passed with old syntax`` () = + Fsx "let inline f_TraitWithByref<'T when 'T : ( static member TryParse: string * byref -> bool) >() = + let mutable result = 0 + (^T : ( static member TryParse: x: string * byref -> bool) (\"42\", &result))" + |> compile + |> shouldSucceed + + [] + let ``Byref can't be passed with new syntax`` () = + Fsx "let inline f_TraitWithByref<'T when 'T : ( static member TryParse: string * byref -> bool) >() = + let mutable result = 0 + 'T.TryParse(\"42\", &result)" + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." + |> withDiagnosticMessageMatches "The address of the variable 'result' cannot be used at this point" From aa8b80a57ed93676119354327832b6cc30b1e9e9 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 18 Jul 2022 17:34:11 +0200 Subject: [PATCH 70/91] Test creating delegates to IWSAM-constrained target methods --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 48 ++++++++++++++++--- .../IWSAMsAndSRTPs/Types.fs | 12 +++++ 2 files changed, 53 insertions(+), 7 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 38bcb2e2576..896c7dbf8c1 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -310,26 +310,60 @@ module Negative = |> ignore -module SRTPInvocationBehavior = +module InvocationBehavior = [] - let ``Expression conversion not supported`` () = - Fsx "let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = + let ``SRTP Delegate conversion not supported`` () = + Fsx "let inline f_TraitWithDelegate<'T when 'T : (static member StaticMethod: x: System.Func -> int) >() = 'T.StaticMethod(fun x -> x + 1)" |> compile |> shouldFail |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" [] - let ``Delegate conversion not supported`` () = - Fsx "let inline f_TraitWithDelegate<'T when 'T : (static member StaticMethod: x: System.Func -> int) >() = + let ``SRTP Expression conversion not supported`` () = + Fsx "let inline f_TraitWithExpression<'T when 'T : (static member StaticMethod: x: System.Linq.Expressions.Expression> -> int) >() = 'T.StaticMethod(fun x -> x + 1)" |> compile |> shouldFail |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" [] - let ``Byref can be passed with old syntax`` () = + let ``IWSAM Delegate conversion works`` () = + Fsx + """ + open Types + + let inline f_IwsamWithFunc<'T when IDelegateConversion<'T>>() = + 'T.FuncConversion(fun x -> x + 1) + + if not (f_IwsamWithFunc().Value = 4) then + failwith "Unexpected result" + + """ + |> setupCompilation + |> compileAndRun + |> shouldSucceed + + [] + let ``IWSAM Expression conversion works`` () = + Fsx + """ + open Types + + let inline f_IwsamWithExpression<'T when IDelegateConversion<'T>>() = + 'T.ExpressionConversion(fun x -> x + 1) + + if not (f_IwsamWithExpression().Value = 4) then + failwith "Unexpected result" + + """ + |> setupCompilation + |> compileAndRun + |> shouldSucceed + + [] + let ``SRTP Byref can be passed with old syntax`` () = Fsx "let inline f_TraitWithByref<'T when 'T : ( static member TryParse: string * byref -> bool) >() = let mutable result = 0 (^T : ( static member TryParse: x: string * byref -> bool) (\"42\", &result))" @@ -337,7 +371,7 @@ module SRTPInvocationBehavior = |> shouldSucceed [] - let ``Byref can't be passed with new syntax`` () = + let ``SRTP Byref can't be passed with new syntax`` () = Fsx "let inline f_TraitWithByref<'T when 'T : ( static member TryParse: string * byref -> bool) >() = let mutable result = 0 'T.TryParse(\"42\", &result)" diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs index 95bb0282752..d8c98028621 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/Types.fs @@ -15,13 +15,25 @@ type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = type ISinOperator<'T when 'T :> ISinOperator<'T>> = static abstract Sin: 'T -> 'T +type IDelegateConversion<'T when 'T :> IDelegateConversion<'T>> = + static abstract FuncConversion: System.Func -> 'T + static abstract ExpressionConversion: System.Linq.Expressions.Expression> -> 'T + type C(c: int) = member _.Value = c + interface IAdditionOperator with static member op_Addition(x, y) = C(x.Value + y.Value) + interface IStaticProperty with static member StaticProperty = C(7) + interface IStaticMethod with static member StaticMethod(x) = C(x.Value + 4) + interface IUnitMethod with static member UnitMethod() = () + + interface IDelegateConversion with + static member FuncConversion(f) = C(f.Invoke(3)) + static member ExpressionConversion(e) = C(e.Compile().Invoke(3)) From 6145058f774a95d4cc37193e8a4c5e355cdde017 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 19 Jul 2022 15:17:32 +0200 Subject: [PATCH 71/91] Tests for implicit conversion and nominal type in constraint selector --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 141 ++++++++++++++++++ 1 file changed, 141 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 896c7dbf8c1..3c2f557bdbd 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -379,3 +379,144 @@ module InvocationBehavior = |> shouldFail |> withDiagnosticMessageMatches "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." |> withDiagnosticMessageMatches "The address of the variable 'result' cannot be used at this point" + + +module ``Implicit conversion`` = + + let library = + FSharp + """ + module Lib + + type ICanBeInt<'T when 'T :> ICanBeInt<'T>> = + static abstract op_Implicit: 'T -> int + //static abstract TakeInt: int -> int + + type C(c: int) = + member _.Value = c + + interface ICanBeInt with + static member op_Implicit(x) = x.Value + + static member TakeInt(x: int) = x + + let add1 (x: int) = x + 1 + """ + |> withLangVersionPreview + |> withOptions ["--nowarn:3535"] + + [] + let ``Function implicit conversion not supported on constrained type`` () = + Fsx + """ + open Lib + let f_function_implicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + add1(a) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'int'\\s+but here has type\\s+''T'" + + [] + let ``Method implicit conversion not supported on constrained type`` () = + Fsx + """ + open Lib + let f_method_implicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + C.TakeInt(a) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'int'\\s+but here has type\\s+''T'" + + [] + let ``Function explicit conversion works on constrained type`` () = + Fsx + """ + open Lib + let f_function_explicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + add1(int(a)) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldSucceed + + [] + let ``Method explicit conversion works on constrained type`` () = + Fsx + """ + open Lib + let f_method_explicit_conversion<'T when ICanBeInt<'T>>(a: 'T) : int = + C.TakeInt(int(a)) + """ + |> withReferences [library] + |> withLangVersionPreview + |> compile + |> shouldSucceed + + +module ``Nominal type after or`` = + + [] + let ``Nominal type can be used after or`` () = + Fsx + """ + type C() = + static member X(n, c) = $"{n} OK" + + let inline callX (x: 'T) (y: C) = ((^T or C): (static member X : 'T * C -> string) (x, y));; + + if not (callX 1 (C()) = "1 OK") then + failwith "Unexpected result" + + if not (callX "A" (C()) = "A OK") then + failwith "Unexpected result" + """ + |> withLangVersionPreview + |> asExe + |> compileAndRun + |> shouldSucceed + + [] + let ``Nominal type can't be used before or`` () = + Fsx + """ + type C() = + static member X(n, c) = $"{n} OK" + + let inline callX (x: 'T) (y: C) = ((C or ^T): (static member X : 'T * C -> string) (x, y));; + """ + |> withLangVersionPreview + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "Unexpected keyword 'static' in binding" + + [] + let ``Nominal type is preferred`` () = + Fsx + """ + type C() = + static member X(a, b) = "C" + + type D() = + static member X(d: D, a) = "D" + + let inline callX (x: 'T) (y: C) = ((^T or C): (static member X : 'T * C -> string) (x, y));; + + if not (callX (D()) (C()) = "C") then + failwith "Unexpected result" + + let inline callX2 (x: C) (y: 'T) = ((^T or C): (static member X : 'T * C -> string) (y, x));; + + if not (callX2 (C()) (D()) = "C") then + failwith "Unexpected result" + """ + |> withLangVersionPreview + |> asExe + |> compileAndRun + |> shouldSucceed From 1a3bb7138719c5ea728fedf5249be85153ed9cc3 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Wed, 27 Jul 2022 14:04:09 +0200 Subject: [PATCH 72/91] IWSAM active patterns tests --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 89 +++++++++++++++++++ 1 file changed, 89 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 3c2f557bdbd..9edce25ebe3 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -520,3 +520,92 @@ module ``Nominal type after or`` = |> asExe |> compileAndRun |> shouldSucceed + +module ``Active patterns`` = + + let library = + FSharp """ + module Potato.Lib + type IPotato<'T when 'T :> IPotato<'T>> = + static abstract member IsGood: 'T -> bool + static abstract member op_Equality: 'T * 'T -> bool + + type Potato() = + interface IPotato with + static member IsGood c = true + static member op_Equality (a, b) = false + + type Rock() = + interface IPotato with + static member IsGood c = false + static member op_Equality (a, b) = false + """ + |> withLangVersionPreview + |> withName "Potato" + |> withOptions ["--nowarn:3535"] + + [] + let ``Using IWSAM in active pattern`` () = + FSharp """ + module Potato.Test + + open Lib + + let (|GoodPotato|_|) (x : 'T when 'T :> IPotato<'T>) = if 'T.IsGood x then Some () else None + + match Potato() with GoodPotato -> () | _ -> failwith "Unexpected result" + match Rock() with GoodPotato -> failwith "Unexpected result" | _ -> () + """ + |> withReferences [library] + |> withLangVersionPreview + |> compileExeAndRun + |> shouldSucceed + |> verifyIL [ + """ + .method public specialname static class [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1 + '|GoodPotato|_|'<(class [Potato]Potato.Lib/IPotato`1) T>(!!T x) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: constrained. !!T + IL_0007: call bool class [Potato]Potato.Lib/IPotato`1::IsGood(!0) + IL_000c: brfalse.s IL_0015 + """ + ] + + [] + let ``Using IWSAM equality in active pattern uses generic equality intrinsic`` () = + FSharp """ + module Potato.Test + + open Lib + + let (|IsEqual|IsNonEqual|) (x: 'T when IPotato<'T>, y: 'T when IPotato<'T>) = + match x with + | x when x = y -> IsEqual + | _ -> IsNonEqual + + match Potato(), Potato() with + | IsEqual -> failwith "Unexpected result" + | IsNonEqual -> () + """ + |> withReferences [library] + |> withLangVersionPreview + |> asExe + |> compileAndRun + |> shouldSucceed + |> verifyIL [ + """ + .method public specialname static class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 + '|IsEqual|IsNonEqual|'<(class [Potato]Potato.Lib/IPotato`1) T>(!!T x, + !!T y) cil managed + { + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: ldarg.1 + IL_0002: call bool [FSharp.Core]Microsoft.FSharp.Core.LanguagePrimitives/HashCompare::GenericEqualityIntrinsic(!!0, + + """ + ] From 9e760a678b89e02f5dbb41cf5ad6a242e4c45a12 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Wed, 27 Jul 2022 14:51:50 +0200 Subject: [PATCH 73/91] Test for C# using IWSAM defined in F# --- .../Interop/StaticsInInterfaces.fs | 56 +++++++++++++++-- tests/FSharp.Test.Utilities/Compiler.fs | 63 ++++++++++++++----- tests/FSharp.Test.Utilities/CompilerAssert.fs | 10 +-- 3 files changed, 102 insertions(+), 27 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 453bd567be3..0d5e0aeee04 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -375,10 +375,7 @@ let main _ = 0 [] #endif let ``F# can call interface with static abstract method`` () = - - let inputFilePath = CompilerAssert.GenerateFsInputPath() - let outputFilePath = CompilerAssert.GenerateDllOutputPath() - let fsharpSource = + FSharp """ #nowarn "3535" namespace Tests @@ -405,7 +402,6 @@ module Test = failwith "incorrect value" 0 """ - FSharpWithInputAndOutputPath fsharpSource inputFilePath outputFilePath |> asExe |> withLangVersionPreview |> compileAndRun @@ -527,3 +523,53 @@ module Test = } """ ] + +#if !NETCOREAPP + [] +#else + [] +#endif + let ``C# can call constrained method defined in F#`` () = + let FSharpLib = + FSharp """ + namespace MyNamespace + + type IFoo<'T> = + static abstract Foo: 'T * 'T -> 'T + + module Stuff = + let F<'T when 'T :> IFoo<'T>>(x: 'T, y: 'T) = + 'T.Foo(x, y) + """ + |> withLangVersionPreview + |> withName "FsLibAssembly" + |> withOptions ["--nowarn:3535"] + + CSharp """ + namespace MyNamespace { + + class Potato : IFoo + { + public Potato(int x) => this.x = x; + + public int x; + + public static Potato Foo(Potato x, Potato y) => new Potato(x.x + y.x); + + public static void Main(string[] args) + { + var x = new Potato(4); + var y = new Potato(9); + var z = Stuff.F(x, y); + if (z.x != 13) + { + throw new System.Exception("incorrect value"); + } + } + } + } + """ + |> withReferences [FSharpLib] + |> withName "CsProgram" + |> compileExeAndRun + |> shouldSucceed diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index b55104faa09..152e57f93dc 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -85,6 +85,7 @@ module rec Compiler = Source: SourceCodeFileKind LangVersion: CSharpLanguageVersion TargetFramework: TargetFramework + OutputType: CompileOutput OutputDirectory: DirectoryInfo option Name: string option References: CompilationUnit list @@ -210,7 +211,8 @@ module rec Compiler = Source = source LangVersion = CSharpLanguageVersion.CSharp9 TargetFramework = TargetFramework.Current - OutputDirectory= None + OutputType = Library + OutputDirectory = None Name = None References = [] } @@ -460,7 +462,8 @@ module rec Compiler = let asExe (cUnit: CompilationUnit) : CompilationUnit = match cUnit with - | FS fs -> FS { fs with OutputType = CompileOutput.Exe } + | FS x -> FS { x with OutputType = Exe } + | CS x -> CS { x with OutputType = Exe } | _ -> failwith "TODO: Implement where applicable." let withPlatform (platform:ExecutionPlatform) (cUnit: CompilationUnit) : CompilationUnit = @@ -565,22 +568,37 @@ module rec Compiler = let compilation = Compilation.CreateFromSources([fs.Source] @ fs.AdditionalSources, output, options, references, name, outputDirectory) compileFSharpCompilation compilation fs.IgnoreWarnings (FS fs) - let private compileCSharpCompilation (compilation: CSharpCompilation) csSource : CompilationResult = - let outputPath = tryCreateTemporaryDirectory() - Directory.CreateDirectory(outputPath) |> ignore - let fileName = compilation.AssemblyName - let output = Path.Combine(outputPath, Path.ChangeExtension(fileName, ".dll")) - let cmplResult = compilation.Emit (output) + let toErrorInfo (d: Diagnostic) = + let span = d.Location.GetMappedLineSpan().Span + let number = d.Id |> Seq.where Char.IsDigit |> String.Concat |> int + + { Error = + match d.Severity with + | DiagnosticSeverity.Error -> Error + | DiagnosticSeverity.Warning -> Warning + | DiagnosticSeverity.Info -> Information + | DiagnosticSeverity.Hidden -> Hidden + | x -> failwith $"Unknown severity {x}" + |> (|>) number + Range = + { StartLine = span.Start.Line + StartColumn = span.Start.Character + EndLine = span.End.Line + EndColumn = span.End.Character } + Message = d.GetMessage() } + + let private compileCSharpCompilation (compilation: CSharpCompilation) csSource (filePath : string) dependencies : CompilationResult = + let cmplResult = compilation.Emit filePath let result = { OutputPath = None - Dependencies = [] + Dependencies = dependencies Adjust = 0 - Diagnostics = [] + Diagnostics = cmplResult.Diagnostics |> Seq.map toErrorInfo |> Seq.toList Output = None Compilation = CS csSource } if cmplResult.Success then - CompilationResult.Success { result with OutputPath = Some output } + CompilationResult.Success { result with OutputPath = Some filePath } else CompilationResult.Failure result @@ -595,9 +613,12 @@ module rec Compiler = | None -> DirectoryInfo(tryCreateTemporaryDirectory()) let additionalReferences = - match processReferences csSource.References outputDirectory with - | [] -> ImmutableArray.Empty - | r -> (List.map (asMetadataReference (CS csSource)) r).ToImmutableArray().As() + processReferences csSource.References outputDirectory + |> List.map (asMetadataReference (CS csSource)) + + let additionalMetadataReferences = additionalReferences.ToImmutableArray().As() + + let additionalReferencePaths = [for r in additionalReferences -> r.FilePath] let references = TargetFrameworkUtil.getReferences csSource.TargetFramework @@ -608,14 +629,22 @@ module rec Compiler = | CSharpLanguageVersion.Preview -> LanguageVersion.Preview | _ -> LanguageVersion.Default + let outputKind, extension = + match csSource.OutputType with + | Exe -> OutputKind.ConsoleApplication, "exe" + | Library -> OutputKind.DynamicallyLinkedLibrary, "dll" + let cmpl = CSharpCompilation.Create( name, [ CSharpSyntaxTree.ParseText (source, CSharpParseOptions lv) ], - references.As().AddRange additionalReferences, - CSharpCompilationOptions (OutputKind.DynamicallyLinkedLibrary)) + references.As().AddRange additionalMetadataReferences, + CSharpCompilationOptions outputKind) + + let filename = Path.ChangeExtension(cmpl.AssemblyName, extension) + let filePath = Path.Combine(outputDirectory.FullName, filename) - compileCSharpCompilation cmpl csSource + compileCSharpCompilation cmpl csSource filePath additionalReferencePaths let compile (cUnit: CompilationUnit) : CompilationResult = match cUnit with diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 81c4e4cc0f8..29c2866a0c5 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -472,7 +472,7 @@ module rec CompilerAssertHelpers = compilationRefs, deps - let rec compileCompilationAux outputDirectory (disposals: ResizeArray) ignoreWarnings (cmpl: Compilation) : (FSharpDiagnostic[] * string) * string list = + let compileCompilationAux outputDirectory (disposals: ResizeArray) ignoreWarnings (cmpl: Compilation) : (FSharpDiagnostic[] * string) * string list = let compilationRefs, deps = evaluateReferences outputDirectory disposals ignoreWarnings cmpl let isExe, sources, options, name = @@ -494,7 +494,7 @@ module rec CompilerAssertHelpers = res, (deps @ deps2) - let rec compileCompilation ignoreWarnings (cmpl: Compilation) f = + let compileCompilation ignoreWarnings (cmpl: Compilation) f = let disposals = ResizeArray() try let outputDirectory = DirectoryInfo(tryCreateTemporaryDirectory()) @@ -510,10 +510,10 @@ module rec CompilerAssertHelpers = let rec returnCompilation (cmpl: Compilation) ignoreWarnings = let outputDirectory = match cmpl with - | Compilation(_, _, _, _, _, Some outputDirectory) -> DirectoryInfo(outputDirectory.FullName) - | Compilation(_, _, _, _, _, _) -> DirectoryInfo(tryCreateTemporaryDirectory()) + | Compilation(outputDirectory = Some outputDirectory) -> DirectoryInfo(outputDirectory.FullName) + | Compilation _ -> DirectoryInfo(tryCreateTemporaryDirectory()) - outputDirectory.Create() |> ignore + outputDirectory.Create() compileCompilationAux outputDirectory (ResizeArray()) ignoreWarnings cmpl let executeBuiltAppAndReturnResult (outputFilePath: string) (deps: string list) : (int * string * string) = From ce3aa0de4845d1095fd1101b0e902966fcee5ed9 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Wed, 27 Jul 2022 14:53:47 +0200 Subject: [PATCH 74/91] Release IL in test --- .../Interop/StaticsInInterfaces.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 0d5e0aeee04..61e1f8b7c75 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -514,7 +514,7 @@ module Test = IL_0021: beq.s IL_002e IL_0023: ldstr "incorrect value" - IL_0028: call class [runtime]System.Exception [FSharp.Core]Microsoft.FSharp.Core.Operators::Failure(string) + IL_0028: newobj instance void [netstandard]System.Exception::.ctor(string) IL_002d: throw IL_002e: ldc.i4.0 From 8b8427ab9804e1dd580dd340e968e333f546451c Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Wed, 27 Jul 2022 18:46:42 +0200 Subject: [PATCH 75/91] Fix test --- .../Interop/StaticsInInterfaces.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs index 61e1f8b7c75..2b7f9e8c87a 100644 --- a/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs +++ b/tests/FSharp.Compiler.ComponentTests/Interop/StaticsInInterfaces.fs @@ -570,6 +570,7 @@ module Test = } """ |> withReferences [FSharpLib] + |> withCSharpLanguageVersion CSharpLanguageVersion.Preview |> withName "CsProgram" |> compileExeAndRun |> shouldSucceed From bc8d9b82431c038fc071a764597c96ca3cdf6ec5 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 28 Jul 2022 11:13:12 +0200 Subject: [PATCH 76/91] Skip IWSAM tests on NET FW --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 42 ++++++++++++++++++- 1 file changed, 41 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 9edce25ebe3..5b8bf8d94fc 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -18,7 +18,12 @@ let setupCompilation compilation = |> withLangVersionPreview |> withReferences [typesModule] + +#if !NETCOREAPP +[] +#else [] +#endif let ``IWSAM test files`` compilation = compilation |> setupCompilation @@ -290,7 +295,11 @@ module Negative = |> withDiagnosticMessage "A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" |> ignore + #if !NETCOREAPP + [] + #else [] + #endif let ``IWSAM warning`` () = Fsx "let fExpectAWarning(x: Types.ISinOperator<'T>) = ()" |> withReferences [typesModule] @@ -328,7 +337,11 @@ module InvocationBehavior = |> shouldFail |> withErrorMessage "This function takes too many arguments, or is used in a context where a function is not expected" + #if !NETCOREAPP + [] + #else [] + #endif let ``IWSAM Delegate conversion works`` () = Fsx """ @@ -345,7 +358,11 @@ module InvocationBehavior = |> compileAndRun |> shouldSucceed + #if !NETCOREAPP + [] + #else [] + #endif let ``IWSAM Expression conversion works`` () = Fsx """ @@ -390,7 +407,6 @@ module ``Implicit conversion`` = type ICanBeInt<'T when 'T :> ICanBeInt<'T>> = static abstract op_Implicit: 'T -> int - //static abstract TakeInt: int -> int type C(c: int) = member _.Value = c @@ -405,7 +421,11 @@ module ``Implicit conversion`` = |> withLangVersionPreview |> withOptions ["--nowarn:3535"] + #if !NETCOREAPP + [] + #else [] + #endif let ``Function implicit conversion not supported on constrained type`` () = Fsx """ @@ -419,7 +439,11 @@ module ``Implicit conversion`` = |> shouldFail |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'int'\\s+but here has type\\s+''T'" + #if !NETCOREAPP + [] + #else [] + #endif let ``Method implicit conversion not supported on constrained type`` () = Fsx """ @@ -433,7 +457,11 @@ module ``Implicit conversion`` = |> shouldFail |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'int'\\s+but here has type\\s+''T'" + #if !NETCOREAPP + [] + #else [] + #endif let ``Function explicit conversion works on constrained type`` () = Fsx """ @@ -446,7 +474,11 @@ module ``Implicit conversion`` = |> compile |> shouldSucceed + #if !NETCOREAPP + [] + #else [] + #endif let ``Method explicit conversion works on constrained type`` () = Fsx """ @@ -544,7 +576,11 @@ module ``Active patterns`` = |> withName "Potato" |> withOptions ["--nowarn:3535"] + #if !NETCOREAPP + [] + #else [] + #endif let ``Using IWSAM in active pattern`` () = FSharp """ module Potato.Test @@ -574,7 +610,11 @@ module ``Active patterns`` = """ ] + #if !NETCOREAPP + [] + #else [] + #endif let ``Using IWSAM equality in active pattern uses generic equality intrinsic`` () = FSharp """ module Potato.Test From ed56f7ed2e27017bf05eaa3eff3a567cd7d404f7 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Aug 2022 11:29:56 +0200 Subject: [PATCH 77/91] fix build --- src/Compiler/AbstractIL/ilprint.fs | 2 +- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/Checking/CheckExpressions.fs | 3 --- src/Compiler/Service/ServiceDeclarationLists.fs | 3 +-- src/Compiler/SyntaxTree/SyntaxTreeOps.fs | 1 + src/FSharp.Build/FSharp.Build.fsproj | 3 +-- 6 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/Compiler/AbstractIL/ilprint.fs b/src/Compiler/AbstractIL/ilprint.fs index 1864fe9b91f..0335e28ef22 100644 --- a/src/Compiler/AbstractIL/ilprint.fs +++ b/src/Compiler/AbstractIL/ilprint.fs @@ -897,7 +897,7 @@ let rec goutput_instr env os inst = output_tailness os tl output_string os "constraint. " goutput_typ env os ty - output_string os (if callvirt then " callvirt " else " call") + output_string os (if callvirt then " callvirt " else " call ") goutput_vararg_mspec env os (mspec, varargs) output_after_tailcall os tl | I_castclass ty -> diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index eb538fd288b..95219774c85 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4033,7 +4033,7 @@ module TcDeclarations = let fldId = ident (CompilerGeneratedName id.idText, mMemberPortion) let headPatIds = if isStatic then [id] else [ident ("__", mMemberPortion);id] let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [], None, mMemberPortion) - let memberFlags kind = Some { memberFlags kind with GetterOrSetterIsCompilerGenerated = true } + let memberFlags = { memberFlags with GetterOrSetterIsCompilerGenerated = true } match propKind, mGetSetOpt with | SynMemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 45a343e25b5..240664d2400 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -8799,10 +8799,7 @@ and TcTraitItemThen cenv overallTy env objOpt traitInfo tpenv mItem delayed = match traitInfo.SupportTypes with | tys when tys.Length > 1 -> - //| (t0 :: (_ :: _) as rest) -> error(Error (FSComp.SR.tcTraitHasMultipleSupportTypes(traitInfo.MemberDisplayNameCore), mItem)) - //for ty in rest do - // UnifyTypes cenv env mItem t0 ty | _ -> () match objOpt, traitInfo.MemberFlags.IsInstance with diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs index e83d0d85499..95d8566ceda 100644 --- a/src/Compiler/Service/ServiceDeclarationLists.fs +++ b/src/Compiler/Service/ServiceDeclarationLists.fs @@ -950,8 +950,7 @@ module internal DescriptionListsImpl = ) - /// Select the items that participate in a MethodGroup. This is almost identical to SelectMethodGroupItems and - // should be merged, and indeed is only used on the + /// Select the items that participate in a MethodGroup. let SelectMethodGroupItems g m item = match item with | Item.CtorGroup(nm, cinfos) -> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) cinfos diff --git a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs index 25ca4420b7c..590f5523214 100644 --- a/src/Compiler/SyntaxTree/SyntaxTreeOps.fs +++ b/src/Compiler/SyntaxTree/SyntaxTreeOps.fs @@ -763,6 +763,7 @@ let ImplementStaticMemberFlags trivia k : SynMemberFlags = IsDispatchSlot = false IsOverrideOrExplicitImpl = true IsFinal = false + GetterOrSetterIsCompilerGenerated = false Trivia = trivia } diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index 98bf38f572e..9d67b00e5bc 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -12,8 +12,7 @@ $(DefineConstants);LOCALIZATION_FSBUILD NU1701;FS0075 true - 5.0 - 6.0 + 6.0 Debug;Release;Proto From 143045dfb535659e043d6c93133c84b0a13f0182 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Aug 2022 11:35:29 +0200 Subject: [PATCH 78/91] fix build --- src/Compiler/Checking/CheckDeclarations.fs | 5 ++--- src/Compiler/Checking/CheckExpressions.fs | 4 ++-- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 95219774c85..c582da3945a 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4048,7 +4048,7 @@ module TcDeclarations = let rhsExpr = SynExpr.Ident fldId let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) let attribs = mkAttributeList attribs mMemberPortion - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, memberFlags, SynBindingTrivia.Zero) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some memberFlags, SynBindingTrivia.Zero) SynMemberDefn.Member (binding, mMemberPortion) yield getter | _ -> () @@ -4060,8 +4060,7 @@ module TcDeclarations = let vId = ident("v", mMemberPortion) let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [mkSynPatVar None vId], None, mMemberPortion) let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId) - //let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) - let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], memberFlagsForSet, SynBindingTrivia.Zero) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, DebugPointAtBinding.NoneAtInvisible, None, rhsExpr, rhsExpr.Range, [], [], Some memberFlagsForSet, SynBindingTrivia.Zero) SynMemberDefn.Member (binding, mMemberPortion) yield setter | _ -> ()] diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 240664d2400..1c8dbd8357c 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1529,7 +1529,7 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf if requiredProps.Length > 0 then let setterPropNames = finalAssignedItemSetters - |> List.choose (function | AssignedItemSetter(_, AssignedPropSetter (pinfo, _, _), _) -> Some pinfo.PropertyName | _ -> None) + |> List.choose (function | AssignedItemSetter(_, AssignedPropSetter (_, pinfo, _, _), _) -> Some pinfo.PropertyName | _ -> None) let missingProps = requiredProps @@ -10071,7 +10071,7 @@ and TcMethodApplication (callExpr6, finalAttributeAssignedNamedItems, delayed), tpenv /// For Method(X = expr) 'X' can be a property, IL Field or F# record field -and TcSetterArgExpr cenv env denv objExpr ad assignedSetter = +and TcSetterArgExpr cenv env denv objExpr ad assignedSetter calledFromConstructor = let g = cenv.g let (AssignedItemSetter(id, setter, callerArg)) = assignedSetter let (CallerArg(callerArgTy, m, isOptCallerArg, argExpr)) = callerArg From 881d431b06cac91b3d45fe42c7dfeaa5ca8e0b33 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Aug 2022 11:47:01 +0200 Subject: [PATCH 79/91] fix test --- .../neg_known_return_type_and_known_type_arguments.bsl | 5 ----- 1 file changed, 5 deletions(-) diff --git a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl index f72c9f2a26e..698171eac59 100644 --- a/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl +++ b/tests/fsharp/typecheck/overloads/neg_known_return_type_and_known_type_arguments.bsl @@ -6,11 +6,6 @@ Known return type: MonoidSample Known type parameters: < MonoidSample , Zero > Available overloads: - - static member Zero.Zero: ^t * Default1 -> ^t when ^t: (static member Zero: ^t) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default1 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ^t when (FromInt32 or ^t) : (static member FromInt32: ^t * FromInt32 -> (int32 -> ^t)) // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default2 -> ('a1 -> 'a1) when ^t: null and ^t: struct // Argument at index 1 doesn't match - - static member Zero.Zero: ^t * Default3 -> ^t when ^t: (static member get_Empty: ^t) // Argument at index 1 doesn't match - static member Zero.Zero: 'a array * Zero -> 'a array // Argument at index 1 doesn't match - static member Zero.Zero: 'a list * Zero -> 'a list // Argument at index 1 doesn't match - static member Zero.Zero: 'a option * Zero -> 'a option // Argument at index 1 doesn't match From 2ae12a5bcf46f61f960849cf62b8c3820e7ea944 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Aug 2022 13:00:45 +0200 Subject: [PATCH 80/91] fix inference tests --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 5b8bf8d94fc..7a90e7f24c8 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -33,11 +33,10 @@ let ``IWSAM test files`` compilation = [] [ ^T")>] -// TODO: fix this: -//[ 'T")>] +[ 'T")>] [ int when ^T: (static member A: int)")>] @@ -68,6 +67,7 @@ let ``IWSAM test files`` compilation = let ``Check static type parameter inference`` code expectedSignature = FSharp code |> ignoreWarnings + |> withLangVersionPreview |> signaturesShouldContain expectedSignature From 4605e77fe9c6562e49149f9450e1ca248da95a57 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 1 Aug 2022 13:20:12 +0200 Subject: [PATCH 81/91] Updated type inference tests --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 5b8bf8d94fc..093decc6b7b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -33,11 +33,10 @@ let ``IWSAM test files`` compilation = [] [ ^T")>] -// TODO: fix this: -//[ 'T")>] +[ 'T")>] [ int when ^T: (static member A: int)")>] @@ -68,9 +67,19 @@ let ``IWSAM test files`` compilation = let ``Check static type parameter inference`` code expectedSignature = FSharp code |> ignoreWarnings + |> withLangVersionPreview |> signaturesShouldContain expectedSignature +[] +let ``Static type parameter inference in version 6`` () = + FSharp """ + let inline f0 (x: ^T) = x + let g0 (x: 'T) = f0 x""" + |> withLangVersion60 + |> signaturesShouldContain "val g0: x: obj -> obj" + + module ``Equivalence of properties and getters`` = [] From 7b964940ef2ca89a5b675180c1b9c9a6600046a3 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 1 Aug 2022 17:02:04 +0200 Subject: [PATCH 82/91] Fix compiler generated attribute for setters --- src/Compiler/Checking/CheckDeclarations.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index c582da3945a..e08c015c6a8 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4034,6 +4034,7 @@ module TcDeclarations = let headPatIds = if isStatic then [id] else [ident ("__", mMemberPortion);id] let headPat = SynPat.LongIdent (SynLongIdent(headPatIds, [], List.replicate headPatIds.Length None), None, Some noInferredTypars, SynArgPats.Pats [], None, mMemberPortion) let memberFlags = { memberFlags with GetterOrSetterIsCompilerGenerated = true } + let memberFlagsForSet = { memberFlagsForSet with GetterOrSetterIsCompilerGenerated = true } match propKind, mGetSetOpt with | SynMemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) From 23f0c61fdb3f36bdd09f5001763b8f7e49500527 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 1 Aug 2022 17:27:36 +0200 Subject: [PATCH 83/91] Prepared System.Numerics suppression test --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 58 +++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 093decc6b7b..64123d12b7f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -658,3 +658,61 @@ module ``Active patterns`` = """ ] + +module ``Suppression of System Numerics interfaces on unitized types`` = + + [] + let Baseline () = + Fsx """ + open System.Numerics + let f (x: 'T when 'T :> IMultiplyOperators<'T,'T,'T>) = x;; + f 3.0 |> ignore""" + |> withLangVersionPreview + |> compile + |> shouldSucceed + + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + let ``Unitized type shouldn't be compatible with System.Numerics.I*`` name paramCount = + let typeParams = Seq.replicate paramCount "'T" |> String.concat "," + let genericType = $"{name}<{typeParams}>" + let potatoParams = Seq.replicate paramCount "float" |> String.concat "," + let potatoType = $"{name}<{potatoParams}>" + Fsx $""" + open System.Numerics + + [] type potato + + let f (x: 'T when {genericType}) = x;; + f 3.0 |> ignore""" + |> withLangVersionPreview + |> compile + |> shouldFail + |> withErrorMessage $"The type 'float' is not compatible with the type '{potatoType}'" From 5c404c0fd267fd4b248f7246ba2aa707a3e56cce Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 1 Aug 2022 18:07:51 +0200 Subject: [PATCH 84/91] Sample project for .NET 7 --- .../projects/Sample_ConsoleApp_net7/Program.fs | 10 ++++++++++ .../Sample_ConsoleApp_net7.fsproj | 17 +++++++++++++++++ 2 files changed, 27 insertions(+) create mode 100644 tests/projects/Sample_ConsoleApp_net7/Program.fs create mode 100644 tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj diff --git a/tests/projects/Sample_ConsoleApp_net7/Program.fs b/tests/projects/Sample_ConsoleApp_net7/Program.fs new file mode 100644 index 00000000000..e3cb1c460c1 --- /dev/null +++ b/tests/projects/Sample_ConsoleApp_net7/Program.fs @@ -0,0 +1,10 @@ +// SDK version 7.0.100-preview.6 or newer has to be installed for this to work +open System.Numerics + +[] type potato + +let f (x: 'T when IMultiplyOperators<'T,'T,'T>) = x + +// f 7.0 + +printfn $"Hello from F# {f 7.0}!" diff --git a/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj b/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj new file mode 100644 index 00000000000..5d190796a15 --- /dev/null +++ b/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj @@ -0,0 +1,17 @@ + + + + Exe + net7.0 + preview + + + + $(MSBuildThisFileDirectory)../../../artifacts/bin/fsc/Debug/net6.0/fsc.dll + + + + + + + From ef3ae6c8294a12a24e0da1eee523114e15db2828 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Aug 2022 20:40:08 +0200 Subject: [PATCH 85/91] fix byref arguments to trait calls --- src/Compiler/Checking/CheckExpressions.fs | 75 ++++++++++++++--------- tests/adhoc.fsx | 56 +++++++++++++++++ 2 files changed, 101 insertions(+), 30 deletions(-) create mode 100644 tests/adhoc.fsx diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 1c8dbd8357c..17987586b4b 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -3065,18 +3065,20 @@ type ApplicableExpr = // the function-valued expression expr: Expr * // is this the first in an application series - isFirst: bool + isFirst: bool * + // Is this a traitCall, where we don't build a lambda + traitCallInfo: (Val list * Expr) option member x.Range = - let (ApplicableExpr (_, expr, _)) = x + let (ApplicableExpr (_, expr, _, _)) = x expr.Range member x.Type = match x with - | ApplicableExpr (cenv, expr, _) -> tyOfExpr cenv.g expr + | ApplicableExpr (cenv, expr, _, _) -> tyOfExpr cenv.g expr member x.SupplyArgument(expr2, m) = - let (ApplicableExpr (cenv, funcExpr, first)) = x + let (ApplicableExpr (cenv, funcExpr, first, traitCallInfo)) = x let g = cenv.g let combinedExpr = @@ -3086,16 +3088,24 @@ type ApplicableExpr = (not (isForallTy g funcExpr0Ty) || isFunTy g (applyTys g funcExpr0Ty (tyargs0, args0))) -> Expr.App (funcExpr0, funcExpr0Ty, tyargs0, args0@[expr2], unionRanges m0 m) | _ -> - Expr.App (funcExpr, tyOfExpr g funcExpr, [], [expr2], m) + // Trait calls do not build a lambda if applied immediately to a tuple of arguments or a unit argument + match traitCallInfo, tryDestRefTupleExpr expr2 with + | Some (vs, traitCall), exprs when vs.Length = exprs.Length -> + mkLetsBind m (mkCompGenBinds vs exprs) traitCall + | _ -> + Expr.App (funcExpr, tyOfExpr g funcExpr, [], [expr2], m) - ApplicableExpr(cenv, combinedExpr, false) + ApplicableExpr(cenv, combinedExpr, false, None) member x.Expr = - let (ApplicableExpr (_, expr, _)) = x + let (ApplicableExpr (_, expr, _, _)) = x expr let MakeApplicableExprNoFlex cenv expr = - ApplicableExpr (cenv, expr, true) + ApplicableExpr (cenv, expr, true, None) + +let MakeApplicableExprForTraitCall cenv expr traitCallInfo = + ApplicableExpr (cenv, expr, true, Some traitCallInfo) /// This function reverses the effect of condensation for a named function value (indeed it can /// work for any expression, though we only invoke it immediately after a call to TcVal). @@ -3141,7 +3151,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = curriedActualTys |> List.exists (List.exists (isByrefTy g)) || curriedActualTys |> List.forall (List.forall (isNonFlexibleTy g))) then - ApplicableExpr (cenv, expr, true) + ApplicableExpr (cenv, expr, true, None) else let curriedFlexibleTys = curriedActualTys |> List.mapSquared (fun actualTy -> @@ -3154,7 +3164,7 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = // Create a coercion to represent the expansion of the application let expr = mkCoerceExpr (expr, mkIteratedFunTy g (List.map (mkRefTupledTy g) curriedFlexibleTys) retTy, m, exprTy) - ApplicableExpr (cenv, expr, true) + ApplicableExpr (cenv, expr, true, None) /// Checks, warnings and constraint assertions for downcasts let TcRuntimeTypeTest isCast isOperator cenv denv m tgtTy srcTy = @@ -3969,19 +3979,19 @@ let buildApp cenv expr resultTy arg m = match expr, arg with // Special rule for building applications of the 'x && y' operator - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [x0], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [x0], _)), _ when valRefEq g vref g.and_vref || valRefEq g vref g.and2_vref -> MakeApplicableExprNoFlex cenv (mkLazyAnd g m x0 arg), resultTy // Special rule for building applications of the 'x || y' operator - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [x0], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [x0], _)), _ when valRefEq g vref g.or_vref || valRefEq g vref g.or2_vref -> MakeApplicableExprNoFlex cenv (mkLazyOr g m x0 arg ), resultTy // Special rule for building applications of the 'reraise' operator - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when valRefEq g vref g.reraise_vref -> // exprTy is of type: "unit -> 'a". Break it and store the 'a type here, used later as return type. @@ -3989,7 +3999,7 @@ let buildApp cenv expr resultTy arg m = // Special rules for NativePtr.ofByRef to generalize result. // See RFC FS-1053.md - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when (valRefEq g vref g.nativeptr_tobyref_vref) -> let argTy = NewInferenceType g @@ -4000,7 +4010,7 @@ let buildApp cenv expr resultTy arg m = // address of an expression. // // See also RFC FS-1053.md - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when valRefEq g vref g.addrof_vref -> let wrap, e1a', readonly, _writeonly = mkExprAddrOfExpr g true false AddressOfOp arg (Some vref) m @@ -4025,7 +4035,7 @@ let buildApp cenv expr resultTy arg m = // Special rules for building applications of the &&expr' operators, which gets the // address of an expression. - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _), _ + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)), _ when valRefEq g vref g.addrof2_vref -> warning(UseOfAddressOfOperator m) @@ -8055,7 +8065,7 @@ and Propagate cenv (overallTy: OverallTy) (env: TcEnv) tpenv (expr: ApplicableEx // See RFC FS-1053.md let isAddrOf = match expr with - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [], _), _) + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [], _)) when (valRefEq g vref g.addrof_vref || valRefEq g vref g.nativeptr_tobyref_vref) -> true | _ -> false @@ -8347,9 +8357,9 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE | _ -> () match leftExpr with - | ApplicableExpr(_, NameOfExpr g _, _) when g.langVersion.SupportsFeature LanguageFeature.NameOf -> + | ApplicableExpr(expr=NameOfExpr g _) when g.langVersion.SupportsFeature LanguageFeature.NameOf -> let replacementExpr = TcNameOfExpr cenv env tpenv synArg - TcDelayed cenv overallTy env tpenv mExprAndArg (ApplicableExpr(cenv, replacementExpr, true)) g.string_ty ExprAtomicFlag.Atomic delayed + TcDelayed cenv overallTy env tpenv mExprAndArg (ApplicableExpr(cenv, replacementExpr, true, None)) g.string_ty ExprAtomicFlag.Atomic delayed | _ -> // Notice the special case 'seq { ... }'. In this case 'seq' is actually a function in the F# library. // Set a flag in the syntax tree to say we noticed a leading 'seq' @@ -8360,7 +8370,7 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE match synArg with | SynExpr.ComputationExpr (false, comp, m) when (match leftExpr with - | ApplicableExpr(_, Expr.Op(TOp.Coerce, _, [SeqExpr g], _), _) -> true + | ApplicableExpr(expr=Expr.Op(TOp.Coerce, _, [SeqExpr g], _)) -> true | _ -> false) -> SynExpr.ComputationExpr (true, comp, m) | _ -> synArg @@ -8371,8 +8381,8 @@ and TcApplicationThen cenv (overallTy: OverallTy) env tpenv mExprAndArg synLeftE // will have debug points on "f expr1" and "g expr2" let env = match leftExpr with - | ApplicableExpr(_, Expr.Val (vref, _, _), _) - | ApplicableExpr(_, Expr.App (Expr.Val (vref, _, _), _, _, [_], _), _) + | ApplicableExpr(expr=Expr.Val (vref, _, _)) + | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [_], _)) when valRefEq g vref g.and_vref || valRefEq g vref g.and2_vref || valRefEq g vref g.or_vref @@ -8826,24 +8836,29 @@ and TcTraitItemThen cenv overallTy env objOpt traitInfo tpenv mItem delayed = mkCompGenLet mItem objVal objExpr, [objValExpr] // Build a lambda for the trait call - let expr = + let applicableExpr, exprTy = // Empty arguments indicates a non-indexer property constraint match argTys with | [] -> - Expr.Op (TOp.TraitCall traitInfo, [], objArgs, mItem) + let expr = Expr.Op (TOp.TraitCall traitInfo, [], objArgs, mItem) + let exprTy = tyOfExpr g expr + let applicableExpr = MakeApplicableExprNoFlex cenv expr + applicableExpr, exprTy | _ -> let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip - let expr = Expr.Op (TOp.TraitCall traitInfo, [], objArgs@ves, mItem) - let v, body = MultiLambdaToTupledLambda g vs expr - mkLambda mItem v (body, retTy) + let traitCall = Expr.Op (TOp.TraitCall traitInfo, [], objArgs@ves, mItem) + let v, body = MultiLambdaToTupledLambda g vs traitCall + let expr = mkLambda mItem v (body, retTy) + let exprTy = tyOfExpr g expr + let applicableExpr = MakeApplicableExprForTraitCall cenv expr (vs, traitCall) + applicableExpr, exprTy // Propagate the types from the known application structure - let applicableExpr = MakeApplicableExprNoFlex cenv expr - Propagate cenv overallTy env tpenv applicableExpr (tyOfExpr g expr) delayed + Propagate cenv overallTy env tpenv applicableExpr exprTy delayed // Check and apply the arguments - let resExpr, tpenv = TcDelayed cenv overallTy env tpenv mItem applicableExpr (tyOfExpr g expr) ExprAtomicFlag.NonAtomic delayed + let resExpr, tpenv = TcDelayed cenv overallTy env tpenv mItem applicableExpr exprTy ExprAtomicFlag.NonAtomic delayed // Aply the wrapper to pre-evaluate the object if any wrapper resExpr, tpenv diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx new file mode 100644 index 00000000000..8d25299dc3b --- /dev/null +++ b/tests/adhoc.fsx @@ -0,0 +1,56 @@ +module Test1 = + type C1() = + static member X(p: C1 byref) = p + + let inline callX<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = (^T: (static member X : 'T byref -> 'T) (&x)) + + let mutable c1 = C1() + let g1 = callX &c1 + +module Test2 = + type C2() = + static member X(p: C2 byref) = p + + let inline callX2<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = 'T.X &x + let mutable c2 = C2() + let g2 = callX2 &c2 + +module Test3 = + + type C3() = + static member X(p: C3 byref, n: int) = p + + let inline callX3<'T when 'T : (static member X: 'T byref * int -> 'T)> (x: 'T byref) = 'T.X (&x, 3) + let mutable c3 = C3() + let g3 = callX3 &c3 + +module Test4 = + type C4() = + static member X() = C4() + + let inline callX4<'T when 'T : (static member X: unit -> 'T)> () = 'T.X () + let g4 = callX4 () + +#if NEGATIVE +// NOTE, we don't expect these to compile. Trait constraints taht involve byref returns +// currently can never be satisfied by any method. No other warning is given - we may enable +// this at some later point but it is orthogonal to the RFC +module Test5 = + type C5() = + static member X(p: C5 byref) = &p + + let inline callX5<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = 'T.X &x + let mutable c5 = C5() + let g5 () = callX5 &c5 + +module Test6 = + + type C6() = + static member X(p: C6 byref) = &p + + // NOTE: you can declare trait call which returns the address of the thing provided, you just can't satisfy the constraint + let inline callX6<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = &'T.X &x + let mutable c6 = C6() + let g6 () = callX6 &c6 +#endif + From c700443e79383e40290cec76d21fe526f9ee0130 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 1 Aug 2022 20:46:50 +0200 Subject: [PATCH 86/91] fix byref arguments to trait calls --- tests/adhoc.fsx | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx index 8d25299dc3b..577213940ee 100644 --- a/tests/adhoc.fsx +++ b/tests/adhoc.fsx @@ -1,3 +1,6 @@ +open System.Runtime.InteropServices + + module Test1 = type C1() = static member X(p: C1 byref) = p @@ -52,5 +55,9 @@ module Test6 = let inline callX6<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = &'T.X &x let mutable c6 = C6() let g6 () = callX6 &c6 -#endif +// No out args allows +module Test7 = + + let inline callX2<'T when 'T : (static member X: [] 'T byref -> bool)> () = () +#endif From 80f1833b89b4e27f2ae34b1ec31761ae915fc51a Mon Sep 17 00:00:00 2001 From: Vlad Zarytovskii Date: Tue, 2 Aug 2022 11:55:13 +0200 Subject: [PATCH 87/91] Added more samples, fixed compiler paths for VS --- .../Sample_ConsoleApp_net7/Program.fs | 115 +++++++++++++++++- .../Sample_ConsoleApp_net7.fsproj | 3 + 2 files changed, 114 insertions(+), 4 deletions(-) diff --git a/tests/projects/Sample_ConsoleApp_net7/Program.fs b/tests/projects/Sample_ConsoleApp_net7/Program.fs index e3cb1c460c1..c6b3afc58b6 100644 --- a/tests/projects/Sample_ConsoleApp_net7/Program.fs +++ b/tests/projects/Sample_ConsoleApp_net7/Program.fs @@ -1,10 +1,117 @@ // SDK version 7.0.100-preview.6 or newer has to be installed for this to work open System.Numerics -[] type potato +type IAdditionOperator<'T when 'T :> IAdditionOperator<'T>> = + static abstract op_Addition: 'T * 'T -> 'T // Produces FS3535, advanced feature warning. -let f (x: 'T when IMultiplyOperators<'T,'T,'T>) = x +type ISinOperator<'T when 'T :> ISinOperator<'T>> = + static abstract Sin: 'T -> 'T // Produces FS3535, advanced feature warning. -// f 7.0 +let square (x: 'T when 'T :> IMultiplyOperators<'T,'T,'T>) = x * x +// ^--- autocompletion works here -printfn $"Hello from F# {f 7.0}!" +let zero (x: 'T when 'T :> INumber<'T>) = 'T.Zero + +let add<'T when IAdditionOperators<'T, 'T, 'T>>(x: 'T) (y: 'T) = x + y +let min<'T when INumber<'T>> (x: 'T) (y: 'T) = 'T.Min(x, y) +// ^ ^-------^--- no type params autocompletion +// +-- no completion here + +// Some declaration tests: +let fAdd<'T when 'T :> IAdditionOperator<'T>>(x: 'T, y: 'T) = x + y +let fSin<'T when ISinOperator<'T>>(x: 'T) = sin x +let fAdd'(x: 'T when 'T :> IAdditionOperator<'T>, y: 'T) = x + y +let fSin'(x: 'T when ISinOperator<'T>) = sin x +let fAdd''(x: #IAdditionOperator<'T>, y) = x + y // Produces FS0064 for x (the construct causes code to be less generic...) +let fSin''(x: #ISinOperator<'T>) = sin x // Produces FS0064 for x (the construct causes code to be less generic...) +let fAdd'''(x: #IAdditionOperator<_>, y) = x + y // Does not produce FS0064 +let fSin'''(x: #ISinOperator<_>) = sin x // Does not produce FS0064 + +type AverageOps<'T when 'T: (static member (+): 'T * 'T -> 'T) + and 'T: (static member DivideByInt : 'T*int -> 'T) + and 'T: (static member Zero : 'T)> = 'T + +let inline f_AverageOps<'T when AverageOps<'T>>(xs: 'T[]) = + let mutable sum = 'T.Zero + for x in xs do + sum <- sum + x + 'T.DivideByInt(sum, xs.Length) +// ^--- autocomplete works here just fine + +let testZeroProp () = + let i = 1I + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1m + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1y + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1uy + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1s + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1us + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1l + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1ul + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1u + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1un + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1L + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1UL + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1F + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i = 1.0 + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + + let i : char = 'a' + let z = zero i + let h = System.Convert.ToByte(z).ToString("x2") + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {h} ({i.GetType().ToString()})" + + let i = '1'B + let z = zero i + printfn $"Get zero for {i} ({i.GetType().ToString()}) = {z} ({i.GetType().ToString()})" + +[] +let main _ = + let x = 40 + let y = 20 + printfn $"Square of {x} is {square x}!" + printfn $"{x} + {y} is {add x y}!" + printfn $"Min of {x} and {y} is {min x y}" + + testZeroProp () + + 0 diff --git a/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj b/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj index 5d190796a15..622de34bbdb 100644 --- a/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj +++ b/tests/projects/Sample_ConsoleApp_net7/Sample_ConsoleApp_net7.fsproj @@ -8,6 +8,9 @@ $(MSBuildThisFileDirectory)../../../artifacts/bin/fsc/Debug/net6.0/fsc.dll + $(MSBuildThisFileDirectory)../../../artifacts/bin/fsc/Debug/net6.0/fsc.dll + False + True From c59553a7574b46f817b3d49aad3b97e9aca23fdb Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 2 Aug 2022 12:31:22 +0200 Subject: [PATCH 88/91] DirectoryAttribute puts each test into its own directory This should avoid collisions of shared references --- .../DirectoryAttribute.fs | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs index 57819a2f036..38023dc319f 100644 --- a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs +++ b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs @@ -28,7 +28,7 @@ type DirectoryAttribute(dir: string) = result let dirInfo = normalizePathSeparator (Path.GetFullPath(dir)) - let outputDirectory name = + let outputDirectory methodName (filename: string) = // If the executing assembly has 'artifacts\bin' in it's path then we are operating normally in the CI or dev tests // Thus the output directory will be in a subdirectory below where we are executing. // The subdirectory will be relative to the source directory containing the test source file, @@ -36,7 +36,7 @@ type DirectoryAttribute(dir: string) = // When the source code is in: // $(repo-root)\tests\FSharp.Compiler.ComponentTests\Conformance\PseudoCustomAttributes // and the test is running in the FSharp.Compiler.ComponentTeststest library - // The output directory will be: + // The output directory will be: // artifacts\bin\FSharp.Compiler.ComponentTests\$(Flavour)\$(TargetFramework)\tests\FSharp.Compiler.ComponentTests\Conformance\PseudoCustomAttributes // // If we can't find anything then we execute in the directory containing the source @@ -51,7 +51,10 @@ type DirectoryAttribute(dir: string) = let testPaths = dirInfo.Replace(testRoot, "").Split('/') testPaths[0] <- "tests" Path.Combine(testPaths) - let n = Path.Combine(testlibraryLocation, testSourceDirectory.Trim('/'), normalizeName name) + let normalizedFilename = + filename.Substring(0, filename.Length - 3) // remove .fs + |> normalizeName + let n = Path.Combine(testlibraryLocation, testSourceDirectory.Trim('/'), normalizeName methodName, normalizedFilename) let outputDirectory = new DirectoryInfo(n) Some outputDirectory else @@ -69,13 +72,13 @@ type DirectoryAttribute(dir: string) = | true -> Some (File.ReadAllText path) | _ -> None - let createCompilationUnit path fs name = - let outputDirectory = outputDirectory name + let createCompilationUnit path filename methodName = + let outputDirectory = outputDirectory methodName filename let outputDirectoryPath = match outputDirectory with | Some path -> path.FullName | None -> failwith "Can't set the output directory" - let sourceFilePath = normalizePathSeparator (path ++ fs) + let sourceFilePath = normalizePathSeparator (path ++ filename) let fsBslFilePath = sourceFilePath + ".err.bsl" let ilBslFilePath = let ilBslPaths = [| @@ -109,8 +112,8 @@ type DirectoryAttribute(dir: string) = | Some s -> s | None -> sourceFilePath + baselineSuffix + ".il.bsl" - let fsOutFilePath = normalizePathSeparator (Path.ChangeExtension(outputDirectoryPath ++ fs, ".err")) - let ilOutFilePath = normalizePathSeparator ( Path.ChangeExtension(outputDirectoryPath ++ fs, ".il")) + let fsOutFilePath = normalizePathSeparator (Path.ChangeExtension(outputDirectoryPath ++ filename, ".err")) + let ilOutFilePath = normalizePathSeparator ( Path.ChangeExtension(outputDirectoryPath ++ filename, ".il")) let fsBslSource = readFileOrDefault fsBslFilePath let ilBslSource = readFileOrDefault ilBslFilePath @@ -126,7 +129,7 @@ type DirectoryAttribute(dir: string) = } Options = [] OutputType = Library - Name = Some fs + Name = Some filename IgnoreWarnings = false References = [] OutputDirectory = outputDirectory } |> FS From 540ba3774f5635fbcb9d66a4517d85a34bfd0ba8 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 2 Aug 2022 15:34:09 +0200 Subject: [PATCH 89/91] Only add extra dir for test if there multiple tests processed by DirectoryAttribute --- .../DirectoryAttribute.fs | 21 ++++++++++++------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs index 38023dc319f..abb37e0b6c5 100644 --- a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs +++ b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs @@ -28,7 +28,7 @@ type DirectoryAttribute(dir: string) = result let dirInfo = normalizePathSeparator (Path.GetFullPath(dir)) - let outputDirectory methodName (filename: string) = + let outputDirectory methodName extraDirectory = // If the executing assembly has 'artifacts\bin' in it's path then we are operating normally in the CI or dev tests // Thus the output directory will be in a subdirectory below where we are executing. // The subdirectory will be relative to the source directory containing the test source file, @@ -51,10 +51,7 @@ type DirectoryAttribute(dir: string) = let testPaths = dirInfo.Replace(testRoot, "").Split('/') testPaths[0] <- "tests" Path.Combine(testPaths) - let normalizedFilename = - filename.Substring(0, filename.Length - 3) // remove .fs - |> normalizeName - let n = Path.Combine(testlibraryLocation, testSourceDirectory.Trim('/'), normalizeName methodName, normalizedFilename) + let n = Path.Combine(testlibraryLocation, testSourceDirectory.Trim('/'), normalizeName methodName, extraDirectory) let outputDirectory = new DirectoryInfo(n) Some outputDirectory else @@ -72,8 +69,14 @@ type DirectoryAttribute(dir: string) = | true -> Some (File.ReadAllText path) | _ -> None - let createCompilationUnit path filename methodName = - let outputDirectory = outputDirectory methodName filename + let createCompilationUnit path (filename: string) methodName multipleFiles = + // if there are multiple files being processed, add extra directory for each test to avoid reference file conflicts + let extraDirectory = + if multipleFiles then + filename.Substring(0, filename.Length - 3) // remove .fs + |> normalizeName + else "" + let outputDirectory = outputDirectory methodName extraDirectory let outputDirectoryPath = match outputDirectory with | Some path -> path.FullName @@ -157,6 +160,8 @@ type DirectoryAttribute(dir: string) = if not <| FileSystem.FileExistsShim(f) then failwithf "Requested file \"%s\" not found.\nAll files: %A.\nIncludes:%A." f allFiles includes + let multipleFiles = fsFiles |> Array.length > 1 + fsFiles - |> Array.map (fun fs -> createCompilationUnit dirInfo fs method.Name) + |> Array.map (fun fs -> createCompilationUnit dirInfo fs method.Name multipleFiles) |> Seq.map (fun c -> [| c |]) From 3fbcb5d0c8aff4d3aa6a0c2a8187799c25cf3e54 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 2 Aug 2022 16:17:51 +0200 Subject: [PATCH 90/91] Moved adhoc byref tests to actual tests --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 113 +++++++++++++++++- tests/adhoc.fsx | 63 ---------- 2 files changed, 110 insertions(+), 66 deletions(-) delete mode 100644 tests/adhoc.fsx diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 64123d12b7f..1799a01ef88 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -397,14 +397,121 @@ module InvocationBehavior = |> shouldSucceed [] - let ``SRTP Byref can't be passed with new syntax`` () = + let ``SRTP Byref can be passed with new syntax`` () = Fsx "let inline f_TraitWithByref<'T when 'T : ( static member TryParse: string * byref -> bool) >() = let mutable result = 0 'T.TryParse(\"42\", &result)" |> compile + |> shouldSucceed + + +module ``SRTP byref tests`` = + + [] + let ``Call with old syntax`` () = + Fsx """ + type C1() = + static member X(p: C1 byref) = p + + let inline callX<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = (^T: (static member X : 'T byref -> 'T) (&x)) + + let mutable c1 = C1() + let g1 = callX &c1 + + if g1 <> c1 then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Call with new syntax`` () = + Fsx """ + type C2() = + static member X(p: C2 byref) = p + + let inline callX2<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = 'T.X &x + let mutable c2 = C2() + let g2 = callX2 &c2 + + if g2 <> c2 then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Call with tuple`` () = + Fsx """ + + type C3() = + static member X(p: C3 byref, n: int) = p + + let inline callX3<'T when 'T : (static member X: 'T byref * int -> 'T)> (x: 'T byref) = 'T.X (&x, 3) + let mutable c3 = C3() + let g3 = callX3 &c3 + + if g3 <> c3 then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let test4 () = + Fsx """ + type C4() = + static member X() = C4() + + let inline callX4<'T when 'T : (static member X: unit -> 'T)> () = 'T.X () + let g4 = callX4 () + + if g4.GetType() <> typeof then + failwith "Unexpected result" + """ + |> compileExeAndRun + |> shouldSucceed + + // Trait constraints that involve byref returns currently can never be satisfied by any method. No other warning is given. + [] + let ``Byref returns not allowed`` () = + Fsx """ + type C5() = + static member X(p: C5 byref) = &p + + let inline callX5<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = 'T.X &x + let mutable c5 = C5() + let g5 () = callX5 &c5 + """ + |> compile |> shouldFail - |> withDiagnosticMessageMatches "A type instantiation involves a byref type. This is not permitted by the rules of Common IL." - |> withDiagnosticMessageMatches "The address of the variable 'result' cannot be used at this point" + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'byref'\\s+but here has type\\s+'C5'" + + [] + let ``Byref returns not allowed pt. 2`` () = + Fsx """ + type C6() = + static member X(p: C6 byref) = &p + + // NOTE: you can declare trait call which returns the address of the thing provided, you just can't satisfy the constraint + let inline callX6<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = &'T.X &x + let mutable c6 = C6() + let g6 () = callX6 &c6 + """ + |> compile + |> shouldFail + |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'byref'\\s+but here has type\\s+'C6'" + + [] + let ``No out args allowed`` () = + Fsx """ + open System.Runtime.InteropServices + + let inline callX2<'T when 'T : (static member X: [] Name: 'T byref -> bool)> () = () + """ + |> compile + |> shouldFail + |> withDiagnosticMessage "A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" module ``Implicit conversion`` = diff --git a/tests/adhoc.fsx b/tests/adhoc.fsx deleted file mode 100644 index 577213940ee..00000000000 --- a/tests/adhoc.fsx +++ /dev/null @@ -1,63 +0,0 @@ -open System.Runtime.InteropServices - - -module Test1 = - type C1() = - static member X(p: C1 byref) = p - - let inline callX<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = (^T: (static member X : 'T byref -> 'T) (&x)) - - let mutable c1 = C1() - let g1 = callX &c1 - -module Test2 = - type C2() = - static member X(p: C2 byref) = p - - let inline callX2<'T when 'T : (static member X: 'T byref -> 'T)> (x: 'T byref) = 'T.X &x - let mutable c2 = C2() - let g2 = callX2 &c2 - -module Test3 = - - type C3() = - static member X(p: C3 byref, n: int) = p - - let inline callX3<'T when 'T : (static member X: 'T byref * int -> 'T)> (x: 'T byref) = 'T.X (&x, 3) - let mutable c3 = C3() - let g3 = callX3 &c3 - -module Test4 = - type C4() = - static member X() = C4() - - let inline callX4<'T when 'T : (static member X: unit -> 'T)> () = 'T.X () - let g4 = callX4 () - -#if NEGATIVE -// NOTE, we don't expect these to compile. Trait constraints taht involve byref returns -// currently can never be satisfied by any method. No other warning is given - we may enable -// this at some later point but it is orthogonal to the RFC -module Test5 = - type C5() = - static member X(p: C5 byref) = &p - - let inline callX5<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = 'T.X &x - let mutable c5 = C5() - let g5 () = callX5 &c5 - -module Test6 = - - type C6() = - static member X(p: C6 byref) = &p - - // NOTE: you can declare trait call which returns the address of the thing provided, you just can't satisfy the constraint - let inline callX6<'T when 'T : (static member X: 'T byref -> 'T byref)> (x: 'T byref) = &'T.X &x - let mutable c6 = C6() - let g6 () = callX6 &c6 - -// No out args allows -module Test7 = - - let inline callX2<'T when 'T : (static member X: [] 'T byref -> bool)> () = () -#endif From a76d013ba03b30871c43ce597fc57a8f6f8b5056 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 2 Aug 2022 18:03:55 +0200 Subject: [PATCH 91/91] Tests update --- .../IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs | 34 +++++++++++-------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs index 1799a01ef88..7ff2a44aaf1 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/TypesAndTypeConstraints/IWSAMsAndSRTPs/IWSAMsAndSRTPsTests.fs @@ -296,14 +296,29 @@ module Negative = [ -> int) >() = ()")>] [] x: int[] -> int) >() = ()")>] [] x: int[] -> int) >() = ()")>] - let ``Trait warning`` code = + [] Name: 'T byref -> bool)> () = ()""")>] + let ``Trait warning or error`` code = + let errorMessage = "A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" + Fsx code + |> withLangVersion60 |> compile |> shouldFail |> withWarningCode 3532 - |> withDiagnosticMessage "A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" + |> withDiagnosticMessage errorMessage |> ignore + Fsx code + |> withLangVersionPreview + |> compile + |> shouldFail + |> withErrorCode 3532 + |> withDiagnosticMessage errorMessage + |> ignore + + #if !NETCOREAPP [] #else @@ -472,7 +487,9 @@ module ``SRTP byref tests`` = |> compileExeAndRun |> shouldSucceed - // Trait constraints that involve byref returns currently can never be satisfied by any method. No other warning is given. + // NOTE: Trait constraints that involve byref returns currently can never be satisfied by any method. No other warning is given. + // This is a bug that may be fixed in the future. + // These tests are pinning down current behavior. [] let ``Byref returns not allowed`` () = Fsx """ @@ -502,17 +519,6 @@ module ``SRTP byref tests`` = |> shouldFail |> withDiagnosticMessageMatches "This expression was expected to have type\\s+'byref'\\s+but here has type\\s+'C6'" - [] - let ``No out args allowed`` () = - Fsx """ - open System.Runtime.InteropServices - - let inline callX2<'T when 'T : (static member X: [] Name: 'T byref -> bool)> () = () - """ - |> compile - |> shouldFail - |> withDiagnosticMessage "A trait may not specify optional, in, out, ParamArray, CallerInfo or Quote arguments" - module ``Implicit conversion`` =