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 12eb6f4ccd9..4049c3d3b0a 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 @@ -11308,7 +11355,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 a27775a174d..81a59c3dc92 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 3bf8597b5ce..17765843400 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)