content: -- |
  -- Module      : GHC.Heap.NormalForm
  -- Copyright   : [2020] The Accelerate Team
  -- License     : BSD3
  --
  -- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
  -- Stability   : experimental
  -- Portability : non-portable (GHC extensions)
  --
  -- https://github.com/input-output-hk/cardano-prelude/blob/96e8dcb29dc3c29eee99c0d020152fad6071af6d/src/Cardano/Prelude/GHC/Heap/NormalForm.hs
  --
  -- This code has been adapted from the module "GHC.AssertNF" of the package
  -- <http://hackage.haskell.org/package/ghc-heap-view ghc-heap-view>
  -- (<https://github.com/nomeata/ghc-heap-view GitHub>) authored by
  -- Joachim Breitner.
  --
  -- To avoid space leaks and unwanted evaluation behaviour, the programmer
  -- might want his data to be fully evaluated at certain positions in the
  -- code. This can be enforced, for example, by ample use of
  -- "Control.DeepSeq", but this comes at a cost.
  --
  -- Experienced users hence use 'Control.DeepSeq.deepseq' only to find out
  -- about the existence of space leaks and optimize their code to not create
  -- the thunks in the first place, until the code no longer shows better
  -- performance with 'deepseq'.
  --
  
  module GHC.Heap.NormalForm (
  
    isHeadNormalForm,
    isNormalForm,
  
  ) where
  
  import GHC.Exts.Heap
  
  -- Everything is in normal form, unless it is a thunk explicitly marked as
  -- such. Indirection are also considered to be in HNF.
  --
  isHeadNormalForm :: Closure -> IO Bool
  isHeadNormalForm c = do
    case c of
      ThunkClosure{}    -> return False
      APClosure{}       -> return False
      SelectorClosure{} -> return False
      BCOClosure{}      -> return False
      _                 -> return True
  
  -- | The function 'isNormalForm' checks whether its argument is fully evaluated
  -- and deeply evaluated.
  --
  -- NOTE 1: If you want to override the behaviour of 'isNormalForm' for specific
  -- types (in particular, for specific types that may be /nested/ somewhere
  -- inside the @a@), consider using
  -- 'Cardano.Prelude.GHC.Heap.NormalForm.Classy.noUnexpectedThunks' instead.
  --
  -- NOTE 2: The normal form check can be quite brittle, especially with @-O0@.
  -- For example, writing something like
  --
  -- > let !(Value x) = ... in ....
  --
  -- might translate to
  --
  -- > let !.. = ... in ... (case ... of Value x -> x)
  --
  -- which would trivially be @False@. In general, 'isNormalForm' should probably
  -- only be used with @-O1@, but even then the answer may still depend on
  -- internal decisions made by ghc during compilation.
  --
  isNormalForm :: a -> IO Bool
  isNormalForm x = isNormalFormBoxed (asBox x)
  
  isNormalFormBoxed :: Box -> IO Bool
  isNormalFormBoxed b = do
    c  <- getBoxedClosureData b
    nf <- isHeadNormalForm c
    if nf
      then do
        c' <- getBoxedClosureData b
        allM isNormalFormBoxed (allClosures c')
      else do
        return False
  
  -- From Control.Monad.Loops in monad-loops
  --
  allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
  allM _ []       = return True
  allM p (x : xs) = do
    q <- p x
    if q
      then allM p xs
      else return False
  
  