实现指树时键入错误

时间:2016-10-04 13:55:58

标签: recursion types f# infinite finger-tree

我希望用Hinze的(Haskell)论文中描述的2-3个手指树来玩游戏(另见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>

现在我无法使viewl函数正常工作,它抱怨类型不匹配:

  

期待一个FingerTree&lt;&#39; a&gt;但是给了一个FingerTree&gt;。

     

在统一&#39;&#39; a&#39;和&#39;节点&#39; a&gt;&#39; 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!"

我之前在prepend中遇到此错误,但能够通过在函数上添加完整类型信息来解决此问题。

// 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)

对于viewl,这似乎不够,所以我也尝试在函数中间添加类型(查找注释)。它没有用。

我有点理解错误及其来源。谁能告诉我如何使这个工作?恕我直言,这应该是可能的,因为否则prepend也不会编译。也许像this这样的技巧有帮助吗? (尽管不明白)。

PS:我还将代码放在FsSnip上,以便在浏览器中播放。

1 个答案:

答案 0 :(得分:5)

viewlprepend等函数依赖于polymorphic recursion:对prepend的递归调用采用与原始调用不同类型的参数。您可以在F#中定义此类函数,但正如您发现它们需要完整类型注释(否则您会收到一个非常混乱的错误消息)。特别要注意,类型参数必须在函数的定义中是显式的(尽管通常可以在调用站点推断它们)。所以第一个问题是您需要在定义中指定viewl<'a>

然而,有一个非常微妙的第二个问题,涉及Digit<_>.OfList。尝试将第一块代码发送到F#interactive,并查看生成的定义的签名:您将看到static member OfList : (obj list -> Digit<obj>),随后会生成viewl,以便无法正确定义OfList。所以发生了什么事?你还没有给'a list签名,所以它不是一般的方法(函数将被推广,但成员永远不会是)。但编译器也无法推断出您希望输入列表属于'a类型,其中int list是类型的泛型参数 - 为什么它会推断出这个特定类型而不是{{1} }或string list等?所以它选择了一个无聊的单态默认值(obj list),除非你在后续代码中做了一些事情来将它约束到另一个具体的单态类型。相反,您需要向Digit添加签名,然后一切都会好的。

通常在F#中,为每个类型创建一个单独的模块以定义相关函数(如ToList等)是惯用的。由于函数定义是一般化的,这也可以避免您遇到的Digit问题这里。也就是说,您可以像这样构建代码:

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