[Git][ghc/ghc][wip/andreask/typedUniqFM] Fix more type errors
Andreas Klebinger
gitlab at gitlab.haskell.org
Tue Jun 23 16:22:09 UTC 2020
Andreas Klebinger pushed to branch wip/andreask/typedUniqFM at Glasgow Haskell Compiler / GHC
Commits:
bacf6449 by Andreas Klebinger at 2020-06-23T18:21:54+02:00
Fix more type errors
- - - - -
11 changed files:
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Data/Graph/Color.hs
- compiler/GHC/Data/Graph/Ops.hs
- compiler/GHC/Data/TrieMap.hs
- compiler/GHC/Types/Literal.hs
- compiler/GHC/Types/Name.hs-boot
- compiler/GHC/Types/Var/Env.hs
- compiler/GHC/Unit/Module/Env.hs
- compiler/GHC/Unit/State.hs
Changes:
=====================================
compiler/GHC/Core/FamInstEnv.hs
=====================================
@@ -352,7 +352,10 @@ UniqFM and UniqDFM.
See Note [Deterministic UniqFM].
-}
-type FamInstEnv = UniqDFM FamilyInstEnv -- Maps a family to its instances
+-- This is used both with Names, and TyCons.
+-- But every tyCon has a name so just use the
+-- names as key for now.
+type FamInstEnv = UniqDFM Name FamilyInstEnv -- Maps a family to its instances
-- See Note [FamInstEnv]
-- See Note [FamInstEnv determinism]
@@ -388,7 +391,7 @@ familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
familyInstances (pkg_fie, home_fie) fam
= get home_fie ++ get pkg_fie
where
- get env = case lookupUDFM env fam of
+ get env = case lookupUDFM env (tyConName fam) of
Just (FamIE insts) -> insts
Nothing -> []
@@ -767,7 +770,7 @@ lookupFamInstEnvByTyCon :: FamInstEnvs -> TyCon -> [FamInst]
lookupFamInstEnvByTyCon (pkg_ie, home_ie) fam_tc
= get pkg_ie ++ get home_ie
where
- get ie = case lookupUDFM ie fam_tc of
+ get ie = case lookupUDFM ie (tyConName fam_tc) of
Nothing -> []
Just (FamIE fis) -> fis
@@ -939,7 +942,7 @@ lookupFamInstEnvInjectivityConflicts injList (pkg_ie, home_ie)
| otherwise = True
lookup_inj_fam_conflicts ie
- | isOpenFamilyTyCon fam, Just (FamIE insts) <- lookupUDFM ie fam
+ | isOpenFamilyTyCon fam, Just (FamIE insts) <- lookupUDFM ie (tyConName fam)
= map (coAxiomSingleBranch . fi_axiom) $
filter isInjConflict insts
| otherwise = []
@@ -979,7 +982,7 @@ lookup_fam_inst_env' -- The worker, local to this module
-> [FamInstMatch]
lookup_fam_inst_env' match_fun ie fam match_tys
| isOpenFamilyTyCon fam
- , Just (FamIE insts) <- lookupUDFM ie fam
+ , Just (FamIE insts) <- lookupUDFM ie (tyConName fam)
= find insts -- The common case
| otherwise = []
where
=====================================
compiler/GHC/Core/InstEnv.hs
=====================================
@@ -385,7 +385,12 @@ Testing with nofib and validate detected no difference between UniqFM and
UniqDFM. See also Note [Deterministic UniqFM]
-}
-type InstEnv = UniqDFM ClsInstEnv -- Maps Class to instances for that class
+-- Class has a Unique which is the same as it's tyCon.
+-- TyCon has a unique which is the same as it's Name.
+-- Name just has a unique which is it's own.
+-- We use all three to index into InstEnv ... so I'm giving
+-- it a key of Name for now.
+type InstEnv = UniqDFM Name ClsInstEnv -- Maps Class to instances for that class
-- See Note [InstEnv determinism]
-- | 'InstEnvs' represents the combination of the global type class instance
@@ -448,7 +453,7 @@ classInstances :: InstEnvs -> Class -> [ClsInst]
classInstances (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods }) cls
= get home_ie ++ get pkg_ie
where
- get env = case lookupUDFM env cls of
+ get env = case lookupUDFM env (className cls) of
Just (ClsIE insts) -> filter (instIsVisible vis_mods) insts
Nothing -> []
@@ -480,7 +485,7 @@ deleteFromInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm })
deleteDFunFromInstEnv :: InstEnv -> DFunId -> InstEnv
-- Delete a specific instance fron an InstEnv
deleteDFunFromInstEnv inst_env dfun
- = adjustUDFM adjust inst_env cls
+ = adjustUDFM adjust inst_env (className cls)
where
(_, _, cls, _) = tcSplitDFunTy (idType dfun)
adjust (ClsIE items) = ClsIE (filterOut same_dfun items)
@@ -790,7 +795,7 @@ lookupInstEnv' ie vis_mods cls tys
all_tvs = all isNothing rough_tcs
--------------
- lookup env = case lookupUDFM env cls of
+ lookup env = case lookupUDFM env (className cls) of
Nothing -> ([],[]) -- No instances for this class
Just (ClsIE insts) -> find [] [] insts
=====================================
compiler/GHC/Core/Tidy.hs
=====================================
@@ -26,6 +26,7 @@ import GHC.Core.Type ( tidyType, tidyVarBndr )
import GHC.Core.Coercion ( tidyCo )
import GHC.Types.Var
import GHC.Types.Var.Env
+import GHC.Types.Unique (getUnique)
import GHC.Types.Unique.FM
import GHC.Types.Name hiding (tidyNameOcc)
import GHC.Types.SrcLoc
@@ -121,7 +122,7 @@ tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
tidyNameOcc :: TidyEnv -> Name -> Name
-- In rules and instances, we have Names, and we must tidy them too
-- Fortunately, we can lookup in the VarEnv with a name
-tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
+tidyNameOcc (_, var_env) n = case lookupUFM_Directly var_env (getUnique n) of
Nothing -> n
Just v -> idName v
=====================================
compiler/GHC/Data/Graph/Color.hs
=====================================
@@ -270,7 +270,7 @@ assignColors colors graph ks
where assignColors' :: UniqFM cls (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
-> Graph k cls color -- ^ the graph
-> [k] -- ^ nodes to assign a color to.
- -> [k] -- ^ Assigned nodes?
+ -> [k]
-> ( Graph k cls color -- the colored graph
, [k])
assignColors' _ graph prob []
=====================================
compiler/GHC/Data/Graph/Ops.hs
=====================================
@@ -645,7 +645,7 @@ checkNode graph node
slurpNodeConflictCount
:: Graph k cls color
- -> UniqFM k (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts)
+ -> UniqFM Unique (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts)
slurpNodeConflictCount graph
= addListToUFM_C_Directly
=====================================
compiler/GHC/Data/TrieMap.hs
=====================================
@@ -33,7 +33,7 @@ import GHC.Prelude
import GHC.Types.Literal
import GHC.Types.Unique.DFM
-import GHC.Types.Unique( Unique )
+import GHC.Types.Unique( Unique, Uniquable )
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
@@ -202,8 +202,8 @@ See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details on how
deterministic.
-}
-instance forall key. TrieMap (UniqDFM key elt) where
- type Key (UniqDFM key elt) = key
+instance forall key. Uniquable key => TrieMap (UniqDFM key) where
+ type Key (UniqDFM key) = key
emptyTM = emptyUDFM
lookupTM k m = lookupUDFM m k
alterTM k f m = alterUDFM f m k
=====================================
compiler/GHC/Types/Literal.hs
=====================================
@@ -63,7 +63,6 @@ import GHC.Types.Basic
import GHC.Utils.Binary
import GHC.Settings.Constants
import GHC.Platform
-import GHC.Types.Name
import GHC.Types.Unique.FM
import GHC.Utils.Misc
=====================================
compiler/GHC/Types/Name.hs-boot
=====================================
@@ -3,4 +3,3 @@ module GHC.Types.Name where
import GHC.Prelude ()
data Name
-data ModuleName
=====================================
compiler/GHC/Types/Var/Env.hs
=====================================
@@ -439,20 +439,24 @@ delTidyEnvList (occ_env, var_env) vs = (occ_env', var_env')
************************************************************************
-}
+-- We would like this to be `UniqFM Var elt`
+-- but the code uses various key types.
+-- So for now make it explicitly untyped
+
-- | Variable Environment
type VarEnv elt = UniqFM Var elt
-- | Identifier Environment
-type IdEnv elt = VarEnv elt
+type IdEnv elt = UniqFM Id elt
-- | Type Variable Environment
-type TyVarEnv elt = VarEnv elt
+type TyVarEnv elt = UniqFM Var elt
-- | Type or Coercion Variable Environment
-type TyCoVarEnv elt = VarEnv elt
+type TyCoVarEnv elt = UniqFM TyCoVar elt
-- | Coercion Variable Environment
-type CoVarEnv elt = VarEnv elt
+type CoVarEnv elt = UniqFM CoVar elt
emptyVarEnv :: VarEnv a
mkVarEnv :: [(Var, a)] -> VarEnv a
=====================================
compiler/GHC/Unit/Module/Env.hs
=====================================
@@ -32,7 +32,7 @@ where
import GHC.Prelude
-import {-# SOURCE #-} GHC.Types.Name (ModuleName)
+import GHC.Unit.Module.Name (ModuleName)
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1730,7 +1730,7 @@ mkModuleNameProvidersMap ctx cfg pkg_map closure vis_map =
in (pk', m', fromReexportedModules e pkg')
return (m, mkModMap pk' m' origin')
- esmap :: UniqFM (Map Module ModuleOrigin)
+ esmap :: UniqFM ModuleName (Map Module ModuleOrigin)
esmap = listToUFM (es False) -- parameter here doesn't matter, orig will
-- be overwritten
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bacf644916012603862b185949c1fee5e5bfde8f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bacf644916012603862b185949c1fee5e5bfde8f
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/20200623/8d0847e5/attachment-0001.html>
More information about the ghc-commits
mailing list