{-# LANGUAGE Safe #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances, FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
module Cryptol.TypeCheck.TypeMap
( TypeMap(..), TypesMap, TrieMap(..)
, insertTM, insertWithTM
, membersTM
, mapTM, mapWithKeyTM, mapMaybeTM
, List(..)
) where
import Cryptol.TypeCheck.AST
import Cryptol.Utils.Ident
import Cryptol.Utils.RecordMap
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe(fromMaybe,maybeToList)
import Control.Monad((<=<))
import Data.Maybe (isNothing)
class TrieMap m k | m -> k where
emptyTM :: m a
nullTM :: m a -> Bool
lookupTM :: k -> m a -> Maybe a
alterTM :: k -> (Maybe a -> Maybe a) -> m a -> m a
unionTM :: (a -> a -> a) -> m a -> m a -> m a
toListTM :: m a -> [(k,a)]
mapMaybeWithKeyTM :: (k -> a -> Maybe b) -> m a -> m b
membersTM :: TrieMap m k => m a -> [a]
membersTM :: forall (m :: * -> *) k a. TrieMap m k => m a -> [a]
membersTM = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM
insertTM :: TrieMap m k => k -> a -> m a -> m a
insertTM :: forall (m :: * -> *) k a. TrieMap m k => k -> a -> m a -> m a
insertTM k
t a
a = forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM k
t (\Maybe a
_ -> forall a. a -> Maybe a
Just a
a)
insertWithTM :: TrieMap m k => (a -> a -> a) -> k -> a -> m a -> m a
insertWithTM :: forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> k -> a -> m a -> m a
insertWithTM a -> a -> a
f k
t a
new = forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM k
t forall a b. (a -> b) -> a -> b
$ \Maybe a
mb -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Maybe a
mb of
Maybe a
Nothing -> a
new
Just a
old -> a -> a -> a
f a
old a
new
{-# INLINE mapTM #-}
mapTM :: TrieMap m k => (a -> b) -> m a -> m b
mapTM :: forall (m :: * -> *) k a b. TrieMap m k => (a -> b) -> m a -> m b
mapTM a -> b
f = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\ k
_ a
a -> forall a. a -> Maybe a
Just (a -> b
f a
a))
{-# INLINE mapWithKeyTM #-}
mapWithKeyTM :: TrieMap m k => (k -> a -> b) -> m a -> m b
mapWithKeyTM :: forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> b) -> m a -> m b
mapWithKeyTM k -> a -> b
f = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\ k
k a
a -> forall a. a -> Maybe a
Just (k -> a -> b
f k
k a
a))
{-# INLINE mapMaybeTM #-}
mapMaybeTM :: TrieMap m k => (a -> Maybe b) -> m a -> m b
mapMaybeTM :: forall (m :: * -> *) k a b.
TrieMap m k =>
(a -> Maybe b) -> m a -> m b
mapMaybeTM a -> Maybe b
f = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\k
_ -> a -> Maybe b
f)
data List m a = L { forall (m :: * -> *) a. List m a -> Maybe a
nil :: Maybe a
, forall (m :: * -> *) a. List m a -> m (List m a)
cons :: m (List m a)
} deriving (forall a b. a -> List m b -> List m a
forall a b. (a -> b) -> List m a -> List m b
forall (m :: * -> *) a b. Functor m => a -> List m b -> List m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> List m a -> List m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> List m b -> List m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> List m b -> List m a
fmap :: forall a b. (a -> b) -> List m a -> List m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> List m a -> List m b
Functor, forall a. List m a -> Bool
forall m a. Monoid m => (a -> m) -> List m a -> m
forall a b. (a -> b -> b) -> b -> List m a -> b
forall (m :: * -> *) a. (Foldable m, Eq a) => a -> List m a -> Bool
forall (m :: * -> *) a. (Foldable m, Num a) => List m a -> a
forall (m :: * -> *) a. (Foldable m, Ord a) => List m a -> a
forall (m :: * -> *) m. (Foldable m, Monoid m) => List m m -> m
forall (m :: * -> *) a. Foldable m => List m a -> Bool
forall (m :: * -> *) a. Foldable m => List m a -> Int
forall (m :: * -> *) a. Foldable m => List m a -> [a]
forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> List m a -> a
forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> List m a -> m
forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> List m a -> b
forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> List m a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => List m a -> a
$cproduct :: forall (m :: * -> *) a. (Foldable m, Num a) => List m a -> a
sum :: forall a. Num a => List m a -> a
$csum :: forall (m :: * -> *) a. (Foldable m, Num a) => List m a -> a
minimum :: forall a. Ord a => List m a -> a
$cminimum :: forall (m :: * -> *) a. (Foldable m, Ord a) => List m a -> a
maximum :: forall a. Ord a => List m a -> a
$cmaximum :: forall (m :: * -> *) a. (Foldable m, Ord a) => List m a -> a
elem :: forall a. Eq a => a -> List m a -> Bool
$celem :: forall (m :: * -> *) a. (Foldable m, Eq a) => a -> List m a -> Bool
length :: forall a. List m a -> Int
$clength :: forall (m :: * -> *) a. Foldable m => List m a -> Int
null :: forall a. List m a -> Bool
$cnull :: forall (m :: * -> *) a. Foldable m => List m a -> Bool
toList :: forall a. List m a -> [a]
$ctoList :: forall (m :: * -> *) a. Foldable m => List m a -> [a]
foldl1 :: forall a. (a -> a -> a) -> List m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> List m a -> a
foldr1 :: forall a. (a -> a -> a) -> List m a -> a
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> List m a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> List m a -> b
$cfoldl' :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> List m a -> b
foldl :: forall b a. (b -> a -> b) -> b -> List m a -> b
$cfoldl :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> List m a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> List m a -> b
$cfoldr' :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> List m a -> b
foldr :: forall a b. (a -> b -> b) -> b -> List m a -> b
$cfoldr :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> List m a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> List m a -> m
$cfoldMap' :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> List m a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> List m a -> m
$cfoldMap :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> List m a -> m
fold :: forall m. Monoid m => List m m -> m
$cfold :: forall (m :: * -> *) m. (Foldable m, Monoid m) => List m m -> m
Foldable, forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {m :: * -> *}. Traversable m => Functor (List m)
forall {m :: * -> *}. Traversable m => Foldable (List m)
forall (m :: * -> *) (m :: * -> *) a.
(Traversable m, Monad m) =>
List m (m a) -> m (List m a)
forall (m :: * -> *) (f :: * -> *) a.
(Traversable m, Applicative f) =>
List m (f a) -> f (List m a)
forall (m :: * -> *) (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> List m a -> m (List m b)
forall (m :: * -> *) (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> List m a -> f (List m b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List m a -> f (List m b)
sequence :: forall (m :: * -> *) a. Monad m => List m (m a) -> m (List m a)
$csequence :: forall (m :: * -> *) (m :: * -> *) a.
(Traversable m, Monad m) =>
List m (m a) -> m (List m a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> List m a -> m (List m b)
$cmapM :: forall (m :: * -> *) (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> List m a -> m (List m b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
List m (f a) -> f (List m a)
$csequenceA :: forall (m :: * -> *) (f :: * -> *) a.
(Traversable m, Applicative f) =>
List m (f a) -> f (List m a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List m a -> f (List m b)
$ctraverse :: forall (m :: * -> *) (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> List m a -> f (List m b)
Traversable)
instance TrieMap m a => TrieMap (List m) [a] where
emptyTM :: forall a. List m a
emptyTM = L { nil :: Maybe a
nil = forall a. Maybe a
Nothing, cons :: m (List m a)
cons = forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM }
nullTM :: forall a. List m a -> Bool
nullTM List m a
k = forall a. Maybe a -> Bool
isNothing (forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
k) Bool -> Bool -> Bool
&& forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
k)
lookupTM :: forall a. [a] -> List m a -> Maybe a
lookupTM [a]
k =
case [a]
k of
[] -> forall (m :: * -> *) a. List m a -> Maybe a
nil
a
x : [a]
xs -> forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [a]
xs forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. List m a -> m (List m a)
cons
alterTM :: forall a. [a] -> (Maybe a -> Maybe a) -> List m a -> List m a
alterTM [a]
k Maybe a -> Maybe a
f List m a
m =
case [a]
k of
[] -> List m a
m { nil :: Maybe a
nil = Maybe a -> Maybe a
f (forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m) }
a
x:[a]
xs -> List m a
m { cons :: m (List m a)
cons = forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM a
x (forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub [a]
xs Maybe a -> Maybe a
f) (forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m) }
toListTM :: forall a. List m a -> [([a], a)]
toListTM List m a
m =
[ ([], a
v) | a
v <- forall a. Maybe a -> [a]
maybeToList (forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m) ] forall a. [a] -> [a] -> [a]
++
[ (a
xforall a. a -> [a] -> [a]
:[a]
xs,a
v) | (a
x,List m a
m1) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m), ([a]
xs,a
v) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM List m a
m1 ]
unionTM :: forall a. (a -> a -> a) -> List m a -> List m a -> List m a
unionTM a -> a -> a
f List m a
m1 List m a
m2 = L { nil :: Maybe a
nil = case (forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m1, forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m2) of
(Just a
x, Just a
y) -> forall a. a -> Maybe a
Just (a -> a -> a
f a
x a
y)
(Just a
x, Maybe a
_) -> forall a. a -> Maybe a
Just a
x
(Maybe a
_, Just a
y) -> forall a. a -> Maybe a
Just a
y
(Maybe a, Maybe a)
_ -> forall a. Maybe a
Nothing
, cons :: m (List m a)
cons = forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM (forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f) (forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m1) (forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m2)
}
mapMaybeWithKeyTM :: forall a b. ([a] -> a -> Maybe b) -> List m a -> List m b
mapMaybeWithKeyTM [a] -> a -> Maybe b
f = forall {m :: * -> *}. TrieMap m a => [a] -> List m a -> List m b
go []
where
go :: [a] -> List m a -> List m b
go [a]
acc List m a
l = L { nil :: Maybe b
nil = [a] -> a -> Maybe b
f (forall a. [a] -> [a]
reverse [a]
acc) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
l
, cons :: m (List m b)
cons = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\a
k List m a
a -> forall a. a -> Maybe a
Just ([a] -> List m a -> List m b
go (a
kforall a. a -> [a] -> [a]
:[a]
acc) List m a
a)) (forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
l)
}
instance Ord a => TrieMap (Map a) a where
emptyTM :: forall a. Map a a
emptyTM = forall k a. Map k a
Map.empty
nullTM :: forall a. Map a a -> Bool
nullTM = forall k a. Map k a -> Bool
Map.null
lookupTM :: forall a. a -> Map a a -> Maybe a
lookupTM = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
alterTM :: forall a. a -> (Maybe a -> Maybe a) -> Map a a -> Map a a
alterTM = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
toListTM :: forall a. Map a a -> [(a, a)]
toListTM = forall k a. Map k a -> [(k, a)]
Map.toList
unionTM :: forall a. (a -> a -> a) -> Map a a -> Map a a -> Map a a
unionTM = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith
mapMaybeWithKeyTM :: forall a b. (a -> a -> Maybe b) -> Map a a -> Map a b
mapMaybeWithKeyTM = forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey
type TypesMap = List TypeMap
data TypeMap a = TM { forall a. TypeMap a -> Map TVar a
tvar :: Map TVar a
, forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon :: Map TCon (List TypeMap a)
, forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec :: Map [Ident] (List TypeMap a)
, forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype :: Map Newtype (List TypeMap a)
} deriving (forall a b. a -> TypeMap b -> TypeMap a
forall a b. (a -> b) -> TypeMap a -> TypeMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TypeMap b -> TypeMap a
$c<$ :: forall a b. a -> TypeMap b -> TypeMap a
fmap :: forall a b. (a -> b) -> TypeMap a -> TypeMap b
$cfmap :: forall a b. (a -> b) -> TypeMap a -> TypeMap b
Functor, forall a. Eq a => a -> TypeMap a -> Bool
forall a. Num a => TypeMap a -> a
forall a. Ord a => TypeMap a -> a
forall m. Monoid m => TypeMap m -> m
forall a. TypeMap a -> Bool
forall a. TypeMap a -> Int
forall a. TypeMap a -> [a]
forall a. (a -> a -> a) -> TypeMap a -> a
forall m a. Monoid m => (a -> m) -> TypeMap a -> m
forall b a. (b -> a -> b) -> b -> TypeMap a -> b
forall a b. (a -> b -> b) -> b -> TypeMap a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => TypeMap a -> a
$cproduct :: forall a. Num a => TypeMap a -> a
sum :: forall a. Num a => TypeMap a -> a
$csum :: forall a. Num a => TypeMap a -> a
minimum :: forall a. Ord a => TypeMap a -> a
$cminimum :: forall a. Ord a => TypeMap a -> a
maximum :: forall a. Ord a => TypeMap a -> a
$cmaximum :: forall a. Ord a => TypeMap a -> a
elem :: forall a. Eq a => a -> TypeMap a -> Bool
$celem :: forall a. Eq a => a -> TypeMap a -> Bool
length :: forall a. TypeMap a -> Int
$clength :: forall a. TypeMap a -> Int
null :: forall a. TypeMap a -> Bool
$cnull :: forall a. TypeMap a -> Bool
toList :: forall a. TypeMap a -> [a]
$ctoList :: forall a. TypeMap a -> [a]
foldl1 :: forall a. (a -> a -> a) -> TypeMap a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TypeMap a -> a
foldr1 :: forall a. (a -> a -> a) -> TypeMap a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> TypeMap a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> TypeMap a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TypeMap a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TypeMap a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TypeMap a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TypeMap a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TypeMap a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TypeMap a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> TypeMap a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> TypeMap a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TypeMap a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TypeMap a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TypeMap a -> m
fold :: forall m. Monoid m => TypeMap m -> m
$cfold :: forall m. Monoid m => TypeMap m -> m
Foldable, Functor TypeMap
Foldable TypeMap
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => TypeMap (m a) -> m (TypeMap a)
forall (f :: * -> *) a.
Applicative f =>
TypeMap (f a) -> f (TypeMap a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TypeMap a -> m (TypeMap b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TypeMap a -> f (TypeMap b)
sequence :: forall (m :: * -> *) a. Monad m => TypeMap (m a) -> m (TypeMap a)
$csequence :: forall (m :: * -> *) a. Monad m => TypeMap (m a) -> m (TypeMap a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TypeMap a -> m (TypeMap b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TypeMap a -> m (TypeMap b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
TypeMap (f a) -> f (TypeMap a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
TypeMap (f a) -> f (TypeMap a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TypeMap a -> f (TypeMap b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TypeMap a -> f (TypeMap b)
Traversable)
instance TrieMap TypeMap Type where
emptyTM :: forall a. TypeMap a
emptyTM = TM { tvar :: Map TVar a
tvar = forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM, tcon :: Map TCon (List TypeMap a)
tcon = forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM, trec :: Map [Ident] (List TypeMap a)
trec = forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM, tnewtype :: Map Newtype (List TypeMap a)
tnewtype = forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM }
nullTM :: forall a. TypeMap a -> Bool
nullTM TypeMap a
ty = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (forall a. TypeMap a -> Map TVar a
tvar TypeMap a
ty)
, forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
ty)
, forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
ty)
, forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype TypeMap a
ty)
]
lookupTM :: forall a. Type -> TypeMap a -> Maybe a
lookupTM Type
ty =
case Type
ty of
TUser Name
_ [Type]
_ Type
t -> forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM Type
t
TVar TVar
x -> forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM TVar
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TypeMap a -> Map TVar a
tvar
TCon TCon
c [Type]
ts -> forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [Type]
ts forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM TCon
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon
TRec RecordMap Ident Type
fs -> let ([Ident]
xs,[Type]
ts) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. RecordMap a b -> [(a, b)]
canonicalFields RecordMap Ident Type
fs
in forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [Type]
ts forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [Ident]
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec
TNewtype Newtype
nt [Type]
ts -> forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [Type]
ts forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM Newtype
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype
alterTM :: forall a. Type -> (Maybe a -> Maybe a) -> TypeMap a -> TypeMap a
alterTM Type
ty Maybe a -> Maybe a
f TypeMap a
m =
case Type
ty of
TUser Name
_ [Type]
_ Type
t -> forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM Type
t Maybe a -> Maybe a
f TypeMap a
m
TVar TVar
x -> TypeMap a
m { tvar :: Map TVar a
tvar = forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM TVar
x Maybe a -> Maybe a
f (forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m) }
TCon TCon
c [Type]
ts -> TypeMap a
m { tcon :: Map TCon (List TypeMap a)
tcon = forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM TCon
c (forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub [Type]
ts Maybe a -> Maybe a
f) (forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m) }
TRec RecordMap Ident Type
fs -> let ([Ident]
xs,[Type]
ts) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. RecordMap a b -> [(a, b)]
canonicalFields RecordMap Ident Type
fs
in TypeMap a
m { trec :: Map [Ident] (List TypeMap a)
trec = forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM [Ident]
xs (forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub [Type]
ts Maybe a -> Maybe a
f) (forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m) }
TNewtype Newtype
nt [Type]
ts -> TypeMap a
m { tnewtype :: Map Newtype (List TypeMap a)
tnewtype = forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM Newtype
nt (forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub [Type]
ts Maybe a -> Maybe a
f) (forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype TypeMap a
m) }
toListTM :: forall a. TypeMap a -> [(Type, a)]
toListTM TypeMap a
m =
[ (TVar -> Type
TVar TVar
x, a
v) | (TVar
x,a
v) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m) ] forall a. [a] -> [a] -> [a]
++
[ (TCon -> [Type] -> Type
TCon TCon
c [Type]
ts, a
v) | (TCon
c,List TypeMap a
m1) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m)
, ([Type]
ts,a
v) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM List TypeMap a
m1 ] forall a. [a] -> [a] -> [a]
++
[ (RecordMap Ident Type -> Type
TRec (forall a b. (Show a, Ord a) => [(a, b)] -> RecordMap a b
recordFromFields (forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
fs [Type]
ts)), a
v)
| ([Ident]
fs,List TypeMap a
m1) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m)
, ([Type]
ts,a
v) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM List TypeMap a
m1 ] forall a. [a] -> [a] -> [a]
++
[ (Newtype -> [Type] -> Type
TNewtype Newtype
nt [Type]
ts, a
v) | (Newtype
nt,List TypeMap a
m1) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype TypeMap a
m)
, ([Type]
ts,a
v) <- forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM List TypeMap a
m1
]
unionTM :: forall a. (a -> a -> a) -> TypeMap a -> TypeMap a -> TypeMap a
unionTM a -> a -> a
f TypeMap a
m1 TypeMap a
m2 = TM { tvar :: Map TVar a
tvar = forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f (forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m1) (forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m2)
, tcon :: Map TCon (List TypeMap a)
tcon = forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM (forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f) (forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m1) (forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m2)
, trec :: Map [Ident] (List TypeMap a)
trec = forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM (forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f) (forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m1) (forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m2)
, tnewtype :: Map Newtype (List TypeMap a)
tnewtype = forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM (forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f) (forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype TypeMap a
m1) (forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype TypeMap a
m2)
}
mapMaybeWithKeyTM :: forall a b. (Type -> a -> Maybe b) -> TypeMap a -> TypeMap b
mapMaybeWithKeyTM Type -> a -> Maybe b
f TypeMap a
m =
TM { tvar :: Map TVar b
tvar = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\TVar
v -> Type -> a -> Maybe b
f (TVar -> Type
TVar TVar
v)) (forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m)
, tcon :: Map TCon (List TypeMap b)
tcon = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> b) -> m a -> m b
mapWithKeyTM (\TCon
c List TypeMap a
l -> forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM
(\[Type]
ts a
a -> Type -> a -> Maybe b
f (TCon -> [Type] -> Type
TCon TCon
c [Type]
ts) a
a) List TypeMap a
l) (forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m)
, trec :: Map [Ident] (List TypeMap b)
trec = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> b) -> m a -> m b
mapWithKeyTM (\[Ident]
fs List TypeMap a
l -> forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM
(\[Type]
ts a
a -> Type -> a -> Maybe b
f (RecordMap Ident Type -> Type
TRec (forall a b. (Show a, Ord a) => [(a, b)] -> RecordMap a b
recordFromFields (forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
fs [Type]
ts))) a
a) List TypeMap a
l) (forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m)
, tnewtype :: Map Newtype (List TypeMap b)
tnewtype = forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> b) -> m a -> m b
mapWithKeyTM (\Newtype
nt List TypeMap a
l -> forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM
(\[Type]
ts a
a -> Type -> a -> Maybe b
f (Newtype -> [Type] -> Type
TNewtype Newtype
nt [Type]
ts) a
a) List TypeMap a
l) (forall a. TypeMap a -> Map Newtype (List TypeMap a)
tnewtype TypeMap a
m)
}
updSub :: TrieMap m k => k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub :: forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub k
k Maybe a -> Maybe a
f = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM k
k Maybe a -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM
instance Show a => Show (TypeMap a) where
showsPrec :: Int -> TypeMap a -> ShowS
showsPrec Int
p TypeMap a
xs = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM TypeMap a
xs)