-- | -- 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 :: Closure -> IO Bool isHeadNormalForm Closure c = do case Closure c of ThunkClosure{} -> Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False APClosure{} -> Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False SelectorClosure{} -> Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False BCOClosure{} -> Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False Closure _ -> Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool 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 :: a -> IO Bool isNormalForm a x = Box -> IO Bool isNormalFormBoxed (a -> Box forall a. a -> Box asBox a x) isNormalFormBoxed :: Box -> IO Bool isNormalFormBoxed :: Box -> IO Bool isNormalFormBoxed Box b = do Closure c <- Box -> IO Closure getBoxedClosureData Box b Bool nf <- Closure -> IO Bool isHeadNormalForm Closure c if Bool nf then do Closure c' <- Box -> IO Closure getBoxedClosureData Box b (Box -> IO Bool) -> [Box] -> IO Bool forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool allM Box -> IO Bool isNormalFormBoxed (Closure -> [Box] forall b. GenClosure b -> [b] allClosures Closure c') else do Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False -- From Control.Monad.Loops in monad-loops -- allM :: Monad m => (a -> m Bool) -> [a] -> m Bool allM :: (a -> m Bool) -> [a] -> m Bool allM a -> m Bool _ [] = Bool -> m Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool True allM a -> m Bool p (a x : [a] xs) = do Bool q <- a -> m Bool p a x if Bool q then (a -> m Bool) -> [a] -> m Bool forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool allM a -> m Bool p [a] xs else Bool -> m Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False