Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 21 additions & 7 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4759,23 +4759,37 @@ and CrackStaticConstantArgs (cenv: cenv) env tpenv (staticParameters: Tainted<Pr
error (Error(FSComp.SR.etTooManyStaticParameters(staticParameters.Length, unnamedArgs.Length, namedArgs.Length), m))

let argsInStaticParameterOrderIncludingDefaults =
let adjustRangeForQuotes (arg: SynType) =
match arg with
| SynType.StaticConstant (SynConst.String (_, kind, m), _) ->
let startOffset, endOffset =
match kind with
| SynStringKind.Regular -> 1, 1
| SynStringKind.Verbatim -> 2, 1
| SynStringKind.TripleQuote -> 3, 3
Comment on lines +4766 to +4769
Copy link
Contributor Author

@kerams kerams Dec 17, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Triple quoted verbatim strings do not have their own kind, so the diagnostic range becomes off by one. Not sure it's worth adding, they are fairly rare.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@abonie : I assume you plan to touch the parsing and tree representation of string kinds anyway, could you account for this as well please?
i.e. the ability to cover the range(s) involved precisely, and perharps even Trivia(s) to give ranges per line in case of multiline strings.


mkFileIndexRange m.FileIndex (mkPos m.StartLine (m.StartColumn + startOffset)) (mkPos m.EndLine (m.EndColumn - endOffset))
|> Some
| _ ->
None

staticParameters |> Array.mapi (fun i sp ->
let spKind = Import.ImportProvidedType cenv.amap m (sp.PApply((fun x -> x.ParameterType), m))
let spName = sp.PUntaint((fun sp -> sp.Name), m)
if i < unnamedArgs.Length then
let v = unnamedArgs[i]
let v, _tpenv = TcStaticConstantParameter cenv env tpenv spKind v None container
v
let arg = unnamedArgs[i]
let v, _tpenv = TcStaticConstantParameter cenv env tpenv spKind arg None container
{ Name = spName; Value = v; ValueRange = arg.Range; ValueRangeAdjusted = adjustRangeForQuotes arg }
else
match namedArgs |> List.filter (fun (n, _) -> n.idText = spName) with
| [(n, v)] ->
let v, _tpenv = TcStaticConstantParameter cenv env tpenv spKind v (Some n) container
v
| [(n, arg)] ->
let v, _tpenv = TcStaticConstantParameter cenv env tpenv spKind arg (Some n) container
{ Name = spName; Value = v; ValueRange = arg.Range; ValueRangeAdjusted = adjustRangeForQuotes arg }
| [] ->
if sp.PUntaint((fun sp -> sp.IsOptional), m) then
match sp.PUntaint((fun sp -> sp.RawDefaultValue), m) with
| Null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m))
| NonNull v -> v
| NonNull v -> { Name = spName; Value = v; ValueRange = range0; ValueRangeAdjusted = None }
else
error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m))
| ps ->
Expand Down
2 changes: 2 additions & 0 deletions src/Compiler/FSComp.txt
Original file line number Diff line number Diff line change
Expand Up @@ -1236,6 +1236,8 @@ invalidFullNameForProvidedType,"invalid full name for provided type"
3085,tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings,"A custom operation may not be used in conjunction with a non-value or recursive 'let' binding in another part of this computation expression"
3086,tcCustomOperationMayNotBeUsedHere,"A custom operation may not be used in conjunction with 'use', 'try/with', 'try/finally', 'if/then/else' or 'match' operators within this computation expression"
3087,tcCustomOperationMayNotBeOverloaded,"The custom operation '%s' refers to a method which is overloaded. The implementations of custom operations may not be overloaded."
3088,etProviderWarning,"The type provider '%s' reported a warning: %s"
3089,etProviderInformational,"The type provider '%s' reported an informational warning: %s"
featureOverloadsForCustomOperations,"overloads for custom operations"
featureExpandedMeasurables,"more types support units of measure"
featurePrintfBinaryFormat,"binary formatting for integers"
Expand Down
114 changes: 80 additions & 34 deletions src/Compiler/TypedTree/TypeProviders.fs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.Syntax
open FSharp.Compiler.Text
open FSharp.Compiler.Text.Position
open FSharp.Compiler.Text.Range

