Type error when implementing finger trees

Question

I wanted to play around with 2-3 finger trees as described in the (Haskell) paper by Hinze (see also this blog).

type Node<'a> =
    | Node2 of 'a * 'a
    | Node3 of 'a * 'a * 'a

    static member OfList = function
        | [a; b] -> Node2(a, b)
        | [a; b; c] -> Node3(a, b, c)
        | _ -> failwith "Only lists of length 2 or 3 accepted!"

    member me.ToList () =
        match me with
        | Node2(a, b) -> [a; b]
        | Node3(a, b, c) -> [a; b; c]

type Digit<'a> =
    | One of 'a
    | Two of 'a * 'a
    | Three of 'a * 'a * 'a
    | Four of 'a * 'a * 'a * 'a

    static member OfList = function
        | [a] -> One(a)
        | [a; b] -> Two(a, b)
        | [a; b; c] -> Three(a, b, c)
        | [a; b; c; d] -> Four(a, b, c, d)
        | _ -> failwith "Only lists of length 1 to 4 accepted!"

    member me.ToList () =
        match me with
        | One a -> [a]
        | Two(a, b) -> [a; b]
        | Three(a, b, c) -> [a; b; c]
        | Four(a, b, c, d) -> [a; b; c; d]

    member me.Append x =
        match me with
        | One a -> Two(a, x)
        | Two(a, b) -> Three(a, b, x)
        | Three(a, b, c) -> Four(a, b, c, x)
        | _ -> failwith "Cannot prepend to Digit.Four!"

    member me.Prepend x =
        match me with
        | One a -> Two(x, a)
        | Two(a, b) -> Three(x, a, b)
        | Three(a, b, c) -> Four(x, a, b, c)
        | _ -> failwith "Cannot prepend to Digit.Four!"

[<NoComparison>]
[<NoEquality>]
type FingerTree<'a> =
    | Empty
    | Single of 'a
    | Deep of Digit<'a> * FingerTree<Node<'a>> * Digit<'a>

type Digit<'a> with
    member me.Promote () =
        match me with
        | One a -> Single a
        | Two(a, b) -> Deep(One a, Empty, One b)
        | Three(a, b, c) -> Deep(One a, Empty, Two(b, c))
        | Four(a, b, c, d) -> Deep(Two(a, b), Empty, Two(c, d))

type View<'a> = Nil | View of 'a * FingerTree<'a>

Now I just cannot get the viewl function working, it complains about a type mismatch:

Expecting a FingerTree<'a> but given a FingerTree>.

The resulting type would be infinite when unifying ''a' and 'Node<'a>' FingerTree.

