From b8c748c69c4fca42d2dc66024388d6e7b69a7971 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 22 Jan 2020 13:37:18 +0000 Subject: [PATCH 1/5] fix 5580 and better encapsulate constraint solver (#8294) * fix 5580 and better encapsulate constraint solver * fix 5580 and better encapsulate constraint solver * fix 5580 and better encapsulate constraint solver * fix 5580 and better encapsulate constraint solver * add new tests * nudge CI --- src/fsharp/ConstraintSolver.fs | 244 ++++++++++++++++++------- src/fsharp/ConstraintSolver.fsi | 127 +++++++------ src/fsharp/IlxGen.fs | 1 - src/fsharp/TypeChecker.fs | 58 ++---- tests/fsharp/tests.fs | 12 ++ tests/fsharp/typecheck/sigs/neg116.bsl | 12 ++ tests/fsharp/typecheck/sigs/neg116.fs | 10 + tests/fsharp/typecheck/sigs/neg117.bsl | 12 ++ tests/fsharp/typecheck/sigs/neg117.fs | 82 +++++++++ tests/fsharp/typecheck/sigs/neg118.bsl | 12 ++ tests/fsharp/typecheck/sigs/neg118.fs | 28 +++ tests/fsharp/typecheck/sigs/neg119.bsl | 22 +++ tests/fsharp/typecheck/sigs/neg119.fs | 40 ++++ 13 files changed, 498 insertions(+), 162 deletions(-) create mode 100644 tests/fsharp/typecheck/sigs/neg116.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg116.fs create mode 100644 tests/fsharp/typecheck/sigs/neg117.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg117.fs create mode 100644 tests/fsharp/typecheck/sigs/neg118.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg118.fs create mode 100644 tests/fsharp/typecheck/sigs/neg119.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg119.fs diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 0360d253dd..59b10f7be7 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -27,9 +27,19 @@ // can-unify predicates used in method overload resolution and trait constraint // satisfaction. // +// The two main principles are: +// 1. Ensure any solution that is found is sound (no logic is skipped), +// 2. Because of method overloading and SRTP constraints and other constructs, processing of +// constraints is algorithmic and must proceed in a definite, fixed order. +// Once we start doing resolutions in a particular order we must keep doing them +// in the same order. +// +// There is little use of back-tracking/undo or "retry" in the constraint solver, except in the +// limited case ofs of SRTP solving and method overloading, and some other adhoc limited cases +// like checking for "printf" format strings. As a result there are cases involving +// method overloading and SRTP that the solver "can't solve". This is intentional and by-design. //------------------------------------------------------------------------- - module internal FSharp.Compiler.ConstraintSolver open Internal.Utilities.Collections @@ -429,8 +439,39 @@ let ShowAccessDomain ad = exception NonRigidTypar of displayEnv: DisplayEnv * string option * range * TType * TType * range -exception LocallyAbortOperationThatFailsToResolveOverload +/// Signal that there is still an unresolved overload in the constraint problem. The +/// unresolved overload constraint remains in the constraint state, and we skip any +/// further processing related to whichever overall adjustment to constraint solver state +/// is being processed. +/// +// NOTE: The addition of this abort+skip appears to be a mistake which has crept into F# type inference, +// and its status is currently under review. See https://github.com/dotnet/fsharp/pull/8294 and others. +// +// Here is the history: +// 1. The local abort was added as part of an attempted performance optimization https://github.com/dotnet/fsharp/pull/1650 +// This change was released in the VS2017 GA release. +// +// 2. However, it also impacts the logic of type inference, by skipping checking. +// Because of this an attempt was made to revert it in https://github.com/dotnet/fsharp/pull/4173. +// +// Unfortunately, existing code had begun to depend on the new behaviours enabled by the +// change, and the revert was abandoned before release in https://github.com/dotnet/fsharp/pull/4348 +// +// Comments on soundness: +// The use of the abort is normally sound because the SRTP constraint +// will be subject to further processing at a later point. +// +// However, it seems likely that the abort may result in other processing associated +// with an overall constraint being skipped (e.g. the processing related to subsequent elements +// of a tuple constraint). +exception AbortForFailedOverloadResolution + +/// This is used at (nearly all) entry points into the constraint solver to make sure that the +/// AbortForFailedOverloadResolution is caught and processing continues. +let inline TryD_IgnoreAbortForFailedOverloadResolution f1 f2 = + TryD f1 (function AbortForFailedOverloadResolution -> CompleteD | exn -> f2 exn) +/// Represents a very local condition where we prefer to report errors before stripping type abbreviations. exception LocallyAbortOperationThatLosesAbbrevs let localAbortD = ErrorD LocallyAbortOperationThatLosesAbbrevs @@ -929,8 +970,9 @@ and private SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln t // Back out of expansions of type abbreviations to give improved error messages. // Note: any "normalization" of equations on type variables must respect the trace parameter TryD (fun () -> SolveTypeEqualsType csenv ndeep m2 trace cxsln ty1 ty2) - (function LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInEqualityRelation(csenv.DisplayEnv, ty1, ty2, csenv.m, m2, csenv.eContextInfo)) - | err -> ErrorD err) + (function + | LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInEqualityRelation(csenv.DisplayEnv, ty1, ty2, csenv.m, m2, csenv.eContextInfo)) + | err -> ErrorD err) and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 = match origl1, origl2 with @@ -1059,8 +1101,9 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional and SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m2 trace cxsln ty1 ty2 = let denv = csenv.DisplayEnv TryD (fun () -> SolveTypeSubsumesType csenv ndeep m2 trace cxsln ty1 ty2) - (function LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv, ty1, ty2, csenv.m, m2)) - | err -> ErrorD err) + (function + | LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv, ty1, ty2, csenv.m, m2)) + | err -> ErrorD err) //------------------------------------------------------------------------- // Solve and record non-equality constraints @@ -1451,7 +1494,9 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, [(callerArgs, [])], false, false, None))) let methOverloadResult, errors = - trace.CollectThenUndoOrCommit (fun (a, _) -> Option.isSome a) (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) (0, 0) AccessibleFromEverywhere calledMethGroup false (Some rty)) + trace.CollectThenUndoOrCommit + (fun (a, _) -> Option.isSome a) + (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) (0, 0) AccessibleFromEverywhere calledMethGroup false (Some rty)) match anonRecdPropSearch, recdPropSearch, methOverloadResult with | Some (anonInfo, tinst, i), None, None -> @@ -1497,7 +1542,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload match errors with | ErrorResult (_, UnresolvedOverloading _) when not ignoreUnresolvedOverload && (not (nm = "op_Explicit" || nm = "op_Implicit")) -> - return! ErrorD LocallyAbortOperationThatFailsToResolveOverload + return! ErrorD AbortForFailedOverloadResolution | _ -> return TTraitUnsolved } @@ -2183,25 +2228,23 @@ and CanMemberSigsMatchUpToCheck // "ty2 casts to ty1" // "a value of type ty2 can be used where a value of type ty1 is expected" and private SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 = - TryD (fun () -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2) - (function - | LocallyAbortOperationThatFailsToResolveOverload -> CompleteD - | res -> - match csenv.eContextInfo with - | ContextInfo.RuntimeTypeTest isOperator -> - // test if we can cast other way around - match CollectThenUndo (fun newTrace -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) cxsln ty2 ty1) with - | OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.DowncastUsedInsteadOfUpcast isOperator, m)) - | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.NoContext, m)) - | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m))) + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2) + (fun res -> + match csenv.eContextInfo with + | ContextInfo.RuntimeTypeTest isOperator -> + // test if we can cast other way around + match CollectThenUndo (fun newTrace -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) cxsln ty2 ty1) with + | OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.DowncastUsedInsteadOfUpcast isOperator, m)) + | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.NoContext, m)) + | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m))) // ty1: actual // ty2: expected and private SolveTypeEqualsTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln actual expected = - TryD (fun () -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m trace cxsln actual expected) - (function - | LocallyAbortOperationThatFailsToResolveOverload -> CompleteD - | res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, actual, expected, res, m))) + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m trace cxsln actual expected) + (fun res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, actual, expected, res, m))) and ArgsMustSubsumeOrConvert (csenv: ConstraintSolverEnv) @@ -2677,16 +2720,22 @@ and ResolveOverloading | None -> None, errors +let ResolveOverloadingForCall denv css m methodName ndeep cx callerArgCounts ad calledMethGroup permitOptArgs reqdRetTyOpt = + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + ResolveOverloading csenv NoTrace methodName ndeep cx callerArgCounts ad calledMethGroup permitOptArgs reqdRetTyOpt /// This is used before analyzing the types of arguments in a single overload resolution let UnifyUniqueOverloading - (csenv: ConstraintSolverEnv) + denv + css + m callerArgCounts methodName ad (calledMethGroup: CalledMeth list) reqdRetTy // The expected return type, if known = + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv let m = csenv.m // See what candidates we have based on name and arity let candidates = calledMethGroup |> List.filter (fun cmeth -> cmeth.IsCandidate(m, ad)) @@ -2716,15 +2765,17 @@ let UnifyUniqueOverloading | _ -> ResultD false -let EliminateConstraintsForGeneralizedTypars csenv (trace: OptionalTrace) (generalizedTypars: Typars) = - // Remove the global constraints where this type variable appears in the support of the constraint - generalizedTypars - |> List.iter (fun tp -> +/// Remove the global constraints where these type variables appear in the support of the constraint +let EliminateConstraintsForGeneralizedTypars denv css m (trace: OptionalTrace) (generalizedTypars: Typars) = + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + for tp in generalizedTypars do let tpn = tp.Stamp let cxst = csenv.SolverState.ExtraCxs let cxs = cxst.FindAll tpn - cxs |> List.iter (fun cx -> trace.Exec (fun () -> cxst.Remove tpn) (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn, cx)))) - ) + for cx in cxs do + trace.Exec + (fun () -> cxst.Remove tpn) + (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn, cx))) //------------------------------------------------------------------------- @@ -2735,7 +2786,8 @@ let EliminateConstraintsForGeneralizedTypars csenv (trace: OptionalTrace) (gener //------------------------------------------------------------------------- let AddCxTypeEqualsType contextInfo denv css m actual expected = - SolveTypeEqualsTypeWithReport (MakeConstraintSolverEnv contextInfo css m denv) 0 m NoTrace None actual expected + let csenv = MakeConstraintSolverEnv contextInfo css m denv + SolveTypeEqualsTypeWithReport csenv 0 m NoTrace None actual expected |> RaiseOperationResult let UndoIfFailed f = @@ -2770,17 +2822,23 @@ let UndoIfFailedOrWarnings f = false let AddCxTypeEqualsTypeUndoIfFailed denv css m ty1 ty2 = - UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2) + UndoIfFailed (fun trace -> + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) let AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv css m ty1 ty2 = - UndoIfFailedOrWarnings (fun trace -> SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) ty1 ty2) + UndoIfFailedOrWarnings (fun trace -> + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) let AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 = let csenv = { MakeConstraintSolverEnv ContextInfo.NoContext css m denv with MatchingOnly = true } UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) let AddCxTypeMustSubsumeTypeUndoIfFailed denv css m ty1 ty2 = - UndoIfFailed (fun trace -> SolveTypeSubsumesTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) None ty1 ty2) + UndoIfFailed (fun trace -> + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + SolveTypeSubsumesTypeKeepAbbrevs csenv 0 m (WithTrace trace) None ty1 ty2) let AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv @@ -2788,64 +2846,114 @@ let AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 = UndoIfFailed (fun trace -> SolveTypeSubsumesTypeKeepAbbrevs csenv 0 m (WithTrace trace) None ty1 ty2) let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 = - SolveTypeSubsumesTypeWithReport (MakeConstraintSolverEnv contextInfo css m denv) 0 m trace None ty1 ty2 + let csenv = MakeConstraintSolverEnv contextInfo css m denv + SolveTypeSubsumesTypeWithReport csenv 0 m trace None ty1 ty2 |> RaiseOperationResult let AddCxMethodConstraint denv css m trace traitInfo = - TryD (fun () -> + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> trackErrors { do! - SolveMemberConstraint (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) true false 0 m trace traitInfo + SolveMemberConstraint csenv true false 0 m trace traitInfo |> OperationResult.ignore }) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportNull denv css m trace ty = - TryD (fun () -> SolveTypeSupportsNull (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeSupportsNull csenv 0 m trace ty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportComparison denv css m trace ty = - TryD (fun () -> SolveTypeSupportsComparison (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeSupportsComparison csenv 0 m trace ty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportEquality denv css m trace ty = - TryD (fun () -> SolveTypeSupportsEquality (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeSupportsEquality csenv 0 m trace ty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportDefaultCtor denv css m trace ty = - TryD (fun () -> SolveTypeRequiresDefaultConstructor (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeRequiresDefaultConstructor csenv 0 m trace ty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsReferenceType denv css m trace ty = - TryD (fun () -> SolveTypeIsReferenceType (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeIsReferenceType csenv 0 m trace ty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsValueType denv css m trace ty = - TryD (fun () -> SolveTypeIsNonNullableValueType (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeIsNonNullableValueType csenv 0 m trace ty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsUnmanaged denv css m trace ty = - TryD (fun () -> SolveTypeIsUnmanaged (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeIsUnmanaged csenv 0 m trace ty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsEnum denv css m trace ty underlying = - TryD (fun () -> SolveTypeIsEnum (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty underlying) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeIsEnum csenv 0 m trace ty underlying) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsDelegate denv css m trace ty aty bty = - TryD (fun () -> SolveTypeIsDelegate (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty aty bty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTypeIsDelegate csenv 0 m trace ty aty bty) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + |> RaiseOperationResult + +let AddCxTyparDefaultsTo denv css m ctxtInfo tp ridx ty = + let csenv = MakeConstraintSolverEnv ctxtInfo css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> AddConstraint csenv 0 m NoTrace tp (TyparConstraint.DefaultsTo(ridx, ty, m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult +let SolveTypeAsError denv css m ty = + let ty2 = NewErrorType () + assert((destTyparTy css.g ty2).IsFromError) + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + SolveTypeEqualsTypeKeepAbbrevs csenv 0 m NoTrace ty ty2 |> ignore + +let ApplyTyparDefaultAtPriority denv css priority (tp: Typar) = + tp.Constraints |> List.iter (fun tpc -> + match tpc with + | TyparConstraint.DefaultsTo(priority2, ty2, m) when priority2 = priority -> + let ty1 = mkTyparTy tp + if not tp.IsSolved && not (typeEquiv css.g ty1 ty2) then + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> + SolveTyparEqualsType csenv 0 m NoTrace ty1 ty2) + (fun res -> + SolveTypeAsError denv css m ty1 + ErrorD(ErrorFromApplyingDefault(css.g, denv, tp, ty2, res, m))) + |> RaiseOperationResult + | _ -> ()) + let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: TraitConstraintInfo) argExprs = trackErrors { let css = { g = g @@ -2952,24 +3060,34 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra | Choice5Of5 () -> ResultD None } - let ChooseTyparSolutionAndSolve css denv tp = let g = css.g let amap = css.amap let max, m = ChooseTyparSolutionAndRange g amap tp let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD (fun () -> SolveTyparEqualsType csenv 0 m NoTrace (mkTyparTy tp) max) - (fun err -> ErrorD(ErrorFromApplyingDefault(g, denv, tp, max, err, m))) + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> SolveTyparEqualsType csenv 0 m NoTrace (mkTyparTy tp) max) + (fun err -> ErrorD(ErrorFromApplyingDefault(g, denv, tp, max, err, m))) |> RaiseOperationResult - let CheckDeclaredTypars denv css m typars1 typars2 = - TryD (fun () -> + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> CollectThenUndo (fun trace -> - SolveTypeEqualsTypeEqns (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) None + SolveTypeEqualsTypeEqns csenv 0 m (WithTrace trace) None (List.map mkTyparTy typars1) (List.map mkTyparTy typars2))) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) + (fun res -> + ErrorD (ErrorFromAddingConstraint(denv, res, m))) + |> RaiseOperationResult + +let CanonicalizePartialInferenceProblem css denv m tps = + // Canonicalize constraints prior to generalization + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + TryD_IgnoreAbortForFailedOverloadResolution + (fun () -> CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult /// An approximation used during name resolution for intellisense to eliminate extension members which will not diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 6aa40c6ea9..8fdaabf82c 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -17,32 +17,32 @@ open FSharp.Compiler.MethodCalls open FSharp.Compiler.InfoReader /// Create a type variable representing the use of a "_" in F# code -val NewAnonTypar : TyparKind * range * TyparRigidity * TyparStaticReq * TyparDynamicReq -> Typar +val NewAnonTypar: TyparKind * range * TyparRigidity * TyparStaticReq * TyparDynamicReq -> Typar /// Create an inference type variable -val NewInferenceType : unit -> TType +val NewInferenceType: unit -> TType /// Create an inference type variable for the kind of a byref pointer -val NewByRefKindInferenceType : TcGlobals -> range -> TType +val NewByRefKindInferenceType: TcGlobals -> range -> TType /// Create an inference type variable representing an error condition when checking an expression -val NewErrorType : unit -> TType +val NewErrorType: unit -> TType /// Create an inference type variable representing an error condition when checking a measure -val NewErrorMeasure : unit -> Measure +val NewErrorMeasure: unit -> Measure /// Create a list of inference type variables, one for each element in the input list -val NewInferenceTypes : 'a list -> TType list +val NewInferenceTypes: 'a list -> TType list /// Given a set of formal type parameters and their constraints, make new inference type variables for /// each and ensure that the constraints on the new type variables are adjusted to refer to these. -val FreshenAndFixupTypars : range -> TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInst * TType list +val FreshenAndFixupTypars: range -> TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInst * TType list -val FreshenTypeInst : range -> Typars -> Typars * TyparInst * TType list +val FreshenTypeInst: range -> Typars -> Typars * TyparInst * TType list -val FreshenTypars : range -> Typars -> TType list +val FreshenTypars: range -> Typars -> TType list -val FreshenMethInfo : range -> MethInfo -> TType list +val FreshenMethInfo: range -> MethInfo -> TType list [] /// Information about the context of a type equation. @@ -114,53 +114,70 @@ type TcValF = (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) type ConstraintSolverState = static member New: TcGlobals * Import.ImportMap * InfoReader * TcValF -> ConstraintSolverState -type ConstraintSolverEnv - -val BakedInTraitConstraintNames : Set - -val MakeConstraintSolverEnv : ContextInfo -> ConstraintSolverState -> range -> DisplayEnv -> ConstraintSolverEnv +val BakedInTraitConstraintNames: Set [] type Trace type OptionalTrace = -| NoTrace -| WithTrace of Trace - -val SimplifyMeasuresInTypeScheme : TcGlobals -> bool -> Typars -> TType -> TyparConstraint list -> Typars -val SolveTyparEqualsType : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult -val SolveTypeEqualsTypeKeepAbbrevs : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult - -/// Canonicalize constraints prior to generalization -val CanonicalizeRelevantMemberConstraints : ConstraintSolverEnv -> int -> OptionalTrace -> Typars -> OperationResult - -val ResolveOverloading : ConstraintSolverEnv -> OptionalTrace -> string -> ndeep: int -> TraitConstraintInfo option -> int * int -> AccessorDomain -> CalledMeth list -> bool -> TType option -> CalledMeth option * OperationResult -val UnifyUniqueOverloading : ConstraintSolverEnv -> int * int -> string -> AccessorDomain -> CalledMeth list -> TType -> OperationResult -val EliminateConstraintsForGeneralizedTypars : ConstraintSolverEnv -> OptionalTrace -> Typars -> unit - -val CheckDeclaredTypars : DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit - -val AddConstraint : ConstraintSolverEnv -> int -> Range.range -> OptionalTrace -> Typar -> TyparConstraint -> OperationResult -val AddCxTypeEqualsType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit -val AddCxTypeEqualsTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool -val AddCxTypeEqualsTypeUndoIfFailedOrWarnings : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool -val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool -val AddCxTypeMustSubsumeType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit -val AddCxTypeMustSubsumeTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool -val AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool -val AddCxMethodConstraint : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TraitConstraintInfo -> unit -val AddCxTypeMustSupportNull : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit -val AddCxTypeMustSupportComparison : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit -val AddCxTypeMustSupportEquality : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit -val AddCxTypeMustSupportDefaultCtor : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit -val AddCxTypeIsReferenceType : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit -val AddCxTypeIsValueType : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit -val AddCxTypeIsUnmanaged : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit -val AddCxTypeIsEnum : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit -val AddCxTypeIsDelegate : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> TType -> unit - -val CodegenWitnessThatTypeSupportsTraitConstraint : TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult - -val ChooseTyparSolutionAndSolve : ConstraintSolverState -> DisplayEnv -> Typar -> unit - -val IsApplicableMethApprox : TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool + | NoTrace + | WithTrace of Trace + +val SimplifyMeasuresInTypeScheme: TcGlobals -> bool -> Typars -> TType -> TyparConstraint list -> Typars + +val ResolveOverloadingForCall: DisplayEnv -> ConstraintSolverState -> range -> string -> ndeep: int -> TraitConstraintInfo option -> int * int -> AccessorDomain -> CalledMeth list -> bool -> TType option -> CalledMeth option * OperationResult + +val UnifyUniqueOverloading: DisplayEnv -> ConstraintSolverState -> range -> int * int -> string -> AccessorDomain -> CalledMeth list -> TType -> OperationResult + +/// Remove the global constraints where these type variables appear in the support of the constraint +val EliminateConstraintsForGeneralizedTypars: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> Typars -> unit + +val CheckDeclaredTypars: DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit + +val AddCxTypeEqualsType: ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit + +val AddCxTypeEqualsTypeUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool + +val AddCxTypeEqualsTypeUndoIfFailedOrWarnings: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool + +val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool + +val AddCxTypeMustSubsumeType: ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit + +val AddCxTypeMustSubsumeTypeUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool + +val AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool + +val AddCxMethodConstraint: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TraitConstraintInfo -> unit + +val AddCxTypeMustSupportNull: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit + +val AddCxTypeMustSupportComparison: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit + +val AddCxTypeMustSupportEquality: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit + +val AddCxTypeMustSupportDefaultCtor: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit + +val AddCxTypeIsReferenceType: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit + +val AddCxTypeIsValueType: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit + +val AddCxTypeIsUnmanaged: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit + +val AddCxTypeIsEnum: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit + +val AddCxTypeIsDelegate: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> TType -> unit + +val AddCxTyparDefaultsTo: DisplayEnv -> ConstraintSolverState -> range -> ContextInfo -> Typar -> int -> TType -> unit + +val SolveTypeAsError: DisplayEnv -> ConstraintSolverState -> range -> TType -> unit + +val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority: int -> Typar -> unit + +val CodegenWitnessThatTypeSupportsTraitConstraint: TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult + +val ChooseTyparSolutionAndSolve: ConstraintSolverState -> DisplayEnv -> Typar -> unit + +val IsApplicableMethApprox: TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool + +val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit \ No newline at end of file diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index bae42ad081..412d1a62ac 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -7754,4 +7754,3 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai /// Invert the compilation of the given value and return its current dynamic value and its compiled System.Type member __.LookupGeneratedValue (ctxt, v) = LookupGeneratedValue amap ctxt ilxGenEnv v - diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 6609d5ad95..c888057686 100644 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -2284,13 +2284,6 @@ module GeneralizationHelpers = ConstraintSolver.ChooseTyparSolutionAndSolve cenv.css denv tp) generalizedTypars - let CanonicalizePartialInferenceProblem (cenv, denv, m) tps = - // Canonicalize constraints prior to generalization - let csenv = (MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denv) - TryD (fun () -> ConstraintSolver.CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) - |> RaiseOperationResult - let ComputeAndGeneralizeGenericTypars (cenv, denv: DisplayEnv, m, @@ -2333,8 +2326,7 @@ module GeneralizationHelpers = generalizedTypars |> List.iter (SetTyparRigid cenv.g denv m) // Generalization removes constraints related to generalized type variables - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denv - EliminateConstraintsForGeneralizedTypars csenv NoTrace generalizedTypars + EliminateConstraintsForGeneralizedTypars denv cenv.css m NoTrace generalizedTypars generalizedTypars @@ -4333,8 +4325,7 @@ let rec TcTyparConstraint ridx cenv newOk checkCxs occ (env: TcEnv) tpenv c = | WhereTyparDefaultsToType(tp, ty, m) -> let ty', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty let tp', tpenv = TcTypar cenv env newOk tpenv tp - let csenv = MakeConstraintSolverEnv env.eContextInfo cenv.css m env.DisplayEnv - AddConstraint csenv 0 m NoTrace tp' (TyparConstraint.DefaultsTo(ridx, ty', m)) |> CommitOperationResult + AddCxTyparDefaultsTo env.DisplayEnv cenv.css m env.eContextInfo tp' ridx ty' tpenv | WhereTyparSubtypeOfType(tp, ty, m) -> @@ -5595,11 +5586,7 @@ and TcPatterns warnOnUpper cenv env vFlags s argTys args = assert (List.length args = List.length argTys) List.mapFold (fun s (ty, pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argTys args) - -and solveTypAsError cenv denv m ty = - let ty2 = NewErrorType () - assert((destTyparTy cenv.g ty2).IsFromError) - SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denv) 0 m NoTrace ty ty2 |> ignore +and solveTypAsError cenv denv m ty = ConstraintSolver.SolveTypeAsError denv cenv.css m ty and RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects cenv env tpenv expr = // This function is motivated by cases like @@ -6782,7 +6769,7 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo, bind) = | _ -> declaredTypars // Canonicalize constraints prior to generalization - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, m) declaredTypars + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv m declaredTypars let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env @@ -9638,7 +9625,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela // Canonicalize inference problem prior to '.' lookup on variable types if isTyparTy cenv.g objExprTy then - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, env.DisplayEnv, mExprAndLongId) (freeInTypeLeftToRight cenv.g false objExprTy) + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy) let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId findFlag false let mExprAndItem = unionRanges mObjExpr mItem @@ -10089,8 +10076,7 @@ and TcMethodApplication yield makeOneCalledMeth (minfo, pinfoOpt, false) ] let uniquelyResolved = - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv - UnifyUniqueOverloading csenv callerArgCounts methodName ad preArgumentTypeCheckingCalledMethGroup returnTy + UnifyUniqueOverloading denv cenv.css mMethExpr callerArgCounts methodName ad preArgumentTypeCheckingCalledMethGroup returnTy uniquelyResolved, preArgumentTypeCheckingCalledMethGroup @@ -10182,17 +10168,15 @@ and TcMethodApplication CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt)) let callerArgCounts = (unnamedCurriedCallerArgs.Length, namedCurriedCallerArgs.Length) - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv // Commit unassociated constraints prior to member overload resolution where there is ambiguity // about the possible target of the call. if not uniquelyResolved then - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, mItem) + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv mItem (//freeInTypeLeftToRight cenv.g false returnTy @ (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type))) - let result, errors = - ResolveOverloading csenv NoTrace methodName 0 None callerArgCounts ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy) + let result, errors = ResolveOverloadingForCall denv cenv.css mMethExpr methodName 0 None callerArgCounts ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy) match afterResolution, result with | AfterResolution.DoNothing, _ -> () @@ -11150,7 +11134,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds // Canonicalize constraints prior to generalization let denv = env.DisplayEnv - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, synBindsRange) + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv synBindsRange (checkedBinds |> List.collect (fun tbinfo -> let (CheckedBindingInfo(_, _, _, _, flex, _, _, _, tauTy, _, _, _, _, _)) = tbinfo let (ExplicitTyparInfo(_, declaredTypars, _)) = flex @@ -12025,7 +12009,7 @@ and TcIncrementalLetRecGeneralization cenv scopem else let supportForBindings = newGeneralizableBindings |> List.collect (TcLetrecComputeSupportForBinding cenv) - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, scopem) supportForBindings + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv scopem supportForBindings let generalizedTyparsL = newGeneralizableBindings |> List.map (TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv) @@ -17530,27 +17514,15 @@ let ApplyDefaults cenv g denvAtEnd m mexpr extraAttribs = try let unsolved = FSharp.Compiler.FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd (mexpr, extraAttribs) - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denvAtEnd, m) unsolved + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denvAtEnd m unsolved - let applyDefaults priority = - unsolved |> List.iter (fun tp -> + // The priority order comes from the order of declaration of the defaults in FSharp.Core. + for priority = 10 downto 0 do + unsolved |> List.iter (fun tp -> if not tp.IsSolved then // Apply the first default. If we're defaulting one type variable to another then // the defaults will be propagated to the new type variable. - tp.Constraints |> List.iter (fun tpc -> - match tpc with - | TyparConstraint.DefaultsTo(priority2, ty2, m) when priority2 = priority -> - let ty1 = mkTyparTy tp - if not tp.IsSolved && not (typeEquiv cenv.g ty1 ty2) then - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denvAtEnd - TryD (fun () -> ConstraintSolver.SolveTyparEqualsType csenv 0 m NoTrace ty1 ty2) - (fun e -> solveTypAsError cenv denvAtEnd m ty1 - ErrorD(ErrorFromApplyingDefault(g, denvAtEnd, tp, ty2, e, m))) - |> RaiseOperationResult - | _ -> ())) - - for priority = 10 downto 0 do - applyDefaults priority + ConstraintSolver.ApplyTyparDefaultAtPriority denvAtEnd cenv.css priority tp) // OK, now apply defaults for any unsolved HeadTypeStaticReq unsolved |> List.iter (fun tp -> diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 2247c318f6..e88033a5a2 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -2660,6 +2660,18 @@ module TypecheckTests = [] let ``type check neg115`` () = singleNegTest (testConfig "typecheck/sigs") "neg115" + [] + let ``type check neg116`` () = singleNegTest (testConfig "typecheck/sigs") "neg116" + + [] + let ``type check neg117`` () = singleNegTest (testConfig "typecheck/sigs") "neg117" + + [] + let ``type check neg118`` () = singleNegTest (testConfig "typecheck/sigs") "neg118" + + [] + let ``type check neg119`` () = singleNegTest (testConfig "typecheck/sigs") "neg119" + [] let ``type check neg_anon_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_anon_1" diff --git a/tests/fsharp/typecheck/sigs/neg116.bsl b/tests/fsharp/typecheck/sigs/neg116.bsl new file mode 100644 index 0000000000..8bd4930a30 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg116.bsl @@ -0,0 +1,12 @@ + +neg116.fs(10,44,10,45): typecheck error FS0043: No overloads match for method 'op_Multiply'. The available overloads are shown below. +neg116.fs(10,44,10,45): typecheck error FS0043: Possible overload: 'static member Polynomial.( * ) : s:Complex * p:Polynomial -> Polynomial'. Type constraint mismatch. The type + 'float' +is not compatible with type + 'Complex' +. +neg116.fs(10,44,10,45): typecheck error FS0043: Possible overload: 'static member Polynomial.( * ) : s:decimal * p:Polynomial -> Polynomial'. Type constraint mismatch. The type + 'float' +is not compatible with type + 'decimal' +. diff --git a/tests/fsharp/typecheck/sigs/neg116.fs b/tests/fsharp/typecheck/sigs/neg116.fs new file mode 100644 index 0000000000..fff55619af --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg116.fs @@ -0,0 +1,10 @@ +module Neg116 + +type Complex = unit + +type Polynomial () = + static member (*) (s: decimal, p: Polynomial) : Polynomial = failwith "" + static member (*) (s: Complex, p: Polynomial) : Polynomial = failwith "" + +module Foo = + let test t (p: Polynomial) = (1.0 - t) * p diff --git a/tests/fsharp/typecheck/sigs/neg117.bsl b/tests/fsharp/typecheck/sigs/neg117.bsl new file mode 100644 index 0000000000..49c2665190 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg117.bsl @@ -0,0 +1,12 @@ + +neg117.fs(79,18,79,59): ilxgen error FS0041: No overloads match for method 'Transform'. The available overloads are shown below. +neg117.fs(79,18,79,59): ilxgen error FS0041: Possible overload: 'static member Neg117.Superpower.Transformer.Transform : ^r * Neg117.TargetA.TargetA * Neg117.Superpower.Transformer -> (Neg117.TargetA.TransformerKind -> ^r) when (Neg117.TargetA.TargetA or ^r) : (static member Transform : ^r * Neg117.TargetA.TargetA -> Neg117.TargetA.TransformerKind -> ^r)'. Type constraint mismatch. The type + 'Neg117.TargetA.M1 Microsoft.FSharp.Core.[]' +is not compatible with type + ''a' +. +neg117.fs(79,18,79,59): ilxgen error FS0041: Possible overload: 'static member Neg117.Superpower.Transformer.Transform : ^f * Neg117.TargetB.TargetB * Neg117.Superpower.Transformer -> (Neg117.TargetB.TransformerKind -> ^f) when (Neg117.TargetB.TargetB or ^f) : (static member Transform : ^f * Neg117.TargetB.TargetB -> Neg117.TargetB.TransformerKind -> ^f)'. Type constraint mismatch. The type + 'Neg117.TargetA.M1 Microsoft.FSharp.Core.[]' +is not compatible with type + ''a' +. diff --git a/tests/fsharp/typecheck/sigs/neg117.fs b/tests/fsharp/typecheck/sigs/neg117.fs new file mode 100644 index 0000000000..a5de1db5a2 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg117.fs @@ -0,0 +1,82 @@ +module Neg117 + +#nowarn "64" // This construct causes code to be less generic than indicated by the type annotations. + +module TargetA = + + [] + type TransformerKind = + | A + | B + + type M1 = int + + type M2 = float + + type Target() = + + member __.TransformM1 (kind: TransformerKind) : M1[] option = [| 0 |] |> Some + member __.TransformM2 (kind: TransformerKind) : M2[] option = [| 1. |] |> Some + + type TargetA = + + static member instance : Target option = None + + static member inline Transform(_: ^r, _: TargetA) = fun (kind:TransformerKind) -> TargetA.instance.Value.TransformM1 kind : ^r + static member inline Transform(_: ^r, _: TargetA) = fun (kind:TransformerKind) -> TargetA.instance.Value.TransformM2 kind : ^r + + static member inline Transform(kind: TransformerKind) = + let inline call2(a:^a, b:^b) = ((^a or ^b) : (static member Transform: _ * _ -> _) b, a) + let inline call (a: 'a) = fun (x: 'x) -> call2(a, Unchecked.defaultof<'r>) x : 'r + call Unchecked.defaultof kind + + let inline Transform kind = TargetA.Transform kind + +module TargetB = + [] + type TransformerKind = + | C + | D + + type M1 = | M1 + + type M2 = | M2 + + type Target() = + + member __.TransformM1 (kind: TransformerKind) = [| M1 |] |> Some + member __.TransformM2 (kind: TransformerKind) = [| M2 |] |> Some + + type TargetB = + + static member instance : Target option = None + + static member inline Transform(_: ^r, _: TargetB) = fun (kind:TransformerKind) -> TargetB.instance.Value.TransformM1 kind : ^r + static member inline Transform(_: ^r, _: TargetB) = fun (kind:TransformerKind) -> TargetB.instance.Value.TransformM2 kind : ^r + + static member inline Transform(kind: TransformerKind) = + let inline call2(a:^a, b:^b) = ((^a or ^b) : (static member Transform: _ * _ -> _) b, a) + let inline call (a: 'a) = fun (x: 'x) -> call2(a, Unchecked.defaultof<'r>) x : 'r + call Unchecked.defaultof kind + let inline Transform kind = TargetB.Transform kind + +module Superpower = + + type Transformer = + + static member inline Transform(_: ^f, _: TargetB.TargetB, _: Transformer) = + fun x -> TargetB.Transform x : ^f + + static member inline Transform(_: ^r, _: TargetA.TargetA, _: Transformer) = + fun x -> TargetA.Transform x : ^r + + static member inline YeahTransform kind = + let inline call2(a:^a, b:^b, c: ^c) = ((^a or ^b or ^c) : (static member Transform: _ * _ * _ -> _) c, b, a) + let inline call (a: 'a) = fun (x: 'x) -> call2(a, Unchecked.defaultof<_>, Unchecked.defaultof<'r>) x : 'r + call Unchecked.defaultof kind + +module Examples = + let a kind = Superpower.Transformer.YeahTransform kind : TargetA.M1[] + let b = Superpower.Transformer.YeahTransform TargetA.TransformerKind.A : TargetA.M2[] option + let c = Superpower.Transformer.YeahTransform TargetB.TransformerKind.C : TargetB.M1[] option + let d = Superpower.Transformer.YeahTransform TargetA.TransformerKind.A : TargetA.M1[] option diff --git a/tests/fsharp/typecheck/sigs/neg118.bsl b/tests/fsharp/typecheck/sigs/neg118.bsl new file mode 100644 index 0000000000..7b70803cc6 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg118.bsl @@ -0,0 +1,12 @@ + +neg118.fs(18,21,18,37): typecheck error FS0003: This value is not a function and cannot be applied. + +neg118.fs(19,21,19,37): typecheck error FS0003: This value is not a function and cannot be applied. + +neg118.fs(20,21,20,39): typecheck error FS0003: This value is not a function and cannot be applied. + +neg118.fs(21,21,21,41): typecheck error FS0003: This value is not a function and cannot be applied. + +neg118.fs(22,21,22,39): typecheck error FS0003: This value is not a function and cannot be applied. + +neg118.fs(25,51,25,67): typecheck error FS0003: This value is not a function and cannot be applied. diff --git a/tests/fsharp/typecheck/sigs/neg118.fs b/tests/fsharp/typecheck/sigs/neg118.fs new file mode 100644 index 0000000000..fb951db31c --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg118.fs @@ -0,0 +1,28 @@ +module Neg118 + +// This is the example provided by Gustavo Leon in https://github.com/dotnet/fsharp/pull/4173 +// The code is potentially valid and, if that PR had been accepted, would compile. +// It's being added as a negative test case to capture the fact that it currently +// fails to compile. + +type FoldArgs<'t> = FoldArgs of ('t -> 't -> 't) + +let inline foldArgs f (x:'t) (y:'t) :'rest = (FoldArgs f $ Unchecked.defaultof<'rest>) x y + +type FoldArgs<'t> with + static member inline ($) (FoldArgs f, _:'t-> 'rest) = fun (a:'t) -> f a >> foldArgs f + static member ($) (FoldArgs f, _:'t ) = f + +let test1() = + let x:int = foldArgs (+) 2 3 + let y:int = foldArgs (+) 2 3 4 + let z:int = foldArgs (+) 2 3 4 5 + let d:decimal = foldArgs (+) 2M 3M 4M + let e:string = foldArgs (+) "h" "e" "l" "l" "o" + let f:float = foldArgs (+) 2. 3. 4. + + let mult3Numbers a b c = a * b * c + let res2 = mult3Numbers 3 (foldArgs (+) 3 4) (foldArgs (+) 2 2 3 3) + () + + diff --git a/tests/fsharp/typecheck/sigs/neg119.bsl b/tests/fsharp/typecheck/sigs/neg119.bsl new file mode 100644 index 0000000000..9f13a88643 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg119.bsl @@ -0,0 +1,22 @@ + +neg119.fs(40,20,40,22): typecheck error FS0071: Type constraint mismatch when applying the default type 'obj' for a type inference variable. No overloads match for method 'Return'. The available overloads are shown below. Consider adding further type constraints +neg119.fs(40,20,40,22): typecheck error FS0071: Possible overload: 'static member Applicatives.Ap.Return : ('r -> 'a) * Ap:Applicatives.Ap -> (('a -> 'r -> 'a2) -> 'a3 -> 'a -> 'r -> 'a2)'. Type constraint mismatch. The type + 'obj' +is not compatible with type + ''a -> 'b' +. +neg119.fs(40,20,40,22): typecheck error FS0071: Possible overload: 'static member Applicatives.Ap.Return : System.Tuple<'a> * Ap:Applicatives.Ap -> ('a -> System.Tuple<'a>)'. Type constraint mismatch. The type + 'obj' +is not compatible with type + 'System.Tuple<'a>' +. +neg119.fs(40,20,40,22): typecheck error FS0071: Possible overload: 'static member Applicatives.Ap.Return : seq<'a> * Ap:Applicatives.Ap -> ('a -> seq<'a>)'. Type constraint mismatch. The type + 'obj' +is not compatible with type + 'seq<'a>' +. +neg119.fs(40,20,40,22): typecheck error FS0071: Possible overload: 'static member Applicatives.Ap.Return : r: ^R * obj -> ('a1 -> ^R) when ^R : (static member Return : 'a1 -> ^R)'. Type constraint mismatch. The type + 'obj' +is not compatible with type + ''a' +. diff --git a/tests/fsharp/typecheck/sigs/neg119.fs b/tests/fsharp/typecheck/sigs/neg119.fs new file mode 100644 index 0000000000..46d64d4939 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg119.fs @@ -0,0 +1,40 @@ +module Neg119 + +// This is an example provided by Gustavo Leon in https://github.com/dotnet/fsharp/pull/4173 +// The code is potentially valid and, if that PR had been accepted, would compile. +// It's being added as a negative test case to capture the fact that it currently +// fails to compile. + +module Applicatives = + open System + + type Ap = Ap with + static member inline Invoke (x:'T) : '``Applicative<'T>`` = + let inline call (mthd : ^M, output : ^R) = ((^M or ^R) : (static member Return: _*_ -> _) output, mthd) + call (Ap, Unchecked.defaultof<'``Applicative<'T>``>) x + static member inline InvokeOnInstance (x:'T) = (^``Applicative<'T>`` : (static member Return: ^T -> ^``Applicative<'T>``) x) + static member inline Return (r:'R , _:obj) = Ap.InvokeOnInstance :_ -> 'R + static member Return (_:seq<'a> , Ap ) = fun x -> Seq.singleton x : seq<'a> + static member Return (_:Tuple<'a>, Ap ) = fun x -> Tuple x : Tuple<'a> + static member Return (_:'r -> 'a , Ap ) = fun k _ -> k : 'a -> 'r -> _ + + let inline result (x:'T) = Ap.Invoke x + + let inline (<*>) (f:'``Applicative<'T->'U>``) (x:'``Applicative<'T>``) : '``Applicative<'U>`` = + (( ^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<*>): _*_ -> _) f, x) + + let inline (+) (a:'Num) (b:'Num) :'Num = a + b + + type ZipList<'s> = ZipList of 's seq with + static member Return (x:'a) = ZipList (Seq.initInfinite (fun _ -> x)) + static member (<*>) (ZipList (f:seq<'a->'b>), ZipList x) = ZipList (Seq.zip f x |> Seq.map (fun (f, x) -> f x)) :ZipList<'b> + + type Ii = Ii + type Idiomatic = Idiomatic with + static member inline ($) (Idiomatic, si) = fun sfi x -> (Idiomatic $ x) (sfi <*> si) + static member ($) (Idiomatic, Ii) = id + let inline idiomatic a b = (Idiomatic $ b) a + let inline iI x = (idiomatic << result) x + + let res1n2n3 = iI (+) (result 0M ) (ZipList [1M;2M;3M]) Ii + let res2n3n4 = iI (+) (result LanguagePrimitives.GenericOne) (ZipList [1 ;2 ;3 ]) Ii From 5ef3492861a9f19feeec7e503ba993710e1a6dd3 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 22 Jan 2020 18:43:21 +0000 Subject: [PATCH 2/5] add more tests for SRTP resolution (#8318) * add more tests * two new tests --- tests/fsharp/tests.fs | 15 ++++ tests/fsharp/typecheck/sigs/neg120.bsl | 27 +++++++ tests/fsharp/typecheck/sigs/neg120.fs | 97 ++++++++++++++++++++++++ tests/fsharp/typecheck/sigs/neg121.bsl | 2 + tests/fsharp/typecheck/sigs/neg121.fs | 19 +++++ tests/fsharp/typecheck/sigs/neg122.bsl | 2 + tests/fsharp/typecheck/sigs/neg122.fs | 19 +++++ tests/fsharp/typecheck/sigs/pos34.fs | 101 +++++++++++++++++++++++++ 8 files changed, 282 insertions(+) create mode 100644 tests/fsharp/typecheck/sigs/neg120.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg120.fs create mode 100644 tests/fsharp/typecheck/sigs/neg121.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg121.fs create mode 100644 tests/fsharp/typecheck/sigs/neg122.bsl create mode 100644 tests/fsharp/typecheck/sigs/neg122.fs create mode 100644 tests/fsharp/typecheck/sigs/pos34.fs diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index e88033a5a2..4dd0f4740a 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -2161,6 +2161,12 @@ module TypecheckTests = fsc cfg "%s --target:library -o:pos33.dll --warnaserror" cfg.fsc_flags ["pos33.fsi"; "pos33.fs"] peverify cfg "pos33.dll" + [] + let ``sigs pos34`` () = + let cfg = testConfig "typecheck/sigs" + fsc cfg "%s --target:library -o:pos34.dll --warnaserror" cfg.fsc_flags ["pos34.fs"] + peverify cfg "pos34.dll" + [] let ``sigs pos23`` () = let cfg = testConfig "typecheck/sigs" @@ -2672,6 +2678,15 @@ module TypecheckTests = [] let ``type check neg119`` () = singleNegTest (testConfig "typecheck/sigs") "neg119" + [] + let ``type check neg120`` () = singleNegTest (testConfig "typecheck/sigs") "neg120" + + [] + let ``type check neg121`` () = singleNegTest (testConfig "typecheck/sigs") "neg121" + + [] + let ``type check neg122`` () = singleNegTest (testConfig "typecheck/sigs") "neg122" + [] let ``type check neg_anon_1`` () = singleNegTest (testConfig "typecheck/sigs") "neg_anon_1" diff --git a/tests/fsharp/typecheck/sigs/neg120.bsl b/tests/fsharp/typecheck/sigs/neg120.bsl new file mode 100644 index 0000000000..1d7137c417 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg120.bsl @@ -0,0 +1,27 @@ + +neg120.fs(95,18,95,21): typecheck error FS0071: Type constraint mismatch when applying the default type 'obj' for a type inference variable. No overloads match for method 'op_GreaterGreaterEquals'. The available overloads are shown below. Consider adding further type constraints +neg120.fs(95,18,95,21): typecheck error FS0071: Possible overload: 'static member Bind.( >>= ) : source:Id<'T> * f:('T -> Id<'U>) -> Id<'U>'. Type constraint mismatch. The type + 'int -> obj' +is not compatible with type + ''a -> Id<'b>' +. +neg120.fs(95,18,95,21): typecheck error FS0071: Possible overload: 'static member Bind.( >>= ) : source:Async<'T> * f:('T -> Async<'a1>) -> Async<'a1>'. Type constraint mismatch. The type + 'Id' +is not compatible with type + 'Async<'a>' +. +neg120.fs(95,18,95,21): typecheck error FS0071: Possible overload: 'static member Bind.( >>= ) : source:'T option * f:('T -> 'U option) -> 'U option'. Type constraint mismatch. The type + 'Id' +is not compatible with type + ''a option' +. +neg120.fs(95,18,95,21): typecheck error FS0071: Possible overload: 'static member Bind.( >>= ) : source:Task<'T> * f:('T -> Task<'U>) -> Task<'U>'. Type constraint mismatch. The type + 'Id' +is not compatible with type + 'Task<'a>' +. +neg120.fs(95,18,95,21): typecheck error FS0071: Possible overload: 'static member Bind.( >>= ) : source:Lazy<'T> * f:('T -> Lazy<'U>) -> Lazy<'U>'. Type constraint mismatch. The type + 'Id' +is not compatible with type + 'Lazy<'a>' +. diff --git a/tests/fsharp/typecheck/sigs/neg120.fs b/tests/fsharp/typecheck/sigs/neg120.fs new file mode 100644 index 0000000000..48ab1db0a0 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg120.fs @@ -0,0 +1,97 @@ +module Neg120 + +// From https://github.com/dotnet/fsharp/issues/4171#issuecomment-528063764 +open System.Threading.Tasks +// [] +type Id<'t> (v: 't) = + let value = v + member __.getValue = value + +[] +module Id = + let run (x: Id<_>) = x.getValue + let map f (x: Id<_>) = Id (f x.getValue) + let create x = Id x + + +type Bind = + static member (>>=) (source: Lazy<'T> , f: 'T -> Lazy<'U> ) = lazy (f source.Value).Value : Lazy<'U> + static member (>>=) (source: Task<'T> , f: 'T -> Task<'U> ) = source.ContinueWith(fun (x: Task<_>) -> f x.Result).Unwrap () : Task<'U> + static member (>>=) (source , f: 'T -> _ ) = Option.bind f source : option<'U> + static member (>>=) (source , f: 'T -> _ ) = async.Bind (source, f) + static member (>>=) (source : Id<_> , f: 'T -> _ ) = f source.getValue : Id<'U> + + static member inline Invoke (source: '``Monad<'T>``) (binder: 'T -> '``Monad<'U>``) : '``Monad<'U>`` = + let inline call (_mthd: 'M, input: 'I, _output: 'R, f) = ((^M or ^I or ^R) : (static member (>>=) : _*_ -> _) input, f) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'U>``>, binder) + +let inline (>>=) (x: '``Monad<'T>``) (f: 'T->'``Monad<'U>``) : '``Monad<'U>`` = Bind.Invoke x f + +type Return = + static member inline Invoke (x: 'T) : '``Applicative<'T>`` = + let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member Return : _*_ -> _) output, mthd) + call (Unchecked.defaultof, Unchecked.defaultof<'``Applicative<'T>``>) x + + static member Return (_: Lazy<'a> , _: Return ) = fun x -> Lazy<_>.CreateFromValue x : Lazy<'a> + static member Return (_: 'a Task , _: Return ) = fun x -> Task.FromResult x : 'a Task + static member Return (_: option<'a> , _: Return ) = fun x -> Some x : option<'a> + static member Return (_: 'a Async , _: Return ) = fun (x: 'a) -> async.Return x + static member Return (_: 'a Id , _: Return ) = fun (x: 'a) -> Id x + +let inline result (x: 'T) : '``Functor<'T>`` = Return.Invoke x + + +type TypeT<'``monad<'t>``> = TypeT of obj +type Node<'``monad<'t>``,'t> = A | B of 't * TypeT<'``monad<'t>``> + +let inline wrap (mit: 'mit) = + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result Node<'mt,'t>.A ) : 'mit + TypeT mit : TypeT<'mt> + +let inline unwrap (TypeT mit : TypeT<'mt>) = + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result Node<'mt,'t>.A ) : 'mit + unbox mit : 'mit + +let inline empty () = wrap ((result Node<'mt,'t>.A) : 'mit) : TypeT<'mt> + +let inline concat l1 l2 = + let rec loop (l1: TypeT<'mt>) (lst2: TypeT<'mt>) = + let (l1, l2) = unwrap l1, unwrap lst2 + TypeT (l1 >>= function A -> l2 | B (x: 't, xs) -> ((result (B (x, loop xs lst2))) : 'mit)) + loop l1 l2 : TypeT<'mt> + + +let inline bind f (source: TypeT<'mt>) : TypeT<'mu> = + // let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_: 't) -> (result Unchecked.defaultof<'u>) : 'mu + let rec loop f input = + TypeT ( + (unwrap input : 'mit) >>= function + | A -> result <| (A : Node<'mu,'u>) : 'miu + | B (h:'t, t: TypeT<'mt>) -> + let res = concat (f h: TypeT<'mu>) (loop f t) + unwrap res : 'miu) + loop f source : TypeT<'mu> + + +let inline map (f: 'T->'U) (x: '``Monad<'T>`` ) = Bind.Invoke x (f >> Return.Invoke) : '``Monad<'U>`` + + +let inline unfold (f:'State -> '``M<('T * 'State) option>``) (s:'State) : TypeT<'MT> = + let rec loop f s = f s |> map (function + | Some (a, s) -> B (a, loop f s) + | None -> A) |> wrap + loop f s + +let inline create (al: '``Monad>``) : TypeT<'``Monad<'T>``> = + unfold (fun i -> map (fun (lst:list<_>) -> if lst.Length > i then Some (lst.[i], i+1) else None) al) 0 + +let inline run (lst: TypeT<'MT>) : '``Monad>`` = + let rec loop acc x = unwrap x >>= function + | A -> result (List.rev acc) + | B (x, xs) -> loop (x::acc) xs + loop [] lst + +let c0 = create (Id ([1..10])) +let res0 = c0 |> run |> create |> run + +// See pos34.fs for the Sealed case that compiles without complaint \ No newline at end of file diff --git a/tests/fsharp/typecheck/sigs/neg121.bsl b/tests/fsharp/typecheck/sigs/neg121.bsl new file mode 100644 index 0000000000..49d735e729 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg121.bsl @@ -0,0 +1,2 @@ + +neg121.fs(19,28,19,38): typecheck error FS0071: Type constraint mismatch when applying the default type 'int' for a type inference variable. The type 'int' does not support the operator 'ParseApply' Consider adding further type constraints diff --git a/tests/fsharp/typecheck/sigs/neg121.fs b/tests/fsharp/typecheck/sigs/neg121.fs new file mode 100644 index 0000000000..598820f4c9 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg121.fs @@ -0,0 +1,19 @@ +module Neg121 + +// See https://github.com/dotnet/fsharp/pull/3582#issuecomment-399755533, which listed +// this as a test case of interest. +// +// This is to pin down that behaviour doesn't change in the future unless we intend it to. +open System +type System.String with static member inline ParseApply (path:string) (fn: string -> ^b) : ^b = fn "" +type System.Int32 with static member inline ParseApply (path:string) (fn: int -> ^b) : ^b = fn 0 +type System.Double with static member inline ParseApply (path:string) (fn: float -> ^b) : ^b = fn 0. +type System.Boolean with static member inline ParseApply (path:string) (fn: bool -> ^b) : ^b = fn true + +let inline parser (fmt:PrintfFormat< ^a -> ^b,_,_,^b>) (fn:^a -> ^b) (v:string) : ^b + when ^a : (static member ParseApply: string -> (^a -> ^b) -> ^b) = + (^a : (static member ParseApply: string -> (^a -> ^b) -> ^b)(v,fn)) + +let inline patternTest (fmt:PrintfFormat< ^a -> Action< ^T>,_,_,Action< ^T>>) (fn:^a -> Action< ^T>) v : Action< ^T> = parser fmt fn v + +let parseFn1 = patternTest "adfadf%i" (fun v -> printfn "%i" v; Unchecked.defaultof> ) diff --git a/tests/fsharp/typecheck/sigs/neg122.bsl b/tests/fsharp/typecheck/sigs/neg122.bsl new file mode 100644 index 0000000000..7fb422b9f4 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg122.bsl @@ -0,0 +1,2 @@ + +neg122.fs(19,28,19,38): typecheck error FS0001: The type 'string' does not support the operator 'ParseApply' diff --git a/tests/fsharp/typecheck/sigs/neg122.fs b/tests/fsharp/typecheck/sigs/neg122.fs new file mode 100644 index 0000000000..981460feb1 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/neg122.fs @@ -0,0 +1,19 @@ +module Neg122 + +// See https://github.com/dotnet/fsharp/pull/3582#issuecomment-399755533, which listed +// this as a test case of interest. +// +// This is to pin down that behaviour doesn't change in the future unless we intend it to. +open System +type System.String with static member inline ParseApply (path:string) (fn: string -> ^b) : ^b = fn "" +type System.Int32 with static member inline ParseApply (path:string) (fn: int -> ^b) : ^b = fn 0 +type System.Double with static member inline ParseApply (path:string) (fn: float -> ^b) : ^b = fn 0. +type System.Boolean with static member inline ParseApply (path:string) (fn: bool -> ^b) : ^b = fn true + +let inline parser (fmt:PrintfFormat< ^a -> ^b,_,_,^b>) (fn:^a -> ^b) (v:string) : ^b + when ^a : (static member ParseApply: string -> (^a -> ^b) -> ^b) = + (^a : (static member ParseApply: string -> (^a -> ^b) -> ^b)(v,fn)) + +let inline patternTest (fmt:PrintfFormat< ^a -> Action< ^T>,_,_,Action< ^T>>) (fn:^a -> Action< ^T>) v : Action< ^T> = parser fmt fn v + +let parseFn2 = patternTest "adf%s245" (fun v -> printfn "%s" v; Unchecked.defaultof> ) diff --git a/tests/fsharp/typecheck/sigs/pos34.fs b/tests/fsharp/typecheck/sigs/pos34.fs new file mode 100644 index 0000000000..73cebb2950 --- /dev/null +++ b/tests/fsharp/typecheck/sigs/pos34.fs @@ -0,0 +1,101 @@ +module Pos34 + +// From https://github.com/dotnet/fsharp/issues/4171#issuecomment-528063764 +// This case is where the type gets labelled as Sealed +// This case compiles without complaint +// +// See also neg120.fs +open System.Threading.Tasks + +[] +type Id<'t> (v: 't) = + let value = v + member __.getValue = value + +[] +module Id = + let run (x: Id<_>) = x.getValue + let map f (x: Id<_>) = Id (f x.getValue) + let create x = Id x + + +type Bind = + static member (>>=) (source: Lazy<'T> , f: 'T -> Lazy<'U> ) = lazy (f source.Value).Value : Lazy<'U> + static member (>>=) (source: Task<'T> , f: 'T -> Task<'U> ) = source.ContinueWith(fun (x: Task<_>) -> f x.Result).Unwrap () : Task<'U> + static member (>>=) (source , f: 'T -> _ ) = Option.bind f source : option<'U> + static member (>>=) (source , f: 'T -> _ ) = async.Bind (source, f) + static member (>>=) (source : Id<_> , f: 'T -> _ ) = f source.getValue : Id<'U> + + static member inline Invoke (source: '``Monad<'T>``) (binder: 'T -> '``Monad<'U>``) : '``Monad<'U>`` = + let inline call (_mthd: 'M, input: 'I, _output: 'R, f) = ((^M or ^I or ^R) : (static member (>>=) : _*_ -> _) input, f) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'U>``>, binder) + +let inline (>>=) (x: '``Monad<'T>``) (f: 'T->'``Monad<'U>``) : '``Monad<'U>`` = Bind.Invoke x f + +type Return = + static member inline Invoke (x: 'T) : '``Applicative<'T>`` = + let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member Return : _*_ -> _) output, mthd) + call (Unchecked.defaultof, Unchecked.defaultof<'``Applicative<'T>``>) x + + static member Return (_: Lazy<'a> , _: Return ) = fun x -> Lazy<_>.CreateFromValue x : Lazy<'a> + static member Return (_: 'a Task , _: Return ) = fun x -> Task.FromResult x : 'a Task + static member Return (_: option<'a> , _: Return ) = fun x -> Some x : option<'a> + static member Return (_: 'a Async , _: Return ) = fun (x: 'a) -> async.Return x + static member Return (_: 'a Id , _: Return ) = fun (x: 'a) -> Id x + +let inline result (x: 'T) : '``Functor<'T>`` = Return.Invoke x + + +type TypeT<'``monad<'t>``> = TypeT of obj +type Node<'``monad<'t>``,'t> = A | B of 't * TypeT<'``monad<'t>``> + +let inline wrap (mit: 'mit) = + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result Node<'mt,'t>.A ) : 'mit + TypeT mit : TypeT<'mt> + +let inline unwrap (TypeT mit : TypeT<'mt>) = + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result Node<'mt,'t>.A ) : 'mit + unbox mit : 'mit + +let inline empty () = wrap ((result Node<'mt,'t>.A) : 'mit) : TypeT<'mt> + +let inline concat l1 l2 = + let rec loop (l1: TypeT<'mt>) (lst2: TypeT<'mt>) = + let (l1, l2) = unwrap l1, unwrap lst2 + TypeT (l1 >>= function A -> l2 | B (x: 't, xs) -> ((result (B (x, loop xs lst2))) : 'mit)) + loop l1 l2 : TypeT<'mt> + + +let inline bind f (source: TypeT<'mt>) : TypeT<'mu> = + // let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_: 't) -> (result Unchecked.defaultof<'u>) : 'mu + let rec loop f input = + TypeT ( + (unwrap input : 'mit) >>= function + | A -> result <| (A : Node<'mu,'u>) : 'miu + | B (h:'t, t: TypeT<'mt>) -> + let res = concat (f h: TypeT<'mu>) (loop f t) + unwrap res : 'miu) + loop f source : TypeT<'mu> + + +let inline map (f: 'T->'U) (x: '``Monad<'T>`` ) = Bind.Invoke x (f >> Return.Invoke) : '``Monad<'U>`` + + +let inline unfold (f:'State -> '``M<('T * 'State) option>``) (s:'State) : TypeT<'MT> = + let rec loop f s = f s |> map (function + | Some (a, s) -> B (a, loop f s) + | None -> A) |> wrap + loop f s + +let inline create (al: '``Monad>``) : TypeT<'``Monad<'T>``> = + unfold (fun i -> map (fun (lst:list<_>) -> if lst.Length > i then Some (lst.[i], i+1) else None) al) 0 + +let inline run (lst: TypeT<'MT>) : '``Monad>`` = + let rec loop acc x = unwrap x >>= function + | A -> result (List.rev acc) + | B (x, xs) -> loop (x::acc) xs + loop [] lst + +let c0 = create (Id ([1..10])) +let res0 = c0 |> run |> create |> run + From 5a0117048ba0076b79a3c0e99ba981000aff720d Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Wed, 22 Jan 2020 13:20:40 -0800 Subject: [PATCH 3/5] delete language server (#8241) --- FSharp.sln | 30 --- VisualFSharp.sln | 45 ---- eng/Build.ps1 | 2 - eng/Versions.props | 1 - eng/build.sh | 1 - eng/targets/Settings.props | 5 - .../Directory.Build.props | 9 - ...rp.Compiler.LanguageServer.DesignTime.proj | 49 ---- ...Compiler.LanguageServer.DesignTime.targets | 52 ---- .../FSharp.Compiler.LanguageServer.fsproj | 59 ----- .../JsonDUConverter.fs | 18 -- .../JsonOptionConverter.fs | 27 -- .../LspExternalAccess.fs | 30 --- .../LspTypes.fs | 87 ------- .../FSharp.Compiler.LanguageServer/Methods.fs | 72 ------ .../FSharp.Compiler.LanguageServer/Program.fs | 16 -- .../FSharp.Compiler.LanguageServer/Server.fs | 30 --- .../FSharp.Compiler.LanguageServer/State.fs | 233 ------------------ .../TextDocument.fs | 75 ------ .../DiagnosticsTests.fs | 154 ------------ .../Directory.Build.props | 9 - ...p.Compiler.LanguageServer.UnitTests.fsproj | 31 --- .../MiscTests.fs | 43 ---- .../ProtocolTests.fs | 55 ----- .../SerializationTests.fs | 33 --- .../TemporaryDirectory.fs | 20 -- .../TestClient.fs | 121 --------- .../Source.extension.vsixmanifest | 4 - .../VisualFSharpFull/VisualFSharpFull.csproj | 18 -- .../FSharp.Editor.Helpers.csproj | 22 -- .../FSharp.Editor.Helpers/LanguageClient.cs | 46 ---- .../src/FSharp.Editor/Common/LspService.fs | 28 --- .../Diagnostics/DocumentDiagnosticAnalyzer.fs | 11 - .../src/FSharp.Editor/FSharp.Editor.fsproj | 10 - .../LanguageService/FSharpLanguageClient.fs | 70 ------ .../FSharp.Editor/Options/EditorOptions.fs | 20 +- .../QuickInfo/QuickInfoProvider.fs | 4 - ...osoft.VisualStudio.Editors.Designer.cs.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.de.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.es.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.fr.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.it.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.ja.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.ko.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.pl.xlf | 3 +- ...ft.VisualStudio.Editors.Designer.pt-BR.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.ru.xlf | 3 +- ...osoft.VisualStudio.Editors.Designer.tr.xlf | 3 +- ....VisualStudio.Editors.Designer.zh-Hans.xlf | 3 +- ....VisualStudio.Editors.Designer.zh-Hant.xlf | 3 +- .../AdvancedOptionsControl.xaml | 11 - .../FSharp.UIResources/Strings.Designer.cs | 9 - .../src/FSharp.UIResources/Strings.resx | 3 - .../src/FSharp.UIResources/xlf/Strings.cs.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.de.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.es.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.fr.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.it.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.ja.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.ko.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.pl.xlf | 5 - .../FSharp.UIResources/xlf/Strings.pt-BR.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.ru.xlf | 5 - .../src/FSharp.UIResources/xlf/Strings.tr.xlf | 5 - .../xlf/Strings.zh-Hans.xlf | 5 - .../xlf/Strings.zh-Hant.xlf | 5 - 66 files changed, 28 insertions(+), 1639 deletions(-) delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/Directory.Build.props delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.proj delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.targets delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/JsonDUConverter.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/JsonOptionConverter.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/Program.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/Server.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/State.fs delete mode 100644 src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/DiagnosticsTests.fs delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/Directory.Build.props delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/FSharp.Compiler.LanguageServer.UnitTests.fsproj delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/MiscTests.fs delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/ProtocolTests.fs delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/SerializationTests.fs delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/TemporaryDirectory.fs delete mode 100644 tests/FSharp.Compiler.LanguageServer.UnitTests/TestClient.fs delete mode 100644 vsintegration/src/FSharp.Editor.Helpers/FSharp.Editor.Helpers.csproj delete mode 100644 vsintegration/src/FSharp.Editor.Helpers/LanguageClient.cs delete mode 100644 vsintegration/src/FSharp.Editor/Common/LspService.fs delete mode 100644 vsintegration/src/FSharp.Editor/LanguageService/FSharpLanguageClient.fs diff --git a/FSharp.sln b/FSharp.sln index 57620c7864..a3412ddea2 100644 --- a/FSharp.sln +++ b/FSharp.sln @@ -42,10 +42,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Packages", "Packages", "{38 EndProject Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "Microsoft.FSharp.Compiler", "src\fsharp\FSharp.Compiler.nuget\Microsoft.FSharp.Compiler.csproj", "{81B9FE26-C976-4FC7-B6CC-C7DB5903CAA7}" EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.LanguageServer", "src\fsharp\FSharp.Compiler.LanguageServer\FSharp.Compiler.LanguageServer.fsproj", "{99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}" -EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.LanguageServer.UnitTests", "tests\FSharp.Compiler.LanguageServer.UnitTests\FSharp.Compiler.LanguageServer.UnitTests.fsproj", "{C97819B0-B428-4B96-9CD7-497D2D1C738C}" -EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.DependencyManager", "src\fsharp\FSharp.DependencyManager\FSharp.DependencyManager.fsproj", "{8B7BF62E-7D8C-4928-BE40-4E392A9EE851}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Private.Scripting", "src\fsharp\FSharp.Compiler.Private.Scripting\FSharp.Compiler.Private.Scripting.fsproj", "{6771860A-614D-4FDD-A655-4C70EBCC91B0}" @@ -218,30 +214,6 @@ Global {81B9FE26-C976-4FC7-B6CC-C7DB5903CAA7}.Release|Any CPU.Build.0 = Release|Any CPU {81B9FE26-C976-4FC7-B6CC-C7DB5903CAA7}.Release|x86.ActiveCfg = Release|Any CPU {81B9FE26-C976-4FC7-B6CC-C7DB5903CAA7}.Release|x86.Build.0 = Release|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Debug|Any CPU.Build.0 = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Debug|x86.ActiveCfg = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Debug|x86.Build.0 = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Proto|Any CPU.Build.0 = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Proto|x86.ActiveCfg = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Proto|x86.Build.0 = Debug|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Release|Any CPU.ActiveCfg = Release|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Release|Any CPU.Build.0 = Release|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Release|x86.ActiveCfg = Release|Any CPU - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA}.Release|x86.Build.0 = Release|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Debug|Any CPU.Build.0 = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Debug|x86.ActiveCfg = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Debug|x86.Build.0 = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Proto|Any CPU.Build.0 = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Proto|x86.ActiveCfg = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Proto|x86.Build.0 = Debug|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Release|Any CPU.ActiveCfg = Release|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Release|Any CPU.Build.0 = Release|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Release|x86.ActiveCfg = Release|Any CPU - {C97819B0-B428-4B96-9CD7-497D2D1C738C}.Release|x86.Build.0 = Release|Any CPU {8B7BF62E-7D8C-4928-BE40-4E392A9EE851}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {8B7BF62E-7D8C-4928-BE40-4E392A9EE851}.Debug|Any CPU.Build.0 = Debug|Any CPU {8B7BF62E-7D8C-4928-BE40-4E392A9EE851}.Debug|x86.ActiveCfg = Debug|Any CPU @@ -295,8 +267,6 @@ Global {88E2D422-6852-46E3-A740-83E391DC7973} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {53C0DAAD-158C-4658-8EC7-D7341530239F} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {81B9FE26-C976-4FC7-B6CC-C7DB5903CAA7} = {3840F2E7-3898-45F7-8CF7-1E6829E56DB8} - {99B3F4A5-80B4-41D9-A073-117DB6D7DBBA} = {B8DDA694-7939-42E3-95E5-265C2217C142} - {C97819B0-B428-4B96-9CD7-497D2D1C738C} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {8B7BF62E-7D8C-4928-BE40-4E392A9EE851} = {3881429D-A97A-49EB-B7AE-A82BA5FE9C77} {6771860A-614D-4FDD-A655-4C70EBCC91B0} = {B8DDA694-7939-42E3-95E5-265C2217C142} {4FEDF286-0252-4EBC-9E75-879CCA3B85DC} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} diff --git a/VisualFSharp.sln b/VisualFSharp.sln index d46221b17b..346a0071b5 100644 --- a/VisualFSharp.sln +++ b/VisualFSharp.sln @@ -144,12 +144,6 @@ Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "Microsoft.FSharp.Compiler", EndProject Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "FSharp.Core.nuget", "src\fsharp\FSharp.Core.nuget\FSharp.Core.nuget.csproj", "{8EC30B2E-F1F9-4A98-BBB5-DD0CF6C84DDC}" EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.LanguageServer", "src\fsharp\FSharp.Compiler.LanguageServer\FSharp.Compiler.LanguageServer.fsproj", "{60BAFFA5-6631-4328-B044-2E012AB76DCA}" -EndProject -Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.LanguageServer.UnitTests", "tests\FSharp.Compiler.LanguageServer.UnitTests\FSharp.Compiler.LanguageServer.UnitTests.fsproj", "{AAF2D233-1C38-4090-8FFA-F7C545625E06}" -EndProject -Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "FSharp.Editor.Helpers", "vsintegration\src\FSharp.Editor.Helpers\FSharp.Editor.Helpers.csproj", "{79255A92-ED00-40BA-9D64-12FCC664A976}" -EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Private.Scripting", "src\fsharp\FSharp.Compiler.Private.Scripting\FSharp.Compiler.Private.Scripting.fsproj", "{20B7BC36-CF51-4D75-9E13-66681C07977F}" EndProject Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Compiler.Private.Scripting.UnitTests", "tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj", "{09F56540-AFA5-4694-B7A6-0DBF6D4618C2}" @@ -848,42 +842,6 @@ Global {8EC30B2E-F1F9-4A98-BBB5-DD0CF6C84DDC}.Release|Any CPU.Build.0 = Release|Any CPU {8EC30B2E-F1F9-4A98-BBB5-DD0CF6C84DDC}.Release|x86.ActiveCfg = Release|Any CPU {8EC30B2E-F1F9-4A98-BBB5-DD0CF6C84DDC}.Release|x86.Build.0 = Release|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Debug|Any CPU.Build.0 = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Debug|x86.ActiveCfg = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Debug|x86.Build.0 = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Proto|Any CPU.Build.0 = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Proto|x86.ActiveCfg = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Proto|x86.Build.0 = Debug|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Release|Any CPU.ActiveCfg = Release|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Release|Any CPU.Build.0 = Release|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Release|x86.ActiveCfg = Release|Any CPU - {60BAFFA5-6631-4328-B044-2E012AB76DCA}.Release|x86.Build.0 = Release|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Debug|Any CPU.Build.0 = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Debug|x86.ActiveCfg = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Debug|x86.Build.0 = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Proto|Any CPU.ActiveCfg = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Proto|Any CPU.Build.0 = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Proto|x86.ActiveCfg = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Proto|x86.Build.0 = Debug|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Release|Any CPU.ActiveCfg = Release|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Release|Any CPU.Build.0 = Release|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Release|x86.ActiveCfg = Release|Any CPU - {AAF2D233-1C38-4090-8FFA-F7C545625E06}.Release|x86.Build.0 = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Debug|Any CPU.Build.0 = Debug|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Debug|x86.ActiveCfg = Debug|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Debug|x86.Build.0 = Debug|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Proto|Any CPU.ActiveCfg = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Proto|Any CPU.Build.0 = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Proto|x86.ActiveCfg = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Proto|x86.Build.0 = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Release|Any CPU.ActiveCfg = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Release|Any CPU.Build.0 = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Release|x86.ActiveCfg = Release|Any CPU - {79255A92-ED00-40BA-9D64-12FCC664A976}.Release|x86.Build.0 = Release|Any CPU {20B7BC36-CF51-4D75-9E13-66681C07977F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {20B7BC36-CF51-4D75-9E13-66681C07977F}.Debug|Any CPU.Build.0 = Debug|Any CPU {20B7BC36-CF51-4D75-9E13-66681C07977F}.Debug|x86.ActiveCfg = Debug|Any CPU @@ -1035,9 +993,6 @@ Global {9482211E-23D0-4BD0-9893-E4AA5559F67A} = {6235B3AF-774D-4EA1-8F37-789E767F6368} {04C59F6E-1C76-4F6A-AC21-2EA7F296A1B8} = {647810D0-5307-448F-99A2-E83917010DAE} {8EC30B2E-F1F9-4A98-BBB5-DD0CF6C84DDC} = {647810D0-5307-448F-99A2-E83917010DAE} - {60BAFFA5-6631-4328-B044-2E012AB76DCA} = {B8DDA694-7939-42E3-95E5-265C2217C142} - {AAF2D233-1C38-4090-8FFA-F7C545625E06} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} - {79255A92-ED00-40BA-9D64-12FCC664A976} = {4C7B48D7-19AF-4AE7-9D1D-3BB289D5480D} {20B7BC36-CF51-4D75-9E13-66681C07977F} = {B8DDA694-7939-42E3-95E5-265C2217C142} {09F56540-AFA5-4694-B7A6-0DBF6D4618C2} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} {DFA30881-C0B1-4813-B087-C21B5AF9B77F} = {3881429D-A97A-49EB-B7AE-A82BA5FE9C77} diff --git a/eng/Build.ps1 b/eng/Build.ps1 index 72ea53f146..a7825b4d4f 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -343,7 +343,6 @@ try { if ($testDesktop -and -not $noVisualStudio) { TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.UnitTests\FSharp.Compiler.UnitTests.fsproj" -targetFramework $desktopTargetFramework - TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.LanguageServer.UnitTests\FSharp.Compiler.LanguageServer.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $desktopTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $desktopTargetFramework @@ -352,7 +351,6 @@ try { if ($testCoreClr) { TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.UnitTests\FSharp.Compiler.UnitTests.fsproj" -targetFramework $coreclrTargetFramework - TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.LanguageServer.UnitTests\FSharp.Compiler.LanguageServer.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $coreclrTargetFramework TestUsingNUnit -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $coreclrTargetFramework diff --git a/eng/Versions.props b/eng/Versions.props index 64a7ddd713..1ee1522072 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -122,7 +122,6 @@ 16.0.28226-alpha 16.1.28916.169 16.1.28917.181 - 16.1.3121 16.1.89 16.1.89 16.1.89 diff --git a/eng/build.sh b/eng/build.sh index 218f4ef977..994263ff7d 100755 --- a/eng/build.sh +++ b/eng/build.sh @@ -290,7 +290,6 @@ BuildSolution if [[ "$test_core_clr" == true ]]; then coreclrtestframework=netcoreapp3.0 TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj" --targetframework $coreclrtestframework - TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.LanguageServer.UnitTests/FSharp.Compiler.LanguageServer.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj" --targetframework $coreclrtestframework TestUsingNUnit --testproject "$repo_root/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj" --targetframework $coreclrtestframework diff --git a/eng/targets/Settings.props b/eng/targets/Settings.props index 474e5d22a8..77f7a0c704 100644 --- a/eng/targets/Settings.props +++ b/eng/targets/Settings.props @@ -11,9 +11,4 @@ false - - - false - - diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/Directory.Build.props b/src/fsharp/FSharp.Compiler.LanguageServer/Directory.Build.props deleted file mode 100644 index 7cd41381b5..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/Directory.Build.props +++ /dev/null @@ -1,9 +0,0 @@ - - - - true - - - - - diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.proj b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.proj deleted file mode 100644 index d02ae419bc..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.proj +++ /dev/null @@ -1,49 +0,0 @@ - - - - - - - $(MSBuildThisFileDirectory)FSharp.Compiler.LanguageServer.DesignTime.targets - - - - - - - - - - - - - - diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.targets b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.targets deleted file mode 100644 index ea8f3e2866..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.DesignTime.targets +++ /dev/null @@ -1,52 +0,0 @@ - - - - - true - false - true - true - false - false - false - true - false - true - false - - - - - - - _ComputeTargetFrameworkItems - _PopulateTargetFrameworks - - - - - <_TargetFramework Include="$(TargetFramework)" /> - - - - - - - - - - - - - - diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj b/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj deleted file mode 100644 index 0bb0899140..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj +++ /dev/null @@ -1,59 +0,0 @@ - - - - - Exe - .exe - net472;netcoreapp3.0 - netcoreapp3.0 - true - Implements the Language Server Protocol (LSP) for F#. - true - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <_PublishedProjectOutputGroupFiles Include="$(PublishDir)\**" /> - - - - - - - - - - diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/JsonDUConverter.fs b/src/fsharp/FSharp.Compiler.LanguageServer/JsonDUConverter.fs deleted file mode 100644 index ae8575195d..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/JsonDUConverter.fs +++ /dev/null @@ -1,18 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open System -open FSharp.Reflection -open Newtonsoft.Json - -type JsonDUConverter() = - inherit JsonConverter() - override __.CanConvert(typ) = FSharpType.IsUnion(typ) - override __.WriteJson(writer, value, _serializer) = - writer.WriteValue(value.ToString().ToLowerInvariant()) - override __.ReadJson(reader, typ, x, serializer) = - let cases = FSharpType.GetUnionCases(typ) - let str = serializer.Deserialize(reader, typeof) :?> string - let case = cases |> Array.find (fun c -> String.Compare(c.Name, str, StringComparison.OrdinalIgnoreCase) = 0) - FSharpValue.MakeUnion(case, [||]) diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/JsonOptionConverter.fs b/src/fsharp/FSharp.Compiler.LanguageServer/JsonOptionConverter.fs deleted file mode 100644 index 937dda00e4..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/JsonOptionConverter.fs +++ /dev/null @@ -1,27 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open System -open FSharp.Reflection -open Newtonsoft.Json - -type JsonOptionConverter() = - inherit JsonConverter() - override __.CanConvert(typ) = typ.IsGenericType && typ.GetGenericTypeDefinition() = typedefof> - override __.WriteJson(writer, value, serializer) = - let value = match value with - | null -> null - | _ -> - let _, fields = FSharpValue.GetUnionFields(value, value.GetType()) - fields.[0] - serializer.Serialize(writer, value) - override __.ReadJson(reader, typ, _, serializer) = - let innerType = typ.GetGenericArguments().[0] - let innerType = - if innerType.IsValueType then (typedefof>).MakeGenericType([|innerType|]) - else innerType - let value = serializer.Deserialize(reader, innerType) - let cases = FSharpType.GetUnionCases(typ) - if value = null then FSharpValue.MakeUnion(cases.[0], [||]) - else FSharpValue.MakeUnion(cases.[1], [|value|]) diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs b/src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs deleted file mode 100644 index 48e4b0b405..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/LspExternalAccess.fs +++ /dev/null @@ -1,30 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open StreamJsonRpc - -[] -module FunctionNames = - [] - let OptionsSet = "options/set" - - [] - let TextDocumentPublishDiagnostics = "textDocument/publishDiagnostics" - -type Options = - { usePreviewTextHover: bool - usePreviewDiagnostics: bool } - static member Default() = - { usePreviewTextHover = false - usePreviewDiagnostics = false } - static member AllOn() = - { usePreviewTextHover = true - usePreviewDiagnostics = true } - -module Extensions = - type JsonRpc with - member jsonRpc.SetOptionsAsync (options: Options) = - async { - do! jsonRpc.InvokeAsync(OptionsSet, options) |> Async.AwaitTask - } diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs b/src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs deleted file mode 100644 index 264e526fcd..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/LspTypes.fs +++ /dev/null @@ -1,87 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open Newtonsoft.Json.Linq -open Newtonsoft.Json - -// Interfaces as defined at https://microsoft.github.io/language-server-protocol/specifications/specification-3-14/. -// The properties on these types are camlCased to match the underlying JSON properties to avoid attributes on every -// field: -// [] - -/// Represents a zero-based line and column of a text document. -type Position = - { line: int - character: int } - -type Range = - { start: Position - ``end``: Position } - -type DocumentUri = string - -type Location = - { uri: DocumentUri - range: Range } - -type DiagnosticRelatedInformation = - { location: Location - message: string } - -type Diagnostic = - { range: Range - severity: int option - code: string - source: string option - message: string - relatedInformation: DiagnosticRelatedInformation[] option } - static member Error = 1 - static member Warning = 2 - static member Information = 3 - static member Hint = 4 - -type PublishDiagnosticsParams = - { uri: DocumentUri - diagnostics: Diagnostic[] } - -type ClientCapabilities = - { workspace: JToken option // TODO: WorkspaceClientCapabilities - textDocument: JToken option // TODO: TextDocumentClientCapabilities, publishDiagnostics: { relatedInformation: bool option } - experimental: JToken option - supportsVisualStudioExtensions: bool option } - -[)>] -type Trace = - | Off - | Messages - | Verbose - -type WorkspaceFolder = - { uri: DocumentUri - name: string } - -/// Note, this type has many more optional values that can be expanded as support is added. -type ServerCapabilities = - { hoverProvider: bool } - static member DefaultCapabilities() = - { ServerCapabilities.hoverProvider = true } - -type InitializeResult = - { capabilities: ServerCapabilities } - -[)>] -type MarkupKind = - | PlainText - | Markdown - -type MarkupContent = - { kind: MarkupKind - value: string } - -type Hover = - { contents: MarkupContent - range: Range option } - -type TextDocumentIdentifier = - { uri: DocumentUri } diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs b/src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs deleted file mode 100644 index 453b7f8228..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/Methods.fs +++ /dev/null @@ -1,72 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open System -open System.Runtime.InteropServices -open System.Threading -open Newtonsoft.Json.Linq -open StreamJsonRpc - -// https://microsoft.github.io/language-server-protocol/specifications/specification-3-14/ -type Methods() = - - let state = State() - - /// Helper to run Async<'T> with a CancellationToken. - let runAsync (cancellationToken: CancellationToken) (computation: Async<'T>) = Async.StartAsTask(computation, cancellationToken=cancellationToken) - - member __.State = state - - //-------------------------------------------------------------------------- - // official LSP methods - //-------------------------------------------------------------------------- - - [] - member __.Initialize - ( - processId: Nullable, - [] rootPath: string, - [] rootUri: DocumentUri, - [] initializationOptions: JToken, - capabilities: ClientCapabilities, - [] trace: string, - [] workspaceFolders: WorkspaceFolder[], - [] cancellationToken: CancellationToken - ) = - state.Initialize rootPath rootUri (fun projectOptions -> TextDocument.PublishDiagnostics(state, projectOptions) |> Async.Start) - { InitializeResult.capabilities = ServerCapabilities.DefaultCapabilities() } - - [] - member __.Initialized () = () - - [] - member __.Shutdown(): obj = state.DoShutdown(); null - - [] - member __.Exit() = state.DoExit() - - [] - member __.cancelRequest (id: JToken) = state.DoCancel() - - [] - member __.TextDocumentHover - ( - textDocument: TextDocumentIdentifier, - position: Position, - [] cancellationToken: CancellationToken - ) = - TextDocument.Hover state textDocument position |> runAsync cancellationToken - - //-------------------------------------------------------------------------- - // unofficial LSP methods that we implement separately - //-------------------------------------------------------------------------- - - [] - member __.OptionsSet - ( - options: Options - ) = - eprintfn "got options %A" options - state.Options <- options - state.InvalidateAllProjects() diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/Program.fs b/src/fsharp/FSharp.Compiler.LanguageServer/Program.fs deleted file mode 100644 index 13d0c9709f..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/Program.fs +++ /dev/null @@ -1,16 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open System - -module Program = - - [] - let main(args: string[]) = - async { - let server = new Server(Console.OpenStandardOutput(), Console.OpenStandardInput()) - server.StartListening() - do! server.WaitForExitAsync() - return 0 - } |> Async.RunSynchronously diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/Server.fs b/src/fsharp/FSharp.Compiler.LanguageServer/Server.fs deleted file mode 100644 index 28d5e49a58..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/Server.fs +++ /dev/null @@ -1,30 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open System -open System.IO -open StreamJsonRpc - -type Server(sendingStream: Stream, receivingStream: Stream) = - - let formatter = JsonMessageFormatter() - let converter = JsonOptionConverter() // special handler to convert between `Option<'T>` and `obj/null`. - do formatter.JsonSerializer.Converters.Add(converter) - let handler = new HeaderDelimitedMessageHandler(sendingStream, receivingStream, formatter) - let methods = Methods() - let rpc = new JsonRpc(handler, methods) - do methods.State.JsonRpc <- Some rpc - - member __.StartListening() = - rpc.StartListening() - - member __.WaitForExitAsync() = - async { - do! Async.AwaitEvent (methods.State.Shutdown) - do! Async.AwaitEvent (methods.State.Exit) - } - - interface IDisposable with - member __.Dispose() = - rpc.Dispose() diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/State.fs b/src/fsharp/FSharp.Compiler.LanguageServer/State.fs deleted file mode 100644 index 0812bb9a7f..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/State.fs +++ /dev/null @@ -1,233 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open System -open System.Collections.Concurrent -open System.Collections.Generic -open System.Diagnostics -open System.IO -open System.Text.RegularExpressions -open FSharp.Compiler.SourceCodeServices -open StreamJsonRpc - -module internal Solution = - // easy unit testing - let getProjectPaths (solutionContent: string) (solutionDir: string) = - // This looks scary, but is much more lightweight than carrying along MSBuild just to have it parse the solution file. - // - // A valid line in .sln looks like: - // Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ConsoleApp2", "ConsoleApp2\ConsoleApp2.fsproj", "{60A4BE67-7E03-4200-AD38-B0E5E8E049C1}" - // and we're hoping to extract this: ------------------------------------^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - // - // therefore: - // ^Project text 'Project' at the start of the line - // .* any number of characters - // \"" double quote character (it's doubled up to escape from the raw string literal here) - // ( start of capture group - // [^\""] not a quote - // * many of those - // \.fsproj literal string ".fsproj" - // ) end of capture group - // \"" double quote - let pattern = Regex(@"^Project.*\""([^\""]*\.fsproj)\""") - let lines = solutionContent.Split('\n') - let relativeProjects = - lines - |> Array.map pattern.Match - |> Array.filter (fun m -> m.Success) - |> Array.map (fun m -> m.Groups.[1].Value) - // .sln files by convention uses backslashes, which might not be appropriate at runtime - |> Array.map (fun p -> p.Replace('\\', Path.DirectorySeparatorChar)) - let projects = - relativeProjects - |> Array.map (fun p -> if Path.IsPathRooted(p) then p else Path.Combine(solutionDir, p)) - projects - -type State() = - - let checker = FSharpChecker.Create() - - let sourceFileToProjectMap = ConcurrentDictionary() - - let shutdownEvent = new Event<_>() - let exitEvent = new Event<_>() - let cancelEvent = new Event<_>() - let projectInvalidatedEvent = new Event<_>() - - let fileChanged (args: FileSystemEventArgs) = - match sourceFileToProjectMap.TryGetValue args.FullPath with - | true, projectOptions -> projectInvalidatedEvent.Trigger(projectOptions) - | false, _ -> () - let fileRenamed (args: RenamedEventArgs) = - match sourceFileToProjectMap.TryGetValue args.FullPath with - | true, projectOptions -> projectInvalidatedEvent.Trigger(projectOptions) - | false, _ -> () - let fileWatcher = new FileSystemWatcher() - do fileWatcher.IncludeSubdirectories <- true - do fileWatcher.Changed.Add(fileChanged) - do fileWatcher.Created.Add(fileChanged) - do fileWatcher.Deleted.Add(fileChanged) - do fileWatcher.Renamed.Add(fileRenamed) - - let execProcess (name: string) (args: string) = - let startInfo = ProcessStartInfo(name, args) - eprintfn "executing: %s %s" name args - startInfo.CreateNoWindow <- true - startInfo.RedirectStandardOutput <- true - startInfo.UseShellExecute <- false - let lines = List() - use proc = new Process() - proc.StartInfo <- startInfo - proc.OutputDataReceived.Add(fun args -> lines.Add(args.Data)) - proc.Start() |> ignore - proc.BeginOutputReadLine() - proc.WaitForExit() - lines.ToArray() - - let linesWithPrefixClean (prefix: string) (lines: string[]) = - lines - |> Array.filter (isNull >> not) - |> Array.map (fun line -> line.TrimStart(' ')) - |> Array.filter (fun line -> line.StartsWith(prefix)) - |> Array.map (fun line -> line.Substring(prefix.Length)) - - let getProjectOptions (rootDir: string) = - if isNull rootDir then [||] - else - fileWatcher.Path <- rootDir - fileWatcher.EnableRaisingEvents <- true - - /// This function is meant to be temporary. Until we figure out what a language server for a project - /// system looks like, we have to guess based on the files we find in the root. - let getProjectOptions (projectPath: string) = - let projectDir = Path.GetDirectoryName(projectPath) - let normalizePath (path: string) = - if Path.IsPathRooted(path) then path - else Path.Combine(projectDir, path) - - // To avoid essentially re-creating a copy of MSBuild alongside this tool, we instead fake a design- - // time build with this project. The output of building this helper project is text that's easily - // parsable. See the helper project for more information. - let reporterProject = Path.Combine(Path.GetDirectoryName(typeof.Assembly.Location), "FSharp.Compiler.LanguageServer.DesignTime.proj") - let detectedTfmSentinel = "DetectedTargetFramework=" - let detectedCommandLineArgSentinel = "DetectedCommandLineArg=" - - let execTfmReporter = - sprintf "build \"%s\" \"/p:ProjectFile=%s\"" reporterProject projectPath - |> execProcess "dotnet" - - let execArgReporter (tfm: string) = - sprintf "build \"%s\" \"/p:ProjectFile=%s\" \"/p:TargetFramework=%s\"" reporterProject projectPath tfm - |> execProcess "dotnet" - - // find the target frameworks - let targetFrameworks = - execTfmReporter - |> linesWithPrefixClean detectedTfmSentinel - - let getArgs (tfm: string) = - execArgReporter tfm - |> linesWithPrefixClean detectedCommandLineArgSentinel - - let tfmAndArgs = - targetFrameworks - |> Array.map (fun tfm -> tfm, getArgs tfm) - - let separateArgs (args: string[]) = - args - |> Array.partition (fun a -> a.StartsWith("-")) - |> (fun (options, files) -> - let normalizedFiles = files |> Array.map normalizePath - options, normalizedFiles) - - // TODO: for now we're only concerned with the first TFM - let _tfm, args = Array.head tfmAndArgs - - let otherOptions, sourceFiles = separateArgs args - - let projectOptions: FSharpProjectOptions = - { ProjectFileName = projectPath - ProjectId = None - SourceFiles = sourceFiles - OtherOptions = otherOptions - ReferencedProjects = [||] // TODO: populate from @(ProjectReference) - IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = false - LoadTime = DateTime.Now - UnresolvedReferences = None - OriginalLoadReferences = [] - ExtraProjectInfo = None - Stamp = None } - projectOptions - let topLevelProjects = Directory.GetFiles(rootDir, "*.fsproj") - let watchableProjectPaths = - match topLevelProjects with - | [||] -> - match Directory.GetFiles(rootDir, "*.sln") with - // TODO: what to do with multiple .sln or a combo of .sln/.fsproj? - | [| singleSolution |] -> - let content = File.ReadAllText(singleSolution) - let solutionDir = Path.GetDirectoryName(singleSolution) - Solution.getProjectPaths content solutionDir - | _ -> [||] - | _ -> topLevelProjects - let watchableProjectOptions = - watchableProjectPaths - |> Array.map getProjectOptions - - // associate source files with project options - let watchFile file projectOptions = - sourceFileToProjectMap.AddOrUpdate(file, projectOptions, fun _ _ -> projectOptions) - - for projectOptions in watchableProjectOptions do - // watch .fsproj - watchFile projectOptions.ProjectFileName projectOptions |> ignore - // TODO: watch .deps.json - for sourceFile in projectOptions.SourceFiles do - let sourceFileFullPath = - if Path.IsPathRooted(sourceFile) then sourceFile - else - let projectDir = Path.GetDirectoryName(projectOptions.ProjectFileName) - Path.Combine(projectDir, sourceFile) - watchFile sourceFileFullPath projectOptions |> ignore - - watchableProjectOptions - - member __.Checker = checker - - /// Initialize the LSP at the specified location. According to the spec, `rootUri` is to be preferred over `rootPath`. - member __.Initialize (rootPath: string) (rootUri: DocumentUri) (computeDiagnostics: FSharpProjectOptions -> unit) = - let rootDir = - if not (isNull rootUri) then Uri(rootUri).LocalPath - else rootPath - let projectOptions = getProjectOptions rootDir - projectInvalidatedEvent.Publish.Add computeDiagnostics // compute diagnostics on project invalidation - for projectOption in projectOptions do - computeDiagnostics projectOption // compute initial set of diagnostics - - [] - member __.Shutdown = shutdownEvent.Publish - - [] - member __.Exit = exitEvent.Publish - - [] - member __.Cancel = cancelEvent.Publish - - [] - member __.ProjectInvalidated = projectInvalidatedEvent.Publish - - member __.DoShutdown() = shutdownEvent.Trigger() - - member __.DoExit() = exitEvent.Trigger() - - member __.DoCancel() = cancelEvent.Trigger() - - member __.InvalidateAllProjects() = - for projectOptions in sourceFileToProjectMap.Values do - projectInvalidatedEvent.Trigger(projectOptions) - - member val Options = Options.Default() with get, set - - member val JsonRpc: JsonRpc option = None with get, set diff --git a/src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs b/src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs deleted file mode 100644 index 489b55ebce..0000000000 --- a/src/fsharp/FSharp.Compiler.LanguageServer/TextDocument.fs +++ /dev/null @@ -1,75 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer - -open System.Threading - -module TextDocument = - - let mutable publishDiagnosticsCancellationTokenSource = new CancellationTokenSource() - - let Hover (state: State) (textDocument: TextDocumentIdentifier) (position: Position) = - async { - eprintfn "hover at %d, %d" position.line position.character - if not state.Options.usePreviewTextHover then return None - else - let startCol, endCol = - if position.character = 0 then 0, 1 - else position.character, position.character + 1 - return Some { contents = { kind = MarkupKind.PlainText - value = "serving textDocument/hover from LSP" } - range = Some { start = { line = position.line; character = startCol } - ``end`` = { line = position.line; character = endCol } } - } - } - - let PublishDiagnostics(state: State, projectOptions: FSharp.Compiler.SourceCodeServices.FSharpProjectOptions) = - // TODO: honor TextDocumentClientCapabilities.publishDiagnostics.relatedInformation - // cancel any existing request to publish diagnostics - publishDiagnosticsCancellationTokenSource.Cancel() - publishDiagnosticsCancellationTokenSource <- new CancellationTokenSource() - async { - if not state.Options.usePreviewDiagnostics then return () - else - eprintfn "starting diagnostics computation" - match state.JsonRpc with - | None -> eprintfn "state.JsonRpc was null; should not be?" - | Some jsonRpc -> - let! results = state.Checker.ParseAndCheckProject projectOptions - let diagnostics = results.Errors - let diagnosticsPerFile = - diagnostics - |> Array.fold (fun state t -> - let existing = Map.tryFind t.FileName state |> Option.defaultValue [] - Map.add t.FileName (t :: existing) state) Map.empty - for sourceFile in projectOptions.SourceFiles do - let diagnostics = - Map.tryFind sourceFile diagnosticsPerFile - |> Option.defaultValue [] - |> List.map (fun d -> - // F# errors count lines starting at 1, but LSP starts at 0 - let range: Range = - { start = { line = d.StartLineAlternate - 1; character = d.StartColumn } - ``end`` = { line = d.EndLineAlternate - 1; character = d.EndColumn } } - let severity = - match d.Severity with - | FSharp.Compiler.SourceCodeServices.FSharpErrorSeverity.Warning -> Diagnostic.Warning - | FSharp.Compiler.SourceCodeServices.FSharpErrorSeverity.Error -> Diagnostic.Error - let res: Diagnostic = - { range = range - severity = Some severity - code = "FS" + d.ErrorNumber.ToString("0000") - source = Some d.FileName - message = d.Message - relatedInformation = None } - res) - |> List.toArray - let args: PublishDiagnosticsParams = - { uri = System.Uri(sourceFile).AbsoluteUri - diagnostics = diagnostics } - - // fire each notification separately - jsonRpc.NotifyAsync(TextDocumentPublishDiagnostics, args) |> Async.AwaitTask |> Async.Start - } - |> (fun computation -> Async.StartAsTask(computation, cancellationToken=publishDiagnosticsCancellationTokenSource.Token)) - |> Async.AwaitTask diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/DiagnosticsTests.fs b/tests/FSharp.Compiler.LanguageServer.UnitTests/DiagnosticsTests.fs deleted file mode 100644 index aaadff258e..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/DiagnosticsTests.fs +++ /dev/null @@ -1,154 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer.UnitTests - -open System -open System.IO -open System.Linq -open System.Threading.Tasks -open FSharp.Compiler.LanguageServer -open Nerdbank.Streams -open NUnit.Framework - -[] -type DiagnosticsTests() = - - let createTestableProject (tfm: string) (sourceFiles: (string * string) list) = - let testDir = new TemporaryDirectory() - let directoryBuildText = "" - File.WriteAllText(Path.Combine(testDir.Directory, "Directory.Build.props"), directoryBuildText) - File.WriteAllText(Path.Combine(testDir.Directory, "Directory.Build.targets"), directoryBuildText) - for name, contents in sourceFiles do - File.WriteAllText(Path.Combine(testDir.Directory, name), contents) - let compileItems = - sourceFiles - |> List.map fst - |> List.map (sprintf " ") - |> List.fold (fun content line -> content + "\n" + line) "" - let replacements = - [ "{{COMPILE}}", compileItems - "{{TARGETFRAMEWORK}}", tfm ] - let projectTemplate = - @" - - - Library - {{TARGETFRAMEWORK}} - - -{{COMPILE}} - -" - let projectFile = - replacements - |> List.fold (fun (content: string) (find, replace) -> content.Replace(find, replace)) projectTemplate - File.WriteAllText(Path.Combine(testDir.Directory, "test.fsproj"), projectFile) - testDir - - let createRpcClient (tempDir: TemporaryDirectory) = - let clientStream, serverStream = FullDuplexStream.CreatePair().ToTuple() - let server = new Server(serverStream, serverStream) - server.StartListening() - let client = new TestClient(tempDir, clientStream, clientStream, server) - client - - let createClientTest (tfm: string) (sourceFiles: (string * string) list) = - let testDir = createTestableProject tfm sourceFiles - let client = createRpcClient testDir - client - - let getDiagnostics (content: string) = - async { - use client = createClientTest "netstandard2.0" [ "lib.fs", content ] - let! diagnostics = client.WaitForDiagnosticsAsync client.Initialize ["lib.fs"] - return diagnostics.["lib.fs"] - } - - [] - member __.``No diagnostics for correct code``() = - async { - let! diagnostics = getDiagnostics @" -namespace Test - -module Numbers = - let one: int = 1 -" - Assert.AreEqual(0, diagnostics.Length) - } |> Async.StartAsTask :> Task - - [] - member __.``Diagnostics for incorrect code``() = - async { - let! diagnostics = getDiagnostics @" -namespace Test - -module Numbers = - let one: int = false -" - let diag = diagnostics.Single() - Assert.AreEqual("FS0001", diag.code) - Assert.AreEqual(Some 1, diag.severity) - Assert.AreEqual(4, diag.range.start.line) - Assert.AreEqual(19, diag.range.start.character) - Assert.AreEqual(4, diag.range.``end``.line) - Assert.AreEqual(24, diag.range.``end``.character) - Assert.AreEqual("This expression was expected to have type\n 'int' \nbut here has type\n 'bool'", diag.message.Trim()) - Assert.IsTrue(diag.source.Value.EndsWith("lib.fs")) - } |> Async.StartAsTask :> Task - - [] - member __.``Diagnostics added for updated incorrect code``() = - async { - let correct = @" -namespace Test - -module Numbers = - let one: int = 1 -" - let incorrect = @" -namespace Test - -module Numbers = - let one: int = false -" - - // verify initial state - use client = createClientTest "netstandard2.0" [ "lib.fs", correct ] - let! diagnostics = client.WaitForDiagnosticsAsync client.Initialize ["lib.fs"] - Assert.AreEqual(0, diagnostics.["lib.fs"].Length) - - // touch file with incorrect data - let touch () = File.WriteAllText(Path.Combine(client.RootPath, "lib.fs"), incorrect) - let! diagnostics = client.WaitForDiagnostics touch ["lib.fs"] - let diag = diagnostics.["lib.fs"].Single() - Assert.AreEqual("FS0001", diag.code) - } |> Async.StartAsTask :> Task - - [] - member __.``Diagnostics removed for updated correct code``() = - async { - let incorrect = @" -namespace Test - -module Numbers = - let one: int = false -" - let correct = @" -namespace Test - -module Numbers = - let one: int = 1 -" - - // verify initial state - use client = createClientTest "netstandard2.0" [ "lib.fs", incorrect ] - let! diagnostics = client.WaitForDiagnosticsAsync client.Initialize ["lib.fs"] - let diag = diagnostics.["lib.fs"].Single() - Assert.AreEqual("FS0001", diag.code) - - // touch file with correct data - let touch () = File.WriteAllText(Path.Combine(client.RootPath, "lib.fs"), correct) - let! diagnostics = client.WaitForDiagnostics touch ["lib.fs"] - let libActualContents = File.ReadAllText(Path.Combine(client.RootPath, "lib.fs")) - Assert.AreEqual(0, diagnostics.["lib.fs"].Length, "Actual on-disk contents of lib.fs:\n" + libActualContents) - } |> Async.StartAsTask :> Task diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/Directory.Build.props b/tests/FSharp.Compiler.LanguageServer.UnitTests/Directory.Build.props deleted file mode 100644 index 7cd41381b5..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/Directory.Build.props +++ /dev/null @@ -1,9 +0,0 @@ - - - - true - - - - - diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/FSharp.Compiler.LanguageServer.UnitTests.fsproj b/tests/FSharp.Compiler.LanguageServer.UnitTests/FSharp.Compiler.LanguageServer.UnitTests.fsproj deleted file mode 100644 index 4e061f5575..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/FSharp.Compiler.LanguageServer.UnitTests.fsproj +++ /dev/null @@ -1,31 +0,0 @@ - - - - - net472;netcoreapp3.0 - netcoreapp3.0 - Library - true - nunit - true - - - - - - - - - - - - - - - - - - - - - diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/MiscTests.fs b/tests/FSharp.Compiler.LanguageServer.UnitTests/MiscTests.fs deleted file mode 100644 index 02104be2e6..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/MiscTests.fs +++ /dev/null @@ -1,43 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer.UnitTests - -open System.IO -open FSharp.Compiler.LanguageServer -open NUnit.Framework - -[] -type MiscTests() = - - [] - member __.``Find F# projects in a .sln file``() = - let slnContent = @" -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.29201.188 -MinimumVisualStudioVersion = 10.0.40219.1 -Project(""{F2A71F9B-5D33-465A-A702-920D77279786}"") = ""ConsoleApp1"", ""ConsoleApp1\ConsoleApp1.fsproj"", ""{60A4BE67-7E03-4200-AD38-B0E5E8E049C1}"" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Any CPU = Debug|Any CPU - Release|Any CPU = Release|Any CPU - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {60A4BE67-7E03-4200-AD38-B0E5E8E049C1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {60A4BE67-7E03-4200-AD38-B0E5E8E049C1}.Debug|Any CPU.Build.0 = Debug|Any CPU - {60A4BE67-7E03-4200-AD38-B0E5E8E049C1}.Release|Any CPU.ActiveCfg = Release|Any CPU - {60A4BE67-7E03-4200-AD38-B0E5E8E049C1}.Release|Any CPU.Build.0 = Release|Any CPU - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {80902CFC-54E6-4485-AC17-4516930C8B2B} - EndGlobalSection -EndGlobal -" - let testDir = @"C:\Dir\With\Solution" // don't care about the potentially improper directory separators here, it's really just a dumb string - let foundProjects = Solution.getProjectPaths slnContent testDir - let expected = Path.Combine(testDir, "ConsoleApp1", "ConsoleApp1.fsproj") // proper directory separator characters will be used at runtime - Assert.AreEqual([| expected |], foundProjects) diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/ProtocolTests.fs b/tests/FSharp.Compiler.LanguageServer.UnitTests/ProtocolTests.fs deleted file mode 100644 index 8b262e2ceb..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/ProtocolTests.fs +++ /dev/null @@ -1,55 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer.UnitTests - -open System.Diagnostics -open System.Threading.Tasks -open FSharp.Compiler.LanguageServer -open NUnit.Framework -open StreamJsonRpc - -[] -type ProtocolTests() = - -#if !NETCOREAPP - // The `netcoreapp` version of `FSharp.Compiler.LanguageServer.exe` can't be run without a `publish` step so - // we're artificially restricting this test to the full framework. - [] -#endif - member __.``Server consuming stdin and stdout``() = - async { - // start server as a console app - let serverAssemblyPath = typeof.Assembly.Location - let startInfo = ProcessStartInfo(serverAssemblyPath) - startInfo.UseShellExecute <- false - startInfo.RedirectStandardInput <- true - startInfo.RedirectStandardOutput <- true - let proc = Process.Start(startInfo) - - // create a fake client over stdin/stdout - let client = new JsonRpc(proc.StandardInput.BaseStream, proc.StandardOutput.BaseStream) - client.StartListening() - - // initialize - let capabilities: ClientCapabilities = - { workspace = None - textDocument = None - experimental = None - supportsVisualStudioExtensions = None } - let! result = - client.InvokeWithParameterObjectAsync( - "initialize", - {| processId = Process.GetCurrentProcess().Id - capabilities = capabilities |} - ) |> Async.AwaitTask - Assert.True(result.capabilities.hoverProvider) - do! client.NotifyAsync("initialized") |> Async.AwaitTask - - // shutdown - let! shutdownResponse = client.InvokeAsync("shutdown") |> Async.AwaitTask - Assert.IsNull(shutdownResponse) - - // exit - do! client.NotifyAsync("exit") |> Async.AwaitTask - if not (proc.WaitForExit(5000)) then failwith "Expected server process to exit." - } |> Async.StartAsTask :> Task diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/SerializationTests.fs b/tests/FSharp.Compiler.LanguageServer.UnitTests/SerializationTests.fs deleted file mode 100644 index 5d8457c4e5..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/SerializationTests.fs +++ /dev/null @@ -1,33 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer.UnitTests - -open System -open FSharp.Compiler.LanguageServer -open NUnit.Framework -open Newtonsoft.Json - -[] -type SerializationTests() = - - let verifyRoundTrip (str: string) (typ: Type) = - let deserialized = JsonConvert.DeserializeObject(str, typ) - let roundTripped = JsonConvert.SerializeObject(deserialized) - Assert.AreEqual(str, roundTripped) - - let verifyRoundTripWithConverter (str: string) (typ: Type) (converter: JsonConverter) = - let deserialized = JsonConvert.DeserializeObject(str, typ, converter) - let roundTripped = JsonConvert.SerializeObject(deserialized, converter) - Assert.AreEqual(str, roundTripped) - - [] - member __.``Discriminated union as lower-case string``() = - verifyRoundTrip "\"plaintext\"" typeof - verifyRoundTrip "\"markdown\"" typeof - - [] - member __.``Option<'T> as obj/null``() = - verifyRoundTripWithConverter "1" typeof> (JsonOptionConverter()) - verifyRoundTripWithConverter "null" typeof> (JsonOptionConverter()) - verifyRoundTripWithConverter "{\"contents\":{\"kind\":\"plaintext\",\"value\":\"v\"},\"range\":{\"start\":{\"line\":1,\"character\":2},\"end\":{\"line\":3,\"character\":4}}}" typeof> (JsonOptionConverter()) - verifyRoundTripWithConverter "null" typeof> (JsonOptionConverter()) diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/TemporaryDirectory.fs b/tests/FSharp.Compiler.LanguageServer.UnitTests/TemporaryDirectory.fs deleted file mode 100644 index ef3953d781..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/TemporaryDirectory.fs +++ /dev/null @@ -1,20 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer.UnitTests - -open System -open System.IO - -type TemporaryDirectory() = - - let directory = Path.Combine(Path.GetTempPath(), Guid.NewGuid().ToString()) - do Directory.CreateDirectory(directory) |> ignore - - member __.Directory = directory - - interface IDisposable with - member __.Dispose() = - try - Directory.Delete(directory, true) - with - | _ -> () diff --git a/tests/FSharp.Compiler.LanguageServer.UnitTests/TestClient.fs b/tests/FSharp.Compiler.LanguageServer.UnitTests/TestClient.fs deleted file mode 100644 index 0baaaf40eb..0000000000 --- a/tests/FSharp.Compiler.LanguageServer.UnitTests/TestClient.fs +++ /dev/null @@ -1,121 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace FSharp.Compiler.LanguageServer.UnitTests - -open System -open System.Collections.Generic -open System.Diagnostics -open System.IO -open System.Threading -open FSharp.Compiler.LanguageServer -open Newtonsoft.Json.Linq -open StreamJsonRpc - -type TestClient(tempDir: TemporaryDirectory, sendingStream: Stream, receivingStream: Stream, server: Server) = - - let rootPath = tempDir.Directory - let rootPath = if rootPath.EndsWith(Path.DirectorySeparatorChar.ToString()) then rootPath else rootPath + Path.DirectorySeparatorChar.ToString() - let diagnosticsEvent = Event<_>() - - let formatter = JsonMessageFormatter() - let converter = JsonOptionConverter() // special handler to convert between `Option<'T>` and `obj/null`. - do formatter.JsonSerializer.Converters.Add(converter) - let handler = new HeaderDelimitedMessageHandler(sendingStream, receivingStream, formatter) - let client = new JsonRpc(handler) - let handler (functionName: string) (args: JToken): JToken = - match functionName with - | TextDocumentPublishDiagnostics -> - let args = args.ToObject(formatter.JsonSerializer) - let fullPath = Uri(args.uri).LocalPath - let shortPath = if fullPath.StartsWith(rootPath) then fullPath.Substring(rootPath.Length) else fullPath - diagnosticsEvent.Trigger((shortPath, args.diagnostics)) - null - | _ -> null - let addHandler (name: string) = - client.AddLocalRpcMethod(name, new Func(handler name)) - do addHandler TextDocumentPublishDiagnostics - do client.StartListening() - - member __.RootPath = rootPath - - member __.Server = server - - [] - member __.PublishDiagnostics = diagnosticsEvent.Publish - - member __.Initialize () = - async { - do! client.NotifyWithParameterObjectAsync(OptionsSet, {| options = Options.AllOn() |}) |> Async.AwaitTask - let capabilities: ClientCapabilities = - { workspace = None - textDocument = None - experimental = None - supportsVisualStudioExtensions = None } - let! _result = - client.InvokeWithParameterObjectAsync( - "initialize", // method - {| processId = Process.GetCurrentProcess().Id - rootPath = rootPath - capabilities = capabilities |} - ) |> Async.AwaitTask - return () - } - - member this.WaitForDiagnostics (triggerAction: unit -> unit) (fileNames: string list) = - async { - // prepare file diagnostic triggers - let diagnosticTriggers = Dictionary() - fileNames |> List.iter (fun f -> diagnosticTriggers.[f] <- new ManualResetEvent(false)) - - // prepare callback handler - let diagnosticsMap = Dictionary() - let handler (fileName: string, diagnostics: Diagnostic[]) = - diagnosticsMap.[fileName] <- diagnostics - // auto-generated files (e.g., AssemblyInfo.fs) won't be in the trigger map - if diagnosticTriggers.ContainsKey(fileName) then - diagnosticTriggers.[fileName].Set() |> ignore - - // subscribe to the event - let wrappedHandler = new Handler(fun _sender args -> handler args) - this.PublishDiagnostics.AddHandler(wrappedHandler) - triggerAction () - - // wait for all triggers to hit - let! results = - diagnosticTriggers - |> Seq.map (fun entry -> - async { - let! result = Async.AwaitWaitHandle(entry.Value, millisecondsTimeout = int (TimeSpan.FromSeconds(10.0).TotalMilliseconds)) - return if result then None - else - let filePath = Path.Combine(rootPath, entry.Key) - let actualContents = File.ReadAllText(filePath) - Some <| sprintf "No diagnostics received for file '%s'. Contents:\n%s\n" entry.Key actualContents - }) - |> Async.Parallel - let results = results |> Array.choose (fun x -> x) - if results.Length > 0 then - let combinedErrors = String.Join("-----\n", results) - let allDiagnosticsEvents = - diagnosticsMap - |> Seq.map (fun entry -> - sprintf "File '%s' reported %d diagnostics." entry.Key entry.Value.Length) - |> (fun s -> String.Join("\n", s)) - failwith <| sprintf "Error waiting for diagnostics:\n%s\n-----\n%s" combinedErrors allDiagnosticsEvents - - // clean up event - this.PublishDiagnostics.RemoveHandler(wrappedHandler) - - // done - return diagnosticsMap - } - - member this.WaitForDiagnosticsAsync (triggerAction: unit -> Async) (fileNames: string list) = - this.WaitForDiagnostics (fun () -> triggerAction () |> Async.RunSynchronously) fileNames - - interface IDisposable with - member __.Dispose() = - try - (tempDir :> IDisposable).Dispose() - with - | _ -> () diff --git a/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest index cae7539766..e35e50e78e 100644 --- a/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest +++ b/vsintegration/Vsix/VisualFSharpFull/Source.extension.vsixmanifest @@ -28,10 +28,6 @@ - - diff --git a/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj b/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj index d68067fe1e..0bfaa8f1cd 100644 --- a/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj +++ b/vsintegration/Vsix/VisualFSharpFull/VisualFSharpFull.csproj @@ -61,14 +61,6 @@ True TargetFramework=$(DependencyTargetFramework) - - {60BAFFA5-6631-4328-B044-2E012AB76DCA} - FSharp.Compiler.LanguageServer - PublishedProjectOutputGroup%3b - false - Build;Publish - TargetFramework=$(DependencyTargetFramework) - {D5870CF0-ED51-4CBC-B3D7-6F56DA84AC06} FSharp.Compiler.Server.Shared @@ -158,16 +150,6 @@ 2 True - - {0A3099F1-F0C7-4ADE-AB9B-526EF193A56F} - FSharp.Editor.Helpers - BuiltProjectOutputGroup%3bGetCopyToOutputDirectoryItems%3bPkgDefProjectOutputGroup%3bSatelliteDllsProjectOutputGroup%3b - DebugSymbolsProjectOutputGroup%3b - true - All - 2 - True - {c4586a06-1402-48bc-8e35-a1b8642f895b} FSharp.UIResources diff --git a/vsintegration/src/FSharp.Editor.Helpers/FSharp.Editor.Helpers.csproj b/vsintegration/src/FSharp.Editor.Helpers/FSharp.Editor.Helpers.csproj deleted file mode 100644 index cb6cfb36cb..0000000000 --- a/vsintegration/src/FSharp.Editor.Helpers/FSharp.Editor.Helpers.csproj +++ /dev/null @@ -1,22 +0,0 @@ - - - - Library - net472 - - - - - - - - - - - FSharp.Editor.Helpers - $(VSAssemblyVersion) - $PackageFolder$\FSharp.Editor.Helpers.dll - - - - diff --git a/vsintegration/src/FSharp.Editor.Helpers/LanguageClient.cs b/vsintegration/src/FSharp.Editor.Helpers/LanguageClient.cs deleted file mode 100644 index 87759ceef7..0000000000 --- a/vsintegration/src/FSharp.Editor.Helpers/LanguageClient.cs +++ /dev/null @@ -1,46 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -using System; -using System.Collections.Generic; -using System.Threading; -using System.Threading.Tasks; -using Microsoft.VisualStudio.LanguageServer.Client; -using Microsoft.VisualStudio.Threading; - -namespace Microsoft.VisualStudio.FSharp.Editor.Helpers -{ - /// - /// Exists as an abstract implementor of purely to manage the non-standard async - /// event handlers. - /// - public abstract class LanguageClient : ILanguageClient - { - public abstract string Name { get; } - - public abstract IEnumerable ConfigurationSections { get; } - - public abstract object InitializationOptions { get; } - - public abstract IEnumerable FilesToWatch { get; } - - public event AsyncEventHandler StartAsync; - -#pragma warning disable 67 // The event 'LanguageClient.StopAsync' is never used - public event AsyncEventHandler StopAsync; -#pragma warning restore 67 - - public abstract Task ActivateAsync(CancellationToken token); - - protected abstract Task DoLoadAsync(); - - public async Task OnLoadedAsync() - { - await DoLoadAsync(); - await StartAsync.InvokeAsync(this, EventArgs.Empty); - } - - public abstract Task OnServerInitializeFailedAsync(Exception e); - - public abstract Task OnServerInitializedAsync(); - } -} diff --git a/vsintegration/src/FSharp.Editor/Common/LspService.fs b/vsintegration/src/FSharp.Editor/Common/LspService.fs deleted file mode 100644 index 433f833839..0000000000 --- a/vsintegration/src/FSharp.Editor/Common/LspService.fs +++ /dev/null @@ -1,28 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor - -open System.ComponentModel.Composition -open FSharp.Compiler.LanguageServer -open FSharp.Compiler.LanguageServer.Extensions -open StreamJsonRpc - -[)>] -type LspService() = - let mutable options = Options.Default() - let mutable jsonRpc: JsonRpc option = None - - let sendOptions () = - async { - match jsonRpc with - | None -> () - | Some rpc -> do! rpc.SetOptionsAsync(options) - } - - member __.SetJsonRpc(rpc: JsonRpc) = - jsonRpc <- Some rpc - sendOptions() - - member __.SetOptions(opt: Options) = - options <- opt - sendOptions() diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs index 0d92ce047b..2e7a44e251 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/DocumentDiagnosticAnalyzer.fs @@ -34,9 +34,6 @@ type internal FSharpDocumentDiagnosticAnalyzer [] () = let getProjectInfoManager(document: Document) = document.Project.Solution.Workspace.Services.GetService().FSharpProjectOptionsManager - let getSettings(document: Document) = - document.Project.Solution.Workspace.Services.GetService() - static let errorInfoEqualityComparer = { new IEqualityComparer with member __.Equals (x, y) = @@ -113,10 +110,6 @@ type internal FSharpDocumentDiagnosticAnalyzer [] () = interface IFSharpDocumentDiagnosticAnalyzer with member this.AnalyzeSyntaxAsync(document: Document, cancellationToken: CancellationToken): Task> = - // if using LSP, just bail early - let settings = getSettings document - if settings.Advanced.UsePreviewDiagnostics then Task.FromResult(ImmutableArray.Empty) - else let projectInfoManager = getProjectInfoManager document asyncMaybe { let! parsingOptions, projectOptions = projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document, cancellationToken) @@ -130,10 +123,6 @@ type internal FSharpDocumentDiagnosticAnalyzer [] () = |> RoslynHelpers.StartAsyncAsTask cancellationToken member this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken): Task> = - // if using LSP, just bail early - let settings = getSettings document - if settings.Advanced.UsePreviewDiagnostics then Task.FromResult(ImmutableArray.Empty) - else let projectInfoManager = getProjectInfoManager document asyncMaybe { let! parsingOptions, _, projectOptions = projectInfoManager.TryGetOptionsForDocumentOrProject(document, cancellationToken) diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index 77add18765..629f7f2b0f 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -35,10 +35,6 @@ - - Common\LspExternalAccess.fs - - @@ -55,10 +51,6 @@ - - LanguageService\JsonOptionConverter.fs - - @@ -122,7 +114,6 @@ - @@ -151,7 +142,6 @@ - diff --git a/vsintegration/src/FSharp.Editor/LanguageService/FSharpLanguageClient.fs b/vsintegration/src/FSharp.Editor/LanguageService/FSharpLanguageClient.fs deleted file mode 100644 index 7a987d665f..0000000000 --- a/vsintegration/src/FSharp.Editor/LanguageService/FSharpLanguageClient.fs +++ /dev/null @@ -1,70 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Microsoft.VisualStudio.FSharp.Editor.LanguageService - -open System.ComponentModel.Composition -open System.Diagnostics -open System.IO -open System.Threading -open System.Threading.Tasks -open Microsoft.FSharp.Control -open Microsoft.VisualStudio.FSharp.Editor -open Microsoft.VisualStudio.FSharp.Editor.Helpers -open Microsoft.VisualStudio.LanguageServer.Client -open Microsoft.VisualStudio.Utilities -open StreamJsonRpc - -// https://docs.microsoft.com/en-us/visualstudio/extensibility/adding-an-lsp-extension?view=vs-2019 - -/// Provides exports necessary to register the language client. -type FSharpContentDefinition() = - - [] - [] - [] - static member val FSharpContentTypeDefinition: ContentTypeDefinition = null with get, set - - [] - [] - [] - static member val FSharpFileExtensionDefinition: FileExtensionToContentTypeDefinition = null with get, set - -[)>] -[] -type internal FSharpLanguageClient - [] - ( - lspService: LspService, - settings: EditorOptions - ) = - inherit LanguageClient() - override __.Name = "F# Language Service" - override this.ActivateAsync(_token: CancellationToken) = - async { - let thisAssemblyPath = Path.GetDirectoryName(this.GetType().Assembly.Location) - let serverAssemblyPath = Path.Combine(thisAssemblyPath, "Agent", "FSharp.Compiler.LanguageServer.exe") - let startInfo = ProcessStartInfo(serverAssemblyPath) - startInfo.UseShellExecute <- false - startInfo.CreateNoWindow <- true // comment to see log messages written to stderr - startInfo.RedirectStandardInput <- true - startInfo.RedirectStandardOutput <- true - let proc = new Process() - proc.StartInfo <- startInfo - return - if proc.Start() then new Connection(proc.StandardOutput.BaseStream, proc.StandardInput.BaseStream) - else null - } |> Async.StartAsTask - override __.ConfigurationSections = null - override __.FilesToWatch = null - override __.InitializationOptions = null - override __.DoLoadAsync() = Task.CompletedTask - override __.OnServerInitializeFailedAsync(_e: exn) = Task.CompletedTask - override __.OnServerInitializedAsync() = Task.CompletedTask - interface ILanguageClientCustomMessage with - member __.CustomMessageTarget = null - member __.MiddleLayer = null - member __.AttachForCustomMessageAsync(rpc: JsonRpc) = - async { - do! lspService.SetJsonRpc(rpc) - do! lspService.SetOptions(settings.Advanced.AsLspOptions()) - } |> Async.StartAsTask :> Task diff --git a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs index af88f02d10..7485176811 100644 --- a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs +++ b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs @@ -5,7 +5,6 @@ open System.ComponentModel.Composition open System.Runtime.InteropServices open System.Windows open System.Windows.Controls -open FSharp.Compiler.LanguageServer open Microsoft.VisualStudio.Shell open Microsoft.VisualStudio.FSharp.UIResources @@ -92,17 +91,10 @@ type CodeLensOptions = [] type AdvancedOptions = { IsBlockStructureEnabled: bool - IsOutliningEnabled: bool - UsePreviewTextHover: bool - UsePreviewDiagnostics: bool } + IsOutliningEnabled: bool } static member Default = { IsBlockStructureEnabled = true - IsOutliningEnabled = true - UsePreviewTextHover = false - UsePreviewDiagnostics = false } - member this.AsLspOptions(): Options = - { usePreviewTextHover = this.UsePreviewTextHover - usePreviewDiagnostics = this.UsePreviewDiagnostics } + IsOutliningEnabled = true } [] type FormattingOptions = @@ -203,14 +195,6 @@ module internal OptionsUI = inherit AbstractOptionPage() override __.CreateView() = upcast AdvancedOptionsControl() - override this.OnApply(args) = - base.OnApply(args) - async { - let lspService = this.GetService() - let settings = this.GetService() - let options = settings.Advanced.AsLspOptions() - do! lspService.SetOptions options - } |> Async.Start [] type internal FormattingOptionPage() = diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs index 7b90bb3aef..a6ea0c9033 100644 --- a/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs +++ b/vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs @@ -206,10 +206,6 @@ type internal FSharpAsyncQuickInfoSource // This method can be called from the background thread. // Do not call IServiceProvider.GetService here. override __.GetQuickInfoItemAsync(session:IAsyncQuickInfoSession, cancellationToken:CancellationToken) : Task = - // The following lines should be disabled for branch `release/dev16.2`, enabled otherwise - //// if using LSP, just bail early - //if settings.Advanced.UsePreviewTextHover then Task.FromResult(null) - //else let triggerPoint = session.GetTriggerPoint(textBuffer.CurrentSnapshot) match triggerPoint.HasValue with | false -> Task.FromResult(null) diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.cs.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.cs.xlf index b071e0c5f7..5340031907 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.cs.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.cs.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.de.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.de.xlf index 4184f3edc5..2ca4bd450e 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.de.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.de.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.es.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.es.xlf index 4b1a5e0d90..394481ad69 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.es.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.es.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.fr.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.fr.xlf index 99d3469919..821545638e 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.fr.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.fr.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.it.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.it.xlf index 8902030751..dd58cb9a11 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.it.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.it.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ja.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ja.xlf index de4d65e71f..c0221174d9 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ja.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ja.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ko.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ko.xlf index e7191ac3c4..6f540b5425 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ko.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ko.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pl.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pl.xlf index 6936b8e97f..f912b6b4c7 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pl.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pl.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pt-BR.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pt-BR.xlf index fefd197867..5a2b75dce0 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pt-BR.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.pt-BR.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ru.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ru.xlf index 355d363084..2b5303d91d 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ru.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.ru.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.tr.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.tr.xlf index 86ac32f4b3..73a72b806a 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.tr.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.tr.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hans.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hans.xlf index 0537632d5f..474f99a3dc 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hans.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hans.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hant.xlf b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hant.xlf index 17c64ffefb..16b7339b2a 100644 --- a/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hant.xlf +++ b/vsintegration/src/FSharp.ProjectSystem.PropertyPages/Resources/xlf/Microsoft.VisualStudio.Editors.Designer.zh-Hant.xlf @@ -1828,8 +1828,9 @@ CONSIDER: get this from CodeDom {0} x {1} - {0} x {1} + {0} x {1} Format string for showing a graphic's size + # {0} = width (as an integer) # {1} = height (as an integer) #Example, for a bitmap of width=123, height = 456, the English version of this string would be "123x456" diff --git a/vsintegration/src/FSharp.UIResources/AdvancedOptionsControl.xaml b/vsintegration/src/FSharp.UIResources/AdvancedOptionsControl.xaml index 57ca75df75..7126d6efb8 100644 --- a/vsintegration/src/FSharp.UIResources/AdvancedOptionsControl.xaml +++ b/vsintegration/src/FSharp.UIResources/AdvancedOptionsControl.xaml @@ -24,17 +24,6 @@ - - diff --git a/vsintegration/src/FSharp.UIResources/Strings.Designer.cs b/vsintegration/src/FSharp.UIResources/Strings.Designer.cs index c03ff05d77..fd74fbb404 100644 --- a/vsintegration/src/FSharp.UIResources/Strings.Designer.cs +++ b/vsintegration/src/FSharp.UIResources/Strings.Designer.cs @@ -419,14 +419,5 @@ public static string Unused_opens_code_fix { return ResourceManager.GetString("Unused_opens_code_fix", resourceCulture); } } - - /// - /// Looks up a localized string similar to (Preview) Use out of process language server. - /// - public static string Use_out_of_process_language_server { - get { - return ResourceManager.GetString("Use_out_of_process_language_server", resourceCulture); - } - } } } diff --git a/vsintegration/src/FSharp.UIResources/Strings.resx b/vsintegration/src/FSharp.UIResources/Strings.resx index 037596b716..19f6d2658b 100644 --- a/vsintegration/src/FSharp.UIResources/Strings.resx +++ b/vsintegration/src/FSharp.UIResources/Strings.resx @@ -231,9 +231,6 @@ Suggest names for unresolved identifiers - - (Preview) Use out of process language server - Text hover diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf index a9808062bd..da6e649a8b 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf @@ -202,11 +202,6 @@ Navrhovat názvy pro nerozpoznané identifikátory - - (Preview) Use out of process language server - (Preview) Použít mimoprocesový jazykový server - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf index 9e48372cb2..653c542d13 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf @@ -202,11 +202,6 @@ Namen für nicht aufgelöste Bezeichner vorschlagen - - (Preview) Use out of process language server - (Vorschauversion) Prozessexternen Sprachserver verwenden - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf index cd6b650ec6..39c2877127 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf @@ -202,11 +202,6 @@ Sugerir nombres para los identificadores no resueltos - - (Preview) Use out of process language server - (Versión preliminar) Usar el servidor de lenguaje fuera del proceso - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf index 90b7e5b378..3d73fe222b 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf @@ -202,11 +202,6 @@ Suggérer des noms pour les identificateurs non résolus - - (Preview) Use out of process language server - (Préversion) Utiliser un serveur de langage hors processus - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf index 51b5a87f28..34d9ec6702 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf @@ -202,11 +202,6 @@ Suggerisci nomi per gli identificatori non risolti - - (Preview) Use out of process language server - (Anteprima) Usa server di linguaggio out-of-process - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf index 7a59c8c4d3..5771c8c584 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf @@ -202,11 +202,6 @@ 未解決の識別子の名前を提案します - - (Preview) Use out of process language server - (プレビュー) プロセス外言語サーバーの使用 - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf index 8ba93bed1b..dacb999656 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf @@ -202,11 +202,6 @@ 확인되지 않은 식별자의 이름 제안 - - (Preview) Use out of process language server - (미리 보기) Out of Process 언어 서버 사용 - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf index 3d83c8f6ad..4a205499f2 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.pl.xlf @@ -202,11 +202,6 @@ Sugeruj nazwy w przypadku nierozpoznanych identyfikatorów - - (Preview) Use out of process language server - (Wersja zapoznawcza) Korzystanie z serwera języka poza procesem - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf index e3a75c3136..13cce041c9 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.pt-BR.xlf @@ -202,11 +202,6 @@ Sugerir nomes para identificadores não resolvidos - - (Preview) Use out of process language server - (Versão Prévia) Usar um servidor de idioma fora do processo - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf index 106dcd8b87..579c059dcd 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.ru.xlf @@ -202,11 +202,6 @@ Предлагать имена для неразрешенных идентификаторов - - (Preview) Use out of process language server - (Предварительная версия) Использование сервера языка процессов - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf index 8525295e6e..6ff42fad0e 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.tr.xlf @@ -202,11 +202,6 @@ Çözümlenmemiş tanımlayıcılar için ad öner - - (Preview) Use out of process language server - (Önizleme) İşlem dışı dil sunucusunu kullanma - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf index ff0bad3144..b85bb0227b 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hans.xlf @@ -202,11 +202,6 @@ 为未解析标识符建议名称 - - (Preview) Use out of process language server - (预览)使用进程外语言服务器 - - \ No newline at end of file diff --git a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf index 1edc051a59..acbacbce08 100644 --- a/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf +++ b/vsintegration/src/FSharp.UIResources/xlf/Strings.zh-Hant.xlf @@ -202,11 +202,6 @@ 為未解析的識別碼建議名稱 - - (Preview) Use out of process language server - (預覽) 使用處理序語言伺服器 - - \ No newline at end of file From 36d779983f60a9233ea386fc3731c42d15b4d44d Mon Sep 17 00:00:00 2001 From: "Brett V. Forsgren" Date: Wed, 22 Jan 2020 13:50:36 -0800 Subject: [PATCH 4/5] only dump package list if the run failed (#8320) --- azure-pipelines.yml | 25 +++++++++++++++---- .../DumpPackageRoot.csproj} | 6 ++++- 2 files changed, 25 insertions(+), 6 deletions(-) rename eng/{AfterSolutionBuild.targets => DumpPackageRoot/DumpPackageRoot.csproj} (86%) diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 131be207af..9388446102 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -187,6 +187,9 @@ stages: publishLocation: Container continueOnError: true condition: eq(variables['_testKind'], 'testFSharpQA') + - script: dotnet build $(Build.SourcesDirectory)/eng/DumpPackageRoot/DumpPackageRoot.csproj + displayName: Dump NuGet cache contents + condition: failed() - task: PublishBuildArtifacts@1 displayName: Publish NuGet cache contents inputs: @@ -194,7 +197,7 @@ stages: ArtifactName: 'NuGetPackageContents Windows $(_testKind)' publishLocation: Container continueOnError: true - condition: always() + condition: failed() # Linux - job: Linux @@ -216,6 +219,9 @@ stages: searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() + - script: dotnet build $(Build.SourcesDirectory)/eng/DumpPackageRoot/DumpPackageRoot.csproj + displayName: Dump NuGet cache contents + condition: failed() - task: PublishBuildArtifacts@1 displayName: Publish NuGet cache contents inputs: @@ -223,7 +229,7 @@ stages: ArtifactName: 'NuGetPackageContents Linux' publishLocation: Container continueOnError: true - condition: always() + condition: failed() # MacOS - job: MacOS @@ -245,6 +251,9 @@ stages: searchFolder: '$(Build.SourcesDirectory)/artifacts/TestResults/$(_BuildConfig)' continueOnError: true condition: always() + - script: dotnet build $(Build.SourcesDirectory)/eng/DumpPackageRoot/DumpPackageRoot.csproj + displayName: Dump NuGet cache contents + condition: failed() - task: PublishBuildArtifacts@1 displayName: Publish NuGet cache contents inputs: @@ -252,7 +261,7 @@ stages: ArtifactName: 'NuGetPackageContents Mac' publishLocation: Container continueOnError: true - condition: always() + condition: failed() # Source Build Linux - job: SourceBuild_Linux @@ -263,6 +272,9 @@ stages: clean: true - script: ./eng/cibuild.sh --configuration Release /p:DotNetBuildFromSource=true /p:FSharpSourceBuild=true displayName: Build + - script: dotnet build $(Build.SourcesDirectory)/eng/DumpPackageRoot/DumpPackageRoot.csproj + displayName: Dump NuGet cache contents + condition: failed() - task: PublishBuildArtifacts@1 displayName: Publish NuGet cache contents inputs: @@ -270,7 +282,7 @@ stages: ArtifactName: 'NuGetPackageContents SourceBuild_Linux' publishLocation: Container continueOnError: true - condition: always() + condition: failed() # Source Build Windows - job: SourceBuild_Windows @@ -281,6 +293,9 @@ stages: clean: true - script: eng\CIBuild.cmd -configuration Release -noSign /p:DotNetBuildFromSource=true /p:FSharpSourceBuild=true displayName: Build + - script: dotnet build $(Build.SourcesDirectory)/eng/DumpPackageRoot/DumpPackageRoot.csproj + displayName: Dump NuGet cache contents + condition: failed() - task: PublishBuildArtifacts@1 displayName: Publish NuGet cache contents inputs: @@ -288,7 +303,7 @@ stages: ArtifactName: 'NuGetPackageContents SourceBuild_Windows' publishLocation: Container continueOnError: true - condition: always() + condition: failed() # Up-to-date - job: UpToDate_Windows diff --git a/eng/AfterSolutionBuild.targets b/eng/DumpPackageRoot/DumpPackageRoot.csproj similarity index 86% rename from eng/AfterSolutionBuild.targets rename to eng/DumpPackageRoot/DumpPackageRoot.csproj index ffd633e4f9..c3b2cedf8f 100644 --- a/eng/AfterSolutionBuild.targets +++ b/eng/DumpPackageRoot/DumpPackageRoot.csproj @@ -1,7 +1,11 @@ - + + + netcoreapp3.1 + + From 4a95e6a6cdd245873d0157960211da79170fc98b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 22 Jan 2020 22:36:46 +0000 Subject: [PATCH 5/5] cleanup and alignment (#8319) * cleanup and alignment * cleanup and alignment * cleanup and alignment --- src/fsharp/ConstraintSolver.fs | 229 ++++++++++++++++++++------------- src/fsharp/TastOps.fs | 6 +- 2 files changed, 147 insertions(+), 88 deletions(-) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 59b10f7be7..92ae10cd75 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -291,6 +291,22 @@ let rec occursCheck g un ty = // Predicates on types //------------------------------------------------------------------------- +/// Some additional solutions are forced prior to generalization (permitWeakResolution=true). These are, roughly speaking, rules +/// for binary-operand constraints arising from constructs such as "1.0 + x" where "x" is an unknown type. THe constraint here +/// involves two type parameters - one for the left, and one for the right. The left is already known to be Double. +/// In this situation (and in the absence of other evidence prior to generalization), constraint solving forces an assumption that +/// the right is also Double - this is "weak" because there is only weak evidence for it. +/// +/// permitWeakResolution also applies to resolutions of multi-type-variable constraints via method overloads. Method overloading gets applied even if +/// only one of the two type variables is known. +/// +/// During code gen we run with permitWeakResolution on, but we only apply it where one of the argument types for the built-in constraint resolution is +/// a variable type. +type PermitWeakResolution = + | Yes + | No + member x.Permit = match x with Yes -> true | No -> false + let rec isNativeIntegerTy g ty = typeEquivAux EraseMeasures g g.nativeint_ty ty || typeEquivAux EraseMeasures g g.unativeint_ty ty || @@ -310,10 +326,10 @@ let isUnsignedIntegerTy g ty = typeEquivAux EraseMeasures g g.unativeint_ty ty || typeEquivAux EraseMeasures g g.uint64_ty ty -let rec isIntegerOrIntegerEnumTy g ty = +let rec IsIntegerOrIntegerEnumTy g ty = isSignedIntegerTy g ty || isUnsignedIntegerTy g ty || - (isEnumTy g ty && isIntegerOrIntegerEnumTy g (underlyingTypeOfEnumTy g ty)) + (isEnumTy g ty && IsIntegerOrIntegerEnumTy g (underlyingTypeOfEnumTy g ty)) let isIntegerTy g ty = isSignedIntegerTy g ty || @@ -334,7 +350,7 @@ let isFpTy g ty = let isDecimalTy g ty = typeEquivAux EraseMeasures g g.decimal_ty ty -let IsNonDecimalNumericOrIntegralEnumType g ty = isIntegerOrIntegerEnumTy g ty || isFpTy g ty +let IsNonDecimalNumericOrIntegralEnumType g ty = IsIntegerOrIntegerEnumTy g ty || isFpTy g ty let IsNumericOrIntegralEnumType g ty = IsNonDecimalNumericOrIntegralEnumType g ty || isDecimalTy g ty @@ -353,6 +369,28 @@ let GetMeasureOfType g ty = | _ -> None | _ -> None +let IsCharOrStringType g ty = isCharTy g ty || isStringTy g ty + +/// Checks the argument type for a built-in solution to an op_Addition, op_Subtraction or op_Modulus constraint. +let IsAddSubModType nm g ty = IsNumericOrIntegralEnumType g ty || (nm = "op_Addition" && IsCharOrStringType g ty) + +/// Checks the argument type for a built-in solution to a bitwise operator constraint +let IsBitwiseOpType g ty = IsIntegerOrIntegerEnumTy g ty || (isEnumTy g ty) + +/// Check the other type in a built-in solution for a binary operator. +/// For weak resolution, require a relevant primitive on one side. +/// For strong resolution, a variable type is permitted. +let IsBinaryOpOtherArgType g permitWeakResolution ty = + match permitWeakResolution with + | PermitWeakResolution.No -> + not (isTyparTy g ty) + + | PermitWeakResolution.Yes -> true + +/// Checks the argument type for a built-in solution to a get_Sign constraint. +let IsSignType g ty = + isSignedIntegerTy g ty || isFpTy g ty || isDecimalTy g ty + type TraitConstraintSolution = | TTraitUnsolved | TTraitBuiltIn @@ -819,10 +857,12 @@ let rec SolveTyparEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optio // Only solve constraints if this is not an error var if r.IsFromError then () else + // Check to see if this type variable is relevant to any trait constraints. // If so, re-solve the relevant constraints. if csenv.SolverState.ExtraCxs.ContainsKey r.Stamp then - do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep false trace r) + do! RepeatWhileD ndeep (fun ndeep -> SolveRelevantMemberConstraintsForTypar csenv ndeep PermitWeakResolution.No trace r) + // Re-solve the other constraints associated with this type variable return! solveTypMeetsTyparConstraints csenv ndeep m2 trace ty r @@ -867,7 +907,7 @@ and solveTypMeetsTyparConstraints (csenv: ConstraintSolverEnv) ndeep m2 trace ty | TyparConstraint.SimpleChoice(tys, m2) -> SolveTypeChoice csenv ndeep m2 trace ty tys | TyparConstraint.CoercesTo(ty2, m2) -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m2 trace None ty2 ty | TyparConstraint.MayResolveMember(traitInfo, m2) -> - SolveMemberConstraint csenv false false ndeep m2 trace traitInfo |> OperationResult.ignore + SolveMemberConstraint csenv false PermitWeakResolution.No ndeep m2 trace traitInfo |> OperationResult.ignore } @@ -1136,16 +1176,9 @@ and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty /// don't. The type-directed static optimization rules in the library code that makes use of this /// will deal with the problem. /// -/// 2. Some additional solutions are forced prior to generalization (permitWeakResolution=true). These are, roughly speaking, rules -/// for binary-operand constraints arising from constructs such as "1.0 + x" where "x" is an unknown type. THe constraint here -/// involves two type parameters - one for the left, and one for the right. The left is already known to be Double. -/// In this situation (and in the absence of other evidence prior to generalization), constraint solving forces an assumption that -/// the right is also Double - this is "weak" because there is only weak evidence for it. -/// -/// permitWeakResolution also applies to resolutions of multi-type-variable constraints via method overloads. Method overloading gets applied even if -/// only one of the two type variables is known -/// -and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace (TTrait(tys, nm, memFlags, argtys, rty, sln)): OperationResult = trackErrors { +/// 2. Some additional solutions are forced prior to generalization (permitWeakResolution= Yes or YesDuringCodeGen). See above +and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace traitInfo : OperationResult = trackErrors { + let (TTrait(tys, nm, memFlags, traitObjAndArgTys, rty, sln)) = traitInfo // Do not re-solve if already solved if sln.Value.IsSome then return true else let g = csenv.g @@ -1158,20 +1191,21 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // Remove duplicates from the set of types in the support let tys = ListSet.setify (typeAEquiv g aenv) tys + // Rebuild the trait info after removing duplicates - let traitInfo = TTrait(tys, nm, memFlags, argtys, rty, sln) + let traitInfo = TTrait(tys, nm, memFlags, traitObjAndArgTys, rty, sln) let rty = GetFSharpViewOfReturnType g rty // Assert the object type if the constraint is for an instance member if memFlags.IsInstance then - match tys, argtys with + match tys, traitObjAndArgTys with | [ty], (h :: _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) // Trait calls are only supported on pseudo type (variables) for e in tys do do! SolveTypStaticReq csenv trace HeadTypeStaticReq e - let argtys = if memFlags.IsInstance then List.tail argtys else argtys + let argtys = if memFlags.IsInstance then List.tail traitObjAndArgTys else traitObjAndArgTys let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo @@ -1205,11 +1239,9 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // decimal<'u> * 'a (let checkRuleAppliesInPreferenceToMethods argty1 argty2 = // Check that at least one of the argument types is numeric - (IsNumericOrIntegralEnumType g argty1) && - // Check that the support of type variables is empty. That is, - // if we're canonicalizing, then having one of the types nominal is sufficient. - // If not, then both must be nominal (i.e. not a type variable). - (permitWeakResolution || not (isTyparTy g argty2)) && + IsNumericOrIntegralEnumType g argty1 && + // Check the other type is nominal, unless using weak resolution + IsBinaryOpOtherArgType g permitWeakResolution argty2 && // This next condition checks that either // - Neither type contributes any methods OR // - We have the special case "decimal<_> * decimal". In this case we have some @@ -1244,8 +1276,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argty1;argty2] when // Ignore any explicit +/- overloads from any basic integral types (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( (IsNumericOrIntegralEnumType g argty1 || (nm = "op_Addition" && (isCharTy g argty1 || isStringTy g argty1))) && (permitWeakResolution || not (isTyparTy g argty2)) - || (IsNumericOrIntegralEnumType g argty2 || (nm = "op_Addition" && (isCharTy g argty2 || isStringTy g argty2))) && (permitWeakResolution || not (isTyparTy g argty1)))) -> + ( IsAddSubModType nm g argty1 && IsBinaryOpOtherArgType g permitWeakResolution argty2 + || IsAddSubModType nm g argty2 && IsBinaryOpOtherArgType g permitWeakResolution argty1)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 return TTraitBuiltIn @@ -1253,8 +1285,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argty1;argty2] when // Ignore any explicit overloads from any basic integral types (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( (IsRelationalType g argty1 && (permitWeakResolution || not (isTyparTy g argty2))) - || (IsRelationalType g argty2 && (permitWeakResolution || not (isTyparTy g argty1))))) -> + ( IsRelationalType g argty1 && IsBinaryOpOtherArgType g permitWeakResolution argty2 + || IsRelationalType g argty2 && IsBinaryOpOtherArgType g permitWeakResolution argty1)) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty g.bool_ty return TTraitBuiltIn @@ -1272,21 +1304,21 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty ty return TTraitBuiltIn - | [], _, false, ("DivideByInt"), [argty1;argty2] + | [], _, false, "DivideByInt", [argty1;argty2] when isFpTy g argty1 || isDecimalTy g argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 return TTraitBuiltIn // We pretend for uniformity that the 'string' and 'array' types have an indexer property called 'Item' - | [], [ty], true, ("get_Item"), [argty1] + | [], [ty], true, "get_Item", [argty1] when isStringTy g ty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty1 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty g.char_ty return TTraitBuiltIn - | [], [ty], true, ("get_Item"), argtys + | [], [ty], true, "get_Item", argtys when isArrayTy g ty -> if rankOfArrayTy g ty <> argtys.Length then do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argtys.Length), m, m2)) @@ -1296,7 +1328,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty ety return TTraitBuiltIn - | [], [ty], true, ("set_Item"), argtys + | [], [ty], true, "set_Item", argtys when isArrayTy g ty -> if rankOfArrayTy g ty <> argtys.Length - 1 then do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argtys.Length - 1)), m, m2)) @@ -1308,8 +1340,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn | [], _, false, ("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"), [argty1;argty2] - when (isIntegerOrIntegerEnumTy g argty1 || (isEnumTy g argty1)) && (permitWeakResolution || not (isTyparTy g argty2)) - || (isIntegerOrIntegerEnumTy g argty2 || (isEnumTy g argty2)) && (permitWeakResolution || not (isTyparTy g argty1)) -> + when IsBitwiseOpType g argty1 && IsBinaryOpOtherArgType g permitWeakResolution argty2 + || IsBitwiseOpType g argty2 && IsBinaryOpOtherArgType g permitWeakResolution argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 @@ -1317,39 +1349,39 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn | [], _, false, ("op_LeftShift" | "op_RightShift"), [argty1;argty2] - when isIntegerOrIntegerEnumTy g argty1 -> + when IsIntegerOrIntegerEnumTy g argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 g.int_ty do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 do! SolveDimensionlessNumericType csenv ndeep m2 trace argty1 return TTraitBuiltIn - | _, _, false, ("op_UnaryPlus"), [argty] + | _, _, false, "op_UnaryPlus", [argty] when IsNumericOrIntegralEnumType g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty return TTraitBuiltIn - | _, _, false, ("op_UnaryNegation"), [argty] + | _, _, false, "op_UnaryNegation", [argty] when isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty return TTraitBuiltIn - | _, _, true, ("get_Sign"), [] - when (let argty = tys.Head in isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty) -> + | _, _, true, "get_Sign", [] + when IsSignType g tys.Head -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty g.int32_ty return TTraitBuiltIn | _, _, false, ("op_LogicalNot" | "op_OnesComplement"), [argty] - when isIntegerOrIntegerEnumTy g argty -> + when IsIntegerOrIntegerEnumTy g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty do! SolveDimensionlessNumericType csenv ndeep m2 trace argty return TTraitBuiltIn - | _, _, false, ("Abs"), [argty] + | _, _, false, "Abs", [argty] when isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty @@ -1374,7 +1406,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty return TTraitBuiltIn - | _, _, false, ("op_Explicit"), [argty] + | _, _, false, "op_Explicit", [argty] when (// The input type. (IsNonDecimalNumericOrIntegralEnumType g argty || isStringTy g argty || isCharTy g argty) && // The output type @@ -1387,7 +1419,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload return TTraitBuiltIn - | _, _, false, ("op_Explicit"), [argty] + | _, _, false, "op_Explicit", [argty] when (// The input type. (IsNumericOrIntegralEnumType g argty || isStringTy g argty) && // The output type @@ -1403,7 +1435,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace rty argty1 return TTraitBuiltIn - | _, _, false, ("Atan2"), [argty1; argty2] + | _, _, false, "Atan2", [argty1; argty2] when isFpTy g argty1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argty2 argty1 match GetMeasureOfType g argty1 with @@ -1534,7 +1566,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // If there's nothing left to learn then raise the errors. // Note: we should likely call MemberConstraintIsReadyForResolution here when permitWeakResolution=false but for stability // reasons we use the more restrictive isNil frees. - if (permitWeakResolution && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then + if (permitWeakResolution.Permit && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then do! errors // Otherwise re-record the trait waiting for canonicalization else @@ -1587,10 +1619,13 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = let mref = IL.mkRefToILMethod (ilMeth.DeclaringTyconRef.CompiledRepresentationForNamedType, ilMeth.RawMetadata) let iltref = ilMeth.ILExtensionMethodDeclaringTyconRef |> Option.map (fun tcref -> tcref.CompiledRepresentationForNamedType) ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst) + | FSMeth(_, ty, vref, _) -> FSMethSln(ty, vref, minst) + | MethInfo.DefaultStructCtor _ -> error(InternalError("the default struct constructor was the unexpected solution to a trait constraint", m)) + #if !NO_EXTENSIONTYPING | ProvidedMeth(amap, mi, _, m) -> let g = amap.g @@ -1599,6 +1634,7 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = let objArgVars, objArgs = (if minfo.IsInstance then [mkLocal m "this" minfo.ApparentEnclosingType] else []) |> List.unzip let callMethInfoOpt, callExpr, callExprTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) let closedExprSln = ClosedExprSln (mkLambdas m [] (objArgVars@allArgVars) (callExpr, callExprTy) ) + // If the call is a simple call to an IL method with all the arguments in the natural order, then revert to use ILMethSln. // This is important for calls to operators on generated provided types. There is an (unchecked) condition // that generative providers do not re=order arguments or insert any more information into operator calls. @@ -1623,9 +1659,9 @@ and TransactMemberConstraintSolution traitInfo (trace: OptionalTrace) sln = /// Only consider overload resolution if canonicalizing or all the types are now nominal. /// That is, don't perform resolution if more nominal information may influence the set of available overloads -and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) permitWeakResolution nm (TTrait(tys, _, memFlags, argtys, rty, soln) as traitInfo): MethInfo list = +and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolution: PermitWeakResolution) nm (TTrait(tys, _, memFlags, argtys, rty, soln) as traitInfo): MethInfo list = let results = - if permitWeakResolution || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then + if permitWeakResolution.Permit || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then let m = csenv.m let minfos = match memFlags.MemberKind with @@ -1647,6 +1683,7 @@ and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) permitWeakResolution |> List.exists (fun minfo2 -> MethInfosEquivByNameAndSig EraseAll true csenv.g csenv.amap m minfo2 minfo1))) else [] + // The trait name "op_Explicit" also covers "op_Implicit", so look for that one too. if nm = "op_Explicit" then results @ GetRelevantMethodsForTrait csenv permitWeakResolution "op_Implicit" (TTrait(tys, "op_Implicit", memFlags, argtys, rty, soln)) @@ -1711,9 +1748,9 @@ and SolveRelevantMemberConstraintsForTypar (csenv: ConstraintSolverEnv) ndeep pe SolveMemberConstraint csenv true permitWeakResolution (ndeep+1) m2 trace traitInfo) and CanonicalizeRelevantMemberConstraints (csenv: ConstraintSolverEnv) ndeep trace tps = - SolveRelevantMemberConstraints csenv ndeep true trace tps + SolveRelevantMemberConstraints csenv ndeep PermitWeakResolution.Yes trace tps -and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace traitInfo support frees = +and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) traitInfo support (frees: Typar list) = let g = csenv.g let aenv = csenv.EquivEnv let cxst = csenv.SolverState.ExtraCxs @@ -2856,7 +2893,7 @@ let AddCxMethodConstraint denv css m trace traitInfo = (fun () -> trackErrors { do! - SolveMemberConstraint csenv true false 0 m trace traitInfo + SolveMemberConstraint csenv true PermitWeakResolution.No 0 m trace traitInfo |> OperationResult.ignore }) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) @@ -2963,33 +3000,42 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra InfoReader = new InfoReader(g, amap) } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true true 0 m NoTrace traitInfo + + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo + let sln = - match traitInfo.Solution with - | None -> Choice5Of5() - | Some sln -> - match sln with - | ILMethSln(origTy, extOpt, mref, minst) -> - let metadataTy = convertToTypeWithMetadataIfPossible g origTy - let tcref = tcrefOfAppTy g metadataTy - let mdef = IL.resolveILMethodRef tcref.ILTyconRawMetadata mref - let ilMethInfo = - match extOpt with - | None -> MethInfo.CreateILMeth(amap, m, origTy, mdef) - | Some ilActualTypeRef -> - let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef - MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef) - Choice1Of5 (ilMethInfo, minst) - | FSMethSln(ty, vref, minst) -> - Choice1Of5 (FSMeth(g, ty, vref, None), minst) - | FSRecdFieldSln(tinst, rfref, isSetProp) -> - Choice2Of5 (tinst, rfref, isSetProp) - | FSAnonRecdFieldSln(anonInfo, tinst, i) -> - Choice3Of5 (anonInfo, tinst, i) - | BuiltInSln -> - Choice5Of5 () - | ClosedExprSln expr -> - Choice4Of5 expr + match traitInfo.Solution with + | None -> Choice5Of5() + | Some sln -> + + // Given the solution information, reconstruct the MethInfo for the solution + match sln with + | ILMethSln(origTy, extOpt, mref, minst) -> + let metadataTy = convertToTypeWithMetadataIfPossible g origTy + let tcref = tcrefOfAppTy g metadataTy + let mdef = IL.resolveILMethodRef tcref.ILTyconRawMetadata mref + let ilMethInfo = + match extOpt with + | None -> MethInfo.CreateILMeth(amap, m, origTy, mdef) + | Some ilActualTypeRef -> + let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef + MethInfo.CreateILExtensionMeth(amap, m, origTy, actualTyconRef, None, mdef) + Choice1Of5 (ilMethInfo, minst) + + | FSMethSln(ty, vref, minst) -> + Choice1Of5 (FSMeth(g, ty, vref, None), minst) + + | FSRecdFieldSln(tinst, rfref, isSetProp) -> + Choice2Of5 (tinst, rfref, isSetProp) + + | FSAnonRecdFieldSln(anonInfo, tinst, i) -> + Choice3Of5 (anonInfo, tinst, i) + + | BuiltInSln -> + Choice5Of5 () + + | ClosedExprSln expr -> + Choice4Of5 expr return! match sln with | Choice1Of5(minfo, methArgTys) -> @@ -3026,19 +3072,27 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra | Choice2Of5 (tinst, rfref, isSet) -> let res = match isSet, rfref.RecdField.IsStatic, argExprs.Length with + + // static setter | true, true, 1 -> - Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m)) + Some (mkStaticRecdFieldSet (rfref, tinst, argExprs.[0], m)) + + // instance setter | true, false, 2 -> - // If we resolve to an instance field on a struct and we haven't yet taken - // the address of the object then go do that - if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then - let h = List.head argExprs - let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false DefinitelyMutates h None m - Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m))) - else - Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m)) + // If we resolve to an instance field on a struct and we haven't yet taken + // the address of the object then go do that + if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then + let h = List.head argExprs + let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false DefinitelyMutates h None m + Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m))) + else + Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m)) + + // static getter | false, true, 0 -> Some (mkStaticRecdFieldGet (rfref, tinst, m)) + + // instance getter | false, false, 1 -> if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs.[0]) then Some (mkRecdFieldGetViaExprAddr (argExprs.[0], rfref, tinst, m)) @@ -3046,6 +3100,7 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra Some (mkRecdFieldGet g (argExprs.[0], rfref, tinst, m)) | _ -> None ResultD res + | Choice3Of5 (anonInfo, tinst, i) -> let res = let tupInfo = anonInfo.TupInfo @@ -3055,9 +3110,11 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra Some (mkAnonRecdFieldGet g (anonInfo, argExprs.[0], tinst, i, m)) ResultD res - | Choice4Of5 expr -> ResultD (Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m))) + | Choice4Of5 expr -> + ResultD (Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m))) - | Choice5Of5 () -> ResultD None + | Choice5Of5 () -> + ResultD None } let ChooseTyparSolutionAndSolve css denv tp = diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 3d474dadbc..9c08ef934f 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -248,12 +248,14 @@ and remapTyparConstraintsAux tyenv cs = Some(TyparConstraint.CoercesTo (remapTypeAux tyenv ty, m)) | TyparConstraint.MayResolveMember(traitInfo, m) -> Some(TyparConstraint.MayResolveMember (remapTraitAux tyenv traitInfo, m)) - | TyparConstraint.DefaultsTo(priority, ty, m) -> Some(TyparConstraint.DefaultsTo(priority, remapTypeAux tyenv ty, m)) + | TyparConstraint.DefaultsTo(priority, ty, m) -> + Some(TyparConstraint.DefaultsTo(priority, remapTypeAux tyenv ty, m)) | TyparConstraint.IsEnum(uty, m) -> Some(TyparConstraint.IsEnum(remapTypeAux tyenv uty, m)) | TyparConstraint.IsDelegate(uty1, uty2, m) -> Some(TyparConstraint.IsDelegate(remapTypeAux tyenv uty1, remapTypeAux tyenv uty2, m)) - | TyparConstraint.SimpleChoice(tys, m) -> Some(TyparConstraint.SimpleChoice(remapTypesAux tyenv tys, m)) + | TyparConstraint.SimpleChoice(tys, m) -> + Some(TyparConstraint.SimpleChoice(remapTypesAux tyenv tys, m)) | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _