.net - 检查 F# 泛型参数是否具有相等或比较约束

Question

是否可以在运行时确定 Type 的通用参数具有 equality 的特殊 F# 约束之一或 comparison ？这些约束记录在案 here .

作为一个具体的例子，给定type X<'y when 'y: equality> = { Y: 'y } ，我如何确定 'y有 equality typedefof<X<_>> 中的约束？

我试过使用一些反射 API，例如 Type.GetGenericParameterConstraints 和 Type.GenericParameterAttributes 但两者都是空的。

这question提到 F# PowerPack 可以像这样使用:

open Microsoft.FSharp.Metadata

let setEntity = FSharpAssembly.FSharpLibrary.GetEntity("Microsoft.FSharp.Collections.FSharpSet`1")
for typeArg in setEntity.GenericParameters do
  printfn "%s - comparison=%b" 
    typeArg.Name 
    (typeArg.Constraints |> Seq.exists (fun c -> c.IsComparisonConstraint))

但是，这个库似乎不支持 .NET 核心，并且已经拆分，现在可以找到 here . GitHub 页面提到“F# 元数据读取器被 FSharp.Compiler.Service 取代”，但在对 FSharp.Compiler.Service 的简短检查中此 API 的设置和使用似乎比上面的示例复杂得多。

有没有一种简单的方法可以使用反射 API 或使用其他一些元数据读取器来访问 F# 6/.NET 6 中的这些特殊约束？

目前我正在通过手动注释来解决这个问题 使用属性的参数:

[<AttributeUsage(validOn = AttributeTargets.GenericParameter, AllowMultiple = false)>]
type ConstraintAttribute([<ParamArray>] constraints: string []) =
    inherit Attribute()
    member _.Constraints = constraints |> List.ofArray

type X<[<Constraint("equality")>] 'y when 'y: equality> = { Y: 'y }

typedefof<X<_>>.GetGenericArguments().[0].GetCustomAttributes<ConstraintAttribute>()

不过，显然必须手动注释并不理想!

Answer 1

与其拉入整个 FSharp.Compiler.Service 包，我认为重新实现 the spec 中定义的逻辑更容易。 :

The constraint type : comparison is a comparison constraint. Such a constraint is met if all the following conditions hold:

• If the type is a named type, then the type definition does not have, and is not inferred to have, the NoComparison attribute, and the type definition implements System.IComparable or is an array type or is System.IntPtr or is System.UIntPtr.

• If the type has comparison dependencies ty1, ..., tyn, then each of these must satisfy tyi : comparison

此代码适用于下面的测试用例，我认为如果发现更多边缘用例，调整起来会相当容易。

open System
open FSharp.Reflection

let comparisonDeps (t : Type) =
  seq {
    if FSharpType.IsTuple t then
      yield! FSharpType.GetTupleElements t

    elif FSharpType.IsUnion t then
      for uci in FSharpType.GetUnionCases(t, true) do
        for f in uci.GetFields() do
          f.PropertyType

    elif FSharpType.IsRecord t then
      for rf in FSharpType.GetRecordFields t do
        rf.PropertyType
  }

let isComparisonType (t : Type) =
  let seen = System.Collections.Generic.HashSet<Type>()

  let rec loop t =
    seen.Add(t) |> ignore
    (
      t = typeof<IntPtr>
    )
    || (
      t = typeof<UIntPtr>
    )
    || (
      t.IsArray
    )
    || (
      (
        t.GetInterfaces()
        |> Seq.contains typeof<System.IComparable>
      )
      && (
        comparisonDeps t
        |> Seq.filter (fun t -> not (seen.Contains(t)))
        |> Seq.forall loop
      )
    )

  loop t




#r "nuget: Expecto, 9.0.4"

open Expecto

let makeTest candidate expected =
  let t = candidate.GetType()

  let message =
    if expected then
      $"%A{candidate} is a comparison type"
    else
      $"%A{candidate} is not a comparison type"

  test $"%s{t.Name} (e.g. %A{candidate})" {
    let actual = isComparisonType t

    Expect.equal actual expected message
  }

type Foo<'t> =
  {
    Foo : 't
  }

[<NoComparison>]
type Bar<'t> =
  {
    Bar : 't
  }

[<NoComparison>]
type Qux =
  {
    Qux : int
  }

type Baz =
  {
    Baz : Qux
  }

let tests =
  testList "isComparisonType" [
    makeTest 123 true
    makeTest "abc" true
    makeTest [ 1; 2; 3 ] true
    makeTest (1, "a") true
    makeTest (Set.ofSeq [ 1; 2; 3 ]) true
    makeTest { Foo = 123 } true
    makeTest (Some { Foo = 123 }) true
    makeTest { Foo = fun x -> x + 1 } false
    makeTest { Bar = "abc" } false
    makeTest [ { Bar = 7 } ] false
    makeTest { Foo = { Bar = "abc" } } false
    makeTest { Qux = 2 } false
    makeTest (true, { Qux = 2 }) false
    makeTest (Map.ofSeq [ 1, { Qux = 2 } ]) true
    makeTest (Some { Qux = 2 }) false
    makeTest { Baz = { Qux = 2 } } false
    makeTest [| true; false |] true
    makeTest (IntPtr 1) true
    makeTest [| IntPtr 1; IntPtr 2; IntPtr 3 |] true
    makeTest (UIntPtr 42u) true
  ]

let args = fsi.CommandLineArgs |> Array.skip 1

runTestsWithCLIArgs [] args tests