2021-09-16 21:51:32 +03:00
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
|
|
|
|
-- | GHC.AssertNF.CPP localizes our use of CPP around calls
|
|
|
|
-- to 'assertNFHere', primarily to give tooling (e.g. ormolu)
|
|
|
|
-- an easier time.
|
2021-10-12 12:33:13 +03:00
|
|
|
--
|
|
|
|
-- We disable the 'assertNF'-related code because it is provided
|
|
|
|
-- by the package ghc-heap-view, which can't be built using profiling.
|
|
|
|
|
|
|
|
#ifdef PROFILING
|
|
|
|
|
2021-09-16 21:51:32 +03:00
|
|
|
module GHC.AssertNF.CPP
|
2021-09-24 01:56:37 +03:00
|
|
|
( assertNFHere,
|
|
|
|
disableAssertNF,
|
2021-09-16 21:51:32 +03:00
|
|
|
)
|
2021-09-24 01:56:37 +03:00
|
|
|
where
|
2021-09-16 21:51:32 +03:00
|
|
|
|
2021-09-24 01:56:37 +03:00
|
|
|
import Hasura.Prelude
|
|
|
|
import Language.Haskell.TH
|
2021-09-16 21:51:32 +03:00
|
|
|
|
|
|
|
assertNFHere :: Q Exp
|
|
|
|
assertNFHere = [| const (return ()) |]
|
2021-10-12 12:33:13 +03:00
|
|
|
|
|
|
|
disableAssertNF :: IO ()
|
|
|
|
disableAssertNF = return ()
|
|
|
|
|
2021-09-16 21:51:32 +03:00
|
|
|
#else
|
2021-10-12 12:33:13 +03:00
|
|
|
|
|
|
|
module GHC.AssertNF.CPP
|
|
|
|
( assertNFHere,
|
|
|
|
disableAssertNF,
|
|
|
|
GHC.AssertNF.assertNFNamed,
|
|
|
|
)
|
|
|
|
where
|
|
|
|
|
|
|
|
import GHC.AssertNF qualified
|
|
|
|
import Hasura.Prelude
|
|
|
|
import Language.Haskell.TH
|
|
|
|
import Text.Printf (printf)
|
|
|
|
|
|
|
|
assertNFHere :: Q Exp
|
2021-09-16 21:51:32 +03:00
|
|
|
-- This is a copy of 'GHC.AssertNF.assertNFHere'. We can't easily
|
|
|
|
-- use the original because that relies on an import of "GHC.AssertNF".
|
|
|
|
-- Instead, we rewrite it to use the re-exported 'assertNFNamed'.
|
|
|
|
assertNFHere = do
|
|
|
|
locStr <- formatLoc <$> location
|
|
|
|
return $ AppE (VarE (mkName "GHC.AssertNF.CPP.assertNFNamed"))
|
|
|
|
(LitE (StringL locStr))
|
|
|
|
where formatLoc :: Loc -> String
|
|
|
|
formatLoc loc = let file = loc_filename loc
|
|
|
|
(line, col) = loc_start loc
|
|
|
|
in printf "parameter at %s:%d:%d" file line col
|
|
|
|
|
|
|
|
disableAssertNF :: IO ()
|
|
|
|
disableAssertNF = GHC.AssertNF.disableAssertNF
|
2021-10-12 12:33:13 +03:00
|
|
|
|
2021-09-16 21:51:32 +03:00
|
|
|
#endif
|