检查 F# 通用参数是否具有相等或比较约束

Question

Is it possible to determine at run-time if a generic parameter to a Type has one of the special F# constraints of equality or comparison ? These constraints are documented here .

As a concrete example, given type X<'y when 'y: equality> = { Y: 'y } , how would I determine that 'y has the equality constraint in typedefof<X<_>> ?

I've tried using a few of the reflection APIs like Type.GetGenericParameterConstraints and Type.GenericParameterAttributes but both are empty.

This question mentions that the F# PowerPack can be used like so:

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))

However, this library does not appear to support .NET core and has since been split up and can now be found here . The GitHub page mentions that "F# metadata reader is replaced by FSharp.Compiler.Service", but on a brief examination of FSharp.Compiler.Service this API appears to be much more complex to set up and use than the example above.

Is there a simple way to access these special constraints in F# 6 / .NET 6 using the reflection API or using some other metadata reader?

Currently I'm working around the issue by manually annotating the parameter using an attribute:

[<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>()

Obviously having to manually annotate is not ideal, though!

Answer 1

Rather than pull in the whole FSharp.Compiler.Service package, I think it is easier to re-implement the logic defined in 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

This code works for the test cases below, and I think it would be fairly easy to tweak if more edge cases are discovered.

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