never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    4 
    5 Check for recursive type constructors.
    6 
    7 -}
    8 
    9 
   10 
   11 module GHC.Core.TyCon.RecWalk (
   12 
   13         -- * Recursion breaking
   14         RecTcChecker, initRecTc, defaultRecTcMaxBound,
   15         setRecTcMaxBound, checkRecTc
   16 
   17     ) where
   18 
   19 import GHC.Prelude
   20 
   21 import GHC.Core.TyCon
   22 import GHC.Core.TyCon.Env
   23 
   24 {-
   25 ************************************************************************
   26 *                                                                      *
   27            Walking over recursive TyCons
   28 *                                                                      *
   29 ************************************************************************
   30 
   31 Note [Expanding newtypes and products]
   32 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   33 When expanding a type to expose a data-type constructor, we need to be
   34 careful about newtypes, lest we fall into an infinite loop. Here are
   35 the key examples:
   36 
   37   newtype Id  x = MkId x
   38   newtype Fix f = MkFix (f (Fix f))
   39   newtype T     = MkT (T -> T)
   40 
   41   Type           Expansion
   42  --------------------------
   43   T              T -> T
   44   Fix Maybe      Maybe (Fix Maybe)
   45   Id (Id Int)    Int
   46   Fix Id         NO NO NO
   47 
   48 Notice that
   49  * We can expand T, even though it's recursive.
   50  * We can expand Id (Id Int), even though the Id shows up
   51    twice at the outer level, because Id is non-recursive
   52 
   53 So, when expanding, we keep track of when we've seen a recursive
   54 newtype at outermost level; and bail out if we see it again.
   55 
   56 We sometimes want to do the same for product types, so that the
   57 strictness analyser doesn't unbox infinitely deeply.
   58 
   59 More precisely, we keep a *count* of how many times we've seen it.
   60 This is to account for
   61    data instance T (a,b) = MkT (T a) (T b)
   62 Then (#10482) if we have a type like
   63         T (Int,(Int,(Int,(Int,Int))))
   64 we can still unbox deeply enough during strictness analysis.
   65 We have to treat T as potentially recursive, but it's still
   66 good to be able to unwrap multiple layers.
   67 
   68 The function that manages all this is checkRecTc.
   69 -}
   70 
   71 data RecTcChecker = RC !Int (TyConEnv Int)
   72   -- The upper bound, and the number of times
   73   -- we have encountered each TyCon
   74 
   75 -- | Initialise a 'RecTcChecker' with 'defaultRecTcMaxBound'.
   76 initRecTc :: RecTcChecker
   77 initRecTc = RC defaultRecTcMaxBound emptyTyConEnv
   78 
   79 -- | The default upper bound (100) for the number of times a 'RecTcChecker' is
   80 -- allowed to encounter each 'TyCon'.
   81 defaultRecTcMaxBound :: Int
   82 defaultRecTcMaxBound = 100
   83 -- Should we have a flag for this?
   84 
   85 -- | Change the upper bound for the number of times a 'RecTcChecker' is allowed
   86 -- to encounter each 'TyCon'.
   87 setRecTcMaxBound :: Int -> RecTcChecker -> RecTcChecker
   88 setRecTcMaxBound new_bound (RC _old_bound rec_nts) = RC new_bound rec_nts
   89 
   90 checkRecTc :: RecTcChecker -> TyCon -> Maybe RecTcChecker
   91 -- Nothing      => Recursion detected
   92 -- Just rec_tcs => Keep going
   93 checkRecTc (RC bound rec_nts) tc
   94   = case lookupTyConEnv rec_nts tc of
   95       Just n | n >= bound -> Nothing
   96              | otherwise  -> Just (RC bound (extendTyConEnv rec_nts tc (n+1)))
   97       Nothing             -> Just (RC bound (extendTyConEnv rec_nts tc 1))