{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      :   Grisette.IR.SymPrim.Data.Prim.InternedTerm.Caches
-- Copyright   :   (c) Sirui Lu 2021-2023
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.IR.SymPrim.Data.Prim.InternedTerm.Caches (typeMemoizedCache) where

import Control.Once
import Data.Data
import qualified Data.HashMap.Strict as M
import Data.IORef
import Data.Interned
import GHC.Base (Any)
import GHC.IO
import Unsafe.Coerce

termCacheCell :: IO (IORef (M.HashMap TypeRep Any))
termCacheCell :: IO (IORef (HashMap TypeRep Any))
termCacheCell = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Once a => a -> IO a
once forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall k v. HashMap k v
M.empty

typeMemoizedCache :: forall a. (Interned a, Typeable a) => Cache a
typeMemoizedCache :: forall a. (Interned a, Typeable a) => Cache a
typeMemoizedCache = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
  IORef (HashMap TypeRep Any)
c <- IO (IORef (HashMap TypeRep Any))
termCacheCell
  forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (HashMap TypeRep Any)
c forall a b. (a -> b) -> a -> b
$ \HashMap TypeRep Any
m ->
    case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a)) HashMap TypeRep Any
m of
      Just Any
d -> (HashMap TypeRep Any
m, forall a b. a -> b
unsafeCoerce Any
d)
      Maybe Any
Nothing -> (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a)) (forall a b. a -> b
unsafeCoerce Cache a
r1) HashMap TypeRep Any
m, Cache a
r1)
        where
          r1 :: Cache a
          !r1 :: Cache a
r1 = forall t. Interned t => Cache t
mkCache
          {-# NOINLINE r1 #-}