Nov 152011
 

Another application of the technique showed in previous posts is to emulate Haskell’s typeclasses.
If you’re not familiar with typeclasses Irecommend reading this tutorial. The typeclassopedia goes through most of the typeclasses covered in this code.
We know how to overloaded functions using an intermediate DU with overloaded operators, this will allow us to define overloads for predefined or built-in types like list and option.
Here’s our first try to define the Functor class.

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

Now we can try, for example:

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

It works as expected, now let’s try the Monad class.
We need two types, one for return and another one for (>>=).
One thing we will need to resolve to implement return is how do we specify different overloads when the only overloaded parameter is the output.
One trick to achieve this is sending a value of the return type as input, that value shouldn’t be used because it may contain an invalid value for that type (ie: a null for a DU).
Here’s how:

type Return = Return with
    static member ($) (Return, t:'a option) = fun (x:'a) -> Some x
    static member ($) (Return, t:'a list)   = fun (x:'a) -> [x]
let inline return' x : ^R = (Return $ Unchecked.defaultof< ^R> ) x

type Bind = Bind with
    static member ($) (Bind, x:option<_>) = fun f -> Option.bind f x
    static member ($) (Bind, x:list<_>  ) = fun f ->
        let rec bind f = function
                         | x::xs -> f x @ (bind f xs)
                         | []    -> []
        bind f x
let inline (>>=) x f = Bind $ x <| f

Some tests

> let a:list<_> = return' 1 ;;
val a : int list = [1]

> let a:option<_> = return' 1 ;;
val a : int option = Some 1

> [(+) 10;(*) 2] >>= fun f -> [f 1;f 2;f 3] ;;
val it : int list = [11; 12; 13; 2; 4; 6]

> return' ((+) 10) >>= fun f -> Some (f 1) ;;
val it : int option = Some 11

Eventually we will need a method accepting two polymorphic parameters, both input parameters or an input and an output parameter.
Then we will need a ternary operator, the only one in F# is the dynamic assignment (?<-). The 2nd parameter of this operator is expected to be a string, so type inference will unify it by default with the string type, that’s why it will be used for the DU that represent the function we’re overloading. Because this operator will cover more cases we will adopt it and use it, even if there are unused parameters (as will be the case for return), just to make the signatures easier. Another thing we can do i order to make the signature more readable is to accept an unused value for the DU but instead of _ will be named _Monad in this example. We will use it to represent the name of the Typeclass. So return’ and bind will be defined as:

// return' and (>>=)

type Return = Return with
    static member (?<-) (_, _Monad:Return, _:'a option   ) = fun (x:'a) -> Some x
    static member (?<-) (_, _Monad:Return, _:'a list     ) = fun (x:'a) -> [x]
let inline return' x : ^R = (() ? (Return) <- Unchecked.defaultof< ^R> ) x

