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 *          


        

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!"