let rec viewl : FingerTree<'a> -> View<'a> = function
    | Empty -> Nil
    | Single x -> View(x, Empty)
    | Deep(One x, deeper(*:FingerTree<'a>/FingerTree<Node<'a>>*), suffix) ->
        let rest =
            match viewl deeper with
            | Nil ->
                suffix.Promote()
            | View (node(*:Node<'a>*), rest) ->
                let prefix = node.ToList() |> Digit<_>.OfList
                Deep(prefix, rest, suffix)
        View(x, rest)
    | Deep(prefix, deeper, suffix) ->
        match prefix.ToList() with
        | x::xs ->
            View(x, Deep(Digit<_>.OfList xs, deeper, suffix))
        | _ -> failwith "Impossible!"

I had this error before in prepend but was able to resolve it by adding the full type info on the function.

// These three/four type annotations solved the problem.
let rec prepend<'a> (a:'a) : FingerTree<'a> -> FingerTree<'a> = function
    | Empty -> Single a
    | Single b -> Deep(One a, Empty, One b)
    | Deep(Four(b, c, d, e), deeper, suffix) ->
        Deep(Two(a, b), prepend (Node3(c, d, e)) deeper, suffix)
    | Deep(prefix, deeper, suffix) ->
        Deep(prefix.Prepend a, deeper, suffix)

For viewl this doesn't seem to be enough, so I also tried adding types in the middle of the function (look for the comments). It didn't work.

I kind of understand the error and where it is coming from. Can anyone tell me how to get this working? IMHO, it should be possible, because otherwise prepend would also not compile. Maybe a trick like this helps? (Don't understand it though).

---

PS: I also put the code on FsSnip for playing around in the browser.

Answer 1

Functions like viewl or prepend rely on polymorphic recursion: the recursive call to prepend takes an argument of a different type than the original call. You can define such functions in F#, but as you discovered they require full type annotations (or else you get a very confusing error message). In particular, note that the type parameters must be explicit in the function's definition (though they can typically be inferred at call sites). So the first problem is that you need to specify viewl<'a> in the definition.

However, there's an extremely subtle second problem, which concerns Digit<_>.OfList. Try sending the first chunk of code to F# interactive and looking at the signatures of the resulting definitions: you'll see static member OfList : (obj list -> Digit<obj>), which will subsequently make it so that viewl can't be defined correctly. So what happened? You haven't given a signature to OfList, so it won't be a generic method (functions will be generalized, but members never will be). But the compiler also can't infer that you intended for the input list to be of type 'a list where the 'a is the type's generic parameter - why would it infer this specific type rather than int list or string list, etc.? So it chooses a boring monomorphic default (obj list), unless you do something in subsequent code to constrain it to a different concrete monomorphic type. Instead, you need to add a signature to Digit and then everything will be fine.

Often in F# it is idiomatic to create a separate module per-type to define related functions like ToList, etc. Since function definitions are generalized, this would also have avoided the Digit problem you face here. That is, you could structure your code like this:

type Node<'a> =
    | Node2 of 'a * 'a
    | Node3 of 'a * 'a * 'a

module Node =
    let ofList = function
    | [a; b] -> Node2(a, b)
    | [a; b; c] -> Node3(a, b, c)
    | _ -> failwith "Only lists of length 2 or 3 accepted!"

    let toList = function
    | Node2(a, b) -> [a; b]
    | Node3(a, b, c) -> [a; b; c]

type Digit<'a> =
    | One of 'a
    | Two of 'a * 'a
    | Three of 'a * 'a * 'a
    | Four of 'a * 'a * 'a * 'a

[<NoComparison>]
[<NoEquality>]
type FingerTree<'a> =
    | Empty
    | Single of 'a
    | Deep of Digit<'a> * FingerTree<Node<'a>> * Digit<'a>

module Digit =
    let ofList = function
    | [a] -> One(a)
    | [a; b] -> Two(a, b)
    | [a; b; c] -> Three(a, b, c)
    | [a; b; c; d] -> Four(a, b, c, d)
    | _ -> failwith "Only lists of length 1 to 4 accepted!"

    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]

    let append x = function
    | One a -> Two(a, x)
    | Two(a, b) -> Three(a, b, x)
    | Three(a, b, c) -> Four(a, b, c, x)
    | _ -> failwith "Cannot prepend to Digit.Four!"

    let prepend x = function
    | One a -> Two(x, a)
    | Two(a, b) -> Three(x, a, b)
    | Three(a, b, c) -> Four(x, a, b, c)
    | _ -> failwith "Cannot prepend to Digit.Four!"

    let promote = function
    | One a -> Single a
    | Two(a, b) -> Deep(One a, Empty, One b)
    | Three(a, b, c) -> Deep(One a, Empty, Two(b, c))
    | Four(a, b, c, d) -> Deep(Two(a, b), Empty, Two(c, d))

type View<'a> = Nil | View of 'a * FingerTree<'a>

let rec viewl<'a> : FingerTree<'a> -> View<'a> = function
    | Empty -> Nil
    | Single x -> View(x, Empty)
    | Deep(One x, deeper, suffix) ->
        let rest =
            match viewl deeper with
            | Nil -> suffix |> Digit.promote
            | View (node, rest) ->
                let prefix = node |> Node.toList |> Digit.ofList
                Deep(prefix, rest, suffix)
        View(x, rest)
    | Deep(prefix, deeper, suffix) ->
        match prefix |> Digit.toList with
        | x::xs ->
            View(x, Deep(Digit.ofList xs, deeper, suffix))
        | _ -> failwith "Impossible!"