type TypeProviderDesignation = TypeProviderDesignation of string
Expand Down Expand Up @@ -412,8 +413,12 @@ type ProvidedType (x: Type, ctxt: ProvidedTypeContext) =

member _.GetGenericArguments() = x.GetGenericArguments() |> ProvidedType.CreateArray ctxt

member _.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[]) =
provider.ApplyStaticArguments(x, fullTypePathAfterArguments, staticArgs) |> ProvidedType.Create ctxt
member _.ApplyStaticArguments(provider: ITypeProvider, fullTypePathAfterArguments, staticArgs: obj[], diagnosticsContext: ITypeProviderDiagnosticsContext) =
match provider with
| (:? ITypeProvider3 as provider) ->
provider.ApplyStaticArguments(diagnosticsContext, x, fullTypePathAfterArguments, staticArgs) |> ProvidedType.Create ctxt
| _ ->
provider.ApplyStaticArguments(x, fullTypePathAfterArguments, staticArgs) |> ProvidedType.Create ctxt

member _.IsVoid = (Type.op_Equality(x, typeof<Void>) || (x.Namespace = "System" && x.Name = "Void"))

Expand Down Expand Up @@ -625,6 +630,38 @@ type ProvidedAssembly (x: Assembly) =

override _.GetHashCode() = assert false; x.GetHashCode()

[<NoComparison; NoEquality>]
type CrackedStaticArgument = {
Name: string
Value: obj
ValueRange: range
/// Range stripped of quotes if the argument is a string constant
ValueRangeAdjusted: range option
}

type TypeProviderDiagnosticsContext (staticArgs: CrackedStaticArgument[], tpDesignation, fallbackRange) =
interface ITypeProviderDiagnosticsContext with
member _.ReportDiagnostic (staticParameterName, rangeInParameterIfString, message, severity) =
let m =
match staticArgs |> Array.tryFind (fun x -> x.Name = staticParameterName) with
| Some x when x.ValueRange <> range0 ->
match x.ValueRangeAdjusted, rangeInParameterIfString with
| Some m, Some (startPosition, endPosition) when startPosition < endPosition && startPosition >= 0 ->
// todo highlighted range spanning multiple lines :/
mkFileIndexRange m.FileIndex (mkPos m.StartLine (m.StartColumn + startPosition)) (mkPos m.EndLine (m.StartColumn + endPosition))
| _ ->
x.ValueRange
| _ ->
fallbackRange

match severity with
| TypeProviderDiagnosticSeverity.Informational ->
Error (FSComp.SR.etProviderInformational (tpDesignation, message), m) |> informationalWarning
| TypeProviderDiagnosticSeverity.Warning ->
Error (FSComp.SR.etProviderWarning (tpDesignation, message), m) |> warning
| TypeProviderDiagnosticSeverity.Error ->
stopProcessingRecovery (Error (FSComp.SR.etProviderError (tpDesignation, message), m)) m
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

stopProcessingRecovery allows the TP to continue, but when I tried to use Error, which does take the control away, the diagnostic gets wrapped in additional exception, and the entire TP range gets a squiggly line, hiding what was meant to be highlighted. Not sure how to avoid that.


[<AllowNullLiteral; AbstractClass>]
type ProvidedMethodBase (x: MethodBase, ctxt) =
inherit ProvidedMemberInfo(x, ctxt)
Expand Down Expand Up @@ -686,15 +723,18 @@ type ProvidedMethodBase (x: MethodBase, ctxt) =

staticParams |> ProvidedParameterInfo.CreateArray ctxt

member _.ApplyStaticArgumentsForMethod(provider: ITypeProvider, fullNameAfterArguments: string, staticArgs: obj[]) =
member _.ApplyStaticArgumentsForMethod(provider: ITypeProvider, fullNameAfterArguments: string, staticArgs: CrackedStaticArgument[], tpDesignation, m) =
let bindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.InvokeMethod
let staticArgValues = staticArgs |> Array.map (fun x -> x.Value)

