Haskell无法推断类型（或类型级别Nat）等式，尽管已显式注释？

我试图用Haskell实现一个Braun树，定义如下：

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

data BraunTree (n :: Nat) a where
    Empty :: BraunTree 0 a
    Fork :: a -> BraunTree n a -> 
            BraunTree m a ->
            Either (n :~: m) (n :~: (m + 1)) ->
            BraunTree (n + m + 1) a

现在，我正在尝试如何“安全地”将内容插入到这棵树中

insert :: a -> BraunTree (n :: Nat) a -> BraunTree (n + 1 :: Nat) a
insert x Empty = Fork x Empty Empty (Left Refl)
insert x (Fork y (t1 :: BraunTree p a) (t2 :: BraunTree q a) (Left (Refl :: p :~: q))) = Fork x (t1' :: BraunTree (p + 1) a) (t2 :: BraunTree q a) (Right (sucCong Refl :: (p + 1) :~: (q + 1)))
    where
        t1' :: BraunTree (p + 1) a
        t1' = insert x t1

将

sucCong

作为

sucCong :: ((p :: Nat) :~: (q :: Nat)) -> (p + 1 :: Nat) :~: (q + 1 :: Nat)
sucCong Refl = Refl

现在，

insert

的第一个子句编译得很好，而第二行抛出了一个令人困惑的错误

/home/agnishom/test/typeExp/braun.hs:31:90: error:
    • Could not deduce: (((n1 + 1) + n1) + 1) ~ (n + 1)
      from the context: n ~ ((n1 + m) + 1)
        bound by a pattern with constructor:
                   Fork :: forall a (n :: Nat) (m :: Nat).
                           a
                           -> BraunTree n a
                           -> BraunTree m a
                           -> Either (n :~: m) (n :~: (m + 1))
                           -> BraunTree ((n + m) + 1) a,
                 in an equation for ‘insert’
        at /home/agnishom/test/typeExp/braun.hs:31:11-85
      or from: m ~ n1
        bound by a pattern with constructor:
                   Refl :: forall k (a :: k). a :~: a,
                 in an equation for ‘insert’
        at /home/agnishom/test/typeExp/braun.hs:31:69-72
      Expected type: BraunTree (n + 1) a
        Actual type: BraunTree (((n1 + 1) + m) + 1) a
      NB: ‘+’ is a type function, and may not be injective
    • In the expression:
        Fork
          x
          (t1' :: BraunTree (p + 1) a)
          (t2 :: BraunTree q a)
          (Right (sucCong Refl :: (p + 1) :~: (q + 1)))
      In an equation for ‘insert’:
          insert
            x
            (Fork y
                  (t1 :: BraunTree p a)
                  (t2 :: BraunTree q a)
                  (Left (Refl :: p :~: q)))
            = Fork
                x
                (t1' :: BraunTree (p + 1) a)
                (t2 :: BraunTree q a)
                (Right (sucCong Refl :: (p + 1) :~: (q + 1)))
            where
                t1' :: BraunTree (p + 1) a
                t1' = insert x (t1 :: BraunTree p a)
    • Relevant bindings include
        t1' :: BraunTree (n1 + 1) a
          (bound at /home/agnishom/test/typeExp/braun.hs:34:9)
        t1 :: BraunTree n1 a
          (bound at /home/agnishom/test/typeExp/braun.hs:31:19)
        insert :: a -> BraunTree n a -> BraunTree (n + 1) a
          (bound at /home/agnishom/test/typeExp/braun.hs:29:1)

我不确定我在这里做错了什么。还有，为什么haskell认为

t1:：BraunTree n1 a

（在错误消息中），即使我已经注释了

t1:：BraunTree p a

---

解释此错误消息的帮助将非常有用

您有太多的类型签名。很难把它们通读一遍。此外，

sucCong

也不是必需的。让我们先清理一下：

insert :: a -> BraunTree n a -> BraunTree (n + 1) a
insert x Empty = Fork x Empty Empty (Left Refl)
insert x (Fork y t1 t2 (Left Refl)) = Fork x (insert x t1) t2 (Right Refl)
-- by matching on Refl       ^^^^ you already prove that p ~ q
-- and (p + 1) ~ (q + 1) just follows naturally (i.e. is Refl)       ^^^^
-- if you just bound the equality to a variable, then sucCong would be necessary
-- as it would match the variable to Refl "for" you.

错误是一样的

Braun.hs:#：39:错误：
•无法推断：（（n1+1）+n1）+1）~（n+1）
从上下文来看：n~（（n1+m）+1）
由具有构造函数的模式绑定：
Fork：：forall a（n：：Nat）（m：：Nat）。
A.
->布朗特里酒店
->布朗特里文学硕士
->或者（n:~:m）（n:~:m+1））
->布朗特里（（n+m）+1）a，
在“插入”的方程式中
布劳恩：11-34
或者来自：m~n1
由具有构造函数的模式绑定：
Refl：：forall k（a：：k）。a:~:a，
在“插入”的方程式中
布劳恩：30-33
预期类型：BraunTree（n+1）a
实际类型：布朗特里（（n1+1）+m）+1）a
NB:“+”是一个非内射型族
•在表达式中：叉x（插入x t1）t2（右反射）
在“插入”的方程式中：
插入x（叉y t1 t2（左反射））
=叉x（插入x t1）t2（右反射）
•相关绑定包括
t1：：布朗特里n1 a（绑定在布朗特：18）
插入：：a->BraunTree n a->BraunTree（n+1）a
（订于布劳恩。hs:#：1）
|
#|插入x（叉y t1 t2（左反射））=叉x（插入x t1）t2（右反射）
|                                       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

在消息的底部，

n1

是

t1

的索引，您称之为

p

。我们还知道

m

（

t2

的索引）等于

p

，而

n

（函数参数）等于

（p+m）+1

。让我们对失败的约束应用所有替换：

（（n1+1）+n1+1）~（n+1）
--将n1重命名为p
（（p+1）+p+1）~（n+1）
--替换n~（p+m）+1
（（p+1）+p+1）～（（p+m）+1）+1）
--m~p
（（p+1）+p+1）～（（p+p）+1）+1）

问题是GHC无法证明

（（p+1）+p）～（（p+p）+1）

。如果您使用了一个更好的

Nat

，一个没有内置到编译器中的Nat，那么您自己就可以证明这是正确的。事实上，最明智的想法可能是：

{-# LANGUAGE AllowAmbiguousTypes #-}
import Unsafe.Coerce
-- using TypeApplications usually means using AllowAmbiguousTypes

-- it is also possible to use a compiler plugin to "teach" GHC the laws
-- of arithmetic
-- by keeping the unsafeCoerce in these wrappers, you decrease the chance of
-- "proving" something that isn't actually true.
plusAssoc :: forall l m r. ((l + m) + r) :~: (l + (m + r))
plusAssoc = unsafeCoerce Refl
plusComm :: forall l r. (l + r) :~: (r + l)
plusComm = unsafeCoerce Refl

insert :: a -> BraunTree n a -> BraunTree (n + 1) a
insert x Empty = Fork x Empty Empty (Left Refl)
insert x (Fork y (t1 :: BraunTree p a) t2 (Left Refl)) =
  case plusAssoc @p @1 @p of Refl -> -- (p + 1) + p => p + (1 + p)
    case plusComm @1 @p of Refl -> -- p + (1 + p) => p + (p + 1)
      case plusAssoc @p @p @1 of Refl -> -- p + (p + 1) => (p + p) + 1
        Fork x (insert x t1) t2 (Right Refl)

---

注意：

BraunTree

真的应该有两个构造函数吗？基本上有两种叉：平衡叉和不平衡叉。将

Fork

拆分为两个构造函数将更有意义（并删除一堆间接操作）。它也会更好，因为您将消除某些部分定义的值。

GHC不知道加法是交换的和关联的

在删除一些类型SIG之后，我得到了一个稍微不同的错误。很明显，所有相同的术语都出现了，但顺序不同：

• Could not deduce: (((n1 + 1) + m) + 1) ~ (n + 1)
  from the context: n ~ ((n1 + m) + 1)

原始方程式是等效的，但不一致地将

m

替换为

n1

---

不幸的是，如果您坚持使用内置的

Nat

，我不知道如何帮助GHC。我敢肯定，您可以切换到自己的

Nat

，并证明必要的平等性。我不知道是否有这样的定理库。

您可以尝试使用这个编译器插件，它可以为您自动推断

Nat

s的类型等式：

---

GHC的错误消息对于存在型变量来说非常糟糕。您可以用您喜欢的任何名称对它们进行注释，但错误消息基本上总是显示GHC分配的内部名称（基于构造函数声明中使用的名称）

n1

和

p

在这里是一样的，但是

p

只是没有出现在错误消息中。感谢您的详细解释。我不明白的是等式

（（p+1）+p）+1）～（（p+p）+1）+1）是如何产生的。左手边来自
叉的类型
n+m+1
变为
（p+1）+p+1
，因为两个子树都有大小
p
。右侧来自
insert
类型，它要求树的大小增加1。在该类型中，
n
是整个树的大小，
（p+p）+1
。右侧有一个
BraunTree p a
，而
insert
为左侧创建一个
BraunTree（p+1）a
。将它们放在
叉下
创建
BraunTree（（（p+1）+p）+1）a
。类型签名表示您应该有一个
BraunTree（（（p+p）+1）+1）a
。因为GHC不能做代数，所以类型不匹配。编辑：忍者d。