是否可以在 F# 中具有不同泛型参数的类型层次结构上进行递归？

Question

Let's say I have the following F# code:

[<AbstractClass>]
type Base<'a>() =
    class end
and Test<'a, 'b>(b: Base<'b>, c: 'b -> 'a) =
    inherit Base<'a>()
    member this.B = b
    member this.C = c

let rec test (b : Base<'a>) : _ =
    match b with
    | :? Test<'a, 'b> as t -> let result = test t.B
                                test (t.C result)
    | _                    -> failwith "Not supported!"

Basically, I would like to recurse on a type (Base<'b> in this case) with a generic parameter that is different to what I am currently using in the current function call (Base<'a> in this case). For example, in the code I am pattern matching on some Base<'a> b, which might be an instance of Test, meaning I am in a function call with Base<'a> currently.

Pattern matching on Test, I would like to recurse on it's field b of Base<'b>, ie a instance of Base that might have a different generic parameter than 'a. HOWEVER, when I do this, on the line with (test tB) I get the following warning, which totally destroys what I am trying to do:

Warning FS0064: This construct causes code to be less generic than indicated by the type annotations. The type variable 'a has been constrained to be type 'b.

My question: Is it possible to get around this constraint/warning somehow in F#? I don't understand why the recursive call on tB (let result = test tB) would cause 'a to be same type as 'b. I would need the two to be able to be different for what I am trying to do.

Thanks.

EDIT: Added the actual code giving this issue (at: return NaiveEval con.Eff):

   type Channel<'a>() =
        let queue = ConcurrentQueue<'a>()
    
        member internal this.Send value =
                queue.Enqueue value
    
        member internal this.Receive =
                let status, value = queue.TryDequeue()
                if status then value else this.Receive

    [<AbstractClass>]
    type Effect<'Result>() =
        class end
    and Input<'Result>(chan : Channel<'Result>, cont : 'Result -> Effect<'Result>) = 
        inherit Effect<'Result>()
        member internal this.Chan = chan
        member internal this.Cont = cont
    and Output<'Result>(value : 'Result, chan : Channel<'Result>, cont : unit -> Effect<'Result>) =
        inherit Effect<'Result>()
        member internal this.Value = value
        member internal this.Chan = chan
        member internal this.Cont = cont
    and Concurrent<'Result, 'Async>(eff: Effect<'Async>, cont: Async<'Async> -> Effect<'Result>) = 
        inherit Effect<'Result>()
        member internal this.Eff = eff
        member internal this.Cont = cont
    and Await<'Result, 'Async>(future: Async<'Async>, cont: 'Async -> Effect<'Result>) =
        inherit Effect<'Result>()
        member internal this.Future = future
        member internal this.Cont = cont
    and Return<'Result>(value : 'Result) =
        inherit Effect<'Result>()
        member internal this.Value = value

    let Send(value, chan, cont) = Output(value, chan, cont)
    let Receive(chan, cont) = Input(chan, cont)
    
    let rec NaiveEval (eff : Effect<'Result>) : 'Result =
        match eff with
        | :? Input<'Result> as input             -> let value = input.Chan.Receive
                                                    NaiveEval <| input.Cont value
        | :? Output<'Result> as output           -> output.Chan.Send output.Value
                                                    NaiveEval <| output.Cont ()
        | :? Concurrent<'Result, 'Async> as con  -> let work = async {
                                                        return NaiveEval con.Eff
                                                    }
                                                    let task = Async.AwaitTask <| Async.StartAsTask work
                                                    NaiveEval <| con.Cont task
        | :? Await<'Result, 'Async> as await     -> let res = Async.RunSynchronously await.Future
                                                    NaiveEval <| await.Cont res
        | :? Return<'Result> as ret              -> ret.Value
        | _                                      -> failwith "Unsupported effect!"

Answer 1

There are a couple of issues here:

• You cannot pattern match against a type that has free type parameters - so :? Test<'a, 'b> as t :? Test<'a, 'b> as t will not work - ideally, this would match any Test and set 'a and 'b to the right types, but that's not how pattern matching works (and the type parameters have to be known to the compiler).

• You are also trying to have a recursive function that calls itself with differnet type parameters, which also is not allowed in F#.

You can come up with various more or less elegant workarounds. The following is one option:

type IOperation = 
  abstract Invoke : Test<'a, 'b> -> unit

and [<AbstractClass>] Base() = 
  abstract Invoke : IOperation -> unit

and [<AbstractClass>] Base<'a>() = 
  inherit Base()

and Test<'a, 'b>(b: Base<'b>, c: 'b -> 'a) =
  inherit Base<'a>()
  member this.B = b
  member this.C = c
  override this.Invoke(op) =
    op.Invoke(this)

let rec test (b : Base) : _ =
    b.Invoke
      ({ new IOperation with 
          member x.Invoke<'b, 'c>(t:Test<'b, 'c>) = 
            test t.B
      })  

It adds a non-generic Base (so that you can write recursive test function) which then has an invoke method that takes IOperation . This then has a generic Invoke method that gets invoked with Test<'b, 'c> - with the right type parameters - by the implementation in Test .

I think this might let you do what you need - but it is hard to say without knowing what specifically are you trying to do!

Answer 2

Okay, so after a lot of experimentation, I've finally been able to solve the problem. Thanks to @TomasPetricek, I've managed to built a sort of visitor pattern that allows what I am trying to do.

type EffectVisitor =
    abstract member VisitInput<'Result> : Input<'Result> -> 'Result
    abstract member VisitOutput<'Result> : Output<'Result> -> 'Result
    abstract member VisitConcurrent<'Result, 'Async> : Concurrent<'Result, 'Async> -> 'Result
    abstract member VisitAwait<'Result, 'Async> : Await<'Result, 'Async> -> 'Result
    abstract member VisitReturn<'Result> : Return<'Result> -> 'Result
and [<AbstractClass>] Effect() =
    abstract member Visit : EffectVisitor -> 'Result
and [<AbstractClass>] Effect<'Result>() =
    abstract member Visit<'Result> : EffectVisitor -> 'Result
and Input<'Result>(chan : Channel<'Result>, cont : 'Result -> Effect<'Result>) =
    inherit Effect<'Result>()
    member internal this.Chan = chan
    member internal this.Cont = cont
    override this.Visit<'Result>(input) =
    input.VisitInput<'Result>(this)
and Output<'Result>(value : 'Result, chan : Channel<'Result>, cont : unit -> Effect<'Result>) =
    inherit Effect<'Result>()
    member internal this.Value = value
    member internal this.Chan = chan
    member internal this.Cont = cont
    override this.Visit<'Result>(input) =
    input.VisitOutput<'Result>(this)
and Concurrent<'Result, 'Async>(eff : Effect<'Async>, cont : Async<'Async> -> Effect<'Result>) =
    inherit Effect<'Result>()
    member internal this.Eff = eff
    member internal this.Cont = cont
    override this.Visit<'Result>(con) =
        con.VisitConcurrent<'Result, 'Async>(this)
and Await<'Result, 'Async>(task : Async<'Async>, cont : 'Async -> Effect<'Result>) =
    inherit Effect<'Result>()
    member internal this.Task = task
    member internal this.Cont = cont
    override this.Visit<'Result>(await) =
        await.VisitAwait<'Result, 'Async>(this)
and Return<'Result>(value : 'Result) =
    inherit Effect<'Result>()
    member internal this.Value = value
    override this.Visit<'Result>(input) =
        input.VisitReturn<'Result>(this)

let Send(value, chan, cont) = Output(value, chan, cont)
let Receive(chan, cont) = Input(chan, cont)

let rec NaiveEval<'Result> (eff : Effect<'Result>) : 'Result =
    eff.Visit({
        new EffectVisitor with
            member _.VisitInput<'Result>(input : Input<'Result>) : 'Result =
                let value = input.Chan.Receive
                NaiveEval <| input.Cont value
            member _.VisitOutput<'Result>(output : Output<'Result>) : 'Result =
                output.Chan.Send output.Value
                NaiveEval <| output.Cont ()
            member _.VisitConcurrent(con) =
                let work = async {
                    return NaiveEval con.Eff
                }
                let task = Async.AwaitTask <| Async.StartAsTask work
                NaiveEval <| con.Cont task
            member _.VisitAwait(await) =
                let result = Async.RunSynchronously await.Task
                NaiveEval <| await.Cont result
            member this.VisitReturn<'Result>(ret : Return<'Result>) : 'Result =
                ret.Value
    })