let mb =
match provider with
| :? ITypeProvider3 as itp3 ->
let ctx = TypeProviderDiagnosticsContext (staticArgs, tpDesignation, m)
itp3.ApplyStaticArgumentsForMethod(ctx, x, fullNameAfterArguments, staticArgValues)
| :? ITypeProvider2 as itp2 ->
itp2.ApplyStaticArgumentsForMethod(x, fullNameAfterArguments, staticArgs)
itp2.ApplyStaticArgumentsForMethod(x, fullNameAfterArguments, staticArgValues)
| _ ->

// To allow a type provider to depend only on FSharp.Core 4.3.0.0, it can alternatively implement a method called GetStaticParametersForMethod
let meth =
provider.GetType().GetMethod( "ApplyStaticArgumentsForMethod", bindingFlags, null,
Expand All @@ -704,7 +744,7 @@ type ProvidedMethodBase (x: MethodBase, ctxt) =
| null -> failwith (FSComp.SR.estApplyStaticArgumentsForMethodNotImplemented())
| _ ->
let mbAsObj =
try meth.Invoke(provider, bindingFlags ||| BindingFlags.InvokeMethod, null, [| box x; box fullNameAfterArguments; box staticArgs |], null)
try meth.Invoke(provider, bindingFlags ||| BindingFlags.InvokeMethod, null, [| box x; box fullNameAfterArguments; box staticArgValues |], null)
with err -> raise (StripException (StripException err))

match mbAsObj with
Expand Down Expand Up @@ -1194,38 +1234,40 @@ let ILPathToProvidedType (st: Tainted<ProvidedType>, m) =

encContrib st, nameContrib st

let ComputeMangledNameForApplyStaticParameters(nm, staticArgs, staticParams: Tainted<ProvidedParameterInfo[]>, m) =
let ComputeMangledNameForApplyStaticParameters(nm, staticArgs: obj[], staticParams: Tainted<ProvidedParameterInfo[]>, m) =
let defaultArgValues =
staticParams.PApply((fun ps -> ps |> Array.map (fun sp -> sp.Name, (if sp.IsOptional then Some (string sp.RawDefaultValue) else None ))), range=m)
staticParams.PApply((fun ps -> ps |> Array.map (fun sp -> sp.Name, (if sp.IsOptional then Some (string sp.RawDefaultValue) else None ))), range = m)

let defaultArgValues = defaultArgValues.PUntaint(id, m)
PrettyNaming.ComputeMangledNameWithoutDefaultArgValues(nm, staticArgs, defaultArgValues)

/// Apply the given provided method to the given static arguments (the arguments are assumed to have been sorted into application order)
let TryApplyProvidedMethod(methBeforeArgs: Tainted<ProvidedMethodBase>, staticArgs: obj[], m: range) =
let TryApplyProvidedMethod(methBeforeArgs: Tainted<ProvidedMethodBase>, staticArgs: CrackedStaticArgument[], m: range) =
if staticArgs.Length = 0 then
Some methBeforeArgs
else
let staticArgValues = staticArgs |> Array.map (fun x -> x.Value)

let mangledName =
let nm = methBeforeArgs.PUntaint((fun x -> x.Name), m)
let staticParams = methBeforeArgs.PApplyWithProvider((fun (mb, resolver) -> mb.GetStaticParametersForMethod resolver), range=m)
let mangledName = ComputeMangledNameForApplyStaticParameters(nm, staticArgs, staticParams, m)
let staticParams = methBeforeArgs.PApplyWithProvider((fun (mb, resolver) -> mb.GetStaticParametersForMethod resolver), range = m)
let mangledName = ComputeMangledNameForApplyStaticParameters(nm, staticArgValues, staticParams, m)
mangledName

match methBeforeArgs.PApplyWithProvider((fun (mb, provider) -> mb.ApplyStaticArgumentsForMethod(provider, mangledName, staticArgs)), range=m) with
match methBeforeArgs.PApplyWithProvider((fun (mb, provider) -> mb.ApplyStaticArgumentsForMethod(provider, mangledName, staticArgs, methBeforeArgs.TypeProviderDesignation, m)), range = m) with
| Tainted.Null -> None
| Tainted.NonNull methWithArguments ->
let actualName = methWithArguments.PUntaint((fun x -> x.Name), m)
if actualName <> mangledName then
error(Error(FSComp.SR.etProvidedAppliedMethodHadWrongName(methWithArguments.TypeProviderDesignation, mangledName, actualName), m))
Some methWithArguments


/// Apply the given provided type to the given static arguments (the arguments are assumed to have been sorted into application order
let TryApplyProvidedType(typeBeforeArguments: Tainted<ProvidedType>, optGeneratedTypePath: string list option, staticArgs: obj[], m: range) =
let TryApplyProvidedType(typeBeforeArguments: Tainted<ProvidedType>, optGeneratedTypePath: string list option, staticArgs: CrackedStaticArgument[], m: range) =
if staticArgs.Length = 0 then
Some (typeBeforeArguments, (fun () -> ()))
else
let staticArgValues = staticArgs |> Array.map (fun x -> x.Value)

let fullTypePathAfterArguments =
// If there is a generated type name, then use that
Expand All @@ -1236,10 +1278,12 @@ let TryApplyProvidedType(typeBeforeArguments: Tainted<ProvidedType>, optGenerate
let nm = typeBeforeArguments.PUntaint((fun x -> x.Name), m)
let enc, _ = ILPathToProvidedType (typeBeforeArguments, m)
let staticParams = typeBeforeArguments.PApplyWithProvider((fun (mb, resolver) -> mb.GetStaticParameters resolver), range=m)
let mangledName = ComputeMangledNameForApplyStaticParameters(nm, staticArgs, staticParams, m)
let mangledName = ComputeMangledNameForApplyStaticParameters(nm, staticArgValues, staticParams, m)
enc @ [ mangledName ]

let ctx = TypeProviderDiagnosticsContext (staticArgs, typeBeforeArguments.TypeProviderDesignation, m)

match typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.ApplyStaticArguments(provider, Array.ofList fullTypePathAfterArguments, staticArgs)), range=m) with
match typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.ApplyStaticArguments(provider, Array.ofList fullTypePathAfterArguments, staticArgValues, ctx)), range=m) with
| Tainted.Null -> None
| Tainted.NonNull typeWithArguments ->
let actualName = typeWithArguments.PUntaint((fun x -> x.Name), m)
Expand Down Expand Up @@ -1287,28 +1331,30 @@ let TryLinkProvidedType(resolver: Tainted<ITypeProvider>, moduleOrNamespace: str
let uet = if pt.IsEnum then pt.GetEnumUnderlyingType() else pt
uet.FullName), range)

