diff options
| author | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2013-02-15 12:09:30 +1100 |
|---|---|---|
| committer | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2013-02-15 13:19:38 +1100 |
| commit | 16389d13d252a7a173095478dd3a393b3f69b475 (patch) | |
| tree | b501f322611ea52f1e07f0e76da4b97f76be9798 | |
| parent | c043732145c274476f904d9b4387740b2a47b401 (diff) | |
| download | haskell-16389d13d252a7a173095478dd3a393b3f69b475.tar.gz | |
Another go at tidying VectInfo
* Test: dph/modules/ExportList
| -rw-r--r-- | compiler/main/TidyPgm.lhs | 9 | ||||
| -rw-r--r-- | compiler/simplCore/SimplCore.lhs | 6 |
2 files changed, 12 insertions, 3 deletions
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index d49d43702b..72b887a588 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -459,18 +459,21 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars | (var, var_v) <- varEnvElts vars , let tidy_var = lookup_var var tidy_var_v = lookup_var var_v - , isExportedId tidy_var - , isExternalId tidy_var_v + , isExternalId tidy_var && isExportedId tidy_var + , isExternalId tidy_var_v && isExportedId tidy_var_v , isDataConWorkId var || not (isImplicitId var) ] tidy_parallelVars = mkVarSet [ tidy_var | var <- varSetElems parallelVars , let tidy_var = lookup_var var - , isExternalId tidy_var] + , isExternalId tidy_var && isExportedId tidy_var + ] lookup_var var = lookupWithDefaultVarEnv var_env var var + -- We need to make sure that all names getting into the iface version of 'VectInfo' are + -- external; otherwise, 'MkIface' will bomb out. isExternalId = isExternalName . idName \end{code} diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 6e01f9647a..62a546de96 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -621,6 +621,12 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) vectVars = mkVarSet $ catMaybes [ fmap snd $ lookupVarEnv (vectInfoVar (mg_vect_info guts)) bndr | Vect bndr _ <- mg_vect_decls guts] + ++ + catMaybes [ fmap snd $ lookupVarEnv (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 + -- vectorised from original version". ; (maybeVects, maybeVectVars) = case sm_phase mode of InitialPhase -> (mg_vect_decls guts, vectVars) |