module HeteroMap.Map
( Key, newKey
, Map, empty, singleton, insert, lookup, overwrite
)
where
import Prelude hiding (lookup)
import Data.Unique
import GHC.Prim (Any)
import qualified Data.Map as Map
import Unsafe.Coerce (unsafeCoerce)
import System.IO.Unsafe (unsafePerformIO)
import Data.Maybe (fromJust)
class In x xs where
access :: xs -> x
replace :: x -> xs -> xs
instance In x (x :* xs) where
access (a:*as) = a
replace x (a:*as) = (x:*as)
instance In x xs => In x (y:*xs) where
access (a:*as) = access as
replace x (a:*as) = (a:*replace x as)
data Z = Z
data a :* b = a :* !b
data Key x a where
Key :: Key a a
newtype Map xs = Map xs
empty :: Map Z
empty = Map Z
singleton :: Key x a -> a -> Map (x :* Z)
singleton Key v = Map (v :* Z)
newKey :: (forall x. Key x a -> b) -> b
newKey cc = cc Key
insert :: Key x a -> a -> Map xs -> Map (x :* xs)
insert Key val (Map m) = Map (val :* m)
lookup :: In x xs => Key x a -> Map xs -> a
lookup Key (Map m) = access m
overwrite :: In x xs => Key x a -> a -> Map xs -> Map xs
overwrite Key x (Map m) = Map (replace x m)