{-# LANGUAGE PatternGuards, DeriveDataTypeable, ViewPatterns, BangPatterns #-}

-- | Interned strings
module General.IString(
    IString, fromIString, toIString
    ) where

import Data.Data
import Data.IORef
import Control.DeepSeq
import General.Str
import qualified Data.Map as Map
import System.IO.Unsafe


data IString = IString {-# UNPACK #-} !Int !Str
    deriving (Typeable IString
DataType
Constr
Typeable IString
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IString -> c IString)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IString)
-> (IString -> Constr)
-> (IString -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IString))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IString))
-> ((forall b. Data b => b -> b) -> IString -> IString)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IString -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IString -> r)
-> (forall u. (forall d. Data d => d -> u) -> IString -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> IString -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IString -> m IString)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IString -> m IString)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IString -> m IString)
-> Data IString
IString -> DataType
IString -> Constr
(forall b. Data b => b -> b) -> IString -> IString
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IString -> c IString
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IString
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IString -> u
forall u. (forall d. Data d => d -> u) -> IString -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IString -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IString -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IString -> m IString
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IString -> m IString
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IString
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IString -> c IString
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IString)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IString)
$cIString :: Constr
$tIString :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IString -> m IString
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IString -> m IString
gmapMp :: (forall d. Data d => d -> m d) -> IString -> m IString
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IString -> m IString
gmapM :: (forall d. Data d => d -> m d) -> IString -> m IString
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IString -> m IString
gmapQi :: Int -> (forall d. Data d => d -> u) -> IString -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IString -> u
gmapQ :: (forall d. Data d => d -> u) -> IString -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IString -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IString -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IString -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IString -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IString -> r
gmapT :: (forall b. Data b => b -> b) -> IString -> IString
$cgmapT :: (forall b. Data b => b -> b) -> IString -> IString
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IString)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IString)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IString)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IString)
dataTypeOf :: IString -> DataType
$cdataTypeOf :: IString -> DataType
toConstr :: IString -> Constr
$ctoConstr :: IString -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IString
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IString
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IString -> c IString
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IString -> c IString
$cp1Data :: Typeable IString
Data,Typeable)

instance Eq IString where
    IString Int
x Str
_ == :: IString -> IString -> Bool
== IString Int
y Str
_ = Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y

instance Ord IString where
    compare :: IString -> IString -> Ordering
compare (IString Int
x1 Str
x2) (IString Int
y1 Str
y2)
        | Int
x1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1 = Ordering
EQ
        | Bool
otherwise = Str -> Str -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Str
x2 Str
y2

instance Show IString where show :: IString -> String
show = Str -> String
strUnpack (Str -> String) -> (IString -> Str) -> IString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IString -> Str
fromIString
instance NFData IString where rnf :: IString -> ()
rnf IString{} = () -- we force the string at construction time


{-# NOINLINE istrings #-}
istrings :: IORef (Map.Map Str IString)
istrings :: IORef (Map Str IString)
istrings = IO (IORef (Map Str IString)) -> IORef (Map Str IString)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Map Str IString)) -> IORef (Map Str IString))
-> IO (IORef (Map Str IString)) -> IORef (Map Str IString)
forall a b. (a -> b) -> a -> b
$ Map Str IString -> IO (IORef (Map Str IString))
forall a. a -> IO (IORef a)
newIORef Map Str IString
forall k a. Map k a
Map.empty

fromIString :: IString -> Str
fromIString :: IString -> Str
fromIString (IString Int
_ Str
x) = Str
x

toIString :: Str -> IString
toIString :: Str -> IString
toIString Str
x = IO IString -> IString
forall a. IO a -> a
unsafePerformIO (IO IString -> IString) -> IO IString -> IString
forall a b. (a -> b) -> a -> b
$ IORef (Map Str IString)
-> (Map Str IString -> (Map Str IString, IString)) -> IO IString
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Map Str IString)
istrings ((Map Str IString -> (Map Str IString, IString)) -> IO IString)
-> (Map Str IString -> (Map Str IString, IString)) -> IO IString
forall a b. (a -> b) -> a -> b
$ \Map Str IString
mp -> case Str -> Map Str IString -> Maybe IString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Str
x Map Str IString
mp of
    Just IString
v -> (Map Str IString
mp, IString
v)
    Maybe IString
Nothing -> let res :: IString
res = Int -> Str -> IString
IString (Map Str IString -> Int
forall k a. Map k a -> Int
Map.size Map Str IString
mp) Str
x in (Str -> IString -> Map Str IString -> Map Str IString
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Str
x IString
res Map Str IString
mp, IString
res)