对于another answer我的,我编写了以下代码,提供 diagonally traversed Universe
可枚举Generic
的实例(与那里的版本略有更新,但使用相同的逻辑):
{-# LANGUAGE DeriveGeneric, TypeOperators, ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, DefaultSignatures #-}
{-# LANGUAGE UndecidableInstances, OverlappingInstances #-}
import Data.Universe
import Control.Monad.Omega
import GHC.Generics
import Control.Monad (mplus, liftM2)
class GUniverse f where
guniverse :: Omega (f x)
instance GUniverse U1 where
guniverse = return U1
instance (Universe c) => GUniverse (K1 i c) where
guniverse = fmap K1 $ each (universe :: [c]) -- (1)
instance (GUniverse f) => GUniverse (M1 i c f) where
guniverse = fmap M1 (guniverse :: Omega (f p))
instance (GUniverse f, GUniverse g) => GUniverse (f :*: g) where
guniverse = liftM2 (:*:) ls rs
where ls = (guniverse :: Omega (f p))
rs = (guniverse :: Omega (g p))
instance (GUniverse f, GUniverse g) => GUniverse (f :+: g) where
guniverse = (fmap L1 $ ls) `mplus` (fmap R1 $ rs) -- (2)
where ls = (guniverse :: Omega (f p))
rs = (guniverse :: Omega (g p))
instance (Generic a, GUniverse (Rep a)) => Universe a where
universe = runOmega $ fmap to $ (guniverse :: Omega (Rep a x))
(Omega
可能与该问题无关,但它是问题的一部分。)
这适用于大多数类型,甚至是像这样的递归类型:
data T6 = T6' | T6 T6 deriving (Show, Generic)
data T = A | B T | C T T deriving (Show, Generic)
data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Show, Generic, Eq)
示例:
*Main> take 5 $ (universe :: [T6])
[T6',T6 T6',T6 (T6 T6'),T6 (T6 (T6 T6')),T6 (T6 (T6 (T6 T6')))]
*Main> take 5 $ (universe :: [T])
[A,B A,B (B A),C A A,B (B (B A))]
*Main> take 5 $ (universe :: [Tree Bool])
[Leaf False,Leaf True,Branch (Leaf False) (Leaf False),Branch (Leaf False) (Leaf True),Branch (Leaf True) (Leaf False)]
但请注意,上述类型都有其递归构造函数不是首先!事实上(这就是问题所在),存在以下分歧:
*Main> data T7 = T7 T7 | T7' deriving (Show, Generic)
*Main> take 5 $ (universe :: [T7])
*** Exception: <<loop>>
我首先想到可能是Omegas
的求值顺序有问题,但是交换(2)
行中的左右部分只会得到T7
工作,而 T6
失败,这是我期望的正确行为。
我目前的怀疑是 (1)
行中对 universe
的调用评估得太早。例如,以下内容也有分歧,而列表中应该恰好有一个值,甚至不应该对其进行评估:
*Main> data T8 = T8 T8 deriving (Show, Generic)
*Main> null $ (universe :: [T8])
*** Exception: <<loop>>
因此,唯一的实例 T8 (T8 (...) ... )
在列表内进行评估,即使不需要它!我不知道这种效果从何而来——是递归使用它自己的Universe实例吗?但是,为什么像 T6
这样的“右递归”类型能够正确运行,而“左递归”类型 (T7
) 却不能呢?
这是一个严格性问题吗?如果是这样,在代码的哪一部分?我的 Universe
实例? 通用
?以及如何修复它?如果重要的话,我使用 GHC 7.6.3。
最佳答案
无法生成像 T8
这样的类型。让我们看看 T8 的Universe 泛型版本实际上简化为:
t8Universe :: [T8]
t8Universe = fmap T8 t8Universe
任何时候都不会产生 (:) 或 []。如果没有另一个非递归构造函数成功生成,就无法取得进展。 t8Universe
的元素数量与 t8Universe
的元素数量完全相同,但这是循环的,因此存在评估循环。
关于haskell - 枚举 Generic 实例的所有值时无限递归,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/23547307/