Как реализовать «эффективную обобщенную кратность» в F#?

type ListIdF =
    abstract Apply : 'a * list<Pair<'a>> -> list<'a>

type ListIdG =
    abstract Apply : Pair<'a> -> Pair<'a>

let rec efold<'a,'b> (f:ListIdF) (g:ListIdG) (h:'a -> 'b) : Nest<'a> -> list<'b> = function
| Nil -> []
| Cons(x,xs) -> f.Apply(h x, efold f g (pair h >> g.Apply) xs)

let toList n = efold { new ListIdF with member __.Apply(a,l) = a::(List.collect (fun (x,y) -> [x;y]) l) } { new ListIdG with member __.Apply(p) = p } id n

Сложный подход

Хотя F# напрямую не поддерживает типы более высокого типа, оказывается, что их можно имитировать достаточно точным образом. Это подход, используемый библиотекой Higher. Вот как будет выглядеть его минимальная версия.

Мы создаем тип App<'T,'a>, который будет представлять некоторое приложение типа T<'a>, но где мы создадим фиктивный сопутствующий тип, который может служить аргументом первого типа для App<_,_>:

type App<'F, 'T>(token : 'F, value : obj) = 
    do
        if obj.ReferenceEquals(token, Unchecked.defaultof<'F>) then
            raise <| new System.InvalidOperationException("Invalid token")

    // Apply the secret token to have access to the encapsulated value
    member self.Apply(token' : 'F) : obj =
        if not (obj.ReferenceEquals(token, token')) then
            raise <| new System.InvalidOperationException("Invalid token")
        value 

Теперь мы можем определить некоторые сопутствующие типы для интересующих нас конструкторов типов (и обычно они могут находиться в некоторой общей библиотеке):

// App<Const<'a>, 'b> represents a value of type 'a (that is, ignores 'b)
type Const<'a> private () =
    static let token = Const ()
    static member Inj (value : 'a) =
        App<Const<'a>, 'b>(token, value)
    static member Prj (app : App<Const<'a>, 'b>) : 'a =
        app.Apply(token) :?> _

// App<List, 'a> represents list<'a>
type List private () = 
    static let token = List()
    static member Inj (value : 'a list) =
        App<List, 'a>(token, value)
    static member Prj (app : App<List, 'a>) : 'a list =
        app.Apply(token) :?> _

// App<Id, 'a> represents just a plain 'a
type Id private () =
    static let token = Id()
    static member Inj (value : 'a) =
        App<Id, 'a>(token, value)
    static member Prj (app : App<Id, 'a>) : 'a =
        app.Apply(token) :?> _

// App<Nest, 'a> represents a Nest<'a>
type Nest private () =
    static let token = Nest()
    static member Inj (value : Nest<'a>) =
        App<Nest, 'a>(token, value)
    static member Prj (app : App<Nest, 'a>) : Nest<'a> =
        app.Apply(token) :?> _

Теперь мы можем раз и навсегда определить типы более высокого ранга для аргументов эффективной складки:

// forall a. n a
type E<'N> =
    abstract Apply<'a> : unit -> App<'N,'a>

// forall a.(m a, n (Pair a)) -> n a)
type F<'M,'N> =
    abstract Apply<'a> : App<'M,'a> * App<'N,'a*'a> -> App<'N,'a>

// forall a.Pair (m a) -> m (Pair a))
type G<'M> =
    abstract Apply<'a> : App<'M,'a> * App<'M,'a> -> App<'M,'a*'a>

так что сгиб просто:

let rec efold<'N,'M,'a,'b> (e:E<'N>) (f:F<'M,'N>) (g:G<'M>) (h:'a -> App<'M,'b>) : Nest<'a> -> App<'N,'b> = function
| Nil -> e.Apply()
| Cons(x,xs) -> f.Apply(h x, efold e f g (g.Apply << pair h) xs)

Теперь, чтобы вызвать efold, нам нужно добавить несколько вызовов различных методов Inj и Prj, но в остальном все выглядит так, как мы и ожидали:

let toList n = 
    efold { new E<_> with member __.Apply() = List.Inj [] } 
          { new F<_,_> with member __.Apply(m,n) = Id.Prj m :: (n |> List.Prj |> List.collect (fun (x,y) -> [x;y])) |> List.Inj }
          { new G<_> with member __.Apply(m1,m2) = (Id.Prj m1, Id.Prj m2) |> Id.Inj }
          Id.Inj
          n
    |> List.Prj

let sumElements n =
    efold { new E<_> with member __.Apply() = Const.Inj 0 }
          { new F<_,_> with member __.Apply(m,n) = Const.Prj m + Const.Prj n |> Const.Inj }
          { new G<_> with member __.Apply(m1,m2) = Const.Prj m1 + Const.Prj m2 |> Const.Inj }
          Const.Inj
          n
    |> Const.Prj

let reverse n = 
    efold { new E<_> with member __.Apply() = Nest.Inj Nil }
          { new F<_,_> with member __.Apply(m,n) = Cons(Id.Prj m, Nest.Prj n) |> Nest.Inj }
          { new G<_> with member __.Apply(m1,m2) = (Id.Prj 2, Id.Prj m1) |> Id.Inj }
          Id.Inj
          n
    |> Nest.Prj

Надеюсь, схема здесь ясна: в каждом объектном выражении метод приложения проецирует каждый аргумент, оперирует с ним, а затем вводит результат обратно в тип App<_,_>. С некоторой магией inline мы можем сделать этот вид еще более последовательным (за счет нескольких аннотаций типа):

let inline (|Prj|) (app:App< ^T, 'a>) = (^T : (static member Prj : App< ^T, 'a> -> 'b) app)
let inline prj (Prj x) = x
let inline inj x = (^T : (static member Inj : 'b -> App< ^T, 'a>) x)

let toList n = 
    efold { new E<List> with member __.Apply() = inj [] } 
          { new F<Id,_> with member __.Apply(Prj m, Prj n) = m :: (n |> List.collect (fun (x,y) -> [x;y])) |> inj }
          { new G<_> with member __.Apply(Prj m1,Prj m2) = (m1, m2) |> inj }
          inj
          n
    |> prj

let sumElements n =
    efold { new E<Const<_>> with member __.Apply() = inj 0 }
          { new F<Const<_>,_> with member __.Apply(Prj m, Prj n) = m + n |> inj }
          { new G<_> with member __.Apply(Prj m1,Prj m2) = m1 + m2 |> inj }
          inj
          n
    |> prj

let reverse n = 
    efold { new E<_> with member __.Apply() = Nest.Inj Nil }
          { new F<Id,_> with member __.Apply(Prj m,Prj n) = Cons(m, n) |> inj }
          { new G<_> with member __.Apply(Prj m1,Prj m2) = (m2, m1) |> inj }
          inj
          n
    |> prj