3

假设我有一个类型类：

data Proxy a = Proxy
class Fixed a where 
  fixed :: Proxy a -> Int

for 的定义fixed非常简单，所以我使用以下方法推导出它GHC.Generics：

class GFixed f where 
  gfixed :: Proxy (f a) -> Int

instance (GFixed f, GFixed g) => GFixed (f :*: g) where ...

instance (GFixed f, GFixed g) => GFixed (f :+: g) where ...

instance GFixed f => GFixed (M1 i c f) where ...

instance Fixed a => GFixed (K1 i a) where ...

....

default fixed :: (Generic a, GFixed (Rep a)) => Proxy a -> Int
fixed _ = fixed (Proxy :: Proxy (Rep a b))

我没有包含 for 的实例，因为拥有for void 类型GFixed U1的实例没有意义。Fixed我对Generics机械的理解不是很好——具体来说，是什么类型，什么M1意思K1。问题如下：我可以GFixed在类型级别进行限制，以便默认定义fixed不适用于递归类型吗？

例如，如果我写：

data Void
instance Fixed Void

我收到一个类型错误：No instance for (GFixed V1)。我想为之类的东西获取类型错误instance Fixed [Int]。

4

2 回答 2

1

该文档对构造函数的含义有适度的帮助。 M1指定元信息（例如记录选择器的名称），并且K1有点像 kind 的各种东西*。如果要禁止所有递归，则需要确保范围内没有实例匹配K1 R a。您仍然需要K范围内的其他一些实例，因此您应该更改

instance Fixed a => GFixed (K1 i a) where

至

instance Fixed a => GFixed (K1 P a) where

我不知道是否还有其他值可以作为 的第一个参数K1，但如果有的话，添加它们应该是安全的K1 R，当然除了。

于 2014-04-17T00:09:46.683 回答
0

经过一些工作，事实证明这是相当简单的，它甚至适用于相互递归的类型。我敢肯定有一些边缘情况会失败，但我还没有发现。

{-# LANGUAGE 
    MultiParamTypeClasses
  , FunctionalDependencies
  , DataKinds
  , TypeOperators
  , TypeFamilies
  , FlexibleContexts
  , FlexibleInstances
  , UndecidableInstances
  , PolyKinds
  , ConstraintKinds
  , DeriveGeneric
  , OverlappingInstances
  #-}

module IsRecursive where 

import GHC.Generics
import Data.Proxy 

type family (:||) (a :: Bool) (b :: Bool) :: Bool where 
  True :|| x = True
  x :|| True = True
  a :|| b = False 

data T2 a b 

type family Elem (x :: k) (xs :: [k]) :: Bool where 
  Elem x '[] = False
  Elem x (x ': xs) = True
  Elem x (y ': xs) = Elem x xs 

class IsRecursive' (tys :: [* -> *]) (rep :: * -> *) (r :: *) | tys rep -> r where 
  isRecursive' :: Proxy tys -> Proxy rep -> Proxy r
  isRecursive' _ _ = Proxy 

-- These types have recursive `Rep`s but aren't recursive because there is no `Rep` for primitive types
instance IsRecursive' tys (K1 R Int)    (T2 False tys)
instance IsRecursive' tys (K1 R Double) (T2 False tys)
instance IsRecursive' tys (K1 R Char)   (T2 False tys)
instance IsRecursive' tys (K1 R Float)  (T2 False tys)

-- Recursive instances - unwrap one layer of `Rep` and look inside
instance IsRecursive' tys U1 (T2 False tys)
instance IsRecursive' tys (Rep c) r => IsRecursive' tys (K1 i c) r 
instance (IsRecursive' tys f (T2 r0 tys0), IsRecursive' tys g (T2 r1 tys1), r2 ~ (r0 :|| r1)) => IsRecursive' tys (f :+: g) (T2 r2 tys1)
instance (IsRecursive' tys f (T2 r0 tys0), IsRecursive' tys g (T2 r1 tys1), r2 ~ (r0 :|| r1)) => IsRecursive' tys (f :*: g) (T2 r2 tys1)
instance (IsRecursive' tys f r) => IsRecursive' tys (M1 i c f) r 

-- This is where the magic happens 
-- Datatype declaration reps are represented as `M1 D` 
-- When one is encountered, save it in the list so far and continue recursion
instance (IsRecDataDec (Elem tyrep tys) tyrep tys f r, tyrep ~ (M1 D c f)) => IsRecursive' tys (M1 D c f) r

-- Context reduction is strict, so this class makes sure we 
-- only recurse if `Elem tyrep tys == False`; otherwise every recursive type
-- would cause a stack overflow
class IsRecDataDec (b :: Bool) (c :: * -> *) (tys :: [* -> *]) (f :: * -> *) (r :: *) | b c tys f -> r 
instance IsRecDataDec True c tys f (T2 True (c ': tys))
instance IsRecursive' (c ': tys) f r => IsRecDataDec False c tys f r 

class IsRecursive t 
instance IsRecursive' '[] (Rep t) (T2 True tys) => IsRecursive t

data TBool (b :: Bool) = TBool
instance Show (TBool True) where show _ = "True"
instance Show (TBool False) where show _ = "False"

isRecursive :: IsRecursive' '[] (Rep t) (T2 r tys) => t -> TBool r
isRecursive _ = TBool

-- test cases
data K = K K deriving Generic
data A = A B deriving Generic
data B = B Q deriving Generic
data Q = Q A deriving Generic
于 2014-04-20T22:19:15.440 回答