Applying the Tagless-Final pattern in F# Generic Programs

A few years back, I blogged about how one could use the TypeShape library for writing practical generic programs in F#. While the library has seen success in both OSS and proprietary applications, from the beginning there have existed pretty self-evident usability issues when working with the library itself.

On simple inspection of a basic example one can easily detect the following problems:

• Accessing generic types requires extensive use of visitors which result in awkward looking code, which is hard to read and hard to write.
• The type checker can hardly handle such expressions, and explicit type annotations are required almost everywhere.
• Most importantly, unsafe casts are required at the boundaries of generic program composition. While those generally only result in errors at program generation time and not at execution time, they are still a source of runtime errors.

In this article, I propose an alternative approach to generic programming in F#, one that provides a simpler and type-safe approach to building polytypic programs. The approach combines techniques that are long established in the literature.

Encoding Higher-Kinded Types

A core ingredient for the new approach is the ability to express higher-kinded types. While F# does not natively support higher-kinded types, they can be encoded using an approach first described by Yallop and White in the context of OCaml. Various ports of that encoding exist in F#, most prominent being the Higher library.

For the purposes of this application, I’m going to use a simplistic variant of the encoding:

type App<'F, 't> = App of payload : obj

module HKT =

    // associate HKT encoding to underlying type using SRTPs
    let inline private assoc<'F, 'a, 'Fa when 'F : (static member Assign : App<'F, 'a> * 'Fa -> unit)> = ()

    // pack and unpack functions
    let inline pack (value : 'Fa) : App<'F, 'a> = assoc<'F, 'a, 'Fa> ; App value
    let inline unpack (App value : App<'F, 'a>) : 'Fa = assoc<'F, 'a, 'Fa> ; unbox value
        
    // helper active pattern
    let inline (|Unpack|) app = unpack app

Let’s put the above definitions into use. Here’s how we can encode optionals as a higher-kinded type:

type Option =
    static member Assign(_ : App<Option, 'a>, _ : 'a option) = ()

let encoded : App<Option, _> = HKT.pack (Some 42)
let payload = HKT.unpack encoded

The HKT.pack function takes an instance of type int option and returns an instance of type App<Option, int>, whereas unpack does the inverse. The type Option is an uninhabited type representing the _ option type constructor and is known as the brand of the encoding. The compiler infers the association between App<Option, int> and int option by virtue of the Assign method type signature using SRTP method constraints.

Let’s see how we can use this encoding to express programs that are generic w.r.t. type constructors. Here’s the obligatory functor example:

type Functor<'F> =
    abstract member Fmap : ('a -> 'b) -> App<'F, 'a> -> App<'F, 'b>

let fmap f xs : _ when 'F :> Functor<'F> = (new 'F()).Fmap f xs

let incrSqr x = x |> fmap ((+) 1) |> fmap ((*) 2)

Here we describe the functor abstraction using an interface that is generic w.r.t the higher-kinded brand. We also use default constructor constraints and type inference to define a generic fmap combinator and a sample pipeline on top of that.

We can create functor instances as follows:

[<Struct>]
type List =
    static member Assign(_ : App<List, 'a>, _ : 'a list) = ()
    interface Functor<List> with
        member __.Fmap f (HKT.Unpack xs) = HKT.pack (List.map f xs)

let lst : App<List,_> = HKT.pack [1;2;3;4]

incrSqr lst |> HKT.unpack
// val it : int list = [4; 6; 8; 10]

If you’re interested in more elaborate HKT encodings, please refer to the original paper or the samples in the Higher library.

Application to Generic Programming

A very common generic programming application is the pretty printer. It involves taking an arbitrary type 'a and generating a function of type 'a -> string. It can be represented using a higher-kinded type encoding like so:

type PrettyPrinter =
    static member Assign(_ : App<PrettyPrinter, 'a>, _ : 'a -> string) = ()

Thus, generating a pretty-printer for type 'a boils down to obtaining an instance of type App<PrettyPrinter,'a>.

Defining Higher-Kinded Generic Programs

We can combine the ideas described above to obtain an abstraction capable of describing most generic programming applications. Consider the interface:

type ITypeBuilder<'F> =
    // base types
    abstract Bool : unit -> App<'F, bool>
    abstract Int : unit -> App<'F, int>
    abstract String : unit -> App<'F, string>
    // combinators
    abstract Option : App<'F, 't> -> App<'F, 't option>
    abstract List : App<'F, 't> -> App<'F, 't list>
    abstract Tuple : App<'F, 't1> -> App<'F, 't2> -> App<'F, 't1 * 't2>

Which defines a set of constructors capable of producing generic programs for a small subset of types. As before, we can use a bit of type inference to expose the interface methods as proper combinators:

let inline private inst() : 'F when 'F :> ITypeBuilder<'F> = new 'F()
let bool () = inst().Bool()
let int () = inst().Int()
let string () = inst().String()
let option t = inst().Option t
let list t = inst().List t
let tuple t = inst().Tuple t

Then, writing

let sample () = int () |> list |> option |> tuple (bool ())

Produces a generic constructor for instances of type App<'F,bool * int list option>.

We can now produce a generic pretty-printer by implementing the ITypeBuilder interface:

[<Struct>]
type PrettyPrinter =
    static member Assign(_ : App<PrettyPrinter, 'a>, _ : 'a -> string) = ()

    interface ITypeBuilder<PrettyPrinter> with
        member __.Bool () = HKT.pack (function true -> "true" | false -> "false")
        member __.Int () = HKT.pack (fun i -> i.ToString())
        member __.String() = HKT.pack (sprintf "\"%s\"")

        member __.Option (HKT.Unpack ep) = HKT.pack(function None -> "None" | Some x -> sprintf "Some(%s)" (ep x))
        member __.List (HKT.Unpack ep) = HKT.pack(Seq.map ep >> String.concat "; " >> sprintf "[%s]")
        member __.Tuple (HKT.Unpack lp) (HKT.Unpack rp) = HKT.pack (fun (l,r) -> sprintf "(%s, %s)" (lp l) (rp r))

Which we can consume as follows:

let mkPrinter (x : App<PrettyPrinter,_>) = HKT.unpack x

let p = sample() |> mkPrinter

p (false, Some [1;2])
// val it : string = "(false, Some([1; 2]))"

The same sample value can be reused in the context of other generic programs. Here is one that returns values with zeroed out fields:

[<Struct>]
type Zero =
    static member Assign(_ : App<Zero, 'a>, _ : 'a) = ()

    interface ITypeBuilder<Zero> with
        member __.Bool () = HKT.pack false
        member __.Int () = HKT.pack 0
        member __.String() = HKT.pack ""

        member __.Option (HKT.Unpack z) = HKT.pack(Some z)
        member __.List (HKT.Unpack z) = HKT.pack [z]
        member __.Tuple (HKT.Unpack lz) (HKT.Unpack rz) = HKT.pack (lz,rz)


let mkZero (x : App<Zero,_>) = HKT.unpack x

sample() |> mkZero
// val it : bool * int list option = (false, Some [0])

For the sake of completeness, I should mention that this application is a special case of the tagless-final pattern, which was originally described in a paper by Kiselyov et al.

Folding arbitrary types

One issue with the above approach is that we need to explicitly construct the App<_,_> instances by calling the combinators. While this might be acceptable in the context of simple applications, we’d still like a way to generate programs just by passing a simple type argument.

Luckily, this can be achieved by harnessing the usual TypeShape constructs:

let rec fold<'F, 't when 'F :> ITypeBuilder<'F> and 'F : (new : unit -> 'F)> () : App<'F, 't> =
    let wrap (x : App<'F,_>) : App<'F, 't> = unbox x
    match shapeof<'t> with
    | Shape.Bool -> bool() |> wrap
    | Shape.Int32 -> int() |> wrap
    | Shape.String -> string() |> wrap
    | Shape.FSharpOption s ->
        s.Element.Accept {
            new ITypeVisitor<App<'F, 't>> with
                member __.Visit<'e> () =
                    let e = fold<'F, 'e>()
                    option e |> wrap
        }

    | Shape.FSharpList s ->
        s.Element.Accept {
            new ITypeVisitor<App<'F, 't>> with
                member __.Visit<'e> () =
                    let e = fold<'F, 'e>()
                    list e |> wrap
        }

    | Shape.Tuple s when s.Elements.Length = 2 ->
        let ls = s.Elements.[0].Member
        let rs = s.Elements.[1].Member
        ls.Accept {
            new ITypeVisitor<App<'F, 't>> with
                member __.Visit<'l> () =
                    rs.Accept {
                        new ITypeVisitor<App<'F, 't>> with
                            member __.Visit<'r>() =
                                let l = fold<'F, 'l>()
                                let r = fold<'F, 'r>()
                                tuple l r |> wrap
                    }
        }
    | _ -> failwithf "I do not know how to fold type %O" typeof<'t>

It is then possible to define a generic pretty-printer by doing the following:

let mkPrettyPrinter<'a> () = fold<PrettyPrinter, 'a> () |> HKT.unpack

let p' = mkPrettyPrinter<int * (bool list * string option)> ()

p' (42, ([false;true], Some "string"))
// val it : string = "(42, ([false; true], Some("string")))"

As before, we can reuse the fold function for the zero program:

let zero<'a> = fold<Zero, 'a> () |> HKT.unpack

zero<int * (string option * bool list)>  
// val it : int * (string option * bool list) = (0, (Some "", [false]))

You can find the code sample above in fssnip, complete with type annotations.

Conclusions

While the ideas above are in an early prototype state, the approach in general seems very promising. It significantly simplifies the generic program authoring process by being type safe, eliminating visitors and requiring almost no type annotations. While it may lack the flexibility of the TypeShape constructs, it seems to be good enough for most generic programming applications.

You can find more involved implementations of the above idea in the TypeShape samples folder.