summaryrefslogtreecommitdiff
path: root/src/InitOnce/TheMap.hs
blob: 5c30794b1e9ead23abaa5352fb4a9e0a7ce4921d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
-- | This is the only module that uses unsafePerformIO; to make sure it's safe,
-- we disable all the known optimisations in GHC that can potentially mess
-- things up: <https://discourse.haskell.org/t/can-noinline-fail-to-prevent-inlining/14324>
-- Also, since there is nothing else in this module, there isn't really very
-- much for GHC /to/ mess up, which is the point.
{-# OPTIONS -fno-cse -fno-full-laziness -fno-state-hack #-}
module InitOnce.TheMap (onceInsert) where

import Control.Concurrent.MVar (modifyMVarMasked, newMVar, MVar)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map (empty, lookup, insert)
import System.IO.Unsafe (unsafePerformIO)

import InitOnce.Types (Location, TypedAny)


{-# NOINLINE theMap #-}
theMap :: MVar (Map Location TypedAny)
theMap = unsafePerformIO (newMVar Map.empty)

-- | The IO action is executed with asynchronous exceptions masked (using
-- 'modifyMVarMasked').
{-# NOINLINE onceInsert #-}
onceInsert :: Location -> IO TypedAny -> TypedAny
onceInsert key mkVal =
  unsafePerformIO $
    modifyMVarMasked theMap $ \mp ->
      case Map.lookup key mp of
        Nothing -> do
          v <- mkVal
          return (Map.insert key v mp, v)
        Just v  -> return (mp, v)