Haskell 无法在两个存在论中就单例库推断KnownNat

我在试验Singleton库，发现了一个我不理解的案例

{-# LANGUAGE GADTs, StandaloneDeriving, RankNTypes, ScopedTypeVariables,
FlexibleInstances, KindSignatures, DataKinds, StandaloneDeriving  #-}

import Data.Singletons.Prelude
import Data.Singletons.TypeLits

data Foo (a :: Nat) where
 Foo :: Foo a
  deriving Show

data Thing where
  Thing :: KnownNat a => Foo a -> Thing

deriving instance Show Thing

afoo1 :: Foo 1
afoo1 = Foo 

afoo2 :: Foo 2
afoo2 = Foo 

athing :: Thing
athing = Thing afoo1

foolen :: forall n. KnownNat n => Foo n -> Integer
foolen foo =
  case sing of (SNat :: Sing n) -> natVal (Proxy :: Proxy n)


minfoo :: forall a b c. (Min a b ~ c, KnownNat c) => Foo a -> Foo b -> Integer
minfoo _ _ = 
  let c = case sing of (SNat :: Sing c) -> natVal (Proxy :: Proxy c)
  in natVal (Proxy :: Proxy c)

thinglen :: Thing -> Integer
thinglen (Thing foo) = foolen foo 

我可以用这个来得到至少两样东西

minthing :: Thing -> Thing -> Integer
minthing (Thing foo1) (Thing foo2) = min (foolen foo1) (foolen foo2)

但是为什么我不能这么做呢

minthing' :: Thing -> Thing -> Integer
minthing' (Thing foo1) (Thing foo2) = minfoo foo1 foo2

• Could not deduce (KnownNat
                      (Data.Singletons.Prelude.Ord.Case_1627967386
                         a
                         a1
                         (Data.Singletons.Prelude.Ord.Case_1627967254
                            a a1 (GHC.TypeLits.CmpNat a a1))))

---

你需要做一些定理证明来检查给定的

KnownNat a

和

KnownNat b

你可以得到

KnownNat（Min a b）

。一种可能的解决办法：

import Data.Constraint

（……）

---

我觉得user3237465的评论需要永久化，因为它删除了containt库依赖项，而且非常简洁

minthing' :: Thing -> Thing -> Integer
minthing' (Thing foo1) (Thing foo2) =
  theorem (fooSing foo1) (fooSing foo2) $ minfoo foo1 foo2
  where
    fooSing :: KnownNat a => Foo a -> Sing a
    fooSing = const sing

theorem :: forall a b c. (KnownNat a, KnownNat b) =>
           Sing a -> Sing b -> (KnownNat (Min a b) => c) -> c
theorem sa sb c = case sCompare sa sb of
  SLT -> c
  SEQ -> c
  SGT -> c

---

我不得不承认，我在这方面做得不多，但在我看来，你在

minfoo

中缺少

（KnownNat a，KnownNat b）

。

minthing' :: Thing -> Thing -> Integer
minthing' (Thing foo1) (Thing foo2) =
  theorem (fooSing foo1) (fooSing foo2) $ minfoo foo1 foo2
  where
    fooSing :: KnownNat a => Foo a -> Sing a
    fooSing = const sing

theorem :: forall a b c. (KnownNat a, KnownNat b) =>
           Sing a -> Sing b -> (KnownNat (Min a b) => c) -> c
theorem sa sb c = case sCompare sa sb of
  SLT -> c
  SEQ -> c
  SGT -> c