match spReprTypeName with
| "System.SByte" -> box (sbyte arg)
| "System.Int16" -> box (int16 arg)
| "System.Int32" -> box (int32 arg)
| "System.Int64" -> box (int64 arg)
| "System.Byte" -> box (byte arg)
| "System.UInt16" -> box (uint16 arg)
| "System.UInt32" -> box (uint32 arg)
| "System.UInt64" -> box (uint64 arg)
| "System.Decimal" -> box (decimal arg)
| "System.Single" -> box (single arg)
| "System.Double" -> box (double arg)
| "System.Char" -> box (char arg)
| "System.Boolean" -> box (arg = "True")
| "System.String" -> box (string arg)
| s -> error(Error(FSComp.SR.etUnknownStaticArgumentKind(s, typeLogicalName), range0))

let v =
match spReprTypeName with
| "System.SByte" -> box (sbyte arg)
| "System.Int16" -> box (int16 arg)
| "System.Int32" -> box (int32 arg)
| "System.Int64" -> box (int64 arg)
| "System.Byte" -> box (byte arg)
| "System.UInt16" -> box (uint16 arg)
| "System.UInt32" -> box (uint32 arg)
| "System.UInt64" -> box (uint64 arg)
| "System.Decimal" -> box (decimal arg)
| "System.Single" -> box (single arg)
| "System.Double" -> box (double arg)
| "System.Char" -> box (char arg)
| "System.Boolean" -> box (arg = "True")
| "System.String" -> box (string arg)
| s -> error(Error(FSComp.SR.etUnknownStaticArgumentKind(s, typeLogicalName), range0))

