How do sequence expressions and polymorphic recursion play together?

Question

This project really is a source of questions for me.

I already learned about polymorphic recursion and I understand why it is a special case and therefore F# needs full type annotations.

For regular functions I might need some fiddeling but usually get it right. Now I'm trying to adapt a (working) basic toSeq to a more specialized finger tree, but can't.

My feeling is that the use of the computation expression has something to do with it. This is the condensed working version:

module ThisWorks =

    module Node =
        type Node<'a> =
            | Node2 of 'a * 'a
            | Node3 of 'a * 'a * 'a

        let toList = function
            | Node2(a, b) -> [a; b]
            | Node3(a, b, c) -> [a; b; c]

    module Digit =
        type Digit<'a> =
            | One of 'a
            | Two of 'a * 'a
            | Three of 'a * 'a * 'a
            | Four of 'a * 'a * 'a * 'a

        let toList = function
            | One a -> [a]
            | Two(a, b) -> [a; b]
            | Three(a, b, c) -> [a; b; c]
            | Four(a, b, c, d) -> [a; b; c; d]

    module FingerTree =
        open Node
        open Digit

        type FingerTree<'a> =
            | Empty
            | Single of 'a
            | Deep of Digit<'a> * Lazy<FingerTree<Node<'a>>> * Digit<'a>

        let rec toSeq<'a> (tree:FingerTree<'a>) : seq<'a> = seq {
            match tree with
            | Single single ->
                yield single
            | Deep(prefix, Lazy deeper, suffix) ->
                yield! prefix |> Digit.toList
                yield! deeper |> toSeq |> Seq.collect Node.toList
                yield! suffix |> Digit.toList
            | Empty -> ()
        }

The one I don't manage to get to compile is this:

module ThisDoesnt =

    module Monoids =
        type IMonoid<'m> =
            abstract Zero:'m
            abstract Plus:'m -> 'm

        type IMeasured<'m when 'm :> IMonoid<'m>> =
            abstract Measure:'m

        type Size(value) =
            new() = Size 0

            member __.Value = value

            interface IMonoid<Size> with
                member __.Zero = Size()
                member __.Plus rhs = Size(value + rhs.Value)

        type Value<'a> =
            | Value of 'a

            interface IMeasured<Size> with
                member __.Measure = Size 1

    open Monoids

    module Node =
        type Node<'m, 'a when 'm :> IMonoid<'m>> =
            | Node2 of 'm * 'a * 'a
            | Node3 of 'm * 'a * 'a * 'a

        let toList = function
            | Node2(_, a, b) -> [a; b]
            | Node3(_, a, b, c) -> [a; b; c]

    module Digit =
        type Digit<'m, 'a when 'm :> IMonoid<'m>> =
            | One of 'a
            | Two of 'a * 'a
            | Three of 'a * 'a * 'a
            | Four of 'a * 'a * 'a * 'a

        let toList = function
            | One a -> [a]
            | Two(a, b) -> [a; b]
            | Three(a, b, c) -> [a; b; c]
            | Four(a, b, c, d) -> [a; b; c; d]

    module FingerTree =
        open Node
        open Digit

        type FingerTree<'m, 'a when 'm :> IMonoid<'m>> =
            | Empty
            | Single of 'a
            | Deep of 'm * Digit<'m, 'a> * Lazy<FingerTree<'m, Node<'m, 'a>>> * Digit<'m, 'a>

        let unpack (Value v) = v

        let rec toSeq<'a> (tree:FingerTree<Size, Value<'a>>) : seq<'a> = seq {
            match tree with
            | Single(Value single) ->
                yield single
            | Deep(_, prefix, Lazy deeper, suffix) ->
                yield! prefix |> Digit.toList |> List.map unpack

                #if ITERATE
                for (Value deep) in toSeq deeper do
                                    ^^^^^
                    yield deep

                #else

                yield! deeper |> toSeq |> Seq.collect (Node.toList >> List.map unpack)
                                 ^^^^^
                #endif

                yield! suffix |> Digit.toList |> List.map unpack
            | Empty -> ()
        }

The error message I get says

Error Type mismatch. Expecting a
FingerTree<Size,Node<Size,Value<'a>>> -> 'b
but given a
FingerTree<Size,Value<'c>> -> seq<'c>
The type 'Node<Size,Value<'a>>' does not match the type 'Value<'b>'

and the squiggles underline the recursive call of toSeq.

I know that the “deeper” type is encapsulated in a Node and in the working code I just unpack it afterwards. But here the compiler trips already before I get the chance to unpack. Trying a for (Value deep) in toSeq deeper do yield deep has the same problem.

I already have a way out, namely to use the toSeq of the “base” Tree and Seq.map unpack afterwards. Not true, trying that yields a very similar error message.

I'm curious what makes this code break and how it could be fixed.

Answer 1

The compiler's error message seems clear to me: toSeq is applicable only to values of type FingerTree<Size, Value<'a>> for some 'a, but you're trying to call it on a value of type FingerTree<Size,Node<Size,Value<'a>>> instead, which is not compatible. There's nothing specific to polymorphic recursion or sequence expressions, these types just don't match.

Instead, it seems like it would be much simpler to make toSeq more generic by taking an input of type FingerTree<Size, 'a> (without any reference to Value), which would enable the recursive call you want. Then you can easily derive the more specific function you actually want by composing the more general toSeq with Seq.map unpack.