[Git][ghc/ghc][wip/cfuneqcan-refactor] Break module cycle
Richard Eisenberg
gitlab at gitlab.haskell.org
Sun Oct 11 02:42:49 UTC 2020
Richard Eisenberg pushed to branch wip/cfuneqcan-refactor at Glasgow Haskell Compiler / GHC
Commits:
25f50147 by Richard Eisenberg at 2020-10-10T22:42:35-04:00
Break module cycle
- - - - -
8 changed files:
- compiler/GHC/Core/Map.hs
- + compiler/GHC/Core/Map/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Stg/CSE.hs
- compiler/GHC/Tc/Instance/Typeable.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/Core/Map.hs
=====================================
@@ -12,24 +12,13 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+ -- Eq (DeBruijn CoreExpr) and Eq (DeBruijn CoreAlt)
+
module GHC.Core.Map (
-- * Maps over Core expressions
CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap,
- -- * Maps over 'Type's
- TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap, foldTypeMap,
- LooseTypeMap,
- -- ** With explicit scoping
- CmEnv, lookupCME, extendTypeMapWithScope, lookupTypeMapWithScope,
- mkDeBruijnContext,
- -- * Maps over 'Maybe' values
- MaybeMap,
- -- * Maps over 'List' values
- ListMap,
- -- * Maps over 'Literal's
- LiteralMap,
- -- * Map for compressing leaves. See Note [Compressed TrieMap]
- GenMap,
- -- * 'TrieMap' class
+ -- * 'TrieMap' class reexports
TrieMap(..), insertTM, deleteTM,
lkDFreeVar, xtDFreeVar,
lkDNamed, xtDNamed,
@@ -41,22 +30,15 @@ module GHC.Core.Map (
import GHC.Prelude
import GHC.Data.TrieMap
+import GHC.Core.Map.Type
import GHC.Core
-import GHC.Core.Coercion
-import GHC.Types.Name
import GHC.Core.Type
-import GHC.Core.TyCo.Rep
import GHC.Types.Var
-import GHC.Data.FastString(FastString)
import GHC.Utils.Misc
import GHC.Utils.Outputable
-import GHC.Utils.Panic
import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
-import GHC.Types.Unique.FM
-import GHC.Types.Var.Env
import GHC.Types.Name.Env
import Control.Monad( (>=>) )
@@ -76,27 +58,12 @@ numbered on the fly.
-- Recall that
-- Control.Monad.(>=>) :: (a -> Maybe b) -> (b -> Maybe c) -> a -> Maybe c
--- NB: Be careful about RULES and type families (#5821). So we should make sure
--- to specify @Key TypeMapX@ (and not @DeBruijn Type@, the reduced form)
-
-- The CoreMap makes heavy use of GenMap. However the CoreMap Types are not
-- known when defining GenMap so we can only specialize them here.
-{-# SPECIALIZE lkG :: Key TypeMapX -> TypeMapG a -> Maybe a #-}
-{-# SPECIALIZE lkG :: Key CoercionMapX -> CoercionMapG a -> Maybe a #-}
{-# SPECIALIZE lkG :: Key CoreMapX -> CoreMapG a -> Maybe a #-}
-
-
-{-# SPECIALIZE xtG :: Key TypeMapX -> XT a -> TypeMapG a -> TypeMapG a #-}
-{-# SPECIALIZE xtG :: Key CoercionMapX -> XT a -> CoercionMapG a -> CoercionMapG a #-}
{-# SPECIALIZE xtG :: Key CoreMapX -> XT a -> CoreMapG a -> CoreMapG a #-}
-
-{-# SPECIALIZE mapG :: (a -> b) -> TypeMapG a -> TypeMapG b #-}
-{-# SPECIALIZE mapG :: (a -> b) -> CoercionMapG a -> CoercionMapG b #-}
{-# SPECIALIZE mapG :: (a -> b) -> CoreMapG a -> CoreMapG b #-}
-
-{-# SPECIALIZE fdG :: (a -> b -> b) -> TypeMapG a -> b -> b #-}
-{-# SPECIALIZE fdG :: (a -> b -> b) -> CoercionMapG a -> b -> b #-}
{-# SPECIALIZE fdG :: (a -> b -> b) -> CoreMapG a -> b -> b #-}
@@ -108,13 +75,6 @@ numbered on the fly.
************************************************************************
-}
-lkDNamed :: NamedThing n => n -> DNameEnv a -> Maybe a
-lkDNamed n env = lookupDNameEnv env (getName n)
-
-xtDNamed :: NamedThing n => n -> XT a -> DNameEnv a -> DNameEnv a
-xtDNamed tc f m = alterDNameEnv f m (getName tc)
-
-
{-
Note [Binders]
~~~~~~~~~~~~~~
@@ -408,431 +368,3 @@ fdA :: (a -> b -> b) -> AltMap a -> b -> b
fdA k m = foldTM k (am_deflt m)
. foldTM (foldTM k) (am_data m)
. foldTM (foldTM k) (am_lit m)
-
-{-
-************************************************************************
-* *
- Coercions
-* *
-************************************************************************
--}
-
--- We should really never care about the contents of a coercion. Instead,
--- just look up the coercion's type.
-newtype CoercionMap a = CoercionMap (CoercionMapG a)
-
-instance TrieMap CoercionMap where
- type Key CoercionMap = Coercion
- emptyTM = CoercionMap emptyTM
- lookupTM k (CoercionMap m) = lookupTM (deBruijnize k) m
- alterTM k f (CoercionMap m) = CoercionMap (alterTM (deBruijnize k) f m)
- foldTM k (CoercionMap m) = foldTM k m
- mapTM f (CoercionMap m) = CoercionMap (mapTM f m)
-
-type CoercionMapG = GenMap CoercionMapX
-newtype CoercionMapX a = CoercionMapX (TypeMapX a)
-
-instance TrieMap CoercionMapX where
- type Key CoercionMapX = DeBruijn Coercion
- emptyTM = CoercionMapX emptyTM
- lookupTM = lkC
- alterTM = xtC
- foldTM f (CoercionMapX core_tm) = foldTM f core_tm
- mapTM f (CoercionMapX core_tm) = CoercionMapX (mapTM f core_tm)
-
-instance Eq (DeBruijn Coercion) where
- D env1 co1 == D env2 co2
- = D env1 (coercionType co1) ==
- D env2 (coercionType co2)
-
-lkC :: DeBruijn Coercion -> CoercionMapX a -> Maybe a
-lkC (D env co) (CoercionMapX core_tm) = lkT (D env $ coercionType co)
- core_tm
-
-xtC :: DeBruijn Coercion -> XT a -> CoercionMapX a -> CoercionMapX a
-xtC (D env co) f (CoercionMapX m)
- = CoercionMapX (xtT (D env $ coercionType co) f m)
-
-{-
-************************************************************************
-* *
- Types
-* *
-************************************************************************
--}
-
--- | @TypeMapG a@ is a map from @DeBruijn Type@ to @a at . The extended
--- key makes it suitable for recursive traversal, since it can track binders,
--- but it is strictly internal to this module. If you are including a 'TypeMap'
--- inside another 'TrieMap', this is the type you want. Note that this
--- lookup does not do a kind-check. Thus, all keys in this map must have
--- the same kind. Also note that this map respects the distinction between
--- @Type@ and @Constraint@, despite the fact that they are equivalent type
--- synonyms in Core.
-type TypeMapG = GenMap TypeMapX
-
--- | @TypeMapX a@ is the base map from @DeBruijn Type@ to @a@, but without the
--- 'GenMap' optimization.
-data TypeMapX a
- = TM { tm_var :: VarMap a
- , tm_app :: TypeMapG (TypeMapG a)
- , tm_tycon :: DNameEnv a
- , tm_forall :: TypeMapG (BndrMap a) -- See Note [Binders]
- , tm_tylit :: TyLitMap a
- , tm_coerce :: Maybe a
- }
- -- Note that there is no tyconapp case; see Note [Equality on AppTys] in GHC.Core.Type
-
--- | Squeeze out any synonyms, and change TyConApps to nested AppTys. Why the
--- last one? See Note [Equality on AppTys] in "GHC.Core.Type"
---
--- Note, however, that we keep Constraint and Type apart here, despite the fact
--- that they are both synonyms of TYPE 'LiftedRep (see #11715).
-trieMapView :: Type -> Maybe Type
-trieMapView ty
- -- First check for TyConApps that need to be expanded to
- -- AppTy chains.
- | Just (tc, tys@(_:_)) <- tcSplitTyConApp_maybe ty
- = Just $ foldl' AppTy (TyConApp tc []) tys
-
- -- Then resolve any remaining nullary synonyms.
- | Just ty' <- tcView ty = Just ty'
-trieMapView _ = Nothing
-
-instance TrieMap TypeMapX where
- type Key TypeMapX = DeBruijn Type
- emptyTM = emptyT
- lookupTM = lkT
- alterTM = xtT
- foldTM = fdT
- mapTM = mapT
-
-instance Eq (DeBruijn Type) where
- env_t@(D env t) == env_t'@(D env' t')
- | Just new_t <- tcView t = D env new_t == env_t'
- | Just new_t' <- tcView t' = env_t == D env' new_t'
- | otherwise
- = case (t, t') of
- (CastTy t1 _, _) -> D env t1 == D env t'
- (_, CastTy t1' _) -> D env t == D env t1'
-
- (TyVarTy v, TyVarTy v')
- -> case (lookupCME env v, lookupCME env' v') of
- (Just bv, Just bv') -> bv == bv'
- (Nothing, Nothing) -> v == v'
- _ -> False
- -- See Note [Equality on AppTys] in GHC.Core.Type
- (AppTy t1 t2, s) | Just (t1', t2') <- repSplitAppTy_maybe s
- -> D env t1 == D env' t1' && D env t2 == D env' t2'
- (s, AppTy t1' t2') | Just (t1, t2) <- repSplitAppTy_maybe s
- -> D env t1 == D env' t1' && D env t2 == D env' t2'
- (FunTy _ w1 t1 t2, FunTy _ w1' t1' t2')
- -> D env w1 == D env w1' && D env t1 == D env' t1' && D env t2 == D env' t2'
- (TyConApp tc tys, TyConApp tc' tys')
- -> tc == tc' && D env tys == D env' tys'
- (LitTy l, LitTy l')
- -> l == l'
- (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty')
- -> D env (varType tv) == D env' (varType tv') &&
- D (extendCME env tv) ty == D (extendCME env' tv') ty'
- (CoercionTy {}, CoercionTy {})
- -> True
- _ -> False
-
-instance {-# OVERLAPPING #-}
- Outputable a => Outputable (TypeMapG a) where
- ppr m = text "TypeMap elts" <+> ppr (foldTM (:) m [])
-
-emptyT :: TypeMapX a
-emptyT = TM { tm_var = emptyTM
- , tm_app = emptyTM
- , tm_tycon = emptyDNameEnv
- , tm_forall = emptyTM
- , tm_tylit = emptyTyLitMap
- , tm_coerce = Nothing }
-
-mapT :: (a->b) -> TypeMapX a -> TypeMapX b
-mapT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon
- , tm_forall = tforall, tm_tylit = tlit
- , tm_coerce = tcoerce })
- = TM { tm_var = mapTM f tvar
- , tm_app = mapTM (mapTM f) tapp
- , tm_tycon = mapTM f ttycon
- , tm_forall = mapTM (mapTM f) tforall
- , tm_tylit = mapTM f tlit
- , tm_coerce = fmap f tcoerce }
-
------------------
-lkT :: DeBruijn Type -> TypeMapX a -> Maybe a
-lkT (D env ty) m = go ty m
- where
- go ty | Just ty' <- trieMapView ty = go ty'
- go (TyVarTy v) = tm_var >.> lkVar env v
- go (AppTy t1 t2) = tm_app >.> lkG (D env t1)
- >=> lkG (D env t2)
- go (TyConApp tc []) = tm_tycon >.> lkDNamed tc
- go ty@(TyConApp _ (_:_)) = pprPanic "lkT TyConApp" (ppr ty)
- go (LitTy l) = tm_tylit >.> lkTyLit l
- go (ForAllTy (Bndr tv _) ty) = tm_forall >.> lkG (D (extendCME env tv) ty)
- >=> lkBndr env tv
- go ty@(FunTy {}) = pprPanic "lkT FunTy" (ppr ty)
- go (CastTy t _) = go t
- go (CoercionTy {}) = tm_coerce
-
------------------
-xtT :: DeBruijn Type -> XT a -> TypeMapX a -> TypeMapX a
-xtT (D env ty) f m | Just ty' <- trieMapView ty = xtT (D env ty') f m
-
-xtT (D env (TyVarTy v)) f m = m { tm_var = tm_var m |> xtVar env v f }
-xtT (D env (AppTy t1 t2)) f m = m { tm_app = tm_app m |> xtG (D env t1)
- |>> xtG (D env t2) f }
-xtT (D _ (TyConApp tc [])) f m = m { tm_tycon = tm_tycon m |> xtDNamed tc f }
-xtT (D _ (LitTy l)) f m = m { tm_tylit = tm_tylit m |> xtTyLit l f }
-xtT (D env (CastTy t _)) f m = xtT (D env t) f m
-xtT (D _ (CoercionTy {})) f m = m { tm_coerce = tm_coerce m |> f }
-xtT (D env (ForAllTy (Bndr tv _) ty)) f m
- = m { tm_forall = tm_forall m |> xtG (D (extendCME env tv) ty)
- |>> xtBndr env tv f }
-xtT (D _ ty@(TyConApp _ (_:_))) _ _ = pprPanic "xtT TyConApp" (ppr ty)
-xtT (D _ ty@(FunTy {})) _ _ = pprPanic "xtT FunTy" (ppr ty)
-
-fdT :: (a -> b -> b) -> TypeMapX a -> b -> b
-fdT k m = foldTM k (tm_var m)
- . foldTM (foldTM k) (tm_app m)
- . foldTM k (tm_tycon m)
- . foldTM (foldTM k) (tm_forall m)
- . foldTyLit k (tm_tylit m)
- . foldMaybe k (tm_coerce m)
-
-------------------------
-data TyLitMap a = TLM { tlm_number :: Map.Map Integer a
- , tlm_string :: UniqFM FastString a
- }
-
-instance TrieMap TyLitMap where
- type Key TyLitMap = TyLit
- emptyTM = emptyTyLitMap
- lookupTM = lkTyLit
- alterTM = xtTyLit
- foldTM = foldTyLit
- mapTM = mapTyLit
-
-emptyTyLitMap :: TyLitMap a
-emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM }
-
-mapTyLit :: (a->b) -> TyLitMap a -> TyLitMap b
-mapTyLit f (TLM { tlm_number = tn, tlm_string = ts })
- = TLM { tlm_number = Map.map f tn, tlm_string = mapUFM f ts }
-
-lkTyLit :: TyLit -> TyLitMap a -> Maybe a
-lkTyLit l =
- case l of
- NumTyLit n -> tlm_number >.> Map.lookup n
- StrTyLit n -> tlm_string >.> (`lookupUFM` n)
-
-xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a
-xtTyLit l f m =
- case l of
- NumTyLit n -> m { tlm_number = Map.alter f n (tlm_number m) }
- StrTyLit n -> m { tlm_string = alterUFM f (tlm_string m) n }
-
-foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b
-foldTyLit l m = flip (foldUFM l) (tlm_string m)
- . flip (Map.foldr l) (tlm_number m)
-
--------------------------------------------------
--- | @TypeMap a@ is a map from 'Type' to @a at . If you are a client, this
--- is the type you want. The keys in this map may have different kinds.
-newtype TypeMap a = TypeMap (TypeMapG (TypeMapG a))
-
-lkTT :: DeBruijn Type -> TypeMap a -> Maybe a
-lkTT (D env ty) (TypeMap m) = lkG (D env $ typeKind ty) m
- >>= lkG (D env ty)
-
-xtTT :: DeBruijn Type -> XT a -> TypeMap a -> TypeMap a
-xtTT (D env ty) f (TypeMap m)
- = TypeMap (m |> xtG (D env $ typeKind ty)
- |>> xtG (D env ty) f)
-
--- Below are some client-oriented functions which operate on 'TypeMap'.
-
-instance TrieMap TypeMap where
- type Key TypeMap = Type
- emptyTM = TypeMap emptyTM
- lookupTM k m = lkTT (deBruijnize k) m
- alterTM k f m = xtTT (deBruijnize k) f m
- foldTM k (TypeMap m) = foldTM (foldTM k) m
- mapTM f (TypeMap m) = TypeMap (mapTM (mapTM f) m)
-
-foldTypeMap :: (a -> b -> b) -> b -> TypeMap a -> b
-foldTypeMap k z m = foldTM k m z
-
-emptyTypeMap :: TypeMap a
-emptyTypeMap = emptyTM
-
-lookupTypeMap :: TypeMap a -> Type -> Maybe a
-lookupTypeMap cm t = lookupTM t cm
-
-extendTypeMap :: TypeMap a -> Type -> a -> TypeMap a
-extendTypeMap m t v = alterTM t (const (Just v)) m
-
-lookupTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> Maybe a
-lookupTypeMapWithScope m cm t = lkTT (D cm t) m
-
--- | Extend a 'TypeMap' with a type in the given context.
--- @extendTypeMapWithScope m (mkDeBruijnContext [a,b,c]) t v@ is equivalent to
--- @extendTypeMap m (forall a b c. t) v@, but allows reuse of the context over
--- multiple insertions.
-extendTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> a -> TypeMap a
-extendTypeMapWithScope m cm t v = xtTT (D cm t) (const (Just v)) m
-
--- | Construct a deBruijn environment with the given variables in scope.
--- e.g. @mkDeBruijnEnv [a,b,c]@ constructs a context @forall a b c.@
-mkDeBruijnContext :: [Var] -> CmEnv
-mkDeBruijnContext = extendCMEs emptyCME
-
--- | A 'LooseTypeMap' doesn't do a kind-check. Thus, when lookup up (t |> g),
--- you'll find entries inserted under (t), even if (g) is non-reflexive.
-newtype LooseTypeMap a
- = LooseTypeMap (TypeMapG a)
-
-instance TrieMap LooseTypeMap where
- type Key LooseTypeMap = Type
- emptyTM = LooseTypeMap emptyTM
- lookupTM k (LooseTypeMap m) = lookupTM (deBruijnize k) m
- alterTM k f (LooseTypeMap m) = LooseTypeMap (alterTM (deBruijnize k) f m)
- foldTM f (LooseTypeMap m) = foldTM f m
- mapTM f (LooseTypeMap m) = LooseTypeMap (mapTM f m)
-
-{-
-************************************************************************
-* *
- Variables
-* *
-************************************************************************
--}
-
-type BoundVar = Int -- Bound variables are deBruijn numbered
-type BoundVarMap a = IntMap.IntMap a
-
-data CmEnv = CME { cme_next :: !BoundVar
- , cme_env :: VarEnv BoundVar }
-
-emptyCME :: CmEnv
-emptyCME = CME { cme_next = 0, cme_env = emptyVarEnv }
-
-extendCME :: CmEnv -> Var -> CmEnv
-extendCME (CME { cme_next = bv, cme_env = env }) v
- = CME { cme_next = bv+1, cme_env = extendVarEnv env v bv }
-
-extendCMEs :: CmEnv -> [Var] -> CmEnv
-extendCMEs env vs = foldl' extendCME env vs
-
-lookupCME :: CmEnv -> Var -> Maybe BoundVar
-lookupCME (CME { cme_env = env }) v = lookupVarEnv env v
-
--- | @DeBruijn a@ represents @a@ modulo alpha-renaming. This is achieved
--- by equipping the value with a 'CmEnv', which tracks an on-the-fly deBruijn
--- numbering. This allows us to define an 'Eq' instance for @DeBruijn a@, even
--- if this was not (easily) possible for @a at . Note: we purposely don't
--- export the constructor. Make a helper function if you find yourself
--- needing it.
-data DeBruijn a = D CmEnv a
-
--- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no
--- bound binders (an empty 'CmEnv'). This is usually what you want if there
--- isn't already a 'CmEnv' in scope.
-deBruijnize :: a -> DeBruijn a
-deBruijnize = D emptyCME
-
-instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where
- D _ [] == D _ [] = True
- D env (x:xs) == D env' (x':xs') = D env x == D env' x' &&
- D env xs == D env' xs'
- _ == _ = False
-
-instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where
- D _ Nothing == D _ Nothing = True
- D env (Just x) == D env' (Just x') = D env x == D env' x'
- _ == _ = False
-
---------- Variable binders -------------
-
--- | A 'BndrMap' is a 'TypeMapG' which allows us to distinguish between
--- binding forms whose binders have different types. For example,
--- if we are doing a 'TrieMap' lookup on @\(x :: Int) -> ()@, we should
--- not pick up an entry in the 'TrieMap' for @\(x :: Bool) -> ()@:
--- we can disambiguate this by matching on the type (or kind, if this
--- a binder in a type) of the binder.
---
--- We also need to do the same for multiplicity! Which, since multiplicities are
--- encoded simply as a 'Type', amounts to have a Trie for a pair of types. Tries
--- of pairs are composition.
-data BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a))
-
-instance TrieMap BndrMap where
- type Key BndrMap = Var
- emptyTM = BndrMap emptyTM
- lookupTM = lkBndr emptyCME
- alterTM = xtBndr emptyCME
- foldTM = fdBndrMap
- mapTM = mapBndrMap
-
-mapBndrMap :: (a -> b) -> BndrMap a -> BndrMap b
-mapBndrMap f (BndrMap tm) = BndrMap (mapTM (mapTM f) tm)
-
-fdBndrMap :: (a -> b -> b) -> BndrMap a -> b -> b
-fdBndrMap f (BndrMap tm) = foldTM (foldTM f) tm
-
-
--- Note [Binders]
--- ~~~~~~~~~~~~~~
--- We need to use 'BndrMap' for 'Coercion', 'CoreExpr' AND 'Type', since all
--- of these data types have binding forms.
-
-lkBndr :: CmEnv -> Var -> BndrMap a -> Maybe a
-lkBndr env v (BndrMap tymap) = do
- multmap <- lkG (D env (varType v)) tymap
- lookupTM (D env <$> varMultMaybe v) multmap
-
-
-xtBndr :: forall a . CmEnv -> Var -> XT a -> BndrMap a -> BndrMap a
-xtBndr env v xt (BndrMap tymap) =
- BndrMap (tymap |> xtG (D env (varType v)) |>> (alterTM (D env <$> varMultMaybe v) xt))
-
-
---------- Variable occurrence -------------
-data VarMap a = VM { vm_bvar :: BoundVarMap a -- Bound variable
- , vm_fvar :: DVarEnv a } -- Free variable
-
-instance TrieMap VarMap where
- type Key VarMap = Var
- emptyTM = VM { vm_bvar = IntMap.empty, vm_fvar = emptyDVarEnv }
- lookupTM = lkVar emptyCME
- alterTM = xtVar emptyCME
- foldTM = fdVar
- mapTM = mapVar
-
-mapVar :: (a->b) -> VarMap a -> VarMap b
-mapVar f (VM { vm_bvar = bv, vm_fvar = fv })
- = VM { vm_bvar = mapTM f bv, vm_fvar = mapTM f fv }
-
-lkVar :: CmEnv -> Var -> VarMap a -> Maybe a
-lkVar env v
- | Just bv <- lookupCME env v = vm_bvar >.> lookupTM bv
- | otherwise = vm_fvar >.> lkDFreeVar v
-
-xtVar :: CmEnv -> Var -> XT a -> VarMap a -> VarMap a
-xtVar env v f m
- | Just bv <- lookupCME env v = m { vm_bvar = vm_bvar m |> alterTM bv f }
- | otherwise = m { vm_fvar = vm_fvar m |> xtDFreeVar v f }
-
-fdVar :: (a -> b -> b) -> VarMap a -> b -> b
-fdVar k m = foldTM k (vm_bvar m)
- . foldTM k (vm_fvar m)
-
-lkDFreeVar :: Var -> DVarEnv a -> Maybe a
-lkDFreeVar var env = lookupDVarEnv env var
-
-xtDFreeVar :: Var -> XT a -> DVarEnv a -> DVarEnv a
-xtDFreeVar v f m = alterDVarEnv f m v
=====================================
compiler/GHC/Core/Map/Type.hs
=====================================
@@ -0,0 +1,501 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module GHC.Core.Map.Type (
+ -- * Maps over 'Type's
+ TypeMap, emptyTypeMap, extendTypeMap, lookupTypeMap, foldTypeMap,
+ LooseTypeMap,
+ -- ** With explicit scoping
+ CmEnv, lookupCME, extendTypeMapWithScope, lookupTypeMapWithScope,
+ mkDeBruijnContext, extendCME, extendCMEs, emptyCME,
+
+ -- * Utilities for use by friends only
+ TypeMapG, CoercionMapG,
+
+ DeBruijn(..), deBruijnize,
+
+ BndrMap, xtBndr, lkBndr,
+ VarMap, xtVar, lkVar, lkDFreeVar, xtDFreeVar,
+
+ xtDNamed, lkDNamed
+
+ ) where
+
+-- This module is separate from GHC.Core.Map to avoid a module loop
+-- between GHC.Core.Unify (which depends on this module) and GHC.Core
+
+import GHC.Prelude
+
+import GHC.Core.Type
+import GHC.Core.Coercion
+import GHC.Core.TyCo.Rep
+import GHC.Data.TrieMap
+
+import GHC.Data.FastString
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Unique.FM
+import GHC.Utils.Outputable
+
+import GHC.Utils.Panic
+
+import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap
+
+import Control.Monad ( (>=>) )
+
+-- NB: Be careful about RULES and type families (#5821). So we should make sure
+-- to specify @Key TypeMapX@ (and not @DeBruijn Type@, the reduced form)
+
+{-# SPECIALIZE lkG :: Key TypeMapX -> TypeMapG a -> Maybe a #-}
+{-# SPECIALIZE lkG :: Key CoercionMapX -> CoercionMapG a -> Maybe a #-}
+
+{-# SPECIALIZE xtG :: Key TypeMapX -> XT a -> TypeMapG a -> TypeMapG a #-}
+{-# SPECIALIZE xtG :: Key CoercionMapX -> XT a -> CoercionMapG a -> CoercionMapG a #-}
+
+{-# SPECIALIZE mapG :: (a -> b) -> TypeMapG a -> TypeMapG b #-}
+{-# SPECIALIZE mapG :: (a -> b) -> CoercionMapG a -> CoercionMapG b #-}
+
+{-# SPECIALIZE fdG :: (a -> b -> b) -> TypeMapG a -> b -> b #-}
+{-# SPECIALIZE fdG :: (a -> b -> b) -> CoercionMapG a -> b -> b #-}
+
+{-
+************************************************************************
+* *
+ Coercions
+* *
+************************************************************************
+-}
+
+-- We should really never care about the contents of a coercion. Instead,
+-- just look up the coercion's type.
+newtype CoercionMap a = CoercionMap (CoercionMapG a)
+
+instance TrieMap CoercionMap where
+ type Key CoercionMap = Coercion
+ emptyTM = CoercionMap emptyTM
+ lookupTM k (CoercionMap m) = lookupTM (deBruijnize k) m
+ alterTM k f (CoercionMap m) = CoercionMap (alterTM (deBruijnize k) f m)
+ foldTM k (CoercionMap m) = foldTM k m
+ mapTM f (CoercionMap m) = CoercionMap (mapTM f m)
+
+type CoercionMapG = GenMap CoercionMapX
+newtype CoercionMapX a = CoercionMapX (TypeMapX a)
+
+instance TrieMap CoercionMapX where
+ type Key CoercionMapX = DeBruijn Coercion
+ emptyTM = CoercionMapX emptyTM
+ lookupTM = lkC
+ alterTM = xtC
+ foldTM f (CoercionMapX core_tm) = foldTM f core_tm
+ mapTM f (CoercionMapX core_tm) = CoercionMapX (mapTM f core_tm)
+
+instance Eq (DeBruijn Coercion) where
+ D env1 co1 == D env2 co2
+ = D env1 (coercionType co1) ==
+ D env2 (coercionType co2)
+
+lkC :: DeBruijn Coercion -> CoercionMapX a -> Maybe a
+lkC (D env co) (CoercionMapX core_tm) = lkT (D env $ coercionType co)
+ core_tm
+
+xtC :: DeBruijn Coercion -> XT a -> CoercionMapX a -> CoercionMapX a
+xtC (D env co) f (CoercionMapX m)
+ = CoercionMapX (xtT (D env $ coercionType co) f m)
+
+{-
+************************************************************************
+* *
+ Types
+* *
+************************************************************************
+-}
+
+-- | @TypeMapG a@ is a map from @DeBruijn Type@ to @a at . The extended
+-- key makes it suitable for recursive traversal, since it can track binders,
+-- but it is strictly internal to this module. If you are including a 'TypeMap'
+-- inside another 'TrieMap', this is the type you want. Note that this
+-- lookup does not do a kind-check. Thus, all keys in this map must have
+-- the same kind. Also note that this map respects the distinction between
+-- @Type@ and @Constraint@, despite the fact that they are equivalent type
+-- synonyms in Core.
+type TypeMapG = GenMap TypeMapX
+
+-- | @TypeMapX a@ is the base map from @DeBruijn Type@ to @a@, but without the
+-- 'GenMap' optimization.
+data TypeMapX a
+ = TM { tm_var :: VarMap a
+ , tm_app :: TypeMapG (TypeMapG a)
+ , tm_tycon :: DNameEnv a
+ , tm_forall :: TypeMapG (BndrMap a) -- See Note [Binders] in GHC.Core.Map
+ , tm_tylit :: TyLitMap a
+ , tm_coerce :: Maybe a
+ }
+ -- Note that there is no tyconapp case; see Note [Equality on AppTys] in GHC.Core.Type
+
+-- | Squeeze out any synonyms, and change TyConApps to nested AppTys. Why the
+-- last one? See Note [Equality on AppTys] in "GHC.Core.Type"
+--
+-- Note, however, that we keep Constraint and Type apart here, despite the fact
+-- that they are both synonyms of TYPE 'LiftedRep (see #11715).
+trieMapView :: Type -> Maybe Type
+trieMapView ty
+ -- First check for TyConApps that need to be expanded to
+ -- AppTy chains.
+ | Just (tc, tys@(_:_)) <- tcSplitTyConApp_maybe ty
+ = Just $ foldl' AppTy (TyConApp tc []) tys
+
+ -- Then resolve any remaining nullary synonyms.
+ | Just ty' <- tcView ty = Just ty'
+trieMapView _ = Nothing
+
+instance TrieMap TypeMapX where
+ type Key TypeMapX = DeBruijn Type
+ emptyTM = emptyT
+ lookupTM = lkT
+ alterTM = xtT
+ foldTM = fdT
+ mapTM = mapT
+
+instance Eq (DeBruijn Type) where
+ env_t@(D env t) == env_t'@(D env' t')
+ | Just new_t <- tcView t = D env new_t == env_t'
+ | Just new_t' <- tcView t' = env_t == D env' new_t'
+ | otherwise
+ = case (t, t') of
+ (CastTy t1 _, _) -> D env t1 == D env t'
+ (_, CastTy t1' _) -> D env t == D env t1'
+
+ (TyVarTy v, TyVarTy v')
+ -> case (lookupCME env v, lookupCME env' v') of
+ (Just bv, Just bv') -> bv == bv'
+ (Nothing, Nothing) -> v == v'
+ _ -> False
+ -- See Note [Equality on AppTys] in GHC.Core.Type
+ (AppTy t1 t2, s) | Just (t1', t2') <- repSplitAppTy_maybe s
+ -> D env t1 == D env' t1' && D env t2 == D env' t2'
+ (s, AppTy t1' t2') | Just (t1, t2) <- repSplitAppTy_maybe s
+ -> D env t1 == D env' t1' && D env t2 == D env' t2'
+ (FunTy _ w1 t1 t2, FunTy _ w1' t1' t2')
+ -> D env w1 == D env w1' && D env t1 == D env' t1' && D env t2 == D env' t2'
+ (TyConApp tc tys, TyConApp tc' tys')
+ -> tc == tc' && D env tys == D env' tys'
+ (LitTy l, LitTy l')
+ -> l == l'
+ (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty')
+ -> D env (varType tv) == D env' (varType tv') &&
+ D (extendCME env tv) ty == D (extendCME env' tv') ty'
+ (CoercionTy {}, CoercionTy {})
+ -> True
+ _ -> False
+
+instance {-# OVERLAPPING #-}
+ Outputable a => Outputable (TypeMapG a) where
+ ppr m = text "TypeMap elts" <+> ppr (foldTM (:) m [])
+
+emptyT :: TypeMapX a
+emptyT = TM { tm_var = emptyTM
+ , tm_app = emptyTM
+ , tm_tycon = emptyDNameEnv
+ , tm_forall = emptyTM
+ , tm_tylit = emptyTyLitMap
+ , tm_coerce = Nothing }
+
+mapT :: (a->b) -> TypeMapX a -> TypeMapX b
+mapT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon
+ , tm_forall = tforall, tm_tylit = tlit
+ , tm_coerce = tcoerce })
+ = TM { tm_var = mapTM f tvar
+ , tm_app = mapTM (mapTM f) tapp
+ , tm_tycon = mapTM f ttycon
+ , tm_forall = mapTM (mapTM f) tforall
+ , tm_tylit = mapTM f tlit
+ , tm_coerce = fmap f tcoerce }
+
+-----------------
+lkT :: DeBruijn Type -> TypeMapX a -> Maybe a
+lkT (D env ty) m = go ty m
+ where
+ go ty | Just ty' <- trieMapView ty = go ty'
+ go (TyVarTy v) = tm_var >.> lkVar env v
+ go (AppTy t1 t2) = tm_app >.> lkG (D env t1)
+ >=> lkG (D env t2)
+ go (TyConApp tc []) = tm_tycon >.> lkDNamed tc
+ go ty@(TyConApp _ (_:_)) = pprPanic "lkT TyConApp" (ppr ty)
+ go (LitTy l) = tm_tylit >.> lkTyLit l
+ go (ForAllTy (Bndr tv _) ty) = tm_forall >.> lkG (D (extendCME env tv) ty)
+ >=> lkBndr env tv
+ go ty@(FunTy {}) = pprPanic "lkT FunTy" (ppr ty)
+ go (CastTy t _) = go t
+ go (CoercionTy {}) = tm_coerce
+
+-----------------
+xtT :: DeBruijn Type -> XT a -> TypeMapX a -> TypeMapX a
+xtT (D env ty) f m | Just ty' <- trieMapView ty = xtT (D env ty') f m
+
+xtT (D env (TyVarTy v)) f m = m { tm_var = tm_var m |> xtVar env v f }
+xtT (D env (AppTy t1 t2)) f m = m { tm_app = tm_app m |> xtG (D env t1)
+ |>> xtG (D env t2) f }
+xtT (D _ (TyConApp tc [])) f m = m { tm_tycon = tm_tycon m |> xtDNamed tc f }
+xtT (D _ (LitTy l)) f m = m { tm_tylit = tm_tylit m |> xtTyLit l f }
+xtT (D env (CastTy t _)) f m = xtT (D env t) f m
+xtT (D _ (CoercionTy {})) f m = m { tm_coerce = tm_coerce m |> f }
+xtT (D env (ForAllTy (Bndr tv _) ty)) f m
+ = m { tm_forall = tm_forall m |> xtG (D (extendCME env tv) ty)
+ |>> xtBndr env tv f }
+xtT (D _ ty@(TyConApp _ (_:_))) _ _ = pprPanic "xtT TyConApp" (ppr ty)
+xtT (D _ ty@(FunTy {})) _ _ = pprPanic "xtT FunTy" (ppr ty)
+
+fdT :: (a -> b -> b) -> TypeMapX a -> b -> b
+fdT k m = foldTM k (tm_var m)
+ . foldTM (foldTM k) (tm_app m)
+ . foldTM k (tm_tycon m)
+ . foldTM (foldTM k) (tm_forall m)
+ . foldTyLit k (tm_tylit m)
+ . foldMaybe k (tm_coerce m)
+
+------------------------
+data TyLitMap a = TLM { tlm_number :: Map.Map Integer a
+ , tlm_string :: UniqFM FastString a
+ }
+
+instance TrieMap TyLitMap where
+ type Key TyLitMap = TyLit
+ emptyTM = emptyTyLitMap
+ lookupTM = lkTyLit
+ alterTM = xtTyLit
+ foldTM = foldTyLit
+ mapTM = mapTyLit
+
+emptyTyLitMap :: TyLitMap a
+emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM }
+
+mapTyLit :: (a->b) -> TyLitMap a -> TyLitMap b
+mapTyLit f (TLM { tlm_number = tn, tlm_string = ts })
+ = TLM { tlm_number = Map.map f tn, tlm_string = mapUFM f ts }
+
+lkTyLit :: TyLit -> TyLitMap a -> Maybe a
+lkTyLit l =
+ case l of
+ NumTyLit n -> tlm_number >.> Map.lookup n
+ StrTyLit n -> tlm_string >.> (`lookupUFM` n)
+
+xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a
+xtTyLit l f m =
+ case l of
+ NumTyLit n -> m { tlm_number = Map.alter f n (tlm_number m) }
+ StrTyLit n -> m { tlm_string = alterUFM f (tlm_string m) n }
+
+foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b
+foldTyLit l m = flip (foldUFM l) (tlm_string m)
+ . flip (Map.foldr l) (tlm_number m)
+
+-------------------------------------------------
+-- | @TypeMap a@ is a map from 'Type' to @a at . If you are a client, this
+-- is the type you want. The keys in this map may have different kinds.
+newtype TypeMap a = TypeMap (TypeMapG (TypeMapG a))
+
+lkTT :: DeBruijn Type -> TypeMap a -> Maybe a
+lkTT (D env ty) (TypeMap m) = lkG (D env $ typeKind ty) m
+ >>= lkG (D env ty)
+
+xtTT :: DeBruijn Type -> XT a -> TypeMap a -> TypeMap a
+xtTT (D env ty) f (TypeMap m)
+ = TypeMap (m |> xtG (D env $ typeKind ty)
+ |>> xtG (D env ty) f)
+
+-- Below are some client-oriented functions which operate on 'TypeMap'.
+
+instance TrieMap TypeMap where
+ type Key TypeMap = Type
+ emptyTM = TypeMap emptyTM
+ lookupTM k m = lkTT (deBruijnize k) m
+ alterTM k f m = xtTT (deBruijnize k) f m
+ foldTM k (TypeMap m) = foldTM (foldTM k) m
+ mapTM f (TypeMap m) = TypeMap (mapTM (mapTM f) m)
+
+foldTypeMap :: (a -> b -> b) -> b -> TypeMap a -> b
+foldTypeMap k z m = foldTM k m z
+
+emptyTypeMap :: TypeMap a
+emptyTypeMap = emptyTM
+
+lookupTypeMap :: TypeMap a -> Type -> Maybe a
+lookupTypeMap cm t = lookupTM t cm
+
+extendTypeMap :: TypeMap a -> Type -> a -> TypeMap a
+extendTypeMap m t v = alterTM t (const (Just v)) m
+
+lookupTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> Maybe a
+lookupTypeMapWithScope m cm t = lkTT (D cm t) m
+
+-- | Extend a 'TypeMap' with a type in the given context.
+-- @extendTypeMapWithScope m (mkDeBruijnContext [a,b,c]) t v@ is equivalent to
+-- @extendTypeMap m (forall a b c. t) v@, but allows reuse of the context over
+-- multiple insertions.
+extendTypeMapWithScope :: TypeMap a -> CmEnv -> Type -> a -> TypeMap a
+extendTypeMapWithScope m cm t v = xtTT (D cm t) (const (Just v)) m
+
+-- | Construct a deBruijn environment with the given variables in scope.
+-- e.g. @mkDeBruijnEnv [a,b,c]@ constructs a context @forall a b c.@
+mkDeBruijnContext :: [Var] -> CmEnv
+mkDeBruijnContext = extendCMEs emptyCME
+
+-- | A 'LooseTypeMap' doesn't do a kind-check. Thus, when lookup up (t |> g),
+-- you'll find entries inserted under (t), even if (g) is non-reflexive.
+newtype LooseTypeMap a
+ = LooseTypeMap (TypeMapG a)
+
+instance TrieMap LooseTypeMap where
+ type Key LooseTypeMap = Type
+ emptyTM = LooseTypeMap emptyTM
+ lookupTM k (LooseTypeMap m) = lookupTM (deBruijnize k) m
+ alterTM k f (LooseTypeMap m) = LooseTypeMap (alterTM (deBruijnize k) f m)
+ foldTM f (LooseTypeMap m) = foldTM f m
+ mapTM f (LooseTypeMap m) = LooseTypeMap (mapTM f m)
+
+{-
+************************************************************************
+* *
+ Variables
+* *
+************************************************************************
+-}
+
+type BoundVar = Int -- Bound variables are deBruijn numbered
+type BoundVarMap a = IntMap.IntMap a
+
+data CmEnv = CME { cme_next :: !BoundVar
+ , cme_env :: VarEnv BoundVar }
+
+emptyCME :: CmEnv
+emptyCME = CME { cme_next = 0, cme_env = emptyVarEnv }
+
+extendCME :: CmEnv -> Var -> CmEnv
+extendCME (CME { cme_next = bv, cme_env = env }) v
+ = CME { cme_next = bv+1, cme_env = extendVarEnv env v bv }
+
+extendCMEs :: CmEnv -> [Var] -> CmEnv
+extendCMEs env vs = foldl' extendCME env vs
+
+lookupCME :: CmEnv -> Var -> Maybe BoundVar
+lookupCME (CME { cme_env = env }) v = lookupVarEnv env v
+
+-- | @DeBruijn a@ represents @a@ modulo alpha-renaming. This is achieved
+-- by equipping the value with a 'CmEnv', which tracks an on-the-fly deBruijn
+-- numbering. This allows us to define an 'Eq' instance for @DeBruijn a@, even
+-- if this was not (easily) possible for @a at . Note: we purposely don't
+-- export the constructor. Make a helper function if you find yourself
+-- needing it.
+data DeBruijn a = D CmEnv a
+
+-- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no
+-- bound binders (an empty 'CmEnv'). This is usually what you want if there
+-- isn't already a 'CmEnv' in scope.
+deBruijnize :: a -> DeBruijn a
+deBruijnize = D emptyCME
+
+instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where
+ D _ [] == D _ [] = True
+ D env (x:xs) == D env' (x':xs') = D env x == D env' x' &&
+ D env xs == D env' xs'
+ _ == _ = False
+
+instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where
+ D _ Nothing == D _ Nothing = True
+ D env (Just x) == D env' (Just x') = D env x == D env' x'
+ _ == _ = False
+
+--------- Variable binders -------------
+
+-- | A 'BndrMap' is a 'TypeMapG' which allows us to distinguish between
+-- binding forms whose binders have different types. For example,
+-- if we are doing a 'TrieMap' lookup on @\(x :: Int) -> ()@, we should
+-- not pick up an entry in the 'TrieMap' for @\(x :: Bool) -> ()@:
+-- we can disambiguate this by matching on the type (or kind, if this
+-- a binder in a type) of the binder.
+--
+-- We also need to do the same for multiplicity! Which, since multiplicities are
+-- encoded simply as a 'Type', amounts to have a Trie for a pair of types. Tries
+-- of pairs are composition.
+data BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a))
+
+instance TrieMap BndrMap where
+ type Key BndrMap = Var
+ emptyTM = BndrMap emptyTM
+ lookupTM = lkBndr emptyCME
+ alterTM = xtBndr emptyCME
+ foldTM = fdBndrMap
+ mapTM = mapBndrMap
+
+mapBndrMap :: (a -> b) -> BndrMap a -> BndrMap b
+mapBndrMap f (BndrMap tm) = BndrMap (mapTM (mapTM f) tm)
+
+fdBndrMap :: (a -> b -> b) -> BndrMap a -> b -> b
+fdBndrMap f (BndrMap tm) = foldTM (foldTM f) tm
+
+
+-- We need to use 'BndrMap' for 'Coercion', 'CoreExpr' AND 'Type', since all
+-- of these data types have binding forms.
+
+lkBndr :: CmEnv -> Var -> BndrMap a -> Maybe a
+lkBndr env v (BndrMap tymap) = do
+ multmap <- lkG (D env (varType v)) tymap
+ lookupTM (D env <$> varMultMaybe v) multmap
+
+
+xtBndr :: forall a . CmEnv -> Var -> XT a -> BndrMap a -> BndrMap a
+xtBndr env v xt (BndrMap tymap) =
+ BndrMap (tymap |> xtG (D env (varType v)) |>> (alterTM (D env <$> varMultMaybe v) xt))
+
+
+--------- Variable occurrence -------------
+data VarMap a = VM { vm_bvar :: BoundVarMap a -- Bound variable
+ , vm_fvar :: DVarEnv a } -- Free variable
+
+instance TrieMap VarMap where
+ type Key VarMap = Var
+ emptyTM = VM { vm_bvar = IntMap.empty, vm_fvar = emptyDVarEnv }
+ lookupTM = lkVar emptyCME
+ alterTM = xtVar emptyCME
+ foldTM = fdVar
+ mapTM = mapVar
+
+mapVar :: (a->b) -> VarMap a -> VarMap b
+mapVar f (VM { vm_bvar = bv, vm_fvar = fv })
+ = VM { vm_bvar = mapTM f bv, vm_fvar = mapTM f fv }
+
+lkVar :: CmEnv -> Var -> VarMap a -> Maybe a
+lkVar env v
+ | Just bv <- lookupCME env v = vm_bvar >.> lookupTM bv
+ | otherwise = vm_fvar >.> lkDFreeVar v
+
+xtVar :: CmEnv -> Var -> XT a -> VarMap a -> VarMap a
+xtVar env v f m
+ | Just bv <- lookupCME env v = m { vm_bvar = vm_bvar m |> alterTM bv f }
+ | otherwise = m { vm_fvar = vm_fvar m |> xtDFreeVar v f }
+
+fdVar :: (a -> b -> b) -> VarMap a -> b -> b
+fdVar k m = foldTM k (vm_bvar m)
+ . foldTM k (vm_fvar m)
+
+lkDFreeVar :: Var -> DVarEnv a -> Maybe a
+lkDFreeVar var env = lookupDVarEnv env var
+
+xtDFreeVar :: Var -> XT a -> DVarEnv a -> DVarEnv a
+xtDFreeVar v f m = alterDVarEnv f m v
+
+-------------------------------------------------
+lkDNamed :: NamedThing n => n -> DNameEnv a -> Maybe a
+lkDNamed n env = lookupDNameEnv env (getName n)
+
+xtDNamed :: NamedThing n => n -> XT a -> DNameEnv a -> DNameEnv a
+xtDNamed tc f m = alterDNameEnv f m (getName tc)
=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -41,7 +41,7 @@ import GHC.Core.TyCon
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs ( tyCoVarsOfCoList, tyCoFVsOfTypes )
import GHC.Core.TyCo.Subst ( mkTvSubst )
-import GHC.Core.Map
+import GHC.Core.Map.Type
import GHC.Utils.FV( FV, fvVarSet, fvVarList )
import GHC.Utils.Misc
import GHC.Data.Pair
=====================================
compiler/GHC/Iface/Ext/Utils.hs
=====================================
@@ -8,7 +8,7 @@ module GHC.Iface.Ext.Utils where
import GHC.Prelude
-import GHC.Core.Map
+import GHC.Core.Map.Type
import GHC.Driver.Session ( DynFlags )
import GHC.Driver.Ppr
import GHC.Data.FastString ( FastString, mkFastString )
=====================================
compiler/GHC/Stg/CSE.hs
=====================================
@@ -103,6 +103,7 @@ import GHC.Core (AltCon(..))
import Data.List (mapAccumL)
import Data.Maybe (fromMaybe)
import GHC.Core.Map
+import GHC.Data.TrieMap
import GHC.Types.Name.Env
import Control.Monad( (>=>) )
=====================================
compiler/GHC/Tc/Instance/Typeable.hs
=====================================
@@ -39,7 +39,7 @@ import GHC.Hs
import GHC.Driver.Session
import GHC.Data.Bag
import GHC.Types.Var ( VarBndr(..) )
-import GHC.Core.Map
+import GHC.Core.Map.Type
import GHC.Settings.Constants
import GHC.Utils.Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints)
import GHC.Utils.Outputable
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -174,7 +174,9 @@ import GHC.Types.Unique
import GHC.Types.Unique.DFM
import GHC.Data.Maybe
-import GHC.Core.Map
+import GHC.Core.Map.Type
+import GHC.Data.TrieMap
+
import Control.Monad
import GHC.Utils.Monad
import Data.IORef
=====================================
compiler/ghc.cabal.in
=====================================
@@ -303,6 +303,7 @@ Library
GHC.Core.Unfold.Make
GHC.Core.Utils
GHC.Core.Map
+ GHC.Core.Map.Type
GHC.Core.Seq
GHC.Core.Stats
GHC.Core.Make
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f50147f3472bf8a098eff1a9dff642b812e36c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f50147f3472bf8a098eff1a9dff642b812e36c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201010/f75b061d/attachment-0001.html>
More information about the ghc-commits
mailing list