module Data.Interned.Extended.SingleThreaded (
    intern
  ) where


import Data.Array
import Data.Hashable
import qualified Data.HashMap.Strict as HashMap
import Data.IORef
import GHC.IO (unsafeDupablePerformIO)

import Data.Interned.Internal hiding ( intern )

--------------------------------------------------

intern :: Interned t => Uninterned t -> t
intern :: Uninterned t -> t
intern !Uninterned t
bt = IO t -> t
forall a. IO a -> a
unsafeDupablePerformIO (IO t -> t) -> IO t -> t
forall a b. (a -> b) -> a -> b
$ IO t -> IO t
forall t. Interned t => IO t -> IO t
modifyAdvice (IO t -> IO t) -> IO t -> IO t
forall a b. (a -> b) -> a -> b
$ do
    CacheState Id
i HashMap (Description t) t
m <- IORef (CacheState t) -> IO (CacheState t)
forall a. IORef a -> IO a
readIORef IORef (CacheState t)
slot
    case Description t -> HashMap (Description t) t -> Maybe t
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Description t
dt HashMap (Description t) t
m of
      Maybe t
Nothing -> do let t :: t
t = Id -> Uninterned t -> t
forall t. Interned t => Id -> Uninterned t -> t
identify (Id
wid Id -> Id -> Id
forall a. Num a => a -> a -> a
* Id
i Id -> Id -> Id
forall a. Num a => a -> a -> a
+ Id
r) Uninterned t
bt
                    IORef (CacheState t) -> CacheState t -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (CacheState t)
slot (Id -> HashMap (Description t) t -> CacheState t
forall t. Id -> HashMap (Description t) t -> CacheState t
CacheState (Id
i Id -> Id -> Id
forall a. Num a => a -> a -> a
+ Id
1) (Description t
-> t -> HashMap (Description t) t -> HashMap (Description t) t
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Description t
dt t
t HashMap (Description t) t
m))
                    t -> IO t
forall (m :: * -> *) a. Monad m => a -> m a
return t
t
      Just t
t  -> t -> IO t
forall (m :: * -> *) a. Monad m => a -> m a
return t
t
  where
  slot :: IORef (CacheState t)
slot = Cache t -> Array Id (IORef (CacheState t))
forall t. Cache t -> Array Id (IORef (CacheState t))
getCache Cache t
forall t. Interned t => Cache t
cache Array Id (IORef (CacheState t)) -> Id -> IORef (CacheState t)
forall i e. Ix i => Array i e -> i -> e
! Id
r
  !dt :: Description t
dt = Uninterned t -> Description t
forall t. Interned t => Uninterned t -> Description t
describe Uninterned t
bt
  !hdt :: Id
hdt = Description t -> Id
forall a. Hashable a => a -> Id
hash Description t
dt
  !wid :: Id
wid = Description t -> Id
forall t (p :: * -> *). Interned t => p t -> Id
cacheWidth Description t
dt
  r :: Id
r = Id
hdt Id -> Id -> Id
forall a. Integral a => a -> a -> a
`mod` Id
wid