Avoid permutation explosion

Gen.fsx

namespace Gist

type Ctx<'a, 'b>(a: 'a, b: 'b) =
    member _.A = a
    member _.B = b

type Ctx<'a>(a: 'a) =
    member _.Create<'t>(t: 't) = Ctx<'a, 't>(a, t)

[<Struct>]
type Ctx =
    member _.Create<'t>(t: 't) = Ctx<'t>(t)

type GenContext<'a, 'b, 'c when 'a: (member Create: 'b -> 'c)> = 'a

type A =
    interface
    end

type B =
    interface
    end

type AExtractor =
    static member Extract(_: AExtractor, e: Ctx<A, 'b>) = e.A
    static member Extract(_: AExtractor, e: Ctx<'a, A>) = e.B


type BExtractor =
    //twice
    static member Extract(_: BExtractor, e: Ctx<B, 'b>) = e.A
    static member Extract(_: BExtractor, e: Ctx<'a, B>) = e.B


[<AutoOpen>]
module Raz =
    let inline extract a b =
        ((^a or ^b or 'c): (static member Extract: ^a * ^b -> 'c) (a, b))

    let inline (|ExtractA|) (a) : A =
        extract (Unchecked.defaultof<AExtractor>) a

    let inline (|ExtractB|) (a) : B =
        extract (Unchecked.defaultof<BExtractor>) a

type Builder() =
    member _.Yield(_: unit) = Ctx()

    [<CustomOperation("add")>]
    member inline _.Add(c: GenContext<_, _, _>, p: A) = c.Create(p)

    [<CustomOperation("add")>]
    member inline _.Add(c: GenContext<_, _, _>, p: B) = c.Create(p)

    member inline _.Run(ExtractA(a) & ExtractB(b)) = (a, b)

module Test =
    let bu = Builder()

    let test1 (a: A, b: B) : (A * B) = bu {
        add (a)
        add (b)
    }

    //run matches both Ctx<A, B> and Ctx<B, A>
    let test2 (a: A, b: B) : (A * B) = bu {
        add (b)
        add (a)
    }