type Bind = Bind with
    static member (?<-) (x:option<_>  , _Monad:Bind,_:option<'b>) = fun f -> Option.bind f x
    static member (?<-) (x:list<_>    , _Monad:Bind,_:list<'b>  ) = fun f -> 
        let rec bind f = function
                         | x::xs -> f x @ bind f xs
                         | []    -> []
        bind f x
let inline (>>=) x f : ^R = (x ? (Bind) <- Unchecked.defaultof< ^R> ) f

Do Notation

Having defined the Monad class, now we can define a generic computation expression.
This will be very similar to Haskell’s do notation, but because do is an F# reserved word we will use do’ instead.

type DoNotationBuilder() =
    member inline b.Return(x) = return' x
    member inline b.Bind(p,rest) = p >>= rest
    member b.Let(p,rest) = rest p
    member b.ReturnFrom(expr) = expr
let do' = new DoNotationBuilder()

This way the liftMs functions can be defined the Haskell way:

let inline liftM  f m1      = do' { let! x1 = m1 in return (f x1) }
let inline liftM2 f m1 m2   = do' { let! x1 = m1 in let! x2 = m2 in return (f x1 x2) }

Adding new instances to existing Typeclasses

Now, let’s suppose we have this code already defined in a library and we can’t or we don’t want to change it, the question is how do we declare functions of a new type as instance of an existing class.

As an example we will create the type IO (same as in Haskell) and make it a Monad.

Well, all we have to do is declare the new type and implement the corresponding static method from the class we’re interested on, with same signature as it was defined, I mean with the arguments in the same order.

Here’s how

type IO<'a> = IO of (unit->'a)

let runIO  (IO f)   = f()
let primretIO  f    = IO(fun () -> f)
let primbindIO io f = IO(fun () -> runIO (f (runIO io )))

let getLine    = IO(fun() -> System.Console.ReadLine())
let putStrLn x = IO(fun() -> printfn "%s" x)

type IO<'a> with // these are not Extension Methods
    static member (?<-) (_      , _Monad:Return, _:'a IO ) = fun (x:'a) -> primretIO x
    static member (?<-) (x:IO<_>, _Monad:Bind  , _:IO<'b>) = fun f      -> primbindIO x f

Once compiled we can test if it’s included on the overload resolution


let action = do' {
    do! putStrLn  "What is your first name?"
    let! fn = getLine
    do! putStrLn  ("Thanks, " + fn)
    do! putStrLn  ("What is your last name?")
    let! ln = getLine
    let  fullname = fn + " " + ln
    do! putStrLn  ("Your full name is: " + fullname)
    return fullname }

    // Compile it and type at the command line runIO action ;;

 

The F# Typeclasses Library

Based on these techniques I created a project here that mimics many Haskell Typeclasses.
At the time I’m writing this post I was able to define Typeclasses like Functor, Applicative Functor, Monoid, Traversable, Monad and even Monad Transformer and Arrow.
There’s still lot of things that could be added to the library. Reviews, suggestions and improvements are welcome.

Conclusion

In this post we covered another trick that will allow us to declare overloads based on the return parameter.
Together with the other techniques covered in previous articles, this post presented a way of implementing Typeclasses in F# at compile time.
As we’re not using recursive inlining compile time is not an issue compared to previous posts.

Nov 072011
 

Although F# seems to have no tuple size limit there’s no primitive functions to “expand” a tuple.
Tuples are intended to be composed and decomposed as Algebraic Data Types, there are only 2 functions provided: fst and snd, and they work only with a 2-uple.
We can build functions with overloads for each arity, up to a reasonable size, the problem with this approach is that we will have a lot of repetitive code for each function.
To avoid the repetitive code, one approach is to use a code generator.
Another approach is to define the primitives functions repeating code and using inline for the rest of the functions.
We can think of a tuple as a list, so the primitives are cons and split in head-tail.
We’ll need a way to represent the 0-uple and a single element 1-uple. For the 1-uple we will a type called Singleton and for the empty tuple we will use the unit value ().

type Singleton<'a>   = Singleton of 'a

type Split = Split with
    static member ($) (Split, Singleton x1    ) = (x1, ())
    static member ($) (Split, (x1,x2)         ) = (x1, Singleton x2)
    static member ($) (Split, (x1,x2,x3)      ) = (x1, (x2,x3))
    static member ($) (Split, (x1,x2,x3,x4)   ) = (x1, (x2,x3,x4))
    static member ($) (Split, (x1,x2,x3,x4,x5)) = (x1, (x2,x3,x4,x5))
 
type Join = Join with
    static member ($) (Join, ()           ) = fun x -> Singleton x
    static member ($) (Join, Singleton x1 ) = fun x -> (x,x1)
    static member ($) (Join, (x1,x2)      ) = fun x -> (x,x1,x2)
    static member ($) (Join, (x1,x2,x3)   ) = fun x -> (x,x1,x2,x3)
    static member ($) (Join, (x1,x2,x3,x4)) = fun x -> (x,x1,x2,x3,x4)

let inline (|Cons|) tuple   = Split $ tuple
let inline Cons (head,tail) = Join $ tail <| head

Functions to be implemented:
Cons – Will be implemented also as an active pattern so we can go both ways.
Rev – Reverse the elements of the tuple.
Map – Map a function into a tuple with elements of the same type.
Fold – Will work also with tuples with elements of the same type.
<*> – Apply each function of the first tuple to the corresponding element of the second tuple. For Haskellers this will be like the <*> operator for the ZipList applicative functor.

We’ll need to define a binary operator, but the first parameter will be the type that represent the function.
As operator we’ll use ($), the Haskell equivalent of (<|) which should be read as ‘apply’.
Some functions take 2 parameters, so for the second parameter we may need to use parenthesis, because the binary operator has precedence over the apply:
f a1 a2 = (f $ a1) a2
But we will use the idiomatic F# ‘apply’ (<|)
f $ a1 <| a2
In some cases we will swap the order of the parameters, because we need the tuple to participate in the ($) operator resolution to select the right overload.
Having implemented the primitives, before doing the rest of the functions, let’s think how would they look for lists.

 

let rec Rev list ac = match list with
                      | x::xs -> Rev xs (x::ac) 
                      | []    -> ac
let rev list = Rev list [] 

let rec Map list f = match list with
                     | x::xs -> f x :: Map xs f
                     | []    -> []
let map f list = Map list f

let rec Fold list f z = match list with
                        | x::xs -> Fold xs f (f z x)
                        | []    -> z
let fold f z list = Fold list f z

let rec Ap fnList list = match fnList with
                         | f::fs -> let (x::xs) = list in (f x :: Ap fs xs)
                         | []    -> []
let (<*>) fnList list = Ap fnList list

Let’s do it point-free.

let rec Rev = function
    | x::xs -> fun ac -> Rev xs (x::ac) 
    | []    -> id
let rev list = Rev list []

let rec Map = function
    | x::xs -> fun f -> f x :: Map xs f
    | []    -> fun _ -> []
let map f list = Map list f

let rec Fold = function
    | x::xs -> fun f z -> Fold xs f (f z x)
    | []    -> fun _ x -> x
let fold f z list = Fold list f z

let rec Ap = function
    | f::fs -> fun (x::xs) -> (f x :: Ap fs xs)
    | []    -> fun _       -> []
let (<*>) fnList list = Ap fnList list

List with different number of elements may share the same type, this is not true with tuples.
For tuples we will go from one type to another all the time.
Remember in previous post the rules to translate a value-level to a type-level implementation?

“for each case in the discriminated union create a separate type, for each case in the match create different overloads of the same method”

We already have different types: () , Singleton, (,) , (,,) , (,,,) and so on. The difference is now we’re using existing types, except for Singleton.
But then in the first post of these series we faced that problem, the solution when we don’t have access to the source code of the type was

“use a DU as intermediate type, implement an operator as static member, accepting an unused parameter which is a value of the DU and the other parameter is overloaded”

So, the same functions for tuples could be written this way:

type Rev = Rev with
    static member inline ($) (Rev, Cons(x,xs)) = fun ac -> Rev $ xs <| Cons(x,ac)
    static member        ($) (Rev, ()        ) = id
let inline rev tuple = Rev $ tuple <| ()

type Map = Map with
    static member inline ($) (Map, Cons(x,xs)) = fun f -> Cons(f x, Map $ xs <| f)
    static member        ($) (Map, ()        ) = fun _ -> ()
let inline map f tuple = Map $ tuple <| f

type Fold = Fold with
    static member inline ($) (Fold, Cons(x,xs)) = fun f z -> Fold $ xs <| f <| f z x
    static member        ($) (Fold, ()        ) = fun _ x -> x
let inline fold f z tuple = Fold $ tuple <| f <| z

type Ap = Ap with
    static member inline ($) (Ap, Cons(f,fs)) = fun (Cons(x,xs)) -> Cons(f x, Ap $ fs <| xs)
    static member        ($) (Ap, ()        ) = fun _            -> ()
let inline (<*>) fnTuple tuple = Ap $ fnTuple <| tuple

A quick test

> rev (1, "second", [3], 4.0) ;;
val it : float * int list * string * int = (4.0, [3], "second", 1)

> map ((+) 10) (5, 15, 25) ;;
val it : int * int * int = (15, 25, 35)

> map string (5, 15, 25) ;;
val it : string * string * string = ("5", "15", "25")

> fold (+) 0 (5, 15, 25) ;;
val it : int = 45

> ((+), (*)) <*> (2, 5.5) <*> (3, 2.0) ;;
val it : int * float = (5, 11.0)

Some functions make more sense with lists, otherwise we are restricted to a tuple of elements of the same type, but in the case of the operator <*> it’s the opposite, it will be more interesting with tuples than with lists because it will be able to operate with different types.

Another interesting function could be nth, but we can’t use integers, because we can’t select a type based on a value.
What we can do is select type based on another type.
Remember Peano numbers?

type Zero     = Zero with
    static member inline (|!|) (Cons(x,_),Zero) = x
 
type Succ<'a> = Succ of 'a with
    static member inline (|!|) (Cons(_,xs),Succ p) = xs |!| p

let inline nth tuple  n = tuple |!| n

Now we can access any element without losing type information.


> let I = Succ Zero ;;
val I : Succ<Zero> = Succ Zero

> let II = Succ I ;;
val II : Succ<Succ<Zero>> = Succ (Succ Zero)

> nth (50, 'b', "F# is fun") Zero ;;
val it : int = 50

> nth (50, 'b', "F# is fun") I ;;
val it : char = 'b'

> nth (50, 'b', "F# is fun") II ;;
val it : string = "F# is fun"

Conclusion

In this post we used and abused of recursive inline functions at the point we’re killing the compiler.
We integrated two different techniques we saw individually in previous posts.
In the next post we will concentrate and refine more this technique.