-- |
-- Module      :  Cryptol.TypeCheck.TypeMap
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE Safe #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances, FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}
module Cryptol.TypeCheck.TypeMap
  ( TypeMap(..), TypesMap, TrieMap(..)
  , insertTM, insertWithTM
  , membersTM
  , mapTM, mapWithKeyTM, mapMaybeTM

  , List(..)
  ) where

import           Cryptol.TypeCheck.AST
import           Cryptol.Utils.Ident

import qualified Data.Map as Map
import           Data.Map (Map)
import           Data.Maybe(fromMaybe,maybeToList)
import           Control.Monad((<=<))
import           Data.List(sortBy)
import           Data.Maybe (isNothing)
import           Data.Ord(comparing)

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 :: m a -> [a]
membersTM  = ((k, a) -> a) -> [(k, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (k, a) -> a
forall a b. (a, b) -> b
snd ([(k, a)] -> [a]) -> (m a -> [(k, a)]) -> m a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> [(k, a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM

insertTM :: TrieMap m k => k -> a -> m a -> m a
insertTM :: k -> a -> m a -> m a
insertTM t :: k
t a :: a
a = k -> (Maybe a -> Maybe a) -> m a -> m a
forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM k
t (\_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
a)

insertWithTM :: TrieMap m k => (a -> a -> a) -> k -> a -> m a -> m a
insertWithTM :: (a -> a -> a) -> k -> a -> m a -> m a
insertWithTM f :: a -> a -> a
f t :: k
t new :: a
new = k -> (Maybe a -> Maybe a) -> m a -> m a
forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM k
t ((Maybe a -> Maybe a) -> m a -> m a)
-> (Maybe a -> Maybe a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ \mb :: Maybe a
mb -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ case Maybe a
mb of
                                                   Nothing  -> a
new
                                                   Just old :: a
old -> a -> a -> a
f a
old a
new

{-# INLINE mapTM #-}
mapTM :: TrieMap m k => (a -> b) -> m a -> m b
mapTM :: (a -> b) -> m a -> m b
mapTM f :: a -> b
f = (k -> a -> Maybe b) -> m a -> m b
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\ _ a :: a
a -> b -> Maybe b
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 :: (k -> a -> b) -> m a -> m b
mapWithKeyTM f :: k -> a -> b
f = (k -> a -> Maybe b) -> m a -> m b
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\ k :: k
k a :: a
a -> b -> Maybe b
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 :: (a -> Maybe b) -> m a -> m b
mapMaybeTM f :: a -> Maybe b
f = (k -> a -> Maybe b) -> m a -> m b
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\_ -> a -> Maybe b
f)

data List m a  = L { List m a -> Maybe a
nil  :: Maybe a
                   , List m a -> m (List m a)
cons :: m (List m a)
                   } deriving (a -> List m b -> List m a
(a -> b) -> List m a -> List m b
(forall a b. (a -> b) -> List m a -> List m b)
-> (forall a b. a -> List m b -> List m a) -> Functor (List m)
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
<$ :: a -> List m b -> List m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> List m b -> List m a
fmap :: (a -> b) -> List m a -> List m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> List m a -> List m b
Functor)

instance TrieMap m a => TrieMap (List m) [a] where
  emptyTM :: List m a
emptyTM = L :: forall (m :: * -> *) a. Maybe a -> m (List m a) -> List m a
L { nil :: Maybe a
nil = Maybe a
forall a. Maybe a
Nothing, cons :: m (List m a)
cons = m (List m a)
forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM }

  nullTM :: List m a -> Bool
nullTM k :: List m a
k = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (List m a -> Maybe a
forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
k) Bool -> Bool -> Bool
&& m (List m a) -> Bool
forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (List m a -> m (List m a)
forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
k)

  lookupTM :: [a] -> List m a -> Maybe a
lookupTM k :: [a]
k =
    case [a]
k of
      []     -> List m a -> Maybe a
forall (m :: * -> *) a. List m a -> Maybe a
nil
      x :: a
x : xs :: [a]
xs -> [a] -> List m a -> Maybe a
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [a]
xs (List m a -> Maybe a)
-> (List m a -> Maybe (List m a)) -> List m a -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (List m a) -> Maybe (List m a)
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM a
x (m (List m a) -> Maybe (List m a))
-> (List m a -> m (List m a)) -> List m a -> Maybe (List m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List m a -> m (List m a)
forall (m :: * -> *) a. List m a -> m (List m a)
cons

  alterTM :: [a] -> (Maybe a -> Maybe a) -> List m a -> List m a
alterTM k :: [a]
k f :: Maybe a -> Maybe a
f m :: List m a
m =
    case [a]
k of
      []    -> List m a
m { nil :: Maybe a
nil = Maybe a -> Maybe a
f (List m a -> Maybe a
forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m) }
      x :: a
x:xs :: [a]
xs  -> List m a
m { cons :: m (List m a)
cons = a
-> (Maybe (List m a) -> Maybe (List m a))
-> m (List m a)
-> m (List m a)
forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM a
x ([a] -> (Maybe a -> Maybe a) -> Maybe (List m a) -> Maybe (List m a)
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) (List m a -> m (List m a)
forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m) }

  toListTM :: List m a -> [([a], a)]
toListTM m :: List m a
m =
    [ ([], a
v)  | a
v <- Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (List m a -> Maybe a
forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m) ] [([a], a)] -> [([a], a)] -> [([a], a)]
forall a. [a] -> [a] -> [a]
++
    [ (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs,a
v) | (x :: a
x,m1 :: List m a
m1) <- m (List m a) -> [(a, List m a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (List m a -> m (List m a)
forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m), (xs :: [a]
xs,v :: a
v) <- List m a -> [([a], a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM List m a
m1 ]

  unionTM :: (a -> a -> a) -> List m a -> List m a -> List m a
unionTM f :: a -> a -> a
f m1 :: List m a
m1 m2 :: List m a
m2 = L :: forall (m :: * -> *) a. Maybe a -> m (List m a) -> List m a
L { nil :: Maybe a
nil  = case (List m a -> Maybe a
forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m1, List m a -> Maybe a
forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
m2) of
                                 (Just x :: a
x, Just y :: a
y) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
f a
x a
y)
                                 (Just x :: a
x, _)      -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                                 (_, Just y :: a
y)      -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
                                 _                -> Maybe a
forall a. Maybe a
Nothing
                      , cons :: m (List m a)
cons = (List m a -> List m a -> List m a)
-> m (List m a) -> m (List m a) -> m (List m a)
forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM ((a -> a -> a) -> List m a -> List m a -> List m a
forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f) (List m a -> m (List m a)
forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m1) (List m a -> m (List m a)
forall (m :: * -> *) a. List m a -> m (List m a)
cons List m a
m2)
                      }

  mapMaybeWithKeyTM :: ([a] -> a -> Maybe b) -> List m a -> List m b
mapMaybeWithKeyTM f :: [a] -> a -> Maybe b
f = [a] -> List m a -> List m b
forall (m :: * -> *). TrieMap m a => [a] -> List m a -> List m b
go []
    where
    go :: [a] -> List m a -> List m b
go acc :: [a]
acc l :: List m a
l = L :: forall (m :: * -> *) a. Maybe a -> m (List m a) -> List m a
L { nil :: Maybe b
nil  = [a] -> a -> Maybe b
f ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc) (a -> Maybe b) -> Maybe a -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< List m a -> Maybe a
forall (m :: * -> *) a. List m a -> Maybe a
nil List m a
l
                 , cons :: m (List m b)
cons = (a -> List m a -> Maybe (List m b)) -> m (List m a) -> m (List m b)
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\k :: a
k a :: List m a
a -> List m b -> Maybe (List m b)
forall a. a -> Maybe a
Just ([a] -> List m a -> List m b
go (a
ka -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) List m a
a)) (List m a -> m (List m 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 :: Map a a
emptyTM  = Map a a
forall k a. Map k a
Map.empty
  nullTM :: Map a a -> Bool
nullTM   = Map a a -> Bool
forall k a. Map k a -> Bool
Map.null
  lookupTM :: a -> Map a a -> Maybe a
lookupTM = a -> Map a a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
  alterTM :: a -> (Maybe a -> Maybe a) -> Map a a -> Map a a
alterTM  = ((Maybe a -> Maybe a) -> a -> Map a a -> Map a a)
-> a -> (Maybe a -> Maybe a) -> Map a a -> Map a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe a -> Maybe a) -> a -> Map a a -> Map a a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
  toListTM :: Map a a -> [(a, a)]
toListTM = Map a a -> [(a, a)]
forall k a. Map k a -> [(k, a)]
Map.toList
  unionTM :: (a -> a -> a) -> Map a a -> Map a a -> Map a a
unionTM  = (a -> a -> a) -> Map a a -> Map a a -> Map a a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith

  mapMaybeWithKeyTM :: (a -> a -> Maybe b) -> Map a a -> Map a b
mapMaybeWithKeyTM = (a -> a -> Maybe b) -> Map a a -> Map a b
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey


type TypesMap = List TypeMap

data TypeMap a = TM { TypeMap a -> Map TVar a
tvar :: Map TVar a
                    , TypeMap a -> Map TCon (List TypeMap a)
tcon :: Map TCon    (List TypeMap a)
                    , TypeMap a -> Map [Ident] (List TypeMap a)
trec :: Map [Ident] (List TypeMap a)
                    } deriving (a -> TypeMap b -> TypeMap a
(a -> b) -> TypeMap a -> TypeMap b
(forall a b. (a -> b) -> TypeMap a -> TypeMap b)
-> (forall a b. a -> TypeMap b -> TypeMap a) -> Functor TypeMap
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
<$ :: a -> TypeMap b -> TypeMap a
$c<$ :: forall a b. a -> TypeMap b -> TypeMap a
fmap :: (a -> b) -> TypeMap a -> TypeMap b
$cfmap :: forall a b. (a -> b) -> TypeMap a -> TypeMap b
Functor)

instance TrieMap TypeMap Type where
  emptyTM :: TypeMap a
emptyTM = TM :: forall a.
Map TVar a
-> Map TCon (List TypeMap a)
-> Map [Ident] (List TypeMap a)
-> TypeMap a
TM { tvar :: Map TVar a
tvar = Map TVar a
forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM, tcon :: Map TCon (List TypeMap a)
tcon = Map TCon (List TypeMap a)
forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM, trec :: Map [Ident] (List TypeMap a)
trec = Map [Ident] (List TypeMap a)
forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM }

  nullTM :: TypeMap a -> Bool
nullTM ty :: TypeMap a
ty = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Map TVar a -> Bool
forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (TypeMap a -> Map TVar a
forall a. TypeMap a -> Map TVar a
tvar TypeMap a
ty)
                  , Map TCon (List TypeMap a) -> Bool
forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (TypeMap a -> Map TCon (List TypeMap a)
forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
ty)
                  , Map [Ident] (List TypeMap a) -> Bool
forall (m :: * -> *) k a. TrieMap m k => m a -> Bool
nullTM (TypeMap a -> Map [Ident] (List TypeMap a)
forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
ty) ]

  lookupTM :: Type -> TypeMap a -> Maybe a
lookupTM ty :: Type
ty =
    case Type
ty of
      TUser _ _ t :: Type
t -> Type -> TypeMap a -> Maybe a
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM Type
t
      TVar x :: TVar
x      -> TVar -> Map TVar a -> Maybe a
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM TVar
x (Map TVar a -> Maybe a)
-> (TypeMap a -> Map TVar a) -> TypeMap a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeMap a -> Map TVar a
forall a. TypeMap a -> Map TVar a
tvar
      TCon c :: TCon
c ts :: [Type]
ts   -> [Type] -> List TypeMap a -> Maybe a
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [Type]
ts (List TypeMap a -> Maybe a)
-> (TypeMap a -> Maybe (List TypeMap a)) -> TypeMap a -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TCon -> Map TCon (List TypeMap a) -> Maybe (List TypeMap a)
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM TCon
c (Map TCon (List TypeMap a) -> Maybe (List TypeMap a))
-> (TypeMap a -> Map TCon (List TypeMap a))
-> TypeMap a
-> Maybe (List TypeMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeMap a -> Map TCon (List TypeMap a)
forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon
      TRec fs :: [(Ident, Type)]
fs     -> let (xs :: [Ident]
xs,ts :: [Type]
ts) = [(Ident, Type)] -> ([Ident], [Type])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Ident, Type)] -> ([Ident], [Type]))
-> [(Ident, Type)] -> ([Ident], [Type])
forall a b. (a -> b) -> a -> b
$ ((Ident, Type) -> (Ident, Type) -> Ordering)
-> [(Ident, Type)] -> [(Ident, Type)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Ident, Type) -> Ident)
-> (Ident, Type) -> (Ident, Type) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Ident, Type) -> Ident
forall a b. (a, b) -> a
fst) [(Ident, Type)]
fs
                     in [Type] -> List TypeMap a -> Maybe a
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [Type]
ts (List TypeMap a -> Maybe a)
-> (TypeMap a -> Maybe (List TypeMap a)) -> TypeMap a -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [Ident] -> Map [Ident] (List TypeMap a) -> Maybe (List TypeMap a)
forall (m :: * -> *) k a. TrieMap m k => k -> m a -> Maybe a
lookupTM [Ident]
xs (Map [Ident] (List TypeMap a) -> Maybe (List TypeMap a))
-> (TypeMap a -> Map [Ident] (List TypeMap a))
-> TypeMap a
-> Maybe (List TypeMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeMap a -> Map [Ident] (List TypeMap a)
forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec

  alterTM :: Type -> (Maybe a -> Maybe a) -> TypeMap a -> TypeMap a
alterTM ty :: Type
ty f :: Maybe a -> Maybe a
f m :: TypeMap a
m =
    case Type
ty of
      TUser _ _ t :: Type
t -> Type -> (Maybe a -> Maybe a) -> TypeMap a -> TypeMap a
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 x :: TVar
x      -> TypeMap a
m { tvar :: Map TVar a
tvar = TVar -> (Maybe a -> Maybe a) -> Map TVar a -> Map TVar a
forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM TVar
x Maybe a -> Maybe a
f (TypeMap a -> Map TVar a
forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m) }
      TCon c :: TCon
c ts :: [Type]
ts   -> TypeMap a
m { tcon :: Map TCon (List TypeMap a)
tcon = TCon
-> (Maybe (List TypeMap a) -> Maybe (List TypeMap a))
-> Map TCon (List TypeMap a)
-> Map TCon (List TypeMap a)
forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM TCon
c ([Type]
-> (Maybe a -> Maybe a)
-> Maybe (List TypeMap a)
-> Maybe (List TypeMap a)
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) (TypeMap a -> Map TCon (List TypeMap a)
forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m) }
      TRec fs :: [(Ident, Type)]
fs     -> let (xs :: [Ident]
xs,ts :: [Type]
ts) = [(Ident, Type)] -> ([Ident], [Type])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Ident, Type)] -> ([Ident], [Type]))
-> [(Ident, Type)] -> ([Ident], [Type])
forall a b. (a -> b) -> a -> b
$ ((Ident, Type) -> (Ident, Type) -> Ordering)
-> [(Ident, Type)] -> [(Ident, Type)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Ident, Type) -> Ident)
-> (Ident, Type) -> (Ident, Type) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Ident, Type) -> Ident
forall a b. (a, b) -> a
fst) [(Ident, Type)]
fs
                     in TypeMap a
