将Ord实例添加到'singleton'包生成的自然

den*_*mal 3 haskell dependent-type template-haskell singleton-type

我使用单一包生成的非常简单的类型级自然.我现在正在尝试向他们添加Ord实例.

{-# LANGUAGE MultiParamTypeClasses, TemplateHaskell, KindSignatures, DataKinds, ScopedTypeVariables, GADTs, TypeFamilies, FlexibleInstances, TypeOperators, UndecidableInstances, InstanceSigs #-}

module Functions where

import Data.Singletons
import Data.Singletons.TH
import Data.Singletons.Prelude
import Data.Promotion.Prelude

singletons [d|
             data Nat = Z | S Nat
               deriving Eq

             instance Ord Nat where
               (<=)    Z     _  = True
               (<=) (S _)    Z  = False
               (<=) (S n) (S m) = n <= m
             |]
Run Code Online (Sandbox Code Playgroud)

我一直在遇到一个错误.最新的一个是:

src/Functions.hs:10:1:
    Couldn't match kind ‘Nat’ with ‘*’
    When matching types
      n0 :: Nat
      t1 :: *
    Expected type: Sing t1
      Actual type: Sing n0
    Relevant bindings include
      n_a9na :: Sing n0 (bound at src/Functions.hs:10:1)
      lambda :: Sing n0 -> Sing m0 -> Sing (Apply (Apply (:<=$) t00) t10)
        (bound at src/Functions.hs:10:1)
    In the second argument of ‘applySing’, namely ‘n_a9na’
    In the first argument of ‘applySing’, namely
      ‘applySing (singFun2 (Proxy :: Proxy (:<=$)) (%:<=)) n_a9na’

src/Functions.hs:10:1:
    Could not deduce (SOrd 'KProxy) arising from a use of ‘%:<=’
    from the context (t00 ~ 'S n)
      bound by a pattern with constructor
                 SS :: forall (z_a9mg :: Nat) (n_a9mh :: Nat).
                       (z_a9mg ~ 'S n_a9mh) =>
                       Sing n_a9mh -> Sing z_a9mg,
               in an equation for ‘%:<=’
      at src/Functions.hs:(10,1)-(18,15)
    or from (t10 ~ 'S n1)
      bound by a pattern with constructor
                 SS :: forall (z_a9mg :: Nat) (n_a9mh :: Nat).
                       (z_a9mg ~ 'S n_a9mh) =>
                       Sing n_a9mh -> Sing z_a9mg,
               in an equation for ‘%:<=’
      at src/Functions.hs:(10,1)-(18,15)
    or from (t00 ~ Apply SSym0 n0, t10 ~ Apply SSym0 m0)
      bound by the type signature for
                 lambda_a9n9 :: (t00 ~ Apply SSym0 n0, t10 ~ Apply SSym0 m0) =>
                                Sing n0 -> Sing m0 -> Sing (Apply (Apply (:<=$) t00) t10)
      at src/Functions.hs:(10,1)-(18,15)
    In the second argument of ‘singFun2’, namely ‘(%:<=)’
    In the first argument of ‘applySing’, namely
      ‘singFun2 (Proxy :: Proxy (:<=$)) (%:<=)’
    In the first argument of ‘applySing’, namely
      ‘applySing (singFun2 (Proxy :: Proxy (:<=$)) (%:<=)) n_a9na’
Run Code Online (Sandbox Code Playgroud)

有谁知道这样做的正确方法是什么?

Ale*_*lec 5

我不确定为什么这会失败.我在实施时遇到的类似失败同样令我感到困惑compare,甚至更加困惑于我在尝试时遇到的失败(看似简单)

singletons [d| data Nat = Z | S Nat deriving (Eq,Ord) |]
Run Code Online (Sandbox Code Playgroud)

我的猜测是Ord关闭的东西......然而,这是有效的.我要试着看看singleton后来的胆量.

singletons [d|
              data Nat = Z | S Nat
                 deriving (Eq)

              instance Ord Nat where
                compare = compare'

              compare' :: Nat -> Nat -> Ordering
              compare' Z Z  = EQ
              compare' (S _) Z = GT
              compare' Z (S _) = LT
              compare' (S n) (S m) = compare' n m
             |] 
Run Code Online (Sandbox Code Playgroud)

顺便说一句,我在这里使用GHC 8.0.

编辑

singletons探索之后,我发现了问题的真正根源(并且已经被可能存在多少类型级别的hackery所震惊).使用-ddump-splicesGHC我能够获得生成的实际Haskell代码(对于您问题中的初始代码).有问题的部分是

instance PEq (Proxy :: Proxy Nat_a7Vb) where
  type (:==) (a_a8Rs :: Nat_a7Vb) (b_a8Rt :: Nat_a7Vb) = Equals_1627424016_a8Rr a_a8Rs b_a8Rt
Run Code Online (Sandbox Code Playgroud)

instance POrd (Proxy :: Proxy Nat_a7Vb) where
  type (:<=) (a_aa9e :: Nat_a7Vb) (a_aa9f :: Nat_a7Vb) = Apply (Apply TFHelper_1627428966Sym0 a_aa9e) a_aa9f
Run Code Online (Sandbox Code Playgroud)

编译生成的代码,我收到了两个稍微有用的错误消息

Expecting one more argument to ‘Proxy’
Expected kind ‘Proxy Nat_a7Vb’, but ‘Proxy’ has kind ‘k0 -> *’
Run Code Online (Sandbox Code Playgroud)

关于所述(Proxy :: Proxy Nat_a7Vb)PEqPOrd类.如果没有,那将无法编译-XPolyKinds.检查了回购singletons,确实它告诉您需要-XTypeInType启用,然后启用-XPolyKinds.

所以,没有错误,你只需要添加PolyKinds或者TypeInType(我推荐后者,因为这是包推荐的......)到你的LANGUAGEpragma以使一切工作.