summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/basicTypes/VarEnv.hs14
-rw-r--r--compiler/iface/MkIface.hs2
-rw-r--r--compiler/iface/TcIface.hs2
-rw-r--r--compiler/main/HscTypes.hs6
-rw-r--r--compiler/main/TidyPgm.hs29
-rw-r--r--compiler/simplCore/SimplCore.hs4
-rw-r--r--compiler/vectorise/Vectorise/Env.hs16
m---------libraries/dph0
8 files changed, 40 insertions, 33 deletions
diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs
index ee63e2c3a2..626b5cdd45 100644
--- a/compiler/basicTypes/VarEnv.hs
+++ b/compiler/basicTypes/VarEnv.hs
@@ -27,15 +27,16 @@ module VarEnv (
DVarEnv, DIdEnv, DTyVarEnv,
-- ** Manipulating these environments
- emptyDVarEnv,
+ emptyDVarEnv, mkDVarEnv,
dVarEnvElts,
extendDVarEnv, extendDVarEnv_C,
+ extendDVarEnvList,
lookupDVarEnv,
isEmptyDVarEnv, foldDVarEnv,
mapDVarEnv,
modifyDVarEnv,
alterDVarEnv,
- plusDVarEnv_C,
+ plusDVarEnv, plusDVarEnv_C,
unitDVarEnv,
delDVarEnv,
delDVarEnvList,
@@ -515,6 +516,9 @@ emptyDVarEnv = emptyUDFM
dVarEnvElts :: DVarEnv a -> [a]
dVarEnvElts = eltsUDFM
+mkDVarEnv :: [(Var, a)] -> DVarEnv a
+mkDVarEnv = listToUDFM
+
extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a
extendDVarEnv = addToUDFM
@@ -530,6 +534,9 @@ mapDVarEnv = mapUDFM
alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a
alterDVarEnv = alterUDFM
+plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a
+plusDVarEnv = plusUDFM
+
plusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a
plusDVarEnv_C = plusUDFM_C
@@ -557,5 +564,8 @@ modifyDVarEnv mangle_fn env key
partitionDVarEnv :: (a -> Bool) -> DVarEnv a -> (DVarEnv a, DVarEnv a)
partitionDVarEnv = partitionUDFM
+extendDVarEnvList :: DVarEnv a -> [(Var, a)] -> DVarEnv a
+extendDVarEnvList = addListToUDFM
+
anyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool
anyDVarEnv = anyUDFM
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index d6a70e4d43..9ebc03c143 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -324,7 +324,7 @@ mkIface_ hsc_env maybe_old_fingerprint
, vectInfoParallelTyCons = vParallelTyCons
}) =
IfaceVectInfo
- { ifaceVectInfoVar = [Var.varName v | (v, _ ) <- varEnvElts vVar]
+ { ifaceVectInfoVar = [Var.varName v | (v, _ ) <- dVarEnvElts vVar]
, ifaceVectInfoTyCon = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t /= t_v]
, ifaceVectInfoTyConReuse = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t == t_v]
, ifaceVectInfoParallelVars = [Var.varName v | v <- dVarSetElems vParallelVars]
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 1f83221725..f366c516cd 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -783,7 +783,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
; vParallelVars <- mapM vectVar parallelVars
; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2)
; return $ VectInfo
- { vectInfoVar = mkVarEnv vVars `extendVarEnvList` concat vScSels
+ { vectInfoVar = mkDVarEnv vVars `extendDVarEnvList` concat vScSels
, vectInfoTyCon = mkNameEnv vTyCons
, vectInfoDataCon = mkNameEnv (concat vDataCons)
, vectInfoParallelVars = mkDVarSet vParallelVars
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index b71e8ae6e6..99c51cd328 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -2640,7 +2640,7 @@ on just the OccName easily in a Core pass.
--
data VectInfo
= VectInfo
- { vectInfoVar :: VarEnv (Var , Var ) -- ^ @(f, f_v)@ keyed on @f@
+ { vectInfoVar :: DVarEnv (Var , Var ) -- ^ @(f, f_v)@ keyed on @f@
, vectInfoTyCon :: NameEnv (TyCon , TyCon) -- ^ @(T, T_v)@ keyed on @T@
, vectInfoDataCon :: NameEnv (DataCon, DataCon) -- ^ @(C, C_v)@ keyed on @C@
, vectInfoParallelVars :: DVarSet -- ^ set of parallel variables
@@ -2674,11 +2674,11 @@ data IfaceVectInfo
noVectInfo :: VectInfo
noVectInfo
- = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyDVarSet emptyNameSet
+ = VectInfo emptyDVarEnv emptyNameEnv emptyNameEnv emptyDVarSet emptyNameSet
plusVectInfo :: VectInfo -> VectInfo -> VectInfo
plusVectInfo vi1 vi2 =
- VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
+ VectInfo (vectInfoVar vi1 `plusDVarEnv` vectInfoVar vi2)
(vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
(vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
(vectInfoParallelVars vi1 `unionDVarSet` vectInfoParallelVars vi2)
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index c02c786ed5..915cd12450 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -57,7 +57,7 @@ import Maybes
import UniqSupply
import ErrUtils (Severity(..))
import Outputable
-import UniqFM
+import UniqDFM
import SrcLoc
import qualified ErrUtils as Err
@@ -484,17 +484,14 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars
where
-- we only export mappings whose domain and co-domain is exported (otherwise, the iface is
-- inconsistent)
- tidy_vars = mkVarEnv [ (tidy_var, (tidy_var, tidy_var_v))
- | (var, var_v) <- nonDetEltsUFM vars
- -- It's OK to use nonDetEltsUFM here because we
- -- immediately forget the ordering by creating
- -- a new env
- , let tidy_var = lookup_var var
- tidy_var_v = lookup_var var_v
- , isExternalId tidy_var && isExportedId tidy_var
- , isExternalId tidy_var_v && isExportedId tidy_var_v
- , isDataConWorkId var || not (isImplicitId var)
- ]
+ tidy_vars = mkDVarEnv [ (tidy_var, (tidy_var, tidy_var_v))
+ | (var, var_v) <- eltsUDFM vars
+ , let tidy_var = lookup_var var
+ tidy_var_v = lookup_var var_v
+ , isExternalId tidy_var && isExportedId tidy_var
+ , isExternalId tidy_var_v && isExportedId tidy_var_v
+ , isDataConWorkId var || not (isImplicitId var)
+ ]
tidy_parallelVars = mkDVarSet
[ tidy_var
@@ -625,7 +622,7 @@ chooseExternalIds :: HscEnv
-> [CoreBind]
-> [CoreBind]
-> [CoreRule]
- -> VarEnv (Var, Var)
+ -> DVarEnv (Var, Var)
-> IO (UnfoldEnv, TidyOccEnv)
-- Step 1 from the notes above
@@ -662,9 +659,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
isJust $ collectStaticPtrSatArgs e
rule_rhs_vars = mapUnionVarSet ruleRhsFreeVars imp_id_rules
- vect_var_vs = mkVarSet [var_v | (var, var_v) <- nonDetEltsUFM vect_vars, isGlobalId var]
- -- It's OK to use nonDetEltsUFM here because we immediately forget the
- -- ordering by creating a set
+ vect_var_vs = mkVarSet [var_v | (var, var_v) <- eltsUDFM vect_vars, isGlobalId var]
flatten_binds = flattenBinds binds
binders = map fst flatten_binds
@@ -716,7 +711,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_
| otherwise = addExternal expose_all refined_id
-- add vectorised version if any exists
- new_ids' = new_ids ++ maybeToList (fmap snd $ lookupVarEnv vect_vars idocc)
+ new_ids' = new_ids ++ maybeToList (fmap snd $ lookupDVarEnv vect_vars idocc)
-- 'idocc' is an *occurrence*, but we need to see the
-- unfolding in the *definition*; so look up in binder_set
diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs
index 29035c87bb..8bc03929f0 100644
--- a/compiler/simplCore/SimplCore.hs
+++ b/compiler/simplCore/SimplCore.hs
@@ -659,10 +659,10 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
-- (In contrast to automatically vectorised variables, their unvectorised versions
-- don't depend on them.)
vectVars = mkVarSet $
- catMaybes [ fmap snd $ lookupVarEnv (vectInfoVar (mg_vect_info guts)) bndr
+ catMaybes [ fmap snd $ lookupDVarEnv (vectInfoVar (mg_vect_info guts)) bndr
| Vect bndr _ <- mg_vect_decls guts]
++
- catMaybes [ fmap snd $ lookupVarEnv (vectInfoVar (mg_vect_info guts)) bndr
+ catMaybes [ fmap snd $ lookupDVarEnv (vectInfoVar (mg_vect_info guts)) bndr
| bndr <- bindersOfBinds binds]
-- FIXME: This second comprehensions is only needed as long as we
-- have vectorised bindings where we get "Could NOT call
diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs
index e4ab79eed7..faaad69ba7 100644
--- a/compiler/vectorise/Vectorise/Env.hs
+++ b/compiler/vectorise/Vectorise/Env.hs
@@ -149,7 +149,7 @@ initGlobalEnv :: Bool
initGlobalEnv vectAvoid info vectDecls instEnvs famInstEnvs
= GlobalEnv
{ global_vect_avoid = vectAvoid
- , global_vars = mapVarEnv snd $ vectInfoVar info
+ , global_vars = mapVarEnv snd $ udfmToUfm $ vectInfoVar info
, global_vect_decls = mkVarEnv vects
, global_parallel_vars = vectInfoParallelVars info
, global_parallel_tycons = vectInfoParallelTyCons info
@@ -206,7 +206,7 @@ setPRFunsEnv ps genv = genv { global_pr_funs = mkNameEnv ps }
modVectInfo :: GlobalEnv -> [Id] -> [TyCon] -> [CoreVect]-> VectInfo -> VectInfo
modVectInfo env mg_ids mg_tyCons vectDecls info
= info
- { vectInfoVar = mk_env ids (global_vars env)
+ { vectInfoVar = mk_denv ids (global_vars env)
, vectInfoTyCon = mk_env tyCons (global_tycons env)
, vectInfoDataCon = mk_env dataCons (global_datacons env)
, vectInfoParallelVars = (global_parallel_vars env `minusDVarSet` vectInfoParallelVars info)
@@ -228,8 +228,10 @@ modVectInfo env mg_ids mg_tyCons vectDecls info
, cls <- maybeToList . tyConClass_maybe $ tycon]
-- Produce an entry for every declaration that is mentioned in the domain of the 'inspectedEnv'
- mk_env decls inspectedEnv
- = mkNameEnv [(name, (decl, to))
- | decl <- decls
- , let name = getName decl
- , Just to <- [lookupNameEnv inspectedEnv name]]
+ mk_env decls inspectedEnv = mkNameEnv $ mk_assoc_env decls inspectedEnv
+ mk_denv decls inspectedEnv = listToUDFM $ mk_assoc_env decls inspectedEnv
+ mk_assoc_env decls inspectedEnv
+ = [(name, (decl, to))
+ | decl <- decls
+ , let name = getName decl
+ , Just to <- [lookupNameEnv inspectedEnv name]]
diff --git a/libraries/dph b/libraries/dph
-Subproject 33eb2fb7e178c18f2afd0d537d791d021ff7523
+Subproject 64eca669f13f4d216af9024474a3fc73ce10179
View Lorry Controller Status