X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fmain%2FTidyPgm.lhs;h=c0ca38a40d183d0ee126ecf36aad3a14241e0612;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hp=6f44bca63a13e74012ead3029727b5a23e16e0d9;hpb=376101055fb111ebd52b5ef1fb76e00334b44304;p=ghc-hetmet.git diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 6f44bca..c0ca38a 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -4,6 +4,13 @@ \section{Tidying up Core} \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module TidyPgm( mkBootModDetails, tidyProgram ) where #include "HsVersions.h" @@ -28,10 +35,7 @@ import IdInfo {- loads of stuff -} import InstEnv ( Instance, DFunId, instanceDFunId, setInstanceDFunId ) import NewDemand ( isBottomingSig, topSig ) import BasicTypes ( Arity, isNeverActive, isNonRuleLoopBreaker ) -import Name ( Name, getOccName, nameOccName, mkInternalName, - localiseName, isExternalName, nameSrcLoc, - isWiredInName, getName - ) +import Name import NameSet ( NameSet, elemNameSet ) import IfaceEnv ( allocateGlobalBinder ) import NameEnv ( filterNameEnv, mapNameEnv ) @@ -124,8 +128,9 @@ mkBootModDetails hsc_env (ModGuts { mg_module = mod , mg_exports = exports , mg_types = type_env , mg_insts = insts - , mg_fam_insts = fam_insts, - mg_dbg_sites = sites }) + , mg_fam_insts = fam_insts + , mg_modBreaks = modBreaks + }) = do { let dflags = hsc_dflags hsc_env ; showPass dflags "Tidy [hoot] type env" @@ -140,7 +145,9 @@ mkBootModDetails hsc_env (ModGuts { mg_module = mod , md_fam_insts = fam_insts , md_rules = [] , md_exports = exports - , md_dbg_sites = sites}) + , md_modBreaks = modBreaks + , md_vect_info = noVectInfo + }) } where @@ -241,10 +248,11 @@ tidyProgram hsc_env 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, - mg_dbg_sites = sites }) + mg_modBreaks = modBreaks }) = do { let dflags = hsc_dflags hsc_env ; showPass dflags "Tidy Core" @@ -303,7 +311,9 @@ tidyProgram hsc_env md_insts = tidy_insts, md_fam_insts = fam_insts, md_exports = exports, - md_dbg_sites = sites }) + md_modBreaks = modBreaks, + md_vect_info = vect_info -- is already tidy + }) } lookup_dfun type_env dfun_id @@ -668,7 +678,7 @@ tidyTopName mod nc_var ext_ids occ_env id global = isExternalName name local = not global internal = not external - loc = nameSrcLoc name + loc = nameSrcSpan name (occ_env', occ') = tidyOccName occ_env (nameOccName name)