{-# 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)