module NLP.Alphabet.IMMC.Internal where
import Data.IORef (newIORef,IORef,readIORef,atomicWriteIORef,atomicModifyIORef')
import System.IO.Unsafe (unsafePerformIO,unsafeDupablePerformIO)
import Data.Bijection.Hash (Bimap,empty,lookupL,lookupR,size,insert)
import NLP.Alphabet.MultiChar
immcBimap :: IORef (Bimap InternedMultiChar Int)
immcBimap = unsafePerformIO $ newIORef empty
immcBimapAdd :: InternedMultiChar -> Int
immcBimapAdd k = unsafeDupablePerformIO $ do
m <- readIORef immcBimap
case lookupL m k of
Just i -> return i
Nothing -> do let s = size m
atomicModifyIORef' immcBimap $ \m -> (insert m (k,s) , s)
immcBimapLookupInt :: Int -> InternedMultiChar
immcBimapLookupInt r = seq r . unsafeDupablePerformIO $ do
m <- readIORef immcBimap
case lookupR m r of
Just l -> return l
Nothing -> error "immcBimapLookupInt: totality assumption invalidated"