localiseName, isExternalName, nameSrcLoc,
isWiredInName, getName
)
-import NameSet ( NameSet, elemNameSet )
+import NameSet ( NameSet, elemNameSet, filterNameSet )
import IfaceEnv ( allocateGlobalBinder )
import NameEnv ( filterNameEnv, mapNameEnv )
import OccName ( TidyOccEnv, initTidyOccEnv, tidyOccName )
, md_rules = []
, md_exports = exports
, md_modBreaks = modBreaks
+ , md_vect_info = noVectInfo
})
}
where
mg_insts = insts, mg_fam_insts = fam_insts,
mg_binds = binds,
mg_rules = imp_rules,
+ mg_vect_info = vect_info,
mg_dir_imps = dir_imps, mg_deps = deps,
mg_foreign = foreign_stubs,
mg_hpc_info = hpc_info,
; implicit_binds = getImplicitBinds type_env
; all_tidy_binds = implicit_binds ++ tidy_binds
; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
+
+ ; tidy_vect_info = VectInfo
+ (filterNameSet (isElemId type_env)
+ (vectInfoCCVar vect_info))
+ -- filter against `type_env', not `tidy_type_env', as we must
+ -- keep all implicit names
}
; endPass dflags "Tidy Core" Opt_D_dump_simpl all_tidy_binds
md_insts = tidy_insts,
md_fam_insts = fam_insts,
md_exports = exports,
- md_modBreaks = modBreaks })
-
+ md_modBreaks = modBreaks,
+ md_vect_info = tidy_vect_info
+ })
}
lookup_dfun type_env dfun_id
Just (AnId dfun_id') -> dfun_id'
other -> pprPanic "lookup_dfun" (ppr dfun_id)
+isElemId type_env name
+ = case lookupTypeEnv type_env name of
+ Just (AnId _) -> True
+ _ -> False
+
tidyTypeEnv :: Bool -> NameSet -> TypeEnv -> [CoreBind] -> TypeEnv
-- The competed type environment is gotten from