X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FTidyPgm.lhs;h=8dabe4ed66b1e56b17f38ca88f0bfe685a4925e7;hp=b001e1d3b3727df853bfc426565b46420bde2cbf;hb=e2782137c799a08711cac0844418cc0345a7ceb5;hpb=cdce647711c0f46f5799b24de087622cb77e647f diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index b001e1d..8dabe4e 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 ) @@ -141,7 +145,7 @@ mkBootModDetails hsc_env (ModGuts { mg_module = mod , md_fam_insts = fam_insts , md_rules = [] , md_exports = exports - , md_modBreaks = modBreaks + , md_vect_info = noVectInfo }) } where @@ -243,6 +247,7 @@ 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, @@ -298,15 +303,16 @@ tidyProgram hsc_env cg_dir_imps = dir_imps, cg_foreign = foreign_stubs, cg_dep_pkgs = dep_pkgs deps, - cg_hpc_info = hpc_info }, + cg_hpc_info = hpc_info, + cg_modBreaks = modBreaks }, ModDetails { md_types = tidy_type_env, md_rules = tidy_rules, md_insts = tidy_insts, md_fam_insts = fam_insts, md_exports = exports, - md_modBreaks = modBreaks }) - + md_vect_info = vect_info -- is already tidy + }) } lookup_dfun type_env dfun_id @@ -671,7 +677,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)