    {-# LANGUAGE GeneralizedNewtypeDeriving #-}

    module General.Intern(
        Intern, Id(..),
        empty, insert, add, lookup, toList, fromList
        ) where

    import Development.Shake.Classes
    import Foreign.Storable
    import Data.Word
    import Prelude hiding (lookup)
    import qualified Data.HashMap.Strict as Map
    import Data.List(foldl')

    -- Invariant: The first field is the highest value in the Map
    data Intern a = Intern {-# UNPACK #-} !Word32 !(Map.HashMap a Id)

    newtype Id = Id Word32
        deriving (Id -> Id -> Bool
    (Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Id -> Id -> Bool
    == :: Id -> Id -> Bool
    $c/= :: Id -> Id -> Bool
    /= :: Id -> Id -> Bool
    Eq,Eq Id
    Eq Id => (Int -> Id -> Int) -> (Id -> Int) -> Hashable Id
    Int -> Id -> Int
    Id -> Int
    forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
    $chashWithSalt :: Int -> Id -> Int
    hashWithSalt :: Int -> Id -> Int
    $chash :: Id -> Int
    hash :: Id -> Int
    Hashable,Eq Id
    Eq Id =>
    (Id -> Id -> Ordering)
    -> (Id -> Id -> Bool)
    -> (Id -> Id -> Bool)
    -> (Id -> Id -> Bool)
    -> (Id -> Id -> Bool)
    -> (Id -> Id -> Id)
    -> (Id -> Id -> Id)
    -> Ord Id
    Id -> Id -> Bool
    Id -> Id -> Ordering
    Id -> Id -> Id
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Id -> Id -> Ordering
    compare :: Id -> Id -> Ordering
    $c< :: Id -> Id -> Bool
    < :: Id -> Id -> Bool
    $c<= :: Id -> Id -> Bool
    <= :: Id -> Id -> Bool
    $c> :: Id -> Id -> Bool
    > :: Id -> Id -> Bool
    $c>= :: Id -> Id -> Bool
    >= :: Id -> Id -> Bool
    $cmax :: Id -> Id -> Id
    max :: Id -> Id -> Id
    $cmin :: Id -> Id -> Id
    min :: Id -> Id -> Id
    Ord,Get Id
    [Id] -> Put
    Id -> Put
    (Id -> Put) -> Get Id -> ([Id] -> Put) -> Binary Id
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: Id -> Put
    put :: Id -> Put
    $cget :: Get Id
    get :: Get Id
    $cputList :: [Id] -> Put
    putList :: [Id] -> Put
    Binary,Int -> Id -> ShowS
    [Id] -> ShowS
    Id -> String
    (Int -> Id -> ShowS)
    -> (Id -> String) -> ([Id] -> ShowS) -> Show Id
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Id -> ShowS
    showsPrec :: Int -> Id -> ShowS
    $cshow :: Id -> String
    show :: Id -> String
    $cshowList :: [Id] -> ShowS
    showList :: [Id] -> ShowS
    Show,Id -> ()
    (Id -> ()) -> NFData Id
    forall a. (a -> ()) -> NFData a
    $crnf :: Id -> ()
    rnf :: Id -> ()
    NFData,Ptr Id -> IO Id
    Ptr Id -> Int -> IO Id
    Ptr Id -> Int -> Id -> IO ()
    Ptr Id -> Id -> IO ()
    Id -> Int
    (Id -> Int)
    -> (Id -> Int)
    -> (Ptr Id -> Int -> IO Id)
    -> (Ptr Id -> Int -> Id -> IO ())
    -> (forall b. Ptr b -> Int -> IO Id)
    -> (forall b. Ptr b -> Int -> Id -> IO ())
    -> (Ptr Id -> IO Id)
    -> (Ptr Id -> Id -> IO ())
    -> Storable Id
    forall b. Ptr b -> Int -> IO Id
    forall b. Ptr b -> Int -> Id -> IO ()
    forall a.
    (a -> Int)
    -> (a -> Int)
    -> (Ptr a -> Int -> IO a)
    -> (Ptr a -> Int -> a -> IO ())
    -> (forall b. Ptr b -> Int -> IO a)
    -> (forall b. Ptr b -> Int -> a -> IO ())
    -> (Ptr a -> IO a)
    -> (Ptr a -> a -> IO ())
    -> Storable a
    $csizeOf :: Id -> Int
    sizeOf :: Id -> Int
    $calignment :: Id -> Int
    alignment :: Id -> Int
    $cpeekElemOff :: Ptr Id -> Int -> IO Id
    peekElemOff :: Ptr Id -> Int -> IO Id
    $cpokeElemOff :: Ptr Id -> Int -> Id -> IO ()
    pokeElemOff :: Ptr Id -> Int -> Id -> IO ()
    $cpeekByteOff :: forall b. Ptr b -> Int -> IO Id
    peekByteOff :: forall b. Ptr b -> Int -> IO Id
    $cpokeByteOff :: forall b. Ptr b -> Int -> Id -> IO ()
    pokeByteOff :: forall b. Ptr b -> Int -> Id -> IO ()
    $cpeek :: Ptr Id -> IO Id
    peek :: Ptr Id -> IO Id
    $cpoke :: Ptr Id -> Id -> IO ()
    poke :: Ptr Id -> Id -> IO ()
    Storable)

    empty :: Intern a
    empty :: forall a. Intern a
    empty = Word32 -> HashMap a Id -> Intern a
    forall a. Word32 -> HashMap a Id -> Intern a
    Intern Word32
    0 HashMap a Id
    forall k v. HashMap k v
    Map.empty

    insert :: (Eq a, Hashable a) => a -> Id -> Intern a -> Intern a
    insert :: forall a. (Eq a, Hashable a) => a -> Id -> Intern a -> Intern a
    insert a
    k v :: Id
    v@(Id Word32
    i) (Intern Word32
    n HashMap a Id
    mp) = Word32 -> HashMap a Id -> Intern a
    forall a. Word32 -> HashMap a Id -> Intern a
    Intern (Word32 -> Word32 -> Word32
    forall a. Ord a => a -> a -> a
    max Word32
    n Word32
    i) (HashMap a Id -> Intern a) -> HashMap a Id -> Intern a
    forall a b. (a -> b) -> a -> b
    $ a -> Id -> HashMap a Id -> HashMap a Id
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    Map.insert a
    k Id
    v HashMap a Id
    mp

    add :: (Eq a, Hashable a) => a -> Intern a -> (Intern a, Id)
    add :: forall a. (Eq a, Hashable a) => a -> Intern a -> (Intern a, Id)
    add a
    k (Intern Word32
    v HashMap a Id
    mp) = (Word32 -> HashMap a Id -> Intern a
    forall a. Word32 -> HashMap a Id -> Intern a
    Intern Word32
    v2 (HashMap a Id -> Intern a) -> HashMap a Id -> Intern a
    forall a b. (a -> b) -> a -> b
    $ a -> Id -> HashMap a Id -> HashMap a Id
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    Map.insert a
    k (Word32 -> Id
    Id Word32
    v2) HashMap a Id
    mp, Word32 -> Id
    Id Word32
    v2)
        where v2 :: Word32
    v2 = Word32
    v Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    1

    lookup :: (Eq a, Hashable a) => a -> Intern a -> Maybe Id
    lookup :: forall a. (Eq a, Hashable a) => a -> Intern a -> Maybe Id
    lookup a
    k (Intern Word32
    _ HashMap a Id
    mp) = a -> HashMap a Id -> Maybe Id
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup a
    k HashMap a Id
    mp

    toList :: Intern a -> [(a, Id)]
    toList :: forall a. Intern a -> [(a, Id)]
    toList (Intern Word32
    _ HashMap a Id
    mp) = HashMap a Id -> [(a, Id)]
    forall k v. HashMap k v -> [(k, v)]
    Map.toList HashMap a Id
    mp

    fromList :: (Eq a, Hashable a) => [(a, Id)] -> Intern a
    fromList :: forall a. (Eq a, Hashable a) => [(a, Id)] -> Intern a
    fromList [(a, Id)]
    xs = Word32 -> HashMap a Id -> Intern a
    forall a. Word32 -> HashMap a Id -> Intern a
    Intern ((Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Word32 -> Word32 -> Word32
    forall a. Ord a => a -> a -> a
    max Word32
    0 [Word32
    i | (a
    _, Id Word32
    i) <- [(a, Id)]
    xs]) ([(a, Id)] -> HashMap a Id
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList [(a, Id)]
    xs)