{ Name = spName; Value = v; ValueRange = range0; ValueRangeAdjusted = None }
| _ ->
if sp.PUntaint ((fun sp -> sp.IsOptional), range) then
match sp.PUntaint((fun sp -> sp.RawDefaultValue), range) with
| Null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, typeBeforeArgumentsName, typeBeforeArgumentsName, spName), range0))
| NonNull v -> v
| NonNull v -> { Name = spName; Value = v; ValueRange = range0; ValueRangeAdjusted = None }
else
error(Error(FSComp.SR.etProvidedTypeReferenceMissingArgument spName, range0)))

Expand Down
13 changes: 11 additions & 2 deletions src/Compiler/TypedTree/TypeProviders.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -439,6 +439,15 @@ type ProvidedVar =

override GetHashCode: unit -> int

[<NoComparison; NoEquality>]
type CrackedStaticArgument = {
Name: string
Value: obj
ValueRange: range
/// Range stripped of quotes if the argument is a string constant
ValueRangeAdjusted: range option
}

/// Get the provided expression for a particular use of a method.
val GetInvokerExpression: ITypeProvider * ProvidedMethodBase * ProvidedVar[] -> ProvidedExpr

Expand All @@ -450,12 +459,12 @@ val ValidateProvidedTypeAfterStaticInstantiation:
/// to check the type name is as expected (this function is called by the caller of TryApplyProvidedType
/// after other checks are made).
val TryApplyProvidedType:
typeBeforeArguments: Tainted<ProvidedType> * optGeneratedTypePath: string list option * staticArgs: obj[] * range ->
typeBeforeArguments: Tainted<ProvidedType> * optGeneratedTypePath: string list option * staticArgs: CrackedStaticArgument[] * range ->
(Tainted<ProvidedType> * (unit -> unit)) option

/// Try to apply a provided method to the given static arguments.
val TryApplyProvidedMethod:
methBeforeArgs: Tainted<ProvidedMethodBase> * staticArgs: obj[] * range -> Tainted<ProvidedMethodBase> option
methBeforeArgs: Tainted<ProvidedMethodBase> * staticArgs: CrackedStaticArgument[] * range -> Tainted<ProvidedMethodBase> option

/// Try to resolve a type in the given extension type resolver
val TryResolveProvidedType: Tainted<ITypeProvider> * range * string[] * typeName: string -> Tainted<ProvidedType> option
Expand Down
10 changes: 10 additions & 0 deletions src/Compiler/xlf/FSComp.txt.cs.xlf
Original file line number Diff line number Diff line change
Expand Up @@ -132,6 +132,16 @@
<target state="translated">Atribut sestavení {0} odkazuje na navržené sestavení {1}, které se nedá načíst nebo neexistuje. Ohlášená výjimka: {2} – {3}</target>
<note />
</trans-unit>
<trans-unit id="etProviderInformational">
<source>The type provider '{0}' reported an informational warning: {1}</source>
<target state="new">The type provider '{0}' reported an informational warning: {1}</target>
<note />
</trans-unit>
<trans-unit id="etProviderWarning">
<source>The type provider '{0}' reported a warning: {1}</source>
<target state="new">The type provider '{0}' reported a warning: {1}</target>
<note />
</trans-unit>
<trans-unit id="featureAdditionalImplicitConversions">
<source>additional type-directed conversions</source>
<target state="translated">další převody orientované na typ</target>
Expand Down
Loading