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!" [] [] type FingerTree<'a> = | Empty | Single of 'a | Deep of Digit<'a> * FingerTree> * 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> module Finger = 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) let rec viewl : FingerTree<'a> -> View<'a> = function | Empty -> Nil | Single x -> View(x, Empty) | Deep(One x, deeper(*:FingerTree<'a>/FingerTree>*), 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!"