Fix deadlock bug when mkFastStringWith is duplicated

In D5211, we use `withMVar` to guard writes to the same segment, this
is unsafe to be duplicated. It can lead to deadlock if it is only run
partially and `putMVar` is not called after `takeMVar`.

Test Plan:
  ./validate

We used to see deadlock when building stackage without this fix, and it
no longer happens.

Reviewers: simonmar, bgamari

Reviewed By: simonmar

Subscribers: rwbarton, carter

Differential Revision: https://phabricator.haskell.org/D5349

2 files changed, 5 insertions, 3 deletions

diff --git a/compiler/utils/FastFunctions.hs b/compiler/utils/FastFunctions.hs
index be3f3cbee4..9a09bb7b76 100644
--- a/compiler/utils/FastFunctions.hs
+++ b/compiler/utils/FastFunctions.hs
@@ -15,7 +15,7 @@ import GhcPrelude ()
 import GHC.Exts
 import GHC.IO   (IO(..))
 
--- Just like unsafePerformIO, but we inline it.
+-- Just like unsafeDupablePerformIO, but we inline it.
 {-# INLINE inlinePerformIO #-}
 inlinePerformIO :: IO a -> a
 inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs
index c53eff1dd1..f9fbeb0e6e 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/utils/FastString.hs
@@ -114,14 +114,13 @@ import qualified Data.ByteString.Unsafe   as BS
 import Foreign.C
 import GHC.Exts
 import System.IO
-import System.IO.Unsafe ( unsafePerformIO )
 import Data.Data
 import Data.IORef
 import Data.Maybe       ( isJust )
 import Data.Char
 import Data.Semigroup as Semi
 
-import GHC.IO           ( IO(..), unIO, unsafeDupablePerformIO )
+import GHC.IO
 
 import Foreign
 
@@ -400,6 +399,9 @@ mkFastStringWith mk_fs !ptr !len = do
   case res of
     Just found -> return found
     Nothing -> do
+      -- The withMVar below is not dupable. It can lead to deadlock if it is
+      -- only run partially and putMVar is not called after takeMVar.
+      noDuplicate
       n <- get_uid
       new_fs <- mk_fs n
       withMVar lock $ \_ -> insert new_fs