F# pattern matching with generic types. Possible?-CodePudding

I have the following code:

[<AbstractClass>]
type Effect<'a>() =
    class end

type Input<'a>(chan : Channel<'a>, cont : 'a -> Effect<'a>) = 
    inherit Effect<'a>()
    member this.Chan = chan
    member this.Cont = cont

type Output<'a>(value : 'a, chan : Channel<'a>, cont : unit -> Effect<'a>) =
    inherit Effect<'a>()
    member this.Value = value
    member this.Chan = chan
    member this.Cont = cont

type Parallel<'a, 'b>(eff1 : Effect<'a>, eff2 : Effect<'b>) =
    inherit Effect<'a * 'b>()
    member this.Eff1 = eff1
    member this.Eff2 = eff2

type Return<'a>(value : 'a) =
    inherit Effect<'a>()
    member this.Value = value

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

let rec NaiveEval (eff : Effect<'a>) =
    match eff with 
    | :? Input<'a> as input           -> ()
    | :? Output<'a> as output         -> ()
    | :? Parallel<'a, 'b> as par      -> () // ERROR: FS0193: Type constraint mismatch. The type 'Parallel<'a,'b> is not compatible with type 'Effect<'a>'.
    | :? Return<'a> as ret            -> ()
    | _                               -> failwith "Unsupported effect!"

I want to be able to pattern match in some way on the different subclasses of Effect as seen in the NaiveEval function. The pattern match on Parallel<'a, 'b> gives the following error:

FS0193: Type constraint mismatch. The type 'Parallel<'a,'b> is not compatible with type 'Effect<'a>'.

I would assume that in this case 'a would be inferred to be 'a * 'b but I guess that is not what's happening.

Any help is appreciated. Thanks.

EDIT to Mark's answer:

So as far as I understand, what I am trying to do is not possible. I started out with a discriminated union, but I thought the type hierarchy would fix my issue. I guess not.

I used this union before:

type Effect<'a> =
     | Input of Channel<'a> * ('a -> Effect<'a>)
     | Output of 'a * Channel<'a> * (unit -> Effect<'a>)
     | Parallel of Effect<'a> * Effect<'a>
     | Return of 'a

I used to use this type, but I wanted to parallel to be: Parallel of Effect<'a> * Effect<'b> and not just both 'a. I assume this is not possible either?

CodePudding user response：

This is because the type parameter in Parallel is defined as corresponding to 'a * 'b. In other words, the single type parameter of Effect<'a> is here 'a * 'b.

Perhaps it's easier to understand how these correspond if you rename the type variables to 'b and 'c:

type Parallel<'b, 'c>(eff1 : Effect<'b>, eff2 : Effect<'c>) =
    inherit Effect<'b * 'c>()
    member this.Eff1 = eff1
    member this.Eff2 = eff2

Now you have that in the Parallel case, 'a = 'b * 'c.

The compiler error is exactly because you're trying to redefine what 'a is. Essentially, you're trying to insist that 'a = 'a * 'b. This doesn't work because you have 'a on both sides of the equals sign.

(We could imagine a more sophisticated type system that would allow this. This would essentially be like saying that x = x y, which is only possible if y = 0. In the world of algebraic data types, this would imply that 'b would be () (unit)... but the F# type system can't infer that, and in any case it's probably not what you want.)

You can exchange the error for a compiler warning by explicitly using the renamed type arguments:

let rec NaiveEval (eff : Effect<'a>) =
    match eff with 
    | :? Input<'a> as input           -> ()
    | :? Output<'a> as output         -> ()
    | :? Parallel<'b, 'c> as par      -> () // Warning FS0064
    | :? Return<'a> as ret            -> ()
    | _                               -> failwith "Unsupported effect!"

The warning, however, is:

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 * 'c'.

In other words, the NaiveEval function can only evaluate Effect<'b * 'c> - probably still not what you want..?

This may still be a little difficult to accept, but imagine that you'd want to do something with par in the Parallel case. This, for example, doesn't compile because, once again, the types don't line up:

| :? Parallel<'b, 'c> as par      ->
    NaiveEval (par.Eff2)

Here, par.Eff2 has the type 'c, but you're currently 'inside' a function of the type Effect<'b * 'c> -> unit. You can't recurse into it, and compiler tells you so:

Error FS0001 The types ''c' and ''b * 'c' cannot be unified.

BTW, have you considered defining a discriminated union instead of a type hierarchy?

CodePudding user response：

I have many moons ago dug into tagless encodings, but I can't seem to get this to work in this context (actually i do further down).

I got something to work using good old fashioned and underated visitor pattern (which is closely related, excuse my idiosyncratic F# its been a while, I think my method signatures should be tupled really, but i dont do that until the final version).

foo outputs 6, and recursively evaluates a parallel effect.

type Channel<'a>() = class end

type IEffectVisitor<'ret> =
    abstract member VisitInput<'a> : Input<'a> -> 'ret
    abstract member VisitOutput<'a> : Output<'a> -> 'ret
    abstract member VisitParallel<'a,'b> : Parallel<'a,'b> -> 'ret 
    abstract member VisitReturn<'a> : Return<'a> -> 'ret
and IEffect<'a> = 
    abstract member Accept<'ret> : IEffectVisitor<'ret> -> 'ret
and Input<'a>(chan : Channel<'a>, cont : 'a -> IEffect<'a>) = 
    interface IEffect<'a> with
        member this.Accept(v) = v.VisitInput(this)
    member this.Chan = chan
    member this.Cont = cont
and Output<'a>(value : 'a, chan : Channel<'a>, cont : unit -> IEffect<'a>) =
    interface IEffect<'a> with
        member this.Accept(v) = v.VisitOutput(this)
    member this.Value = value
    member this.Chan = chan
    member this.Cont = cont
and Parallel<'a, 'b>(eff1 : IEffect<'a>, eff2 : IEffect<'b>) =
    interface IEffect<'a> with
        member this.Accept(v) = v.VisitParallel(this)
    member this.Eff1 = eff1
    member this.Eff2 = eff2
and Return<'a>(value : 'a) =
    interface IEffect<'a> with
        member this.Accept(v) = v.VisitReturn(this)
    member this.Value = value

let rec NaiveEval (eff : IEffect<'a>) : int =
    eff.Accept(
        { new IEffectVisitor<int> with
            member this.VisitOutput x = 
                1
            member this.VisitParallel x =                     
                x.Eff1.Accept(this)   x.Eff2.Accept(this)
            member this.VisitReturn x = 
                3
            member __.VisitInput x = 
                4 })

let foo() = 
    let x = Parallel(Return 1, Return "a")
    printfn "%A" <| NaiveEval(x)
    ()

actually thinking about this, I went back to it, you can lose the type parameter on the effect all together without (in the example) any loss of type safety, and this paves the way for a more tagless like implementation.

type Channel<'a>() = class end

type IEffectVisitor<'ret> =
    abstract member VisitInput<'a> : Input<'a> -> 'ret
    abstract member VisitOutput<'a> : Output<'a> -> 'ret
    abstract member VisitParallel<'a,'b> : Parallel -> 'ret 
    abstract member VisitReturn<'a> : Return<'a> -> 'ret
and IEffect = 
    abstract member Accept<'ret> : IEffectVisitor<'ret> -> 'ret
and Input<'a>(chan : Channel<'a>, cont : 'a -> IEffect) = 
    interface IEffect with
        member this.Accept(v) = v.VisitInput(this)
    member this.Chan = chan
    member this.Cont = cont
and Output<'a>(value : 'a, chan : Channel<'a>, cont : unit -> IEffect) =
    interface IEffect with
        member this.Accept(v) = v.VisitOutput(this)
    member this.Value = value
    member this.Chan = chan
    member this.Cont = cont
and Parallel(eff1 : IEffect, eff2 : IEffect) =
    interface IEffect with
        member this.Accept(v) = v.VisitParallel(this)
    member this.Eff1 = eff1
    member this.Eff2 = eff2
and Return<'a>(value : 'a) =
    interface IEffect with
        member this.Accept(v) = v.VisitReturn(this)
    member this.Value = value


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

    let rec NaiveEval (eff : IEffect) : int =
        eff.Accept(
            { new IEffectVisitor<int> with
                member this.VisitOutput x = 
                    1
                member this.VisitParallel x =                     
                    x.Eff1.Accept(this)   x.Eff2.Accept(this)
                member this.VisitReturn x = 
                    3
                member __.VisitInput x = 
                    4 })

    let foo() = 
        let x = Parallel(Return 1, Return "a")
        printfn "%A" <| NaiveEval(x)
        ()

which leads you onto something a bit tagless....(I always love this bit, becuase of the realisation that a factory pattern is actually a special case of a visitor - in a way, and all your classes and DUs evaporate into functions/methods).

type Channel<'a>() = class end

type IEffectAlgebra<'retInput,'retOutput,'retParallel,'retReturn> =
    abstract member Input<'a> : Channel<'a> * ('a -> IEffect) -> 'retInput
    abstract member Output<'a> : 'a * Channel<'a> * (unit -> IEffect) -> 'retOutput
    abstract member Parallel<'a,'b> : IEffect * IEffect -> 'retParallel
    abstract member Return<'a> : 'a -> 'retReturn
and IEffect = 
    abstract member Accept<'ret> : IEffectAlgebra<'ret,'ret,'ret,'ret> -> 'ret

type IEffectVisitor<'ret> = IEffectAlgebra<'ret,'ret,'ret,'ret>
type IEffectFactory = IEffectVisitor<IEffect>

let effectFactory = 
    { new IEffectFactory with
        member __.Input(arg1, arg2) = 
            { new IEffect with 
                member __.Accept(v) = v.Input(arg1, arg2) }
        member __.Output(arg1, arg2, arg3) = 
            { new IEffect with 
                member __.Accept(v) = v.Output(arg1, arg2, arg3) }
        member __.Parallel(arg1, arg2) = 
            { new IEffect with 
                member __.Accept(v) = v.Parallel(arg1, arg2) }
        member __.Return(arg1) = 
            { new IEffect with 
                member __.Accept(v) = v.Return arg1 }
    }

module Foo = 
    let Send(value, chan, cont) = effectFactory.Output(value, chan, cont)
    let Receive(chan, cont) = effectFactory.Input(chan, cont)

    let rec NaiveEval (eff : IEffect) : int =
        eff.Accept(
            { new IEffectVisitor<int> with
                  member __.Input(_, _) = 1
                  member __.Output(_, _, _) = 2
                  member this.Parallel(arg1, arg2) = 
                    arg1.Accept this   arg2.Accept this
                  member __.Return(_) = 4 })

    let foo() = 
        let x = effectFactory.Parallel(effectFactory.Return 1, effectFactory.Return "a")
        printfn "%A" <| NaiveEval(x)
        ()