module GHC.Core.TyCon.RecWalk (
RecTcChecker, initRecTc, defaultRecTcMaxBound,
setRecTcMaxBound, checkRecTc
) where
import GHC.Prelude
import GHC.Core.TyCon
import GHC.Core.TyCon.Env
import GHC.Utils.Outputable
data RecTcChecker = RC !Int (TyConEnv Int)
instance Outputable RecTcChecker where
ppr :: RecTcChecker -> SDoc
ppr (RC Int
n TyConEnv Int
env) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RC:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyConEnv Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConEnv Int
env
initRecTc :: RecTcChecker
initRecTc :: RecTcChecker
initRecTc = Int -> TyConEnv Int -> RecTcChecker
RC Int
defaultRecTcMaxBound TyConEnv Int
forall a. TyConEnv a
emptyTyConEnv
defaultRecTcMaxBound :: Int
defaultRecTcMaxBound :: Int
defaultRecTcMaxBound = Int
100
setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker
setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker
setRecTcMaxBound Int
new_bound (RC Int
_old_bound TyConEnv Int
rec_nts) = Int -> TyConEnv Int -> RecTcChecker
RC Int
new_bound TyConEnv Int
rec_nts
checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker
checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker
checkRecTc (RC Int
bound TyConEnv Int
rec_nts) TyCon
tc
= case TyConEnv Int -> TyCon -> Maybe Int
forall a. TyConEnv a -> TyCon -> Maybe a
lookupTyConEnv TyConEnv Int
rec_nts TyCon
tc of
Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bound -> Maybe RecTcChecker
forall a. Maybe a
Nothing
| Bool
otherwise -> RecTcChecker -> Maybe RecTcChecker
forall a. a -> Maybe a
Just (Int -> TyConEnv Int -> RecTcChecker
RC Int
bound (TyConEnv Int -> TyCon -> Int -> TyConEnv Int
forall a. TyConEnv a -> TyCon -> a -> TyConEnv a
extendTyConEnv TyConEnv Int
rec_nts TyCon
tc (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)))
Maybe Int
Nothing -> RecTcChecker -> Maybe RecTcChecker
forall a. a -> Maybe a
Just (Int -> TyConEnv Int -> RecTcChecker
RC Int
bound (TyConEnv Int -> TyCon -> Int -> TyConEnv Int
forall a. TyConEnv a -> TyCon -> a -> TyConEnv a
extendTyConEnv TyConEnv Int
rec_nts TyCon
tc Int
1))