枚举通用实例的所有值时的无限递归

Question

对于我的另一个答案,我编写了以下代码,为可枚举的s 提供了对角遍历的 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失败,这就是我所期望的正确行为.

我目前的怀疑是,对universe线的呼叫(1)过早评估.例如,以下内容也有所不同,而列表中应该只有一个值,甚至不应该评估:

*Main> data T8 = T8 T8  deriving (Show, Generic)
*Main> null $ (universe :: [T8])
*** Exception: <<loop>>

因此,唯一的实例,即使不需要,也会在列表中T8 (T8 (...) ... )进行评估!我不知道这种效果来自何处 - 是否是它自己的实例的递归使用？但是,为什么"正确的递归"类型行为正确,而"左递归"类()则不行？UniverseT6T7

这是严格问题吗？如果是这样,代码的哪一部分？我的Universe实例？Generic？以及如何解决它？如果重要的话,我使用GHC 7.6.3.

Answer 1

像这样的类型T8无法生成。让我们看看 T8 的Universe 泛型版本实际上简化为：

t8Universe :: [T8]
t8Universe = fmap T8 t8Universe

任何时候都不会产生 (:) 或 []。如果没有另一个非递归构造函数成功生成，就无法取得进展。t8Universe具有与 has 一样多的元素t8Universe，但这是循环的，因此评估循环。