m { trec :: Map [Ident] (List TypeMap a)
trec = [Ident]
-> (Maybe (List TypeMap a) -> Maybe (List TypeMap a))
-> Map [Ident] (List TypeMap a)
-> Map [Ident] (List TypeMap a)
forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM [Ident]
xs ([Type]
-> (Maybe a -> Maybe a)
-> Maybe (List TypeMap a)
-> Maybe (List TypeMap a)
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) (TypeMap a -> Map [Ident] (List TypeMap a)
forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m) }

  toListTM :: TypeMap a -> [(Type, a)]
toListTM m :: TypeMap a
m =
    [ (TVar -> Type
TVar TVar
x,           a
v) | (x :: TVar
x,v :: a
v)   <- Map TVar a -> [(TVar, a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (TypeMap a -> Map TVar a
forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m) ] [(Type, a)] -> [(Type, a)] -> [(Type, a)]
forall a. [a] -> [a] -> [a]
++
    [ (TCon -> [Type] -> Type
TCon TCon
c [Type]
ts,        a
v) | (c :: TCon
c,m1 :: List TypeMap a
m1)  <- Map TCon (List TypeMap a) -> [(TCon, List TypeMap a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (TypeMap a -> Map TCon (List TypeMap a)
forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m)
                            , (ts :: [Type]
ts,v :: a
v)  <- List TypeMap a -> [([Type], a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM List TypeMap a
m1 ] [(Type, a)] -> [(Type, a)] -> [(Type, a)]
forall a. [a] -> [a] -> [a]
++
    [ ([(Ident, Type)] -> Type
TRec ([Ident] -> [Type] -> [(Ident, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
fs [Type]
ts), a
v) | (fs :: [Ident]
fs,m1 :: List TypeMap a
m1) <- Map [Ident] (List TypeMap a) -> [([Ident], List TypeMap a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM (TypeMap a -> Map [Ident] (List TypeMap a)
forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m)
                            , (ts :: [Type]
ts,v :: a
v)  <- List TypeMap a -> [([Type], a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM List TypeMap a
m1 ]

  unionTM :: (a -> a -> a) -> TypeMap a -> TypeMap a -> TypeMap a
unionTM f :: a -> a -> a
f m1 :: TypeMap a
m1 m2 :: TypeMap a
m2 = TM :: forall a.
Map TVar a
-> Map TCon (List TypeMap a)
-> Map [Ident] (List TypeMap a)
-> TypeMap a
TM { tvar :: Map TVar a
tvar = (a -> a -> a) -> Map TVar a -> Map TVar a -> Map TVar a
forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f (TypeMap a -> Map TVar a
forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m1) (TypeMap a -> Map TVar a
forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m2)
                       , tcon :: Map TCon (List TypeMap a)
tcon = (List TypeMap a -> List TypeMap a -> List TypeMap a)
-> Map TCon (List TypeMap a)
-> Map TCon (List TypeMap a)
-> Map TCon (List TypeMap a)
forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM ((a -> a -> a) -> List TypeMap a -> List TypeMap a -> List TypeMap a
forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f) (TypeMap a -> Map TCon (List TypeMap a)
forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m1) (TypeMap a -> Map TCon (List TypeMap a)
forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m2)
                       , trec :: Map [Ident] (List TypeMap a)
trec = (List TypeMap a -> List TypeMap a -> List TypeMap a)
-> Map [Ident] (List TypeMap a)
-> Map [Ident] (List TypeMap a)
-> Map [Ident] (List TypeMap a)
forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM ((a -> a -> a) -> List TypeMap a -> List TypeMap a -> List TypeMap a
forall (m :: * -> *) k a.
TrieMap m k =>
(a -> a -> a) -> m a -> m a -> m a
unionTM a -> a -> a
f) (TypeMap a -> Map [Ident] (List TypeMap a)
forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m1) (TypeMap a -> Map [Ident] (List TypeMap a)
forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m2)
                       }

  mapMaybeWithKeyTM :: (Type -> a -> Maybe b) -> TypeMap a -> TypeMap b
mapMaybeWithKeyTM f :: Type -> a -> Maybe b
f m :: TypeMap a
m =
    TM :: forall a.
Map TVar a
-> Map TCon (List TypeMap a)
-> Map [Ident] (List TypeMap a)
-> TypeMap a
TM { tvar :: Map TVar b
tvar = (TVar -> a -> Maybe b) -> Map TVar a -> Map TVar b
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM (\v :: TVar
v -> Type -> a -> Maybe b
f (TVar -> Type
TVar TVar
v)) (TypeMap a -> Map TVar a
forall a. TypeMap a -> Map TVar a
tvar TypeMap a
m)
       , tcon :: Map TCon (List TypeMap b)
tcon = (TCon -> List TypeMap a -> List TypeMap b)
-> Map TCon (List TypeMap a) -> Map TCon (List TypeMap b)
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> b) -> m a -> m b
mapWithKeyTM (\c :: TCon
c  l :: List TypeMap a
l -> ([Type] -> a -> Maybe b) -> List TypeMap a -> List TypeMap b
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM
                             (\ts :: [Type]
ts a :: a
a -> Type -> a -> Maybe b
f (TCon -> [Type] -> Type
TCon TCon
c [Type]
ts) a
a) List TypeMap a
l) (TypeMap a -> Map TCon (List TypeMap a)
forall a. TypeMap a -> Map TCon (List TypeMap a)
tcon TypeMap a
m)
       , trec :: Map [Ident] (List TypeMap b)
trec = ([Ident] -> List TypeMap a -> List TypeMap b)
-> Map [Ident] (List TypeMap a) -> Map [Ident] (List TypeMap b)
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> b) -> m a -> m b
mapWithKeyTM (\fs :: [Ident]
fs l :: List TypeMap a
l -> ([Type] -> a -> Maybe b) -> List TypeMap a -> List TypeMap b
forall (m :: * -> *) k a b.
TrieMap m k =>
(k -> a -> Maybe b) -> m a -> m b
mapMaybeWithKeyTM
                             (\ts :: [Type]
ts a :: a
a -> Type -> a -> Maybe b
f ([(Ident, Type)] -> Type
TRec ([Ident] -> [Type] -> [(Ident, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
fs [Type]
ts)) a
a) List TypeMap a
l) (TypeMap a -> Map [Ident] (List TypeMap a)
forall a. TypeMap a -> Map [Ident] (List TypeMap a)
trec TypeMap a
m)
       }


updSub :: TrieMap m k => k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub :: k -> (Maybe a -> Maybe a) -> Maybe (m a) -> Maybe (m a)
updSub k :: k
k f :: Maybe a -> Maybe a
f = m a -> Maybe (m a)
forall a. a -> Maybe a
Just (m a -> Maybe (m a))
-> (Maybe (m a) -> m a) -> Maybe (m a) -> Maybe (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> (Maybe a -> Maybe a) -> m a -> m a
forall (m :: * -> *) k a.
TrieMap m k =>
k -> (Maybe a -> Maybe a) -> m a -> m a
alterTM k
k Maybe a -> Maybe a
f (m a -> m a) -> (Maybe (m a) -> m a) -> Maybe (m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Maybe (m a) -> m a
forall a. a -> Maybe a -> a
fromMaybe m a
forall (m :: * -> *) k a. TrieMap m k => m a
emptyTM

instance Show a => Show (TypeMap a) where
  showsPrec :: Int -> TypeMap a -> ShowS
showsPrec p :: Int
p xs :: TypeMap a
xs = Int -> [(Type, a)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (TypeMap a -> [(Type, a)]
forall (m :: * -> *) k a. TrieMap m k => m a -> [(k, a)]
toListTM TypeMap a
xs)