Emulating Haskell type classes in F#

One language feature I like most in Haskell is type class. It was originally conceived as a way of implementing overloaded arithmetic and equality operators. It is a clever trick to support ad-hoc polymorphism, which does not require extensive modifications of the compiler or the type system.

F# does not provide type class, but we can emulate it with other F# language features such as operator overloading and inline function. Type Classes for F# shows this trick. Here’s the Functor example taken from the blog:

type Fmap = Fmap with
    static member ($) (Fmap, x:option<_>) = fun f -> Option.map f x
    static member ($) (Fmap, x:list<_>  ) = fun f -> List.map   f x
let inline fmap f x = Fmap $ x <| f

Here, fmap function must be inline because inline functions can have statically resolved type parameters. Without the inline modifier, type inference forces the function to take a specific type. In this case, the compiler can’t decide between option and list and emits an error.

You can use it as in the following:

> fmap ((+) 2) [1;2;3] ;;
val it : int list = [3; 4; 5]
> fmap ((+) 2) (Some 3) ;;
val it : int option = Some 5

I transliterated the TreeRec example of Simon Thompson’s paper, Higher-order + Polymorphic = Reusable into F# by emulating type class in this way.

type Tree<'a> =
    | Leaf
    | Node of 'a * Tree<'a> * Tree<'a>

type LeafClass = LeafClass with
    static member ($) (LeafClass, t:'a list)  = []
    static member ($) (LeafClass, t:Tree<'a>) = Leaf
let inline leaf () : ^R = (LeafClass $ Unchecked.defaultof< ^R> )

type NodeClass = NodeClass with
    static member ($) (NodeClass, l1:'a list)  = fun a l2 -> List.concat [l1; [a]; l2]
    static member ($) (NodeClass, t1:Tree<'a>) = fun a t2 -> Node(a, t1, t2)
let inline node a x1 x2 = (NodeClass $ x1) a x2

type TreeRecClass = TreeRecClass with
    static member ($) (TreeRecClass, l:'a list) = fun f st ->
        let listToTree = function
            | [] -> failwith "listToTree"
            | a::x ->
                let n = List.length x / 2
                let l1 = Seq.take n x |> Seq.toList
                let l2 = Seq.skip n x |> Seq.toList
                (a, l1, l2)
        let rec treeRec' = function
            | [] -> st
            | l ->
                let a, t1, t2 = listToTree l
                let v1 = treeRec' t1
                let v2 = treeRec' t2
                f v1 v2 a t1 t2
        treeRec' l
    static member ($) (TreeRecClass, t:Tree<'a>) = fun f st ->
        let rec treeRec' f st = function
            | Leaf -> st
            | Node(a, t1, t2) -> f (treeRec' f st t1) (treeRec' f st t2) a t1 t2
        treeRec' f st t
let inline treeRec f st x = (TreeRecClass $ x) f st

let inline tSort x =
     // FIXME: Implement sorting!
    let mVal sort1 sort2 v = List.concat [sort1; sort2; [v]]
    let mergeVal sort1 sort2 v t1 t2 = mVal sort1 sort2 v
    treeRec mergeVal [] x

One problem with this approach is that we no longer can group related operations together into a single class. It can’t express that Tree-like type t* has three operations: leaf, node and treeRec. We end up having three distinct types LeafClass, NodeClass and TreeRecClass.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s