Как выражения последовательности и полиморфная рекурсия играют вместе?

Question

Этот проект действительно является источником вопросов для меня.

Я уже узнал о полиморфной рекурсии и понимаю, почему это особый случай, и поэтому F# требует полных аннотаций типа.

Для обычных функций мне, возможно, понадобится немного поиграть, но, как правило, все получается правильно. Сейчас я пытаюсь адаптировать (рабочий) основной toSeq к более специализированному пальцу, но не могу.

Мне кажется, что использование выражения для вычисления как-то связано с этим. Это сжатая рабочая версия:

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 -> ()
        }

То, что мне не удается собрать, это:

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 -> ()
        }

Сообщение об ошибке, которое я получаю, говорит

Ошибка типа несоответствие. Ожидая
FingerTree <размер, узел <размер, значение <'a >>> -> ' b
но учитывая
FingerTree <размер, значение <'c >> -> seq <' c>
Тип 'Узел <Размер, Значение <' a >> 'не соответствует типу' Значение <'b> '

и загогулины подчеркивают рекурсивный зов toSeq,

Я знаю, что "глубокий" тип инкапсулирован в Node и в рабочем коде я просто распаковываю его потом. Но здесь компилятор отключается, прежде чем я получу возможность распаковать. Пытаясь for (Value deep) in toSeq deeper do yield deep имеет ту же проблему.

У меня уже есть выход, а именно использовать toSeq "базы" Tree а также Seq.map unpack после этого. Неверно, попытка выдает очень похожее сообщение об ошибке.

Мне любопытно, что заставляет этот код ломаться и как это можно исправить.

Answer 1

Сообщение об ошибке компилятора мне кажется ясным: toSeq применимо только к значениям типа FingerTree<Size, Value<'a>> для некоторых 'a, но вы пытаетесь вызвать его на значение типа FingerTree<Size,Node<Size,Value<'a>>> вместо этого, который не совместим. Нет ничего специфического для полиморфной рекурсии или выражений последовательности, эти типы просто не совпадают.

Вместо этого кажется, что было бы намного проще сделать toSeq более общий, принимая ввод типа FingerTree<Size, 'a> (без каких-либо ссылок на Value), что позволит включить рекурсивный вызов, который вы хотите. Тогда вы можете легко получить более конкретную функцию, которую вы на самом деле хотите, составив более общие toSeq с Seq.map unpack,