Is it possible to recurse on a type hierarchy with distinct generic parameters in F#?
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>, i.e. a instance of Base that might have a different generic parameter than 'a. HOWEVER, when I do this, on the line with (test t.B) 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 t.B (let result = test t.B) 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!"
There are a couple of issues here:
-
You cannot pattern match against a type that has free type parameters - so
:? Test<'a, 'b> as twill not work - ideally, this would match anyTestand set'aand'bto 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!
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
})