From 75ba6aeef88df2f051b73aa916fb66ce4c6b8a14 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Wed, 1 Jul 2026 22:48:53 +0100
Subject: Initial

---
 src/InitOnce/TheMap.hs | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)
 create mode 100644 src/InitOnce/TheMap.hs

(limited to 'src/InitOnce/TheMap.hs')

diff --git a/src/InitOnce/TheMap.hs b/src/InitOnce/TheMap.hs
new file mode 100644
index 0000000..5c30794
--- /dev/null
+++ b/src/InitOnce/TheMap.hs
@@ -0,0 +1,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)
-- 
cgit v1.3.1