From 146e1c396c7bae35cd48dd594f98061a4ffcc1ea Mon Sep 17 00:00:00 2001
From: David Binder <david.binder@uni-tuebingen.de>
Date: Tue, 19 Sep 2023 19:50:31 +0200
Subject: [PATCH] Implement getHpcFlags
---
libraries/base/GHC/RTS/Flags.hsc | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/libraries/base/GHC/RTS/Flags.hsc b/libraries/base/GHC/RTS/Flags.hsc
index 16075aa3c6ac..ec235e35b86e 100644
--- a/libraries/base/GHC/RTS/Flags.hsc
+++ b/libraries/base/GHC/RTS/Flags.hsc
@@ -501,7 +501,11 @@ getParFlags = do
getHpcFlags :: IO HpcFlags
-getHpcFlags = error "TODO: Implement getHpcFlags"
+getHpcFlags = do
+ let ptr = (#ptr RTS_FLAGS, HpcFlags) rtsFlagsPtr
+ HpcFlags
+ <$> (toBool <$>
+ (#{peek HPC_FLAGS, emitTixFile} ptr :: IO CBool))
getConcFlags :: IO ConcFlags
getConcFlags = do